Mercurial > emacs
annotate lisp/international/mule-util.el @ 25173:cf6d2213e0a7
(Man-softhyphen-to-minus): Fix for multibyte case, do
nothing in Latin-N environment.
author | Dave Love <fx@gnu.org> |
---|---|
date | Wed, 04 Aug 1999 19:00:57 +0000 |
parents | 84d705e026b4 |
children | 1f573e26070a |
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 | |
23196 | 127 ;;; For backward compatibility ... |
17052 | 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) | |
23196 | 137 "Return t if OBJ is a nested alist. |
17052 | 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. | |
23196 | 151 Optional 4th arg LEN non-nil means the first LEN elements in KEYSEQ |
17052 | 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) | |
23196 | 157 (error "Invalid argument %s" alist)) |
17052 | 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) | |
23196 | 192 (error "invalid argument %s" alist)) |
17052 | 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) |
24866
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
215 "Return the string indicating end-of-line format of CODING-SYSTEM." |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
216 (let* ((eol-type (coding-system-eol-type coding-system)) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
217 (val (cond ((vectorp eol-type) eol-mnemonic-undecided) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
218 ((eq eol-type 0) eol-mnemonic-unix) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
219 ((eq eol-type 1) eol-mnemonic-dos) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
220 ((eq eol-type 2) eol-mnemonic-mac) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
221 (t "-")))) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
222 (if (stringp val) |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
223 val |
84d705e026b4
(coding-system-eol-type-mnemonic):
Kenichi Handa <handa@m17n.org>
parents:
24485
diff
changeset
|
224 (char-to-string val)))) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
225 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
226 ;;;###autoload |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
227 (defun coding-system-post-read-conversion (coding-system) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
228 "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
|
229 (coding-system-get coding-system 'post-read-conversion)) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
230 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
231 ;;;###autoload |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
232 (defun coding-system-pre-write-conversion (coding-system) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
233 "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
|
234 (coding-system-get coding-system 'pre-write-conversion)) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
235 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
236 ;;;###autoload |
22126
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
237 (defun coding-system-translation-table-for-decode (coding-system) |
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
238 "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
|
239 (coding-system-get coding-system 'translation-table-for-decode)) |
19455
7cf3d42a6fd7
(coding-system-unification-table):
Kenichi Handa <handa@m17n.org>
parents:
19264
diff
changeset
|
240 |
7cf3d42a6fd7
(coding-system-unification-table):
Kenichi Handa <handa@m17n.org>
parents:
19264
diff
changeset
|
241 ;;;###autoload |
22126
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
242 (defun coding-system-translation-table-for-encode (coding-system) |
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
243 "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
|
244 (coding-system-get coding-system 'translation-table-for-encode)) |
17052 | 245 |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
246 ;;;###autoload |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
247 (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
|
248 "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
|
249 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
|
250 or one is an alias of the other." |
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
251 (or (eq coding-system-1 coding-system-2) |
20113
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
252 (and (equal (coding-system-spec coding-system-1) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
253 (coding-system-spec coding-system-2)) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
254 (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
|
255 (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
|
256 (or (eq eol-type-1 eol-type-2) |
00ca5f419c16
(coding-system-base): Moved to
Kenichi Handa <handa@m17n.org>
parents:
19932
diff
changeset
|
257 (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
|
258 |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
259 ;;;###autoload |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
260 (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
|
261 "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
|
262 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
|
263 coding systems ordered by priority." |
24485
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
264 `(unwind-protect |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
265 (let* ((prio-list ,priority-list) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
266 (coding-category-list coding-category-list) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
267 ,@(mapcar (function (lambda (x) (list x x))) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
268 coding-category-list)) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
269 (mapcar (function (lambda (x) (set (car x) (cdr x)))) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
270 prio-list) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
271 (set-coding-priority (mapcar (function (lambda (x) (car x))) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
272 prio-list)) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
273 (detect-coding-region ,from ,to)) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
274 ;; We must restore the internal database. |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
275 (set-coding-priority coding-category-list) |
ab39ea2168e7
(detect-coding-with-priority): Restore the internal database.
Kenichi Handa <handa@m17n.org>
parents:
24346
diff
changeset
|
276 (update-coding-systems-internal))) |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
277 |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
278 ;;;###autoload |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
279 (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
|
280 "Detect a coding system of the text between FROM and TO with LANG-ENV. |
23196 | 281 The detection takes into account the coding system priorities for the |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
282 language environment LANG-ENV." |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
283 (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
|
284 (if coding-priority |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
285 (detect-coding-with-priority |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
286 from to |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
287 (mapcar (function (lambda (x) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
288 (cons (coding-system-get x 'coding-category) x))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
289 coding-priority)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
290 (detect-coding-region from to)))) |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
291 |
17052 | 292 |
23196 | 293 ;;; Composite character manipulations. |
17052 | 294 |
295 ;;;###autoload | |
296 (defun compose-region (start end) | |
297 "Compose all characters in the current region into one composite character. | |
298 When called from a program, expects two arguments, | |
299 positions (integers or markers) specifying the region." | |
300 (interactive "r") | |
301 (save-excursion | |
302 (let ((str (buffer-substring start end))) | |
303 (goto-char start) | |
23549
aab4ef022ffd
(compose-region): Insert then delete
Kenichi Handa <handa@m17n.org>
parents:
23196
diff
changeset
|
304 (insert (compose-string str)) |
aab4ef022ffd
(compose-region): Insert then delete
Kenichi Handa <handa@m17n.org>
parents:
23196
diff
changeset
|
305 (delete-char (- end start))))) |
17052 | 306 |
307 ;;;###autoload | |
308 (defun decompose-region (start end) | |
309 "Decompose all composite characters in the current region. | |
310 Composite characters are broken up into individual components. | |
311 When called from a program, expects two arguments, | |
312 positions (integers or markers) specifying the region." | |
313 (interactive "r") | |
24027
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
314 (let ((buf (current-buffer)) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
315 (cmpchar-head (char-to-string leading-code-composition))) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
316 (with-temp-buffer |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
317 (insert-buffer-substring buf start end) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
318 (set-buffer-multibyte nil) |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
319 (goto-char (point-min)) |
24027
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
320 (while (search-forward cmpchar-head nil t) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
321 (if (looking-at "[\240-\377][\240-\377][\240-\377][\240-\377]+") |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
322 (let* ((from (1- (point))) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
323 (to (match-end 0)) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
324 (str (string-as-multibyte (buffer-substring from to)))) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
325 (if (cmpcharp (string-to-char str)) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
326 (progn |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
327 (delete-region from to) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
328 (insert (string-as-unibyte (decompose-string str)))) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
329 (goto-char to))))) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
330 (set-buffer-multibyte t) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
331 (let ((tempbuf (current-buffer))) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
332 (save-excursion |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
333 (set-buffer buf) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
334 (goto-char start) |
660b6f8b7928
(decompose-region): Do decomposition
Kenichi Handa <handa@m17n.org>
parents:
24006
diff
changeset
|
335 (delete-region start end) |
24338 | 336 (insert-buffer-substring tempbuf)))))) |
17052 | 337 |
338 ;;;###autoload | |
19264
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
339 (defun decompose-string (string) |
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
340 "Decompose all composite characters in STRING." |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
341 (let ((len (length string)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
342 (idx 0) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
343 (i 0) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
344 (str-list nil) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
345 ch) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
346 (while (< idx len) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
347 (setq ch (aref string idx)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
348 (if (>= ch min-composite-char) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
349 (progn |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
350 (if (> idx i) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
351 (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
|
352 (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
|
353 (setq i (1+ idx)))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
354 (setq idx (1+ idx))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
355 (if (not str-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
356 (copy-sequence string) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
357 (if (> idx i) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
358 (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
|
359 (apply 'concat (nreverse str-list))))) |
19264
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
360 |
6122dbba797f
(prefer-coding-system): Moved to mule-util.el.
Kenichi Handa <handa@m17n.org>
parents:
19056
diff
changeset
|
361 ;;;###autoload |
17052 | 362 (defconst reference-point-alist |
363 '((tl . 0) (tc . 1) (tr . 2) | |
364 (ml . 3) (mc . 4) (mr . 5) | |
365 (bl . 6) (bc . 7) (br . 8) | |
366 (top-left . 0) (top-center . 1) (top-right . 2) | |
367 (mid-left . 3) (mid-center . 4) (mid-right . 5) | |
368 (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) | |
369 (0 . 0) (1 . 1) (2 . 2) | |
370 (3 . 3) (4 . 4) (5 . 5) | |
371 (6 . 6) (7 . 7) (8 . 8)) | |
372 "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
|
373 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
|
374 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
|
375 (which see). |
65112b3cc989
(reference-point-alist): Doc-string modified.
Kenichi Handa <handa@m17n.org>
parents:
19016
diff
changeset
|
376 |
17052 | 377 Meanings of reference point codes are as follows: |
378 | |
379 0----1----2 <-- ascent 0:tl or top-left | |
380 | | 1:tc or top-center | |
381 | | 2:tr or top-right | |
382 | | 3:ml or mid-left | |
383 | 4 <--+---- center 4:mc or mid-center | |
384 | | 5:mr or mid-right | |
385 --- 3 5 <-- baseline 6:bl or bottom-left | |
386 | | 7:bc or bottom-center | |
387 6----7----8 <-- descent 8:br or bottom-right | |
388 | |
389 Reference point symbols are to be used to specify composition rule of | |
390 the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where GLOBAL-REF-POINT | |
391 is a reference point in the overall glyphs already composed, and | |
392 NEW-REF-POINT is a reference point in the new glyph to be added. | |
393 | |
394 For instance, if GLOBAL-REF-POINT is 8 and NEW-REF-POINT is 1, the | |
395 overall glyph is updated as follows: | |
396 | |
397 +-------+--+ <--- new ascent | |
398 | | | | |
399 | global| | | |
400 | glyph | | | |
401 --- | | | <--- baseline (doesn't change) | |
402 +----+--+--+ | |
403 | | new | | |
404 | |glyph| | |
405 +----+-----+ <--- new descent | |
406 ") | |
407 | |
408 ;; Return a string for char CH to be embedded in multibyte form of | |
409 ;; composite character. | |
24241
31a8f281b188
(compose-chars-component): Add autoload cookie.
Kenichi Handa <handa@m17n.org>
parents:
24027
diff
changeset
|
410 ;;;###autoload |
17052 | 411 (defun compose-chars-component (ch) |
412 (if (< ch 128) | |
413 (format "\240%c" (+ ch 128)) | |
20841
ef5fd882ca63
(compose-chars-component): Return
Kenichi Handa <handa@m17n.org>
parents:
20730
diff
changeset
|
414 (let ((str (string-as-unibyte (char-to-string ch)))) |
17052 | 415 (if (cmpcharp ch) |
23687
9913df387dfb
(compose-chars-component): Signal
Kenichi Handa <handa@m17n.org>
parents:
23549
diff
changeset
|
416 (if (= (aref str 1) ?\xFF) |
9913df387dfb
(compose-chars-component): Signal
Kenichi Handa <handa@m17n.org>
parents:
23549
diff
changeset
|
417 (error "Can't compose a rule-based composition character") |
9913df387dfb
(compose-chars-component): Signal
Kenichi Handa <handa@m17n.org>
parents:
23549
diff
changeset
|
418 (substring str (if (= (aref str 1) ?\xFF) 2 1))) |
17052 | 419 (aset str 0 (+ (aref str 0) ?\x20)) |
420 str)))) | |
421 | |
422 ;; Return a string for composition rule RULE to be embedded in | |
423 ;; multibyte form of composite character. | |
424 (defsubst compose-chars-rule (rule) | |
425 (char-to-string (+ ?\xA0 | |
426 (* (cdr (assq (car rule) reference-point-alist)) 9) | |
427 (cdr (assq (cdr rule) reference-point-alist))))) | |
428 | |
429 ;;;###autoload | |
430 (defun compose-chars (first-component &rest args) | |
431 "Return one char string composed from the arguments. | |
24250
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
432 For relative composition, each argument should be a non-composition character |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
433 or a relative-composition character. |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
434 For rule-based composition, Nth (where N is odd) argument should be |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
435 a non-composition character or a rule-based-composition character, |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
436 and Mth (where M is even) argument should be a composition rule. |
17052 | 437 A composition rule has the form \(GLOBAL-REF-POINT . NEW-REF-POINT). |
438 See the documentation of `reference-point-alist' for more detail." | |
439 (if (= (length args) 0) | |
440 (char-to-string first-component) | |
441 (let* ((with-rule (consp (car args))) | |
24250
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
442 (str (if (cmpcharp first-component) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
443 (string-as-unibyte (char-to-string first-component)) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
444 (if with-rule |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
445 (concat (vector leading-code-composition ?\xFF) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
446 (compose-chars-component first-component)) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
447 (concat (char-to-string leading-code-composition) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
448 (compose-chars-component first-component)))))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
449 (if (and (cmpcharp first-component) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
450 (eq with-rule (/= (aref str 1) ?\xFF))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
451 (error "%s-compostion-character is not allowed in %s composition: %c" |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
452 (if with-rule "relative" "rule-based") |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
453 (if with-rule "rule-based" "relative") |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
454 first-component)) |
17052 | 455 (while args |
456 (if with-rule | |
24250
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
457 (setq str (concat str (compose-chars-rule (car args))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
458 args (cdr args))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
459 (if (cmpcharp (car args)) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
460 (let ((cmp-str (string-as-unibyte (char-to-string (car args))))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
461 (if (eq with-rule (/= (aref cmp-str 1) ?\xFF)) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
462 (error "%s-compostion-character is not allowed in %s composition: %c" |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
463 (if with-rule "relative" "rule-based") |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
464 (if with-rule "rule-based" "relative") |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
465 (car args))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
466 (setq str (concat str (substring cmp-str |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
467 (if with-rule 2 1))))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
468 (setq str (concat str (compose-chars-component (car args))))) |
98056b9021a6
(compose-chars): Doc-string
Kenichi Handa <handa@m17n.org>
parents:
24241
diff
changeset
|
469 (setq args (cdr args))) |
20841
ef5fd882ca63
(compose-chars-component): Return
Kenichi Handa <handa@m17n.org>
parents:
20730
diff
changeset
|
470 (string-as-multibyte str)))) |
17052 | 471 |
472 ;;;###autoload | |
473 (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
|
474 "Convert composite character CHAR to a sequence of the components. |
17052 | 475 Optional 1st arg TYPE specifies the type of sequence returned. |
476 It should be `string' (default), `list', or `vector'. | |
477 Optional 2nd arg WITH-COMPOSITION-RULE non-nil means the returned | |
478 sequence contains embedded composition rules if any. In this case, the | |
479 order of elements in the sequence is the same as arguments for | |
480 `compose-chars' to create CHAR. | |
481 If TYPE is omitted or is `string', composition rules are omitted | |
482 even if WITH-COMPOSITION-RULE is t." | |
483 (or type | |
484 (setq type 'string)) | |
485 (let* ((len (composite-char-component-count char)) | |
486 (i (1- len)) | |
487 l) | |
488 (setq with-composition-rule (and with-composition-rule | |
489 (not (eq type 'string)) | |
490 (composite-char-composition-rule-p char))) | |
491 (while (> i 0) | |
492 (setq l (cons (composite-char-component char i) l)) | |
493 (if with-composition-rule | |
494 (let ((rule (- (composite-char-composition-rule char i) ?\xA0))) | |
495 (setq l (cons (cons (/ rule 9) (% rule 9)) l)))) | |
496 (setq i (1- i))) | |
497 (setq l (cons (composite-char-component char 0) l)) | |
498 (cond ((eq type 'string) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
499 (apply 'string l)) |
17052 | 500 ((eq type 'list) |
501 l) | |
502 (t ; i.e. TYPE is vector | |
503 (vconcat l))))) | |
504 | |
505 ;;; mule-util.el ends here |