lisp/composite.el

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