*** empty log message ***
[bpt/emacs.git] / lisp / composite.el
CommitLineData
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.
42A glyph reference point symbol is to be used to specify a composition
1d1af02d 43rule in COMPONENTS argument to such functions as `compose-region'.
c674f351
KH
44
45Meanings 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
57Glyph reference point symbols are to be used to specify composition
58rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where
59GLOBAL-REF-POINT is a reference point in the overall glyphs already
60composed, and NEW-REF-POINT is a reference point in the new glyph to
61be added.
62
63For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and
8f625692 64NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as
c674f351
KH
65follows (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
77A composition rule may have the form \(GLOBAL-REF-POINT
78NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much
79to shift NEW-REF-POINT from GLOBAL-REF-POINT. In this case, XOFF
80and YOFF are integers in the range -100..100 representing the
81shifting 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.
87RULE 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
186Characters are composed relatively, i.e. composed by overstricking or
187stacking depending on ascent, descent and other properties.
188
c674f351
KH
189When called from a program, expects these four arguments.
190
191First two arguments START and END are positions (integers or markers)
192specifying the region.
193
1d1af02d
DL
194Optional 3rd argument COMPONENTS, if non-nil, is a character, a string
195or a vector or list of integers and rules.
c674f351
KH
196
197If it is a character, it is an alternate character to display instead
198of the text in the region.
199
c0cd1255
KH
200If it is a string, the elements are alternate characters. In
201this case, TAB element has a special meaning. If the first
202characer is TAB, the glyphs are displayed with left padding space
203so that no pixel overlaps with the previous column. If the last
204character is TAB, the glyphs are displayed with rigth padding
205space so that no pixel overlaps with the following column.
c674f351
KH
206
207If it is a vector or list, it is a sequence of alternate characters and
208composition rules, where (2N)th elements are characters and (2N+1)th
209elements are composition rules to specify how to compose (2N+2)th
210elements with previously composed N glyphs.
211
212A composition rule is a cons of global and new glyph reference point
213symbols. See the documentation of `reference-point-alist' for more
214detail.
215
216Optional 4th argument MODIFICATION-FUNC is a function to call to
217adjust the composition when it gets invalid because of a change of
218text 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
230When called from a program, expects two arguments,
231positions (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 241The return value is STRING with the `composition' property put on all
c674f351
KH
242the characters in it.
243
244Optional 2nd and 3rd arguments START and END specify the range of
c1750694 245STRING to be composed. They default to the beginning and the end of
c674f351
KH
246STRING respectively.
247
248Optional 4th argument COMPONENTS, if non-nil, is a character or a
249sequence (vector, list, or string) of integers. See the function
250`compose-region' for more detail.
251
252Optional 5th argument MODIFICATION-FUNC is a function to call to
253adjust the composition when it gets invalid because of a change of
254text 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.
269For relative composition, arguments are characters.
270For rule-based composition, Mth \(where M is odd) arguments are
271characters, and Nth \(where N is even) arguments are composition rules.
272A 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
293If the character at POS has `composition' property, the value is a list
294of FROM, TO, and VALID-P.
295
296FROM and TO specify the range of text that has the same `composition'
297property, VALID-P is non-nil if and only if this composition is valid.
298
299If there's no composition at POS, and the optional 2nd argument LIMIT
300is non-nil, search for a composition toward LIMIT.
301
302If no composition is found, return nil.
303
304Optional 3rd argument STRING, if non-nil, is a string to look for a
305composition in; nil means the current buffer.
306
307If a valid composition is found and the optional 4th argument DETAIL-P
308is non-nil, the return value is a list of FROM, TO, COMPONENTS,
309RELATIVE-P, MOD-FUNC, and WIDTH.
310
311COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
312
313RELATIVE-P is t if the composition method is relative, else nil.
314
315If RELATIVE-P is t, COMPONENTS is a vector of characters to be
316composed. If RELATIVE-P is nil, COMPONENTS is a vector of characters
317and composition rules as described in `compose-region'.
318
319MOD-FUNC is a modification function of the composition.
320
321WIDTH 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
332It looks up the char-table `composition-function-table' (which
333see) by a character at POS, and compose characters after POS
334according to the contents of `composition-function-table'.
335
336Optional 2nd arg LIMIT, if non-nil, limits characters to compose.
c674f351 337
7141ee65 338Optional 3rd arg OBJECT, if non-nil, is a string that contains the
1d1af02d 339text to compose. In that case, POS and LIMIT index into the string.
7141ee65 340
c674f351
KH
341This 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
371The argument is a parameterized event of the form
372 \(compose-last-chars N COMPONENTS),
373where N is the number of characters before point to compose,
374COMPONENTS, 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 376and that function finds a proper rule to compose the target characters.
c674f351
KH
377This function is intended to be used from input methods.
378The global keymap binds special event `compose-last-chars' to this
3b923ad8 379function. Input method may generate an event (compose-last-chars N COMPONENTS)
2624e2ac 380after 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.
397For each character that has to be composed automatically with
398preceding and/or following characters, this char table contains
399a function to call to compose that character.
400
00ddf712
KH
401An element, if non-nil, is FUNC or an alist of PATTERNs vs FUNCs,
402where PATTERNs are regular expressions and FUNCs are functions.
403If the element is FUNC, FUNC itself determines the region to
404compose.
68fbe650 405
627a335d 406Each function is called with 4 arguments, FROM, TO, FONT-OBJECT,
00ddf712 407and STRING.
68fbe650 408
00ddf712 409If STRING is nil, FROM and TO are positions specifying the region
ad1b4641 410matching with PATTERN in the current buffer, and the function has
00ddf712 411to compose character in that region (possibly with characters
67125135
KH
412preceding FROM). FONT-OBJECT may be nil if not
413available (e.g. for the case of terminal). The return value of
414the function is the end position where characters are composed,
ad1b4641 415or nil if no composition is made.
00ddf712
KH
416
417Otherwise, STRING is a string, and FROM and TO are indices into
418the string. In this case, the function has to compose a
67125135 419character in the string. The others are the same as above.
68fbe650 420
67125135 421See 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.
450Non-spacing characters are composed with the preceding spacing
451character. 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.
484This is like `composition-function-table' but used when Emacs is running
485on 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 489WINDOW is a window displaying the current buffer.
00ddf712
KH
490If STRING is non-nil, it is a string, and FROM and TO are indices
491into the string. In that case, compose characters in the string.
68fbe650
KH
492
493This 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.
555With ARG, turn Auto Composition mode off if and only if ARG is a non-positive
556number; if ARG is nil, toggle Auto Composition mode; anything else turns Auto
557Composition on.
37707939
KH
558
559When Auto Composition is enabled, text characters are automatically composed
560by functions registered in `composition-function-table' (which see).
561
ad1b4641 562You can use `global-auto-composition-mode' to turn on
37707939
KH
563Auto 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 635With 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
688If 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
690vector of CHAR respectively.
691Optional 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