lisp/composite.el

   1 ;;; composite.el --- support character composition
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
   4 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   5 ;;   Registration Number H14PRO021
   6
   7 ;; Keywords: mule, multilingual, character composition
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (defconst reference-point-alist
  31   '((tl . 0) (tc . 1) (tr . 2)
  32     (Bl . 3) (Bc . 4) (Br . 5)
  33     (bl . 6) (bc . 7) (br . 8)
  34     (cl . 9) (cc . 10) (cr . 11)
  35     (top-left . 0) (top-center . 1) (top-right . 2)
  36     (base-left . 3) (base-center . 4) (base-right . 5)
  37     (bottom-left . 6) (bottom-center . 7) (bottom-right . 8)
  38     (center-left . 9) (center-center . 10) (center-right . 11)
  39     ;; For backward compatibility...
  40     (ml . 3) (mc . 10) (mr . 5)
  41     (mid-left . 3) (mid-center . 10) (mid-right . 5))
  42   "Alist of symbols vs integer codes of glyph reference points.
  43 A glyph reference point symbol is to be used to specify a composition
  44 rule in COMPONENTS argument to such functions as `compose-region'.
  45
  46 Meanings of glyph reference point codes are as follows:
  47
  48     0----1----2 <---- ascent    0:tl or top-left
  49     |         |                 1:tc or top-center
  50     |         |                 2:tr or top-right
  51     |         |                 3:Bl or base-left     9:cl or center-left
  52     9   10   11 <---- center    4:Bc or base-center  10:cc or center-center
  53     |         |                 5:Br or base-right   11:cr or center-right
  54   --3----4----5-- <-- baseline  6:bl or bottom-left
  55     |         |                 7:bc or bottom-center
  56     6----7----8 <---- descent   8:br or bottom-right
  57
  58 Glyph reference point symbols are to be used to specify composition
  59 rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where
  60 GLOBAL-REF-POINT is a reference point in the overall glyphs already
  61 composed, and NEW-REF-POINT is a reference point in the new glyph to
  62 be added.
  63
  64 For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and
  65 NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as
  66 follows (the point `*' corresponds to both reference points):
  67
  68     +-------+--+ <--- new ascent
  69     |       |  |
  70     | global|  |
  71     | glyph |  |
  72  -- |       |  |-- <--- baseline \(doesn't change)
  73     +----+--*--+
  74     |    | new |
  75     |    |glyph|
  76     +----+-----+ <--- new descent
  77
  78 A composition rule may have the form \(GLOBAL-REF-POINT
  79 NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much
  80 to shift NEW-REF-POINT from GLOBAL-REF-POINT.  In this case, XOFF
  81 and YOFF are integers in the range -100..100 representing the
  82 shifting percentage against the font size.")
  83
  84
  85 ;;;###autoload
  86 (defun encode-composition-rule (rule)
  87   "Encode composition rule RULE into an integer value.
  88 RULE is a cons of global and new reference point symbols
  89 \(see `reference-point-alist')."
  90
  91   ;; This must be compatible with C macro COMPOSITION_ENCODE_RULE
  92   ;; defined in composite.h.
  93
  94   (if (and (integerp rule) (< rule 144))
  95       ;; Already encoded.
  96       rule
  97     (if (consp rule)
  98         (let ((gref (car rule))
  99               (nref (cdr rule))
 100               xoff yoff)
 101           (if (consp nref)              ; (GREF NREF XOFF YOFF)
 102               (progn
 103                 (setq xoff (nth 1 nref)
 104                       yoff (nth 2 nref)
 105                       nref (car nref))
 106                 (or (and (>= xoff -100) (<= xoff 100)
 107                          (>= yoff -100) (<= yoff 100))
 108                     (error "Invalid compostion rule: %s" rule))
 109                 (setq xoff (+ xoff 128) yoff (+ yoff 128)))
 110             ;; (GREF . NREF)
 111             (setq xoff 0 yoff 0))
 112           (or (integerp gref)
 113               (setq gref (cdr (assq gref reference-point-alist))))
 114           (or (integerp nref)
 115               (setq nref (cdr (assq nref reference-point-alist))))
 116           (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
 117               (error "Invalid composition rule: %S" rule))
 118           (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref)))
 119       (error "Invalid composition rule: %S" rule))))
 120
 121 ;; Decode encoded composition rule RULE-CODE.  The value is a cons of
 122 ;; global and new reference point symbols.
 123 ;; This must be compatible with C macro COMPOSITION_DECODE_RULE
 124 ;; defined in composite.h.
 125
 126 (defun decode-composition-rule (rule-code)
 127   (or (and (natnump rule-code) (< rule-code #x1000000))
 128       (error "Invalid encoded composition rule: %S" rule-code))
 129   (let ((xoff (lsh rule-code -16))
 130         (yoff (logand (lsh rule-code -8) #xFF))
 131         gref nref)
 132     (setq rule-code (logand rule-code #xFF)
 133           gref (car (rassq (/ rule-code 12) reference-point-alist))
 134           nref (car (rassq (% rule-code 12) reference-point-alist)))
 135     (or (and gref (symbolp gref) nref (symbolp nref))
 136         (error "Invalid composition rule code: %S" rule-code))
 137     (if (and (= xoff 0) (= yoff 0))
 138         (cons gref nref)
 139       (setq xoff (- xoff 128) yoff (- yoff 128))
 140       (list gref xoff yoff nref))))
 141
 142 ;; Encode composition rules in composition components COMPONENTS.  The
 143 ;; value is a copy of COMPONENTS, where composition rules (cons of
 144 ;; global and new glyph reference point symbols) are replaced with
 145 ;; encoded composition rules.  Optional 2nd argument NOCOPY non-nil
 146 ;; means don't make a copy but modify COMPONENTS directly.
 147
 148 (defun encode-composition-components (components &optional nocopy)
 149   (or nocopy
 150       (setq components (copy-sequence components)))
 151   (if (vectorp components)
 152       (let ((len (length components))
 153             (i 1))
 154         (while (< i len)
 155           (aset components i
 156                 (encode-composition-rule (aref components i)))
 157           (setq i (+ i 2))))
 158     (let ((tail (cdr components)))
 159       (while tail
 160         (setcar tail
 161                 (encode-composition-rule (car tail)))
 162         (setq tail (nthcdr 2 tail)))))
 163   components)
 164
 165 ;; Decode composition rule codes in composition components COMPONENTS.
 166 ;; The value is a copy of COMPONENTS, where composition rule codes are
 167 ;; replaced with composition rules (cons of global and new glyph
 168 ;; reference point symbols).  Optional 2nd argument NOCOPY non-nil
 169 ;; means don't make a copy but modify COMPONENTS directly.
 170 ;; It is assumed that COMPONENTS is a vector and is for rule-base
 171 ;; composition, thus (2N+1)th elements are rule codes.
 172
 173 (defun decode-composition-components (components &optional nocopy)
 174   (or nocopy
 175       (setq components (copy-sequence components)))
 176   (let ((len (length components))
 177         (i 1))
 178     (while (< i len)
 179       (aset components i
 180             (decode-composition-rule (aref components i)))
 181       (setq i (+ i 2))))
 182   components)
 183
 184 (defun compose-region (start end &optional components modification-func)
 185   "Compose characters in the current region.
 186
 187 Characters are composed relatively, i.e. composed by overstricking or
 188 stacking depending on ascent, descent and other properties.
 189
 190 When called from a program, expects these four arguments.
 191
 192 First two arguments START and END are positions (integers or markers)
 193 specifying the region.
 194
 195 Optional 3rd argument COMPONENTS, if non-nil, is a character, a string
 196 or a vector or list of integers and rules.
 197
 198 If it is a character, it is an alternate character to display instead
 199 of the text in the region.
 200
 201 If it is a string, the elements are alternate characters.
 202
 203 If it is a vector or list, it is a sequence of alternate characters and
 204 composition rules, where (2N)th elements are characters and (2N+1)th
 205 elements are composition rules to specify how to compose (2N+2)th
 206 elements with previously composed N glyphs.
 207
 208 A composition rule is a cons of global and new glyph reference point
 209 symbols.  See the documentation of `reference-point-alist' for more
 210 detail.
 211
 212 Optional 4th argument MODIFICATION-FUNC is a function to call to
 213 adjust the composition when it gets invalid because of a change of
 214 text in the composition."
 215   (interactive "r")
 216   (let ((modified-p (buffer-modified-p))
 217         (inhibit-read-only t))
 218     (if (or (vectorp components) (listp components))
 219         (setq components (encode-composition-components components)))
 220     (compose-region-internal start end components modification-func)
 221     (restore-buffer-modified-p modified-p)))
 222
 223 (defun decompose-region (start end)
 224   "Decompose text in the current region.
 225
 226 When called from a program, expects two arguments,
 227 positions (integers or markers) specifying the region."
 228   (interactive "r")
 229   (let ((modified-p (buffer-modified-p))
 230         (inhibit-read-only t))
 231     (remove-text-properties start end '(composition nil))
 232     (restore-buffer-modified-p modified-p)))
 233
 234 (defun compose-string (string &optional start end components modification-func)
 235   "Compose characters in string STRING.
 236
 237 The return value is STRING with the `composition' property put on all
 238 the characters in it.
 239
 240 Optional 2nd and 3rd arguments START and END specify the range of
 241 STRING to be composed.  They default to the beginning and the end of
 242 STRING respectively.
 243
 244 Optional 4th argument COMPONENTS, if non-nil, is a character or a
 245 sequence (vector, list, or string) of integers.  See the function
 246 `compose-region' for more detail.
 247
 248 Optional 5th argument MODIFICATION-FUNC is a function to call to
 249 adjust the composition when it gets invalid because of a change of
 250 text in the composition."
 251   (if (or (vectorp components) (listp components))
 252       (setq components (encode-composition-components components)))
 253   (or start (setq start 0))
 254   (or end (setq end (length string)))
 255   (compose-string-internal string start end components modification-func)
 256   string)
 257
 258 (defun decompose-string (string)
 259   "Return STRING where `composition' property is removed."
 260   (remove-text-properties 0 (length string) '(composition nil) string)
 261   string)
 262
 263 (defun compose-chars (&rest args)
 264   "Return a string from arguments in which all characters are composed.
 265 For relative composition, arguments are characters.
 266 For rule-based composition, Mth \(where M is odd) arguments are
 267 characters, and Nth \(where N is even) arguments are composition rules.
 268 A composition rule is a cons of glyph reference points of the form
 269 \(GLOBAL-REF-POINT . NEW-REF-POINT).  See the documentation of
 270 `reference-point-alist' for more detail."
 271   (let (str components)
 272     (if (consp (car (cdr args)))
 273         ;; Rule-base composition.
 274         (let ((len (length args))
 275               (tail (encode-composition-components args 'nocopy)))
 276
 277           (while tail
 278             (setq str (cons (car tail) str))
 279             (setq tail (nthcdr 2 tail)))
 280           (setq str (concat (nreverse str))
 281                 components args))
 282       ;; Relative composition.
 283       (setq str (concat args)))
 284     (compose-string-internal str 0 (length str) components)))
 285
 286 (defun find-composition (pos &optional limit string detail-p)
 287   "Return information about a composition at or nearest to buffer position POS.
 288
 289 If the character at POS has `composition' property, the value is a list
 290 of FROM, TO, and VALID-P.
 291
 292 FROM and TO specify the range of text that has the same `composition'
 293 property, VALID-P is non-nil if and only if this composition is valid.
 294
 295 If there's no composition at POS, and the optional 2nd argument LIMIT
 296 is non-nil, search for a composition toward LIMIT.
 297
 298 If no composition is found, return nil.
 299
 300 Optional 3rd argument STRING, if non-nil, is a string to look for a
 301 composition in; nil means the current buffer.
 302
 303 If a valid composition is found and the optional 4th argument DETAIL-P
 304 is non-nil, the return value is a list of FROM, TO, COMPONENTS,
 305 RELATIVE-P, MOD-FUNC, and WIDTH.
 306
 307 COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
 308
 309 RELATIVE-P is t if the composition method is relative, else nil.
 310
 311 If RELATIVE-P is t, COMPONENTS is a vector of characters to be
 312 composed.  If RELATIVE-P is nil, COMPONENTS is a vector of characters
 313 and composition rules as described in `compose-region'.
 314
 315 MOD-FUNC is a modification function of the composition.
 316
 317 WIDTH is a number of columns the composition occupies on the screen."
 318   (let ((result (find-composition-internal pos limit string detail-p)))
 319     (if (and detail-p result (nth 2 result) (not (nth 3 result)))
 320         ;; This is a valid rule-base composition.
 321         (decode-composition-components (nth 2 result) 'nocopy))
 322     result))
 323
 324 \f
 325 (defun compose-chars-after (pos &optional limit object)
 326   "Compose characters in current buffer after position POS.
 327
 328 It looks up the char-table `composition-function-table' (which see) by
 329 a character after POS.  If non-nil value is found, the format of the
 330 value should be an alist of PATTERNs vs FUNCs, where PATTERNs are
 331 regular expressions and FUNCs are functions.  If the text after POS
 332 matches one of PATTERNs, call the corresponding FUNC with three
 333 arguments POS, TO, and PATTERN, where TO is the end position of text
 334 matching PATTERN, and return what FUNC returns.  Otherwise, return
 335 nil.
 336
 337 FUNC is responsible for composing the text properly.  The return value
 338 is:
 339   nil -- if no characters were composed.
 340   CHARS (integer) -- if CHARS characters were composed.
 341
 342 Optional 2nd arg LIMIT, if non-nil, limits the matching of text.
 343
 344 Optional 3rd arg OBJECT, if non-nil, is a string that contains the
 345 text to compose.  In that case, POS and LIMIT index into the string.
 346
 347 This function is the default value of `compose-chars-after-function'."
 348   (let ((tail (aref composition-function-table (char-after pos)))
 349         pattern func result)
 350     (when tail
 351       (save-match-data
 352         (save-excursion
 353           (while (and tail (not func))
 354             (setq pattern (car (car tail))
 355                   func (cdr (car tail)))
 356             (goto-char pos)
 357             (if (if limit
 358                     (and (re-search-forward pattern limit t)
 359                          (= (match-beginning 0) pos))
 360                   (looking-at pattern))
 361                 (setq result (funcall func pos (match-end 0) pattern nil))
 362               (setq func nil tail (cdr tail)))))))
 363       result))
 364
 365 (defun compose-last-chars (args)
 366   "Compose last characters.
 367 The argument is a parameterized event of the form
 368         \(compose-last-chars N COMPONENTS),
 369 where N is the number of characters before point to compose,
 370 COMPONENTS, if non-nil, is the same as the argument to `compose-region'
 371 \(which see).  If it is nil, `compose-chars-after' is called,
 372 and that function finds a proper rule to compose the target characters.
 373 This function is intended to be used from input methods.
 374 The global keymap binds special event `compose-last-chars' to this
 375 function.  Input method may generate an event (compose-last-chars N COMPONENTS)
 376 after a sequence of character events."
 377   (interactive "e")
 378   (let ((chars (nth 1 args)))
 379     (if (and (numberp chars)
 380              (>= (- (point) (point-min)) chars))
 381         (if (nth 2 args)
 382             (compose-region (- (point) chars) (point) (nth 2 args))
 383           (compose-chars-after (- (point) chars) (point))))))
 384
 385 (global-set-key [compose-last-chars] 'compose-last-chars)
 386
 387 \f
 388 ;;; Automatic character composition.
 389
 390 (defvar composition-function-table
 391   (make-char-table nil)
 392   "Char table of functions for automatic character composition.
 393 For each character that has to be composed automatically with
 394 preceding and/or following characters, this char table contains
 395 a function to call to compose that character.
 396
 397 An element, if non-nil, is FUNC or an alist of PATTERNs vs FUNCs,
 398 where PATTERNs are regular expressions and FUNCs are functions.
 399 If the element is FUNC, FUNC itself determines the region to
 400 compose.
 401
 402 Each function is called with 5 arguments, FROM, TO, FONT-OBJECT,
 403 and STRING.
 404
 405 If STRING is nil, FROM and TO are positions specifying the region
 406 maching with PATTERN in the current buffer, and the function has
 407 to compose character in that region (possibly with characters
 408 preceding FROM).  The return value of the function is the end
 409 position where characters are composed.
 410
 411 Otherwise, STRING is a string, and FROM and TO are indices into
 412 the string.  In this case, the function has to compose a
 413 character in the string.
 414
 415 FONT-OBJECT may be nil if not available (e.g. for the case of
 416 terminal).
 417
 418 See also the command `toggle-auto-composition'.")
 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 Compostion mode.
 545 With arg, turn Auto Compostion mode off if and only if arg is a non-positive
 546 number; if arg is nil, toggle Auto Compostion mode; anything else turns Auto
 547 Compostion 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 automagically 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                 (pos (point)))
 662             (if (functionp func)
 663                 (goto-char (funcall func (point) nil)))
 664             (if (<= (point) pos)
 665                 (forward-char 1)))))
 666       (put-text-property from to 'auto-composed t)
 667       (set-buffer-modified-p modified-p))))
 668
 669 \f
 670 ;; The following codes are only for backward compatibility with Emacs
 671 ;; 20.4 and earlier.
 672
 673 (defun decompose-composite-char (char &optional type with-composition-rule)
 674   "Convert CHAR to string.
 675
 676 If optional 2nd arg TYPE is non-nil, it is `string', `list', or
 677 `vector'.  In this case, CHAR is converted to string, list of CHAR, or
 678 vector of CHAR respectively.
 679 Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
 680   (cond ((or (null type) (eq type 'string)) (char-to-string char))
 681         ((eq type 'list) (list char))
 682         (t (vector char))))
 683
 684 (make-obsolete 'decompose-composite-char 'char-to-string "21.1")
 685
 686 \f
 687
 688 ;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
 689 ;;; composite.el ends here