Commit | Line | Data |
---|---|---|
60370d40 | 1 | ;;; composite.el --- support character composition |
c674f351 | 2 | |
409cc4a3 GM |
3 | ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
4 | ;; 2008 | |
ce03bf76 KH |
5 | ;; National Institute of Advanced Industrial Science and Technology (AIST) |
6 | ;; Registration Number H14PRO021 | |
c674f351 KH |
7 | |
8 | ;; Keywords: mule, multilingual, character composition | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
eb3fa2cf | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c674f351 | 13 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
c674f351 KH |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c674f351 | 24 | |
60370d40 PJ |
25 | ;;; Commentary: |
26 | ||
c674f351 KH |
27 | ;;; Code: |
28 | ||
c674f351 KH |
29 | (defconst reference-point-alist |
30 | '((tl . 0) (tc . 1) (tr . 2) | |
31 | (Bl . 3) (Bc . 4) (Br . 5) | |
32 | (bl . 6) (bc . 7) (br . 8) | |
33 | (cl . 9) (cc . 10) (cr . 11) | |
34 | (top-left . 0) (top-center . 1) (top-right . 2) | |
35 | (base-left . 3) (base-center . 4) (base-right . 5) | |
36 | (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) | |
37 | (center-left . 9) (center-center . 10) (center-right . 11) | |
38 | ;; For backward compatibility... | |
39 | (ml . 3) (mc . 10) (mr . 5) | |
40 | (mid-left . 3) (mid-center . 10) (mid-right . 5)) | |
41 | "Alist of symbols vs integer codes of glyph reference points. | |
42 | A glyph reference point symbol is to be used to specify a composition | |
1d1af02d | 43 | rule in COMPONENTS argument to such functions as `compose-region'. |
c674f351 KH |
44 | |
45 | Meanings of glyph reference point codes are as follows: | |
46 | ||
47 | 0----1----2 <---- ascent 0:tl or top-left | |
48 | | | 1:tc or top-center | |
49 | | | 2:tr or top-right | |
50 | | | 3:Bl or base-left 9:cl or center-left | |
51 | 9 10 11 <---- center 4:Bc or base-center 10:cc or center-center | |
52 | | | 5:Br or base-right 11:cr or center-right | |
53 | --3----4----5-- <-- baseline 6:bl or bottom-left | |
54 | | | 7:bc or bottom-center | |
55 | 6----7----8 <---- descent 8:br or bottom-right | |
56 | ||
57 | Glyph reference point symbols are to be used to specify composition | |
58 | rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where | |
59 | GLOBAL-REF-POINT is a reference point in the overall glyphs already | |
60 | composed, and NEW-REF-POINT is a reference point in the new glyph to | |
61 | be added. | |
62 | ||
63 | For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and | |
8f625692 | 64 | NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as |
c674f351 KH |
65 | follows (the point `*' corresponds to both reference points): |
66 | ||
67 | +-------+--+ <--- new ascent | |
68 | | | | | |
69 | | global| | | |
70 | | glyph | | | |
71 | -- | | |-- <--- baseline \(doesn't change) | |
72 | +----+--*--+ | |
73 | | | new | | |
74 | | |glyph| | |
75 | +----+-----+ <--- new descent | |
9c87e5c4 KH |
76 | |
77 | A composition rule may have the form \(GLOBAL-REF-POINT | |
78 | NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much | |
79 | to shift NEW-REF-POINT from GLOBAL-REF-POINT. In this case, XOFF | |
80 | and YOFF are integers in the range -100..100 representing the | |
81 | shifting percentage against the font size.") | |
c674f351 | 82 | |
c674f351 | 83 | |
59a2dac0 | 84 | ;;;###autoload |
c674f351 | 85 | (defun encode-composition-rule (rule) |
59a2dac0 KH |
86 | "Encode composition rule RULE into an integer value. |
87 | RULE is a cons of global and new reference point symbols | |
2624e2ac | 88 | \(see `reference-point-alist')." |
59a2dac0 KH |
89 | |
90 | ;; This must be compatible with C macro COMPOSITION_ENCODE_RULE | |
91 | ;; defined in composite.h. | |
92 | ||
c674f351 KH |
93 | (if (and (integerp rule) (< rule 144)) |
94 | ;; Already encoded. | |
95 | rule | |
9c87e5c4 KH |
96 | (if (consp rule) |
97 | (let ((gref (car rule)) | |
98 | (nref (cdr rule)) | |
99 | xoff yoff) | |
100 | (if (consp nref) ; (GREF NREF XOFF YOFF) | |
101 | (progn | |
102 | (setq xoff (nth 1 nref) | |
103 | yoff (nth 2 nref) | |
104 | nref (car nref)) | |
105 | (or (and (>= xoff -100) (<= xoff 100) | |
106 | (>= yoff -100) (<= yoff 100)) | |
ad1b4641 | 107 | (error "Invalid composition rule: %s" rule)) |
9c87e5c4 KH |
108 | (setq xoff (+ xoff 128) yoff (+ yoff 128))) |
109 | ;; (GREF . NREF) | |
110 | (setq xoff 0 yoff 0)) | |
111 | (or (integerp gref) | |
112 | (setq gref (cdr (assq gref reference-point-alist)))) | |
113 | (or (integerp nref) | |
114 | (setq nref (cdr (assq nref reference-point-alist)))) | |
115 | (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12)) | |
116 | (error "Invalid composition rule: %S" rule)) | |
117 | (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref))) | |
118 | (error "Invalid composition rule: %S" rule)))) | |
c674f351 KH |
119 | |
120 | ;; Decode encoded composition rule RULE-CODE. The value is a cons of | |
121 | ;; global and new reference point symbols. | |
122 | ;; This must be compatible with C macro COMPOSITION_DECODE_RULE | |
123 | ;; defined in composite.h. | |
124 | ||
125 | (defun decode-composition-rule (rule-code) | |
9c87e5c4 | 126 | (or (and (natnump rule-code) (< rule-code #x1000000)) |
c674f351 | 127 | (error "Invalid encoded composition rule: %S" rule-code)) |
9c87e5c4 KH |
128 | (let ((xoff (lsh rule-code -16)) |
129 | (yoff (logand (lsh rule-code -8) #xFF)) | |
130 | gref nref) | |
131 | (setq rule-code (logand rule-code #xFF) | |
132 | gref (car (rassq (/ rule-code 12) reference-point-alist)) | |
133 | nref (car (rassq (% rule-code 12) reference-point-alist))) | |
c674f351 KH |
134 | (or (and gref (symbolp gref) nref (symbolp nref)) |
135 | (error "Invalid composition rule code: %S" rule-code)) | |
9c87e5c4 KH |
136 | (if (and (= xoff 0) (= yoff 0)) |
137 | (cons gref nref) | |
138 | (setq xoff (- xoff 128) yoff (- yoff 128)) | |
139 | (list gref xoff yoff nref)))) | |
c674f351 KH |
140 | |
141 | ;; Encode composition rules in composition components COMPONENTS. The | |
142 | ;; value is a copy of COMPONENTS, where composition rules (cons of | |
143 | ;; global and new glyph reference point symbols) are replaced with | |
144 | ;; encoded composition rules. Optional 2nd argument NOCOPY non-nil | |
145 | ;; means don't make a copy but modify COMPONENTS directly. | |
146 | ||
147 | (defun encode-composition-components (components &optional nocopy) | |
148 | (or nocopy | |
149 | (setq components (copy-sequence components))) | |
150 | (if (vectorp components) | |
151 | (let ((len (length components)) | |
152 | (i 1)) | |
153 | (while (< i len) | |
154 | (aset components i | |
155 | (encode-composition-rule (aref components i))) | |
156 | (setq i (+ i 2)))) | |
157 | (let ((tail (cdr components))) | |
158 | (while tail | |
159 | (setcar tail | |
160 | (encode-composition-rule (car tail))) | |
161 | (setq tail (nthcdr 2 tail))))) | |
162 | components) | |
163 | ||
164 | ;; Decode composition rule codes in composition components COMPONENTS. | |
165 | ;; The value is a copy of COMPONENTS, where composition rule codes are | |
166 | ;; replaced with composition rules (cons of global and new glyph | |
167 | ;; reference point symbols). Optional 2nd argument NOCOPY non-nil | |
168 | ;; means don't make a copy but modify COMPONENTS directly. | |
169 | ;; It is assumed that COMPONENTS is a vector and is for rule-base | |
170 | ;; composition, thus (2N+1)th elements are rule codes. | |
171 | ||
172 | (defun decode-composition-components (components &optional nocopy) | |
173 | (or nocopy | |
174 | (setq components (copy-sequence components))) | |
175 | (let ((len (length components)) | |
176 | (i 1)) | |
177 | (while (< i len) | |
178 | (aset components i | |
179 | (decode-composition-rule (aref components i))) | |
180 | (setq i (+ i 2)))) | |
181 | components) | |
182 | ||
c674f351 KH |
183 | (defun compose-region (start end &optional components modification-func) |
184 | "Compose characters in the current region. | |
185 | ||
c9f60860 KH |
186 | Characters are composed relatively, i.e. composed by overstricking or |
187 | stacking depending on ascent, descent and other properties. | |
188 | ||
c674f351 KH |
189 | When called from a program, expects these four arguments. |
190 | ||
191 | First two arguments START and END are positions (integers or markers) | |
192 | specifying the region. | |
193 | ||
1d1af02d DL |
194 | Optional 3rd argument COMPONENTS, if non-nil, is a character, a string |
195 | or a vector or list of integers and rules. | |
c674f351 KH |
196 | |
197 | If it is a character, it is an alternate character to display instead | |
198 | of the text in the region. | |
199 | ||
c0cd1255 KH |
200 | If it is a string, the elements are alternate characters. In |
201 | this case, TAB element has a special meaning. If the first | |
202 | characer is TAB, the glyphs are displayed with left padding space | |
203 | so that no pixel overlaps with the previous column. If the last | |
204 | character is TAB, the glyphs are displayed with rigth padding | |
205 | space so that no pixel overlaps with the following column. | |
c674f351 KH |
206 | |
207 | If it is a vector or list, it is a sequence of alternate characters and | |
208 | composition rules, where (2N)th elements are characters and (2N+1)th | |
209 | elements are composition rules to specify how to compose (2N+2)th | |
210 | elements with previously composed N glyphs. | |
211 | ||
212 | A composition rule is a cons of global and new glyph reference point | |
213 | symbols. See the documentation of `reference-point-alist' for more | |
214 | detail. | |
215 | ||
216 | Optional 4th argument MODIFICATION-FUNC is a function to call to | |
217 | adjust the composition when it gets invalid because of a change of | |
218 | text in the composition." | |
219 | (interactive "r") | |
220 | (let ((modified-p (buffer-modified-p)) | |
09d52401 | 221 | (inhibit-read-only t)) |
c674f351 KH |
222 | (if (or (vectorp components) (listp components)) |
223 | (setq components (encode-composition-components components))) | |
224 | (compose-region-internal start end components modification-func) | |
6b61353c | 225 | (restore-buffer-modified-p modified-p))) |
c674f351 | 226 | |
c674f351 KH |
227 | (defun decompose-region (start end) |
228 | "Decompose text in the current region. | |
229 | ||
230 | When called from a program, expects two arguments, | |
231 | positions (integers or markers) specifying the region." | |
232 | (interactive "r") | |
233 | (let ((modified-p (buffer-modified-p)) | |
09d52401 | 234 | (inhibit-read-only t)) |
c674f351 | 235 | (remove-text-properties start end '(composition nil)) |
09d52401 | 236 | (restore-buffer-modified-p modified-p))) |
c674f351 | 237 | |
c674f351 KH |
238 | (defun compose-string (string &optional start end components modification-func) |
239 | "Compose characters in string STRING. | |
240 | ||
c1750694 | 241 | The return value is STRING with the `composition' property put on all |
c674f351 KH |
242 | the characters in it. |
243 | ||
244 | Optional 2nd and 3rd arguments START and END specify the range of | |
c1750694 | 245 | STRING to be composed. They default to the beginning and the end of |
c674f351 KH |
246 | STRING respectively. |
247 | ||
248 | Optional 4th argument COMPONENTS, if non-nil, is a character or a | |
249 | sequence (vector, list, or string) of integers. See the function | |
250 | `compose-region' for more detail. | |
251 | ||
252 | Optional 5th argument MODIFICATION-FUNC is a function to call to | |
253 | adjust the composition when it gets invalid because of a change of | |
254 | text in the composition." | |
255 | (if (or (vectorp components) (listp components)) | |
256 | (setq components (encode-composition-components components))) | |
257 | (or start (setq start 0)) | |
258 | (or end (setq end (length string))) | |
259 | (compose-string-internal string start end components modification-func) | |
260 | string) | |
261 | ||
c674f351 KH |
262 | (defun decompose-string (string) |
263 | "Return STRING where `composition' property is removed." | |
264 | (remove-text-properties 0 (length string) '(composition nil) string) | |
265 | string) | |
266 | ||
c674f351 KH |
267 | (defun compose-chars (&rest args) |
268 | "Return a string from arguments in which all characters are composed. | |
269 | For relative composition, arguments are characters. | |
270 | For rule-based composition, Mth \(where M is odd) arguments are | |
271 | characters, and Nth \(where N is even) arguments are composition rules. | |
272 | A composition rule is a cons of glyph reference points of the form | |
273 | \(GLOBAL-REF-POINT . NEW-REF-POINT). See the documentation of | |
274 | `reference-point-alist' for more detail." | |
275 | (let (str components) | |
276 | (if (consp (car (cdr args))) | |
277 | ;; Rule-base composition. | |
278 | (let ((len (length args)) | |
279 | (tail (encode-composition-components args 'nocopy))) | |
280 | ||
281 | (while tail | |
282 | (setq str (cons (car tail) str)) | |
283 | (setq tail (nthcdr 2 tail))) | |
284 | (setq str (concat (nreverse str)) | |
285 | components args)) | |
286 | ;; Relative composition. | |
287 | (setq str (concat args))) | |
288 | (compose-string-internal str 0 (length str) components))) | |
289 | ||
c674f351 KH |
290 | (defun find-composition (pos &optional limit string detail-p) |
291 | "Return information about a composition at or nearest to buffer position POS. | |
292 | ||
293 | If the character at POS has `composition' property, the value is a list | |
294 | of FROM, TO, and VALID-P. | |
295 | ||
296 | FROM and TO specify the range of text that has the same `composition' | |
297 | property, VALID-P is non-nil if and only if this composition is valid. | |
298 | ||
299 | If there's no composition at POS, and the optional 2nd argument LIMIT | |
300 | is non-nil, search for a composition toward LIMIT. | |
301 | ||
302 | If no composition is found, return nil. | |
303 | ||
304 | Optional 3rd argument STRING, if non-nil, is a string to look for a | |
305 | composition in; nil means the current buffer. | |
306 | ||
307 | If a valid composition is found and the optional 4th argument DETAIL-P | |
308 | is non-nil, the return value is a list of FROM, TO, COMPONENTS, | |
309 | RELATIVE-P, MOD-FUNC, and WIDTH. | |
310 | ||
311 | COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P. | |
312 | ||
313 | RELATIVE-P is t if the composition method is relative, else nil. | |
314 | ||
315 | If RELATIVE-P is t, COMPONENTS is a vector of characters to be | |
316 | composed. If RELATIVE-P is nil, COMPONENTS is a vector of characters | |
317 | and composition rules as described in `compose-region'. | |
318 | ||
319 | MOD-FUNC is a modification function of the composition. | |
320 | ||
321 | WIDTH is a number of columns the composition occupies on the screen." | |
322 | (let ((result (find-composition-internal pos limit string detail-p))) | |
323 | (if (and detail-p result (nth 2 result) (not (nth 3 result))) | |
324 | ;; This is a valid rule-base composition. | |
325 | (decode-composition-components (nth 2 result) 'nocopy)) | |
326 | result)) | |
327 | ||
328 | \f | |
7141ee65 | 329 | (defun compose-chars-after (pos &optional limit object) |
c674f351 KH |
330 | "Compose characters in current buffer after position POS. |
331 | ||
67125135 KH |
332 | It looks up the char-table `composition-function-table' (which |
333 | see) by a character at POS, and compose characters after POS | |
334 | according to the contents of `composition-function-table'. | |
335 | ||
336 | Optional 2nd arg LIMIT, if non-nil, limits characters to compose. | |
c674f351 | 337 | |
7141ee65 | 338 | Optional 3rd arg OBJECT, if non-nil, is a string that contains the |
1d1af02d | 339 | text to compose. In that case, POS and LIMIT index into the string. |
7141ee65 | 340 | |
c674f351 KH |
341 | This function is the default value of `compose-chars-after-function'." |
342 | (let ((tail (aref composition-function-table (char-after pos))) | |
67125135 KH |
343 | (font-obj (and (display-multi-font-p) |
344 | (and (not (stringp object)) | |
345 | (font-at pos (selected-window))))) | |
c674f351 | 346 | pattern func result) |
67125135 KH |
347 | (or limit |
348 | (setq limit (if (stringp object) (length object) (point-max)))) | |
d04effb3 | 349 | (when (and font-obj tail) |
339cebdc KH |
350 | (save-match-data |
351 | (save-excursion | |
67125135 KH |
352 | (while tail |
353 | (if (functionp (car tail)) | |
354 | (setq pattern nil func (car tail)) | |
355 | (setq pattern (car (car tail)) | |
356 | func (cdr (car tail)))) | |
339cebdc | 357 | (goto-char pos) |
67125135 KH |
358 | (if pattern |
359 | (if (and (if (stringp object) | |
360 | (eq (string-match pattern object) 0) | |
361 | (looking-at pattern)) | |
362 | (<= (match-end 0) limit)) | |
363 | (setq result | |
364 | (funcall func pos (match-end 0) font-obj object))) | |
365 | (setq result (funcall func pos limit font-obj object))) | |
366 | (if result (setq tail nil)))))) | |
367 | result)) | |
c674f351 | 368 | |
c674f351 KH |
369 | (defun compose-last-chars (args) |
370 | "Compose last characters. | |
3b923ad8 KH |
371 | The argument is a parameterized event of the form |
372 | \(compose-last-chars N COMPONENTS), | |
373 | where N is the number of characters before point to compose, | |
374 | COMPONENTS, if non-nil, is the same as the argument to `compose-region' | |
375 | \(which see). If it is nil, `compose-chars-after' is called, | |
2624e2ac | 376 | and that function finds a proper rule to compose the target characters. |
c674f351 KH |
377 | This function is intended to be used from input methods. |
378 | The global keymap binds special event `compose-last-chars' to this | |
3b923ad8 | 379 | function. Input method may generate an event (compose-last-chars N COMPONENTS) |
2624e2ac | 380 | after a sequence of character events." |
c674f351 KH |
381 | (interactive "e") |
382 | (let ((chars (nth 1 args))) | |
383 | (if (and (numberp chars) | |
384 | (>= (- (point) (point-min)) chars)) | |
3b923ad8 KH |
385 | (if (nth 2 args) |
386 | (compose-region (- (point) chars) (point) (nth 2 args)) | |
387 | (compose-chars-after (- (point) chars) (point)))))) | |
c674f351 | 388 | |
68fbe650 | 389 | (global-set-key [compose-last-chars] 'compose-last-chars) |
c674f351 KH |
390 | |
391 | \f | |
68fbe650 KH |
392 | ;;; Automatic character composition. |
393 | ||
394 | (defvar composition-function-table | |
395 | (make-char-table nil) | |
396 | "Char table of functions for automatic character composition. | |
397 | For each character that has to be composed automatically with | |
398 | preceding and/or following characters, this char table contains | |
399 | a function to call to compose that character. | |
400 | ||
00ddf712 KH |
401 | An element, if non-nil, is FUNC or an alist of PATTERNs vs FUNCs, |
402 | where PATTERNs are regular expressions and FUNCs are functions. | |
403 | If the element is FUNC, FUNC itself determines the region to | |
404 | compose. | |
68fbe650 | 405 | |
627a335d | 406 | Each function is called with 4 arguments, FROM, TO, FONT-OBJECT, |
00ddf712 | 407 | and STRING. |
68fbe650 | 408 | |
00ddf712 | 409 | If STRING is nil, FROM and TO are positions specifying the region |
ad1b4641 | 410 | matching with PATTERN in the current buffer, and the function has |
00ddf712 | 411 | to compose character in that region (possibly with characters |
67125135 KH |
412 | preceding FROM). FONT-OBJECT may be nil if not |
413 | available (e.g. for the case of terminal). The return value of | |
414 | the function is the end position where characters are composed, | |
ad1b4641 | 415 | or nil if no composition is made. |
00ddf712 KH |
416 | |
417 | Otherwise, STRING is a string, and FROM and TO are indices into | |
418 | the string. In this case, the function has to compose a | |
67125135 | 419 | character in the string. The others are the same as above. |
68fbe650 | 420 | |
67125135 | 421 | See also the documentation of `auto-composition-mode'.") |
68fbe650 KH |
422 | |
423 | ;; Copied from font-lock.el. | |
424 | (eval-when-compile | |
68fbe650 KH |
425 | ;; Borrowed from lazy-lock.el. |
426 | ;; We use this to preserve or protect things when modifying text properties. | |
427 | (defmacro save-buffer-state (varlist &rest body) | |
428 | "Bind variables according to VARLIST and eval BODY restoring buffer state." | |
ba8972b6 KH |
429 | `(let* ,(append varlist |
430 | '((modified (buffer-modified-p)) (buffer-undo-list t) | |
431 | (inhibit-read-only t) (inhibit-point-motion-hooks t) | |
432 | (inhibit-modification-hooks t) | |
433 | deactivate-mark buffer-file-name buffer-file-truename)) | |
434 | ,@body | |
435 | (unless modified | |
436 | (restore-buffer-modified-p nil)))) | |
1d1af02d | 437 | ;; Fixme: This makes bootstrapping fail with this error. |
ba8972b6 KH |
438 | ;; Symbol's function definition is void: eval-defun |
439 | ;;(def-edebug-spec save-buffer-state let) | |
440 | ) | |
68fbe650 | 441 | |
02bf0a0a KH |
442 | (put 'save-buffer-state 'lisp-indent-function 1) |
443 | ||
3617b1eb KH |
444 | (defsubst terminal-composition-base-character-p (ch) |
445 | (not (memq (get-char-code-property ch 'general-category) | |
446 | '(Mn Mc Me Zs Zl Zp Cc Cf Cs)))) | |
447 | ||
38a82365 | 448 | (defun terminal-composition-function (from to font-object string) |
3f0cd392 KH |
449 | "General composition function used on terminal. |
450 | Non-spacing characters are composed with the preceding spacing | |
451 | character. All non-spacing characters has this function in | |
452 | `terminal-composition-function-table'." | |
3617b1eb | 453 | (let ((pos from)) |
3f0cd392 | 454 | (if string |
00ddf712 KH |
455 | (progn |
456 | (while (and (< pos to) | |
457 | (= (aref char-width-table (aref string pos)) 0)) | |
458 | (setq pos (1+ pos))) | |
3617b1eb | 459 | (if (and (> from 0) |
a509862b KH |
460 | (terminal-composition-base-character-p |
461 | (aref string (1- from)))) | |
00ddf712 KH |
462 | (compose-string string (1- from) pos) |
463 | (compose-string string from pos | |
464 | (concat " " (buffer-substring from pos))))) | |
465 | (while (and (< pos to) | |
3f0cd392 KH |
466 | (= (aref char-width-table (char-after pos)) 0)) |
467 | (setq pos (1+ pos))) | |
3617b1eb | 468 | (if (and (> from (point-min)) |
a509862b | 469 | (terminal-composition-base-character-p (char-after (1- from)))) |
3617b1eb | 470 | (compose-region (1- from) pos) |
00ddf712 KH |
471 | (compose-region from pos |
472 | (concat " " (buffer-substring from pos))))) | |
473 | pos)) | |
3f0cd392 KH |
474 | |
475 | (defvar terminal-composition-function-table | |
476 | (let ((table (make-char-table nil))) | |
477 | (map-char-table | |
478 | #'(lambda (key val) | |
479 | (if (= val 0) (set-char-table-range table key | |
480 | 'terminal-composition-function))) | |
481 | char-width-table) | |
482 | table) | |
483 | "Char table of functions for automatic character composition on terminal. | |
484 | This is like `composition-function-table' but used when Emacs is running | |
485 | on a terminal.") | |
486 | ||
00ddf712 KH |
487 | (defun auto-compose-chars (from to window string) |
488 | "Compose characters in the region between FROM and TO. | |
4fa0f779 | 489 | WINDOW is a window displaying the current buffer. |
00ddf712 KH |
490 | If STRING is non-nil, it is a string, and FROM and TO are indices |
491 | into the string. In that case, compose characters in the string. | |
68fbe650 KH |
492 | |
493 | This function is the default value of `auto-composition-function' (which see)." | |
494 | (save-buffer-state nil | |
c8e89221 | 495 | (save-excursion |
00ddf712 KH |
496 | (save-restriction |
497 | (save-match-data | |
498 | (let ((table (if (display-graphic-p) | |
499 | composition-function-table | |
500 | terminal-composition-function-table)) | |
501 | (start from)) | |
502 | (setq to (or (text-property-any (1+ from) to 'auto-composed t | |
503 | string) | |
504 | to)) | |
505 | (if string | |
506 | (while (< from to) | |
507 | (let* ((ch (aref string from)) | |
508 | (elt (aref table ch)) | |
509 | font-obj newpos) | |
d04effb3 | 510 | (when (and elt |
3617b1eb KH |
511 | (or (not (display-graphic-p)) |
512 | (setq font-obj (font-at from window string)))) | |
00ddf712 KH |
513 | (if (functionp elt) |
514 | (setq newpos (funcall elt from to font-obj string)) | |
515 | (while (and elt | |
516 | (or (not (eq (string-match (caar elt) string | |
517 | from) | |
518 | from)) | |
519 | (not (setq newpos | |
520 | (funcall (cdar elt) from | |
521 | (match-end 0) | |
522 | font-obj string))))) | |
523 | (setq elt (cdr elt))))) | |
524 | (if (and newpos (> newpos from)) | |
525 | (setq from newpos) | |
526 | (setq from (1+ from))))) | |
527 | (narrow-to-region from to) | |
528 | (while (< from to) | |
529 | (let* ((ch (char-after from)) | |
530 | (elt (aref table ch)) | |
531 | func pattern font-obj newpos) | |
d04effb3 | 532 | (when (and elt |
3617b1eb KH |
533 | (or (not (display-graphic-p)) |
534 | (setq font-obj (font-at from window)))) | |
00ddf712 KH |
535 | (if (functionp elt) |
536 | (setq newpos (funcall elt from to font-obj nil)) | |
537 | (goto-char from) | |
538 | (while (and elt | |
539 | (or (not (looking-at (caar elt))) | |
540 | (not (setq newpos | |
541 | (funcall (cdar elt) from | |
542 | (match-end 0) | |
543 | font-obj nil))))) | |
544 | (setq elt (cdr elt))))) | |
545 | (if (and newpos (> newpos from)) | |
546 | (setq from newpos) | |
547 | (setq from (1+ from)))))) | |
548 | (put-text-property start to 'auto-composed t string))))))) | |
68fbe650 | 549 | |
37707939 KH |
550 | (make-variable-buffer-local 'auto-composition-function) |
551 | ||
16d58d04 | 552 | ;;;###autoload |
37707939 | 553 | (define-minor-mode auto-composition-mode |
ad1b4641 GM |
554 | "Toggle Auto Composition mode. |
555 | With ARG, turn Auto Composition mode off if and only if ARG is a non-positive | |
556 | number; if ARG is nil, toggle Auto Composition mode; anything else turns Auto | |
557 | Composition on. | |
37707939 KH |
558 | |
559 | When Auto Composition is enabled, text characters are automatically composed | |
560 | by functions registered in `composition-function-table' (which see). | |
561 | ||
ad1b4641 | 562 | You can use `global-auto-composition-mode' to turn on |
37707939 KH |
563 | Auto Composition mode in all buffers (this is the default)." |
564 | nil nil nil | |
565 | (if noninteractive | |
566 | (setq auto-composition-mode nil)) | |
567 | (cond (auto-composition-mode | |
568 | (add-hook 'after-change-functions 'auto-composition-after-change nil t) | |
569 | (setq auto-composition-function 'auto-compose-chars)) | |
570 | (t | |
571 | (remove-hook 'after-change-functions 'auto-composition-after-change t) | |
572 | (setq auto-composition-function nil))) | |
573 | (save-buffer-state nil | |
574 | (save-restriction | |
575 | (widen) | |
576 | (remove-text-properties (point-min) (point-max) '(auto-composed nil)) | |
577 | (decompose-region (point-min) (point-max))))) | |
578 | ||
579 | (defun auto-composition-after-change (start end old-len) | |
2968197a KH |
580 | (save-buffer-state nil |
581 | (if (< start (point-min)) | |
582 | (setq start (point-min))) | |
583 | (if (> end (point-max)) | |
584 | (setq end (point-max))) | |
585 | (when (and auto-composition-mode (not memory-full)) | |
586 | (let (func1 func2) | |
587 | (when (and (> start (point-min)) | |
588 | (setq func2 (aref composition-function-table | |
589 | (char-after (1- start)))) | |
590 | (or (= start (point-max)) | |
591 | (not (setq func1 (aref composition-function-table | |
592 | (char-after start)))) | |
593 | (eq func1 func2))) | |
594 | (setq start (1- start) | |
595 | func1 func2) | |
596 | (while (eq func1 func2) | |
597 | (if (> start (point-min)) | |
598 | (setq start (1- start) | |
599 | func2 (aref composition-function-table | |
600 | (char-after start))) | |
601 | (setq func2 nil)))) | |
602 | (when (and (< end (point-max)) | |
603 | (setq func2 (aref composition-function-table | |
604 | (char-after end))) | |
605 | (or (= end (point-min)) | |
606 | (not (setq func1 (aref composition-function-table | |
607 | (char-after (1- end))))) | |
608 | (eq func1 func2))) | |
609 | (setq end (1+ end) | |
610 | func1 func2) | |
611 | (while (eq func1 func2) | |
612 | (if (< end (point-max)) | |
613 | (setq func2 (aref composition-function-table | |
614 | (char-after end)) | |
615 | end (1+ end)) | |
616 | (setq func2 nil)))) | |
617 | (if (< start end) | |
c02e996e | 618 | (remove-text-properties start end '(auto-composed nil))))))) |
37707939 KH |
619 | |
620 | (defun turn-on-auto-composition-if-enabled () | |
2968197a KH |
621 | (if enable-multibyte-characters |
622 | (auto-composition-mode 1))) | |
37707939 | 623 | |
16d58d04 | 624 | ;;;###autoload |
37707939 KH |
625 | (define-global-minor-mode global-auto-composition-mode |
626 | auto-composition-mode turn-on-auto-composition-if-enabled | |
627 | :extra-args (dummy) | |
628 | :initialize 'custom-initialize-safe-default | |
379ef066 | 629 | :init-value (not noninteractive) |
37707939 KH |
630 | :group 'auto-composition |
631 | :version "23.1") | |
68fbe650 KH |
632 | |
633 | (defun toggle-auto-composition (&optional arg) | |
634 | "Change whether automatic character composition is enabled in this buffer. | |
d4f635a5 | 635 | With arg, enable it if and only if arg is positive." |
68fbe650 KH |
636 | (interactive "P") |
637 | (let ((enable (if (null arg) (not auto-composition-function) | |
638 | (> (prefix-numeric-value arg) 0)))) | |
639 | (if enable | |
640 | (kill-local-variable 'auto-composition-function) | |
641 | (make-local-variable 'auto-composition-function) | |
642 | (setq auto-composition-function nil) | |
643 | (save-buffer-state nil | |
644 | (save-restriction | |
645 | (widen) | |
646 | (decompose-region (point-min) (point-max))))) | |
647 | ||
648 | (save-buffer-state nil | |
649 | (save-restriction | |
650 | (widen) | |
c02e996e KH |
651 | (remove-text-properties (point-min) (point-max) |
652 | '(auto-composed nil)))))) | |
bd4a85b9 KH |
653 | |
654 | (defun auto-compose-region (from to) | |
655 | "Force automatic character composition on the region FROM and TO." | |
656 | (save-excursion | |
657 | (if (get-text-property from 'auto-composed) | |
658 | (setq from (next-single-property-change from 'auto-composed nil to))) | |
659 | (goto-char from) | |
660 | (let ((modified-p (buffer-modified-p)) | |
661 | (inhibit-read-only '(composition auto-composed)) | |
662 | (stop (next-single-property-change (point) 'auto-composed nil to))) | |
663 | (while (< (point) to) | |
664 | (if (= (point) stop) | |
665 | (progn | |
666 | (goto-char (next-single-property-change (point) | |
667 | 'auto-composed nil to)) | |
668 | (setq stop (next-single-property-change (point) | |
669 | 'auto-composed nil to))) | |
670 | (let ((func (aref composition-function-table (following-char))) | |
67125135 KH |
671 | (font-obj (and (display-multi-font-p) |
672 | (font-at (point) (selected-window)))) | |
bd4a85b9 | 673 | (pos (point))) |
d04effb3 | 674 | (if (and (functionp func) font-obj) |
67125135 | 675 | (goto-char (funcall func (point) to font-obj nil))) |
bd4a85b9 KH |
676 | (if (<= (point) pos) |
677 | (forward-char 1))))) | |
678 | (put-text-property from to 'auto-composed t) | |
679 | (set-buffer-modified-p modified-p)))) | |
680 | ||
c674f351 | 681 | \f |
09d52401 SM |
682 | ;; The following codes are only for backward compatibility with Emacs |
683 | ;; 20.4 and earlier. | |
c674f351 | 684 | |
c674f351 KH |
685 | (defun decompose-composite-char (char &optional type with-composition-rule) |
686 | "Convert CHAR to string. | |
c674f351 KH |
687 | |
688 | If optional 2nd arg TYPE is non-nil, it is `string', `list', or | |
1ea62389 JB |
689 | `vector'. In this case, CHAR is converted to string, list of CHAR, or |
690 | vector of CHAR respectively. | |
691 | Optional 3rd arg WITH-COMPOSITION-RULE is ignored." | |
c674f351 KH |
692 | (cond ((or (null type) (eq type 'string)) (char-to-string char)) |
693 | ((eq type 'list) (list char)) | |
694 | (t (vector char)))) | |
695 | ||
8d787845 KH |
696 | (make-obsolete 'decompose-composite-char 'char-to-string "21.1") |
697 | ||
c674f351 | 698 | \f |
6b61353c | 699 | |
09d52401 | 700 | ;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33 |
c674f351 | 701 | ;;; composite.el ends here |