Mercurial > emacs
annotate lisp/international/mule-util.el @ 23192:1ea9db09a678
(checkdoc-buffer-label): New function.
(checkdoc-start-section, checkdoc-error): Use `checkdoc-buffer-label'.
(checkdoc-this-string-valid-engine): Permit ? as terminating
punctuation for first line sentence breaking.
(checkdoc-this-string-valid): When converting a comment into a doc
string, make sure " chars are \".
(checkdoc-sentencespace-region-engine): Only do double space check
if based on the variable `sentence-end-double-space'
author | Eric M. Ludlam <zappo@gnu.org> |
---|---|
date | Sat, 05 Sep 1998 13:46:23 +0000 |
parents | 205a87f52b30 |
children | 30beacf88b75 |
rev | line source |
---|---|
17052 | 1 ;;; mule-util.el --- Utility functions for mulitilingual environment (mule) |
2 | |
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
18377
8b4a66c66dd6
Change copyright notice.
Richard M. Stallman <rms@gnu.org>
parents:
18313
diff
changeset
|
4 ;; Licensed to the Free Software Foundation. |
17052 | 5 |
6 ;; Keywords: mule, multilingual | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
17071 | 21 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
17052 | 24 |
25 ;;; Code: | |
26 | |
27 ;;; String manipulations while paying attention to multibyte | |
28 ;;; characters. | |
29 | |
30 ;;;###autoload | |
31 (defun string-to-sequence (string type) | |
32 "Convert STRING to a sequence of TYPE which contains characters in STRING. | |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
33 TYPE should be `list' or `vector'." |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
34 (let ((len (length string)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
35 (i 0) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
36 val) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
37 (cond ((eq type 'list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
38 (setq val (make-list len 0)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
39 (let ((l val)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
40 (while (< i len) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
41 (setcar l (aref string i)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
42 (setq l (cdr l) i (1+ i))))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
43 ((eq type 'vector) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
44 (setq val (make-vector len 0)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
45 (while (< i len) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
46 (aset val i (aref string i)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
47 (setq i (1+ i)))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
48 (t |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
49 (error "Invalid type: %s" type))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
50 val)) |
17052 | 51 |
52 ;;;###autoload | |
53 (defsubst string-to-list (string) | |
54 "Return a list of characters in STRING." | |
55 (string-to-sequence string 'list)) | |
56 | |
57 ;;;###autoload | |
58 (defsubst string-to-vector (string) | |
59 "Return a vector of characters in STRING." | |
60 (string-to-sequence string 'vector)) | |
61 | |
62 ;;;###autoload | |
63 (defun store-substring (string idx obj) | |
64 "Embed OBJ (string or character) at index IDX of STRING." | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
65 (if (integerp obj) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
66 (aset string idx obj) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
67 (let ((len1 (length obj)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
68 (len2 (length string)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
69 (i 0)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
70 (while (< i len1) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
71 (aset string (+ idx i) (aref obj i)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
72 (setq i (1+ i))))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
73 string) |
17052 | 74 |
75 ;;;###autoload | |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
76 (defun truncate-string-to-width (str end-column &optional start-column padding) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
77 "Truncate string STR to end at column END-COLUMN. |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
78 The optional 2nd arg START-COLUMN, if non-nil, specifies |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
79 the starting column; that means to return the characters occupying |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
80 columns START-COLUMN ... END-COLUMN of STR. |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
81 |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
82 The optional 3rd arg PADDING, if non-nil, specifies a padding character |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
83 to add at the end of the result if STR doesn't reach column END-COLUMN, |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
84 or if END-COLUMN comes in the middle of a character in STR. |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
85 PADDING is also added at the beginning of the result |
19928
7e4718c779b2
(truncate-string-to-width): Doc typo fix.
Richard M. Stallman <rms@gnu.org>
parents:
19916
diff
changeset
|
86 if column START-COLUMN appears in the middle of a character in STR. |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
87 |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
88 If PADDING is nil, no padding is added in these cases, so |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
89 the resulting string may be narrower than END-COLUMN." |
17052 | 90 (or start-column |
91 (setq start-column 0)) | |
92 (let ((len (length str)) | |
93 (idx 0) | |
94 (column 0) | |
95 (head-padding "") (tail-padding "") | |
96 ch last-column last-idx from-idx) | |
97 (condition-case nil | |
98 (while (< column start-column) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
99 (setq ch (aref str idx) |
17052 | 100 column (+ column (char-width ch)) |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
101 idx (1+ idx))) |
17052 | 102 (args-out-of-range (setq idx len))) |
103 (if (< column start-column) | |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
104 (if padding (make-string end-column padding) "") |
17052 | 105 (if (and padding (> column start-column)) |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
106 (setq head-padding (make-string (- column start-column) padding))) |
17052 | 107 (setq from-idx idx) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
108 (if (< end-column column) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
109 (setq idx from-idx) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
110 (condition-case nil |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
111 (while (< column end-column) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
112 (setq last-column column |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
113 last-idx idx |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
114 ch (aref str idx) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
115 column (+ column (char-width ch)) |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
116 idx (1+ idx))) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
117 (args-out-of-range (setq idx len))) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
118 (if (> column end-column) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
119 (setq column last-column idx last-idx)) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
120 (if (and padding (< column end-column)) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
121 (setq tail-padding (make-string (- end-column column) padding)))) |
17052 | 122 (setq str (substring str from-idx idx)) |
123 (if padding | |
124 (concat head-padding str tail-padding) | |
125 str)))) | |
126 | |
127 ;;; For backward compatiblity ... | |
128 ;;;###autoload | |
129 (defalias 'truncate-string 'truncate-string-to-width) | |
130 (make-obsolete 'truncate-string 'truncate-string-to-width) | |
131 | |
132 ;;; Nested alist handler. Nested alist is alist whose elements are | |
133 ;;; also nested alist. | |
134 | |
135 ;;;###autoload | |
136 (defsubst nested-alist-p (obj) | |
137 "Return t if OBJ is a nesetd alist. | |
138 | |
139 Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is | |
140 any Lisp object, and BRANCHES is a list of cons cells of the form | |
141 (KEY-ELEMENT . NESTED-ALIST). | |
142 | |
143 You can use a nested alist to store any Lisp object (ENTRY) for a key | |
144 sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ | |
145 can be a string, a vector, or a list." | |
146 (and obj (listp obj) (listp (cdr obj)))) | |
147 | |
148 ;;;###autoload | |
149 (defun set-nested-alist (keyseq entry alist &optional len branches) | |
150 "Set ENTRY for KEYSEQ in a nested alist ALIST. | |
151 Optional 4th arg LEN non-nil means the firlst LEN elements in KEYSEQ | |
152 is considered. | |
153 Optional argument BRANCHES if non-nil is branches for a keyseq | |
154 longer than KEYSEQ. | |
155 See the documentation of `nested-alist-p' for more detail." | |
156 (or (nested-alist-p alist) | |
157 (error "Invalid arguement %s" alist)) | |
158 (let ((islist (listp keyseq)) | |
159 (len (or len (length keyseq))) | |
160 (i 0) | |
161 key-elt slot) | |
162 (while (< i len) | |
163 (if (null (nested-alist-p alist)) | |
164 (error "Keyseq %s is too long for this nested alist" keyseq)) | |
165 (setq key-elt (if islist (nth i keyseq) (aref keyseq i))) | |
166 (setq slot (assoc key-elt (cdr alist))) | |
167 (if (null slot) | |
168 (progn | |
169 (setq slot (cons key-elt (list t))) | |
170 (setcdr alist (cons slot (cdr alist))))) | |
171 (setq alist (cdr slot)) | |
172 (setq i (1+ i))) | |
173 (setcar alist entry) | |
174 (if branches | |
175 (if (cdr alist) | |
176 (error "Can't set branches for keyseq %s" keyseq) | |
177 (setcdr alist branches))))) | |
178 | |
179 ;;;###autoload | |
180 (defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long) | |
181 "Look up key sequence KEYSEQ in nested alist ALIST. Return the definition. | |
182 Optional 1st argument LEN specifies the length of KEYSEQ. | |
183 Optional 2nd argument START specifies index of the starting key. | |
184 The returned value is normally a nested alist of which | |
185 car part is the entry for KEYSEQ. | |
186 If ALIST is not deep enough for KEYSEQ, return number which is | |
187 how many key elements at the front of KEYSEQ it takes | |
188 to reach a leaf in ALIST. | |
189 Optional 3rd argument NIL-FOR-TOO-LONG non-nil means return nil | |
190 even if ALIST is not deep enough." | |
191 (or (nested-alist-p alist) | |
192 (error "invalid arguement %s" alist)) | |
193 (or len | |
194 (setq len (length keyseq))) | |
195 (let ((i (or start 0))) | |
196 (if (catch 'lookup-nested-alist-tag | |
197 (if (listp keyseq) | |
198 (while (< i len) | |
199 (if (setq alist (cdr (assoc (nth i keyseq) (cdr alist)))) | |
200 (setq i (1+ i)) | |
201 (throw 'lookup-nested-alist-tag t)))) | |
202 (while (< i len) | |
203 (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist)))) | |
204 (setq i (1+ i)) | |
205 (throw 'lookup-nested-alist-tag t)))) | |
206 ;; KEYSEQ is too long. | |
207 (if nil-for-too-long nil i) | |
208 alist))) | |
209 | |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
210 |
17052 | 211 ;; Coding system related functions. |
212 | |
213 ;;;###autoload | |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
214 (defun coding-system-eol-type-mnemonic (coding-system) |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
215 "Return mnemonic letter of eol-type of CODING-SYSTEM." |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
216 (let ((eol-type (coding-system-eol-type coding-system))) |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
217 (cond ((vectorp eol-type) eol-mnemonic-undecided) |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
218 ((eq eol-type 0) eol-mnemonic-unix) |
21488
2c0815a83862
(coding-system-eol-type-mnemonic): Return correct eol-type mnemonics
Eli Zaretskii <eliz@gnu.org>
parents:
20841
diff
changeset
|
219 ((eq eol-type 1) eol-mnemonic-dos) |
2c0815a83862
(coding-system-eol-type-mnemonic): Return correct eol-type mnemonics
Eli Zaretskii <eliz@gnu.org>
parents:
20841
diff
changeset
|
220 ((eq eol-type 2) eol-mnemonic-mac) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
221 (t ?-)))) |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
222 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
223 ;;;###autoload |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
224 (defun coding-system-post-read-conversion (coding-system) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
225 "Return the value of CODING-SYSTEM's post-read-conversion property." |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
226 (coding-system-get coding-system 'post-read-conversion)) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
227 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
228 ;;;###autoload |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
229 (defun coding-system-pre-write-conversion (coding-system) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
230 "Return the value of CODING-SYSTEM's pre-write-conversion property." |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
231 (coding-system-get coding-system 'pre-write-conversion)) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
232 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
233 ;;;###autoload |
22126
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
234 (defun coding-system-translation-table-for-decode (coding-system) |
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
235 "Return the value of CODING-SYSTEM's translation-table-for-decode property." |
22186
fc4aaf1b1772
Change term "character translation table" to "translation table".
Kenichi Handa <handa@m17n.org>
parents:
22126
diff
changeset
|
236 (coding-system-get coding-system 'translation-table-for-decode)) |
19455
7cf3d42a6fd7
(coding-system-unification-table):
Kenichi Handa <handa@m17n.org>
parents:
19264
diff
changeset
|
237 |
7cf3d42a6fd7
(coding-system-unification-table):
Kenichi Handa <handa@m17n.org>
parents:
19264
diff
changeset
|
238 ;;;###autoload |
22126
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
239 (defun coding-system-translation-table-for-encode (coding-system) |
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
240 "Return the value of CODING-SYSTEM's translation-table-for-encode property." |
22186
fc4aaf1b1772
Change term "character translation table" to "translation table".
Kenichi Handa <handa@m17n.org>
parents:
22126
diff
changeset
|
241 (coding-system-get coding-system 'translation-table-for-encode)) |
17052 | 242 |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
243 (defun coding-system-lessp (x y) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
244 (cond ((eq x 'no-conversion) t) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
245 ((eq y 'no-conversion) nil) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
246 ((eq x 'emacs-mule) t) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
247 ((eq y 'emacs-mule) nil) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
248 ((eq x 'undecided) t) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
249 ((eq y 'undecided) nil) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
250 (t (let ((c1 (coding-system-mnemonic x)) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
251 (c2 (coding-system-mnemonic y))) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
252 (or (< (downcase c1) (downcase c2)) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
253 (and (not (> (downcase c1) (downcase c2))) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
254 (< c1 c2))))))) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
255 |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
256 ;;;###autoload |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
257 (defun coding-system-list (&optional base-only) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
258 "Return a list of all existing coding systems. |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
259 If optional arg BASE-ONLY is non-nil, only base coding systems are listed." |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
260 (let* ((codings (sort (copy-sequence coding-system-list) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
261 'coding-system-lessp)) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
262 (tail (cons nil codings))) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
263 ;; Remove subsidiary coding systems (eol variants) and alias |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
264 ;; coding systems (if necessary). |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
265 (while (cdr tail) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
266 (let* ((coding (car (cdr tail))) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
267 (aliases (coding-system-get coding 'alias-coding-systems))) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
268 (if (or |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
269 ;; CODING is an eol varinant if not in ALIASES. |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
270 (not (memq coding aliases)) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
271 ;; CODING is an alias if it is not car of ALISES. |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
272 (and base-only (not (eq coding (car aliases))))) |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
273 (setcdr tail (cdr (cdr tail))) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
274 (setq tail (cdr tail))))) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
275 codings)) |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
276 |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
277 ;;;###autoload |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
278 (defun coding-system-equal (coding-system-1 coding-system-2) |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
279 "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical. |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
280 Two coding systems are identical if two symbols are equal |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
281 or one is an alias of the other." |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
282 (or (eq coding-system-1 coding-system-2) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
283 (and (equal (coding-system-spec coding-system-1) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
284 (coding-system-spec coding-system-2)) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
285 (let ((eol-type-1 (coding-system-eol-type coding-system-1)) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
286 (eol-type-2 (coding-system-eol-type coding-system-2))) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
287 (or (eq eol-type-1 eol-type-2) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
288 (and (vectorp eol-type-1) (vectorp eol-type-2))))))) |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
289 |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
290 ;;;###autoload |
21554
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
291 (defun coding-system-change-eol-conversion (coding-system eol-type) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
292 "Return a coding system which differs from CODING-SYSTEM in eol conversion. |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
293 The returned coding system converts end-of-line by EOL-TYPE |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
294 but text as the same way as CODING-SYSTEM. |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
295 EOL-TYPE should be `unix', `dos', `mac', or nil. |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
296 If EOL-TYPE is nil, the returned coding system detects |
22814
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
297 how end-of-line is formatted automatically while decoding. |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
298 |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
299 EOL-TYPE can be specified by an integer 0, 1, or 2. |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
300 They means `unix', `dos', and `mac' respectively." |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
301 (if (symbolp eol-type) |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
302 (setq eol-type (cond ((eq eol-type 'unix) 0) |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
303 ((eq eol-type 'dos) 1) |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
304 ((eq eol-type 'mac) 2) |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
305 (t eol-type)))) |
205a87f52b30
(coding-system-change-eol-conversion): Make it accepts an integer
Kenichi Handa <handa@m17n.org>
parents:
22186
diff
changeset
|
306 (let ((orig-eol-type (coding-system-eol-type coding-system))) |
21554
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
307 (if (vectorp orig-eol-type) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
308 (if (not eol-type) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
309 coding-system |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
310 (aref orig-eol-type eol-type)) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
311 (let ((base (coding-system-base coding-system))) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
312 (if (not eol-type) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
313 base |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
314 (if (= eol-type orig-eol-type) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
315 coding-system |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
316 (setq orig-eol-type (coding-system-eol-type base)) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
317 (if (vectorp orig-eol-type) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
318 (aref orig-eol-type eol-type)))))))) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
319 |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
320 ;;;###autoload |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
321 (defun coding-system-change-text-conversion (coding-system coding) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
322 "Return a coding system which differs from CODING-SYSTEM in text conversion. |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
323 The returned coding system converts text by CODING |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
324 but end-of-line as the same way as CODING-SYSTEM. |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
325 If CODING is nil, the returned coding system detects |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
326 how text is formatted automatically while decoding." |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
327 (if (not coding) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
328 (coding-system-base coding-system) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
329 (let ((eol-type (coding-system-eol-type coding-system))) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
330 (coding-system-change-eol-conversion |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
331 coding |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
332 (if (numberp eol-type) (aref [unix dos mac] eol-type)))))) |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
333 |
90119d523093
(coding-system-change-eol-coding): New function.
Kenichi Handa <handa@m17n.org>
parents:
21488
diff
changeset
|
334 ;;;###autoload |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
335 (defmacro detect-coding-with-priority (from to priority-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
336 "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
337 PRIORITY-LIST is an alist of coding categories vs the corresponding |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
338 coding systems ordered by priority." |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
339 `(let* ((prio-list ,priority-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
340 (coding-category-list coding-category-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
341 ,@(mapcar (function (lambda (x) (list x x))) coding-category-list)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
342 (mapcar (function (lambda (x) (set (car x) (cdr x)))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
343 prio-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
344 (set-coding-priority (mapcar (function (lambda (x) (car x))) prio-list)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
345 (detect-coding-region ,from ,to))) |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
346 |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
347 ;;;###autoload |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
348 (defun detect-coding-with-language-environment (from to lang-env) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
349 "Detect a coding system of the text between FROM and TO with LANG-ENV. |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
350 The detection takes into accont the coding system priorities for the |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
351 language environment LANG-ENV." |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
352 (let ((coding-priority (get-language-info lang-env 'coding-priority))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
353 (if coding-priority |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
354 (detect-coding-with-priority |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
355 from to |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
356 (mapcar (function (lambda (x) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
357 (cons (coding-system-get x 'coding-category) x))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
358 coding-priority)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
359 (detect-coding-region from to)))) |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
360 |
17052 | 361 |
362 ;;; Composite charcater manipulations. | |
363 | |
364 ;;;###autoload | |
365 (defun compose-region (start end) | |
366 "Compose all characters in the current region into one composite character. | |
367 When called from a program, expects two arguments, | |
368 positions (integers or markers) specifying the region." | |
369 (interactive "r") | |
370 (save-excursion | |
371 (let ((str (buffer-substring start end))) | |
372 (goto-char start) | |
373 (delete-region start end) | |
374 (insert (compose-string str))))) | |
375 | |
376 ;;;###autoload | |
377 (defun decompose-region (start end) | |
378 "Decompose all composite characters in the current region. | |
379 Composite characters are broken up into individual components. | |
380 When called from a program, expects two arguments, | |
381 positions (integers or markers) specifying the region." | |
382 (interactive "r") | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
383 (save-excursion |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
384 (save-restriction |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
385 (narrow-to-region start end) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
386 (goto-char (point-min)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
387 (while (not (eobp)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
388 (let ((ch (following-char))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
389 (if (>= ch min-composite-char) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
390 (progn |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
391 (delete-char 1) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
392 (insert (decompose-composite-char ch))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
393 (forward-char 1))))))) |
17052 | 394 |
395 ;;;###autoload | |
19264
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
396 (defun decompose-string (string) |
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
397 "Decompose all composite characters in STRING." |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
398 (let ((len (length string)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
399 (idx 0) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
400 (i 0) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
401 (str-list nil) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
402 ch) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
403 (while (< idx len) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
404 (setq ch (aref string idx)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
405 (if (>= ch min-composite-char) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
406 (progn |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
407 (if (> idx i) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
408 (setq str-list (cons (substring string i idx) str-list))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
409 (setq str-list (cons (decompose-composite-char ch) str-list)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
410 (setq i (1+ idx)))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
411 (setq idx (1+ idx))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
412 (if (not str-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
413 (copy-sequence string) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
414 (if (> idx i) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
415 (setq str-list (cons (substring string i idx) str-list))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
416 (apply 'concat (nreverse str-list))))) |
19264
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
417 |
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
418 ;;;###autoload |
17052 | 419 (defconst reference-point-alist |
420 '((tl . 0) (tc . 1) (tr . 2) | |
421 (ml . 3) (mc . 4) (mr . 5) | |
422 (bl . 6) (bc . 7) (br . 8) | |
423 (top-left . 0) (top-center . 1) (top-right . 2) | |
424 (mid-left . 3) (mid-center . 4) (mid-right . 5) | |
425 (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) | |
426 (0 . 0) (1 . 1) (2 . 2) | |
427 (3 . 3) (4 . 4) (5 . 5) | |
428 (6 . 6) (7 . 7) (8 . 8)) | |
429 "Alist of reference point symbols vs reference point codes. | |
19048
65112b3cc989
(reference-point-alist): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
19016
diff
changeset
|
430 A reference point symbol is to be used to specify a composition rule |
65112b3cc989
(reference-point-alist): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
19016
diff
changeset
|
431 while making a composite character by the function `compose-chars' |
65112b3cc989
(reference-point-alist): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
19016
diff
changeset
|
432 (which see). |
65112b3cc989
(reference-point-alist): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
19016
diff
changeset
|
433 |
17052 | 434 Meanings of reference point codes are as follows: |
435 | |
436 0----1----2 <-- ascent 0:tl or top-left | |
437 | | 1:tc or top-center | |
438 | | 2:tr or top-right | |
439 | | 3:ml or mid-left | |
440 | 4 <--+---- center 4:mc or mid-center | |
441 | | 5:mr or mid-right | |
442 --- 3 5 <-- baseline 6:bl or bottom-left | |
443 | | 7:bc or bottom-center | |
444 6----7----8 <-- descent 8:br or bottom-right | |
445 | |
446 Reference point symbols are to be used to specify composition rule of | |
447 the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where GLOBAL-REF-POINT | |
448 is a reference point in the overall glyphs already composed, and | |
449 NEW-REF-POINT is a reference point in the new glyph to be added. | |
450 | |
451 For instance, if GLOBAL-REF-POINT is 8 and NEW-REF-POINT is 1, the | |
452 overall glyph is updated as follows: | |
453 | |
454 +-------+--+ <--- new ascent | |
455 | | | | |
456 | global| | | |
457 | glyph | | | |
458 --- | | | <--- baseline (doesn't change) | |
459 +----+--+--+ | |
460 | | new | | |
461 | |glyph| | |
462 +----+-----+ <--- new descent | |
463 ") | |
464 | |
465 ;; Return a string for char CH to be embedded in multibyte form of | |
466 ;; composite character. | |
467 (defun compose-chars-component (ch) | |
468 (if (< ch 128) | |
469 (format "\240%c" (+ ch 128)) | |
20841
ef5fd882ca63
(compose-chars-component): Return
Kenichi Handa <handa@m17n.org>
parents:
20730
diff
changeset
|
470 (let ((str (string-as-unibyte (char-to-string ch)))) |
17052 | 471 (if (cmpcharp ch) |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
472 (substring str (if (= (aref str 1) ?\xFF) 2 1)) |
17052 | 473 (aset str 0 (+ (aref str 0) ?\x20)) |
474 str)))) | |
475 | |
476 ;; Return a string for composition rule RULE to be embedded in | |
477 ;; multibyte form of composite character. | |
478 (defsubst compose-chars-rule (rule) | |
479 (char-to-string (+ ?\xA0 | |
480 (* (cdr (assq (car rule) reference-point-alist)) 9) | |
481 (cdr (assq (cdr rule) reference-point-alist))))) | |
482 | |
483 ;;;###autoload | |
484 (defun compose-chars (first-component &rest args) | |
485 "Return one char string composed from the arguments. | |
486 Each argument is a character (including a composite chararacter) | |
487 or a composition rule. | |
488 A composition rule has the form \(GLOBAL-REF-POINT . NEW-REF-POINT). | |
489 See the documentation of `reference-point-alist' for more detail." | |
490 (if (= (length args) 0) | |
491 (char-to-string first-component) | |
492 (let* ((with-rule (consp (car args))) | |
493 (str (if with-rule (concat (vector leading-code-composition ?\xFF)) | |
494 (char-to-string leading-code-composition)))) | |
495 (setq str (concat str (compose-chars-component first-component))) | |
496 (while args | |
497 (if with-rule | |
498 (progn | |
499 (if (not (consp (car args))) | |
500 (error "Invalid composition rule: %s" (car args))) | |
501 (setq str (concat str (compose-chars-rule (car args)) | |
502 (compose-chars-component (car (cdr args)))) | |
503 args (cdr (cdr args)))) | |
504 (setq str (concat str (compose-chars-component (car args))) | |
505 args (cdr args)))) | |
20841
ef5fd882ca63
(compose-chars-component): Return
Kenichi Handa <handa@m17n.org>
parents:
20730
diff
changeset
|
506 (string-as-multibyte str)))) |
17052 | 507 |
508 ;;;###autoload | |
509 (defun decompose-composite-char (char &optional type with-composition-rule) | |
20841
ef5fd882ca63
(compose-chars-component): Return
Kenichi Handa <handa@m17n.org>
parents:
20730
diff
changeset
|
510 "Convert composite character CHAR to a sequence of the components. |
17052 | 511 Optional 1st arg TYPE specifies the type of sequence returned. |
512 It should be `string' (default), `list', or `vector'. | |
513 Optional 2nd arg WITH-COMPOSITION-RULE non-nil means the returned | |
514 sequence contains embedded composition rules if any. In this case, the | |
515 order of elements in the sequence is the same as arguments for | |
516 `compose-chars' to create CHAR. | |
517 If TYPE is omitted or is `string', composition rules are omitted | |
518 even if WITH-COMPOSITION-RULE is t." | |
519 (or type | |
520 (setq type 'string)) | |
521 (let* ((len (composite-char-component-count char)) | |
522 (i (1- len)) | |
523 l) | |
524 (setq with-composition-rule (and with-composition-rule | |
525 (not (eq type 'string)) | |
526 (composite-char-composition-rule-p char))) | |
527 (while (> i 0) | |
528 (setq l (cons (composite-char-component char i) l)) | |
529 (if with-composition-rule | |
530 (let ((rule (- (composite-char-composition-rule char i) ?\xA0))) | |
531 (setq l (cons (cons (/ rule 9) (% rule 9)) l)))) | |
532 (setq i (1- i))) | |
533 (setq l (cons (composite-char-component char 0) l)) | |
534 (cond ((eq type 'string) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
535 (apply 'string l)) |
17052 | 536 ((eq type 'list) |
537 l) | |
538 (t ; i.e. TYPE is vector | |
539 (vconcat l))))) | |
540 | |
541 ;;; mule-util.el ends here |