X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/430d2ee2919b2d4693780f2474ba40148442d206..5b8ccc5e3ba2c9f46e52f7aa1b149475ebf24861:/lisp/composite.el

diff --git a/lisp/composite.el b/lisp/composite.el
index 90f6b775bc..4832848cb9 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,18 +1,21 @@
 ;;; composite.el --- support character composition
 
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008
+;;   2008, 2009, 2010, 2011
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 
+;; Author: Kenichi HANDA <handa@etl.go.jp>
+;; (according to ack.texi)
 ;; Keywords: mule, multilingual, character composition
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +23,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -44,7 +45,7 @@
 A glyph reference point symbol is to be used to specify a composition
 rule in COMPONENTS argument to such functions as `compose-region'.
 
-Meanings of glyph reference point codes are as follows:
+The meaning of glyph reference point codes is as follows:
 
     0----1----2 <---- ascent	0:tl or top-left
     |         |			1:tc or top-center
@@ -77,7 +78,7 @@ follows (the point `*' corresponds to both reference points):
     +----+-----+ <--- new descent
 
 A composition rule may have the form \(GLOBAL-REF-POINT
-NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much
+NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specify how much
 to shift NEW-REF-POINT from GLOBAL-REF-POINT.  In this case, XOFF
 and YOFF are integers in the range -100..100 representing the
 shifting percentage against the font size.")
@@ -106,7 +107,7 @@ RULE is a cons of global and new reference point symbols
 		      nref (car nref))
 		(or (and (>= xoff -100) (<= xoff 100)
 			 (>= yoff -100) (<= yoff 100))
-		    (error "Invalid compostion rule: %s" rule))
+		    (error "Invalid composition rule: %s" rule))
 		(setq xoff (+ xoff 128) yoff (+ yoff 128)))
 	    ;; (GREF . NREF)
 	    (setq xoff 0 yoff 0))
@@ -185,8 +186,17 @@ RULE is a cons of global and new reference point symbols
 (defun compose-region (start end &optional components modification-func)
   "Compose characters in the current region.
 
-Characters are composed relatively, i.e. composed by overstricking or
-stacking depending on ascent, descent and other properties.
+Characters are composed relatively, i.e. composed by overstriking
+or stacking depending on ascent, descent and other metrics of
+glyphs.
+
+For instance, if the region has three characters \"XYZ\", X is
+regarded as BASE glyph, and Y is displayed:
+  (1) above BASE if Y's descent value is not positive
+  (2) below BASE if Y's ascent value is not positive
+  (3) on BASE (i.e. at the BASE position) otherwise
+and Z is displayed with the same rule while regarding the whole
+XY glyphs as BASE.
 
 When called from a program, expects these four arguments.
 
@@ -199,7 +209,12 @@ or a vector or list of integers and rules.
 If it is a character, it is an alternate character to display instead
 of the text in the region.
 
-If it is a string, the elements are alternate characters.
+If it is a string, the elements are alternate characters.  In
+this case, TAB element has a special meaning.  If the first
+character is TAB, the glyphs are displayed with left padding space
+so that no pixel overlaps with the previous column.  If the last
+character is TAB, the glyphs are displayed with right padding
+space so that no pixel overlaps with the following column.
 
 If it is a vector or list, it is a sequence of alternate characters and
 composition rules, where (2N)th elements are characters and (2N+1)th
@@ -208,7 +223,7 @@ elements with previously composed N glyphs.
 
 A composition rule is a cons of global and new glyph reference point
 symbols.  See the documentation of `reference-point-alist' for more
-detail.
+details.
 
 Optional 4th argument MODIFICATION-FUNC is a function to call to
 adjust the composition when it gets invalid because of a change of
@@ -272,9 +287,7 @@ A composition rule is a cons of glyph reference points of the form
   (let (str components)
     (if (consp (car (cdr args)))
 	;; Rule-base composition.
-	(let ((len (length args))
-	      (tail (encode-composition-components args 'nocopy)))
-
+	(let ((tail (encode-composition-components args 'nocopy)))
 	  (while tail
 	    (setq str (cons (car tail) str))
 	    (setq tail (nthcdr 2 tail)))
@@ -285,16 +298,16 @@ A composition rule is a cons of glyph reference points of the form
     (compose-string-internal str 0 (length str) components)))
 
 (defun find-composition (pos &optional limit string detail-p)
-  "Return information about a composition at or nearest to buffer position POS.
+  "Return information about a composition at or near buffer position POS.
 
 If the character at POS has `composition' property, the value is a list
-of FROM, TO, and VALID-P.
+\(FROM TO VALID-P).
 
 FROM and TO specify the range of text that has the same `composition'
-property, VALID-P is non-nil if and only if this composition is valid.
+property, VALID-P is t if this composition is valid, and nil if not.
 
 If there's no composition at POS, and the optional 2nd argument LIMIT
-is non-nil, search for a composition toward LIMIT.
+is non-nil, search for a composition toward the position given by LIMIT.
 
 If no composition is found, return nil.
 
@@ -302,8 +315,9 @@ Optional 3rd argument STRING, if non-nil, is a string to look for a
 composition in; nil means the current buffer.
 
 If a valid composition is found and the optional 4th argument DETAIL-P
-is non-nil, the return value is a list of FROM, TO, COMPONENTS,
-RELATIVE-P, MOD-FUNC, and WIDTH.
+is non-nil, the return value is a list of the form
+
+   (FROM TO COMPONENTS RELATIVE-P MOD-FUNC WIDTH)
 
 COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
 
@@ -315,9 +329,16 @@ and composition rules as described in `compose-region'.
 
 MOD-FUNC is a modification function of the composition.
 
-WIDTH is a number of columns the composition occupies on the screen."
+WIDTH is a number of columns the composition occupies on the screen.
+
+When Automatic Composition mode is on, this function also finds a
+chunk of text that is automatically composed.  If such a chunk is
+found closer to POS than the position that has `composition'
+property, the value is a list of FROM, TO, and a glyph-string
+that specifies how the chunk is to be composed.  See the function
+`composition-get-gstring' for the format of the glyph-string."
   (let ((result (find-composition-internal pos limit string detail-p)))
-    (if (and detail-p result (nth 2 result) (not (nth 3 result)))
+    (if (and detail-p (> (length result) 3) (nth 2 result) (not (nth 3 result)))
 	;; This is a valid rule-base composition.
 	(decode-composition-components (nth 2 result) 'nocopy))
     result))
@@ -326,42 +347,42 @@ WIDTH is a number of columns the composition occupies on the screen."
 (defun compose-chars-after (pos &optional limit object)
   "Compose characters in current buffer after position POS.
 
-It looks up the char-table `composition-function-table' (which see) by
-a character after POS.  If non-nil value is found, the format of the
-value should be an alist of PATTERNs vs FUNCs, where PATTERNs are
-regular expressions and FUNCs are functions.  If the text after POS
-matches one of PATTERNs, call the corresponding FUNC with three
-arguments POS, TO, and PATTERN, where TO is the end position of text
-matching PATTERN, and return what FUNC returns.  Otherwise, return
-nil.
+It looks up the char-table `composition-function-table' (which
+see) by a character at POS, and compose characters after POS
+according to the contents of `composition-function-table'.
 
-FUNC is responsible for composing the text properly.  The return value
-is:
-  nil -- if no characters were composed.
-  CHARS (integer) -- if CHARS characters were composed.
-
-Optional 2nd arg LIMIT, if non-nil, limits the matching of text.
+Optional 2nd arg LIMIT, if non-nil, limits characters to compose.
 
 Optional 3rd arg OBJECT, if non-nil, is a string that contains the
 text to compose.  In that case, POS and LIMIT index into the string.
 
 This function is the default value of `compose-chars-after-function'."
   (let ((tail (aref composition-function-table (char-after pos)))
+	(font-obj (and (display-multi-font-p)
+		       (and (not (stringp object))
+			    (font-at pos (selected-window)))))
 	pattern func result)
-    (when tail
+    (or limit
+	(setq limit (if (stringp object) (length object) (point-max))))
+    (when (and font-obj tail)
       (save-match-data
 	(save-excursion
-	  (while (and tail (not func))
-	    (setq pattern (car (car tail))
-		  func (cdr (car tail)))
+	  (while tail
+	    (if (functionp (car tail))
+		(setq pattern nil func (car tail))
+	      (setq pattern (car (car tail))
+		    func (cdr (car tail))))
 	    (goto-char pos)
-	    (if (if limit
-		    (and (re-search-forward pattern limit t)
-			 (= (match-beginning 0) pos))
-		  (looking-at pattern))
-		(setq result (funcall func pos (match-end 0) pattern nil))
-	      (setq func nil tail (cdr tail)))))))
-      result))
+	    (if pattern
+		(if (and (if (stringp object)
+			     (eq (string-match pattern object) 0)
+			   (looking-at pattern))
+			 (<= (match-end 0) limit))
+		    (setq result
+			  (funcall func pos (match-end 0) font-obj object)))
+	      (setq result (funcall func pos limit font-obj  object)))
+	    (if result (setq tail nil))))))
+    result))
 
 (defun compose-last-chars (args)
   "Compose last characters.
@@ -388,303 +409,351 @@ after a sequence of character events."
 
 ;;; Automatic character composition.
 
-(defvar composition-function-table
-  (make-char-table nil)
-  "Char table of functions for automatic character composition.
-For each character that has to be composed automatically with
-preceding and/or following characters, this char table contains
-a function to call to compose that character.
-
-An element, if non-nil, is FUNC or an alist of PATTERNs vs FUNCs,
-where PATTERNs are regular expressions and FUNCs are functions.
-If the element is FUNC, FUNC itself determines the region to
-compose.
-
-Each function is called with 5 arguments, FROM, TO, FONT-OBJECT,
-and STRING.
-
-If STRING is nil, FROM and TO are positions specifying the region
-maching with PATTERN in the current buffer, and the function has
-to compose character in that region (possibly with characters
-preceding FROM).  The return value of the function is the end
-position where characters are composed.
-
-Otherwise, STRING is a string, and FROM and TO are indices into
-the string.  In this case, the function has to compose a
-character in the string.
-
-FONT-OBJECT may be nil if not available (e.g. for the case of
-terminal).
-
-See also the command `toggle-auto-composition'.")
-
-;; Copied from font-lock.el.
-(eval-when-compile
-  ;; Borrowed from lazy-lock.el.
-  ;; We use this to preserve or protect things when modifying text properties.
-  (defmacro save-buffer-state (varlist &rest body)
-    "Bind variables according to VARLIST and eval BODY restoring buffer state."
-    `(let* ,(append varlist
-		    '((modified (buffer-modified-p)) (buffer-undo-list t)
-		      (inhibit-read-only t) (inhibit-point-motion-hooks t)
-		      (inhibit-modification-hooks t)
-		      deactivate-mark buffer-file-name buffer-file-truename))
-       ,@body
-       (unless modified
-	 (restore-buffer-modified-p nil))))
-  ;; Fixme: This makes bootstrapping fail with this error.
-  ;;   Symbol's function definition is void: eval-defun
-  ;;(def-edebug-spec save-buffer-state let)
-  )
-
-(put 'save-buffer-state 'lisp-indent-function 1)
-
-(defun terminal-composition-function (from to font-object string)
-  "General composition function used on terminal.
-Non-spacing characters are composed with the preceding spacing
-character.  All non-spacing characters has this function in
-`terminal-composition-function-table'."
-  (let ((pos (1+ from)))
-    (if string
-	(progn
-	  (while (and (< pos to)
-		      (= (aref char-width-table (aref string pos)) 0))
-	    (setq pos (1+ pos)))
-	  (if (> from 0)
-	      (compose-string string (1- from) pos)
-	    (compose-string string from pos
-			    (concat " " (buffer-substring from pos)))))
-      (while (and (< pos to)
-		  (= (aref char-width-table (char-after pos)) 0))
-	(setq pos (1+ pos)))
-      (if (> from (point-min))
-	  (compose-region (1- from) pos (buffer-substring from pos))
-	(compose-region from pos
-			(concat " " (buffer-substring from pos)))))
-    pos))
-
-(defvar terminal-composition-function-table
-  (let ((table (make-char-table nil)))
-    (map-char-table
-     #'(lambda (key val)
-	 (if (= val 0) (set-char-table-range table key
-					     'terminal-composition-function)))
-     char-width-table)
-    table)
-  "Char table of functions for automatic character composition on terminal.
-This is like `composition-function-table' but used when Emacs is running
-on a terminal.")
-
-(defun auto-compose-chars (from to window string)
-  "Compose characters in the region between FROM and TO.
-WINDOW is a window displaying the current buffer.
+;; These macros must match with C macros LGSTRING_XXX and LGLYPH_XXX in font.h
+(defsubst lgstring-header (gstring) (aref gstring 0))
+(defsubst lgstring-set-header (gstring header) (aset gstring 0 header))
+(defsubst lgstring-font (gstring) (aref (lgstring-header gstring) 0))
+(defsubst lgstring-char (gstring i) (aref (lgstring-header gstring) (1+ i)))
+(defsubst lgstring-char-len (gstring) (1- (length (lgstring-header gstring))))
+(defsubst lgstring-shaped-p (gstring) (aref gstring 1))
+(defsubst lgstring-set-id (gstring id) (aset gstring 1 id))
+(defsubst lgstring-glyph (gstring i) (aref gstring (+ i 2)))
+(defsubst lgstring-glyph-len (gstring) (- (length gstring) 2))
+(defsubst lgstring-set-glyph (gstring i glyph) (aset gstring (+ i 2) glyph))
+
+(defsubst lglyph-from (glyph) (aref glyph 0))
+(defsubst lglyph-to (glyph) (aref glyph 1))
+(defsubst lglyph-char (glyph) (aref glyph 2))
+(defsubst lglyph-code (glyph) (aref glyph 3))
+(defsubst lglyph-width (glyph) (aref glyph 4))
+(defsubst lglyph-lbearing (glyph) (aref glyph 5))
+(defsubst lglyph-rbearing (glyph) (aref glyph 6))
+(defsubst lglyph-ascent (glyph) (aref glyph 7))
+(defsubst lglyph-descent (glyph) (aref glyph 8))
+(defsubst lglyph-adjustment (glyph) (aref glyph 9))
+
+(defsubst lglyph-set-from-to (glyph from to)
+  (progn (aset glyph 0 from) (aset glyph 1 to)))
+(defsubst lglyph-set-char (glyph char) (aset glyph 2 char))
+(defsubst lglyph-set-code (glyph code) (aset glyph 3 code))
+(defsubst lglyph-set-width (glyph width) (aset glyph 4 width))
+(defsubst lglyph-set-adjustment (glyph &optional xoff yoff wadjust)
+  (aset glyph 9 (vector (or xoff 0) (or yoff 0) (or wadjust 0))))
+
+(defsubst lglyph-copy (glyph) (copy-sequence glyph))
+
+(defun lgstring-insert-glyph (gstring idx glyph)
+  (let ((nglyphs (lgstring-glyph-len gstring))
+	(i idx))
+    (while (and (< i nglyphs) (lgstring-glyph gstring i))
+      (setq i (1+ i)))
+    (if (= i nglyphs)
+	(setq gstring (vconcat gstring (vector glyph)))
+      (if (< (1+ i) nglyphs)
+	  (lgstring-set-glyph gstring (1+ i) nil)))
+    (while (> i idx)
+      (lgstring-set-glyph gstring i (lgstring-glyph gstring (1- i)))
+      (setq i (1- i)))
+    (lgstring-set-glyph gstring i glyph)
+    gstring))
+
+(defun compose-glyph-string (gstring from to)
+  (let ((glyph (lgstring-glyph gstring from))
+	from-pos to-pos)
+    (setq from-pos (lglyph-from glyph)
+	  to-pos (lglyph-to (lgstring-glyph gstring (1- to))))
+    (lglyph-set-from-to glyph from-pos to-pos)
+    (setq from (1+ from))
+    (while (and (< from to)
+		(setq glyph (lgstring-glyph gstring from)))
+      (lglyph-set-from-to glyph from-pos to-pos)
+      (let ((xoff (if (<= (lglyph-rbearing glyph) 0) 0
+		    (- (lglyph-width glyph)))))
+	(lglyph-set-adjustment glyph xoff 0 0))
+      (setq from (1+ from)))
+    gstring))
+
+(defun compose-glyph-string-relative (gstring from to &optional gap)
+  (let ((font-object (lgstring-font gstring))
+	(glyph (lgstring-glyph gstring from))
+	from-pos to-pos
+	ascent descent)
+    (if gap
+	(setq gap (floor (* (font-get font-object :size) gap)))
+      (setq gap 0))
+    (setq from-pos (lglyph-from glyph)
+	  to-pos (lglyph-to (lgstring-glyph gstring (1- to)))
+	  ascent (lglyph-ascent glyph)
+	  descent (lglyph-descent glyph))
+    (lglyph-set-from-to glyph from-pos to-pos)
+    (setq from (1+ from))
+    (while (< from to)
+      (setq glyph (lgstring-glyph gstring from))
+      (lglyph-set-from-to glyph from-pos to-pos)
+      (let ((this-ascent (lglyph-ascent glyph))
+	    (this-descent (lglyph-descent glyph))
+	    xoff yoff)
+	(setq xoff (if (<= (lglyph-rbearing glyph) 0) 0
+		     (- (lglyph-width glyph))))
+	(if (> this-ascent 0)
+	    (if (< this-descent 0)
+		(setq yoff (- 0 ascent gap this-descent)
+		      ascent (+ ascent gap this-ascent this-descent))
+	      (setq yoff 0))
+	  (setq yoff (+ descent gap this-ascent)
+		descent (+ descent gap this-ascent this-descent)))
+	(if (or (/= xoff 0) (/= yoff 0))
+	    (lglyph-set-adjustment glyph xoff yoff 0)))
+      (setq from (1+ from)))
+    gstring))
+
+(defun compose-gstring-for-graphic (gstring)
+  "Compose glyph-string GSTRING for graphic display.
+Combining characters are composed with the preceding base
+character.  If the preceding character is not a base character,
+each combining character is composed as a spacing character by
+a padding space before and/or after the character.
+
+All non-spacing characters have this function in
+`composition-function-table' unless overwritten."
+  (let ((nchars (lgstring-char-len gstring))
+        (nglyphs (lgstring-glyph-len gstring))
+        (glyph (lgstring-glyph gstring 0)))
+    (cond
+     ;; A non-spacing character not following a proper base character.
+     ((= nchars 1)
+      (let ((lbearing (lglyph-lbearing glyph))
+	    (rbearing (lglyph-rbearing glyph))
+	    (width (lglyph-width glyph))
+	    xoff)
+	(if (< lbearing 0)
+	    (setq xoff (- lbearing))
+	  (setq xoff 0 lbearing 0))
+	(if (< rbearing width)
+	    (setq rbearing width))
+	(lglyph-set-adjustment glyph xoff 0 (- rbearing lbearing))
+	gstring))
+
+     ;; This sequence doesn't start with a proper base character.
+     ((memq (get-char-code-property (lgstring-char gstring 0)
+				    'general-category)
+	    '(Mn Mc Me Zs Zl Zp Cc Cf Cs))
+      nil)
+
+     ;; A base character and the following non-spacing characters.
+     (t
+      (let ((gstr (font-shape-gstring gstring)))
+	(if (and gstr
+		 (> (lglyph-to (lgstring-glyph gstr 0)) 0))
+	    gstr
+	  ;; The shaper of the font couldn't shape the gstring.
+	  ;; Shape them according to canonical-combining-class.
+	  (lgstring-set-id gstring nil)
+	  (let* ((width (lglyph-width glyph))
+		 (ascent (lglyph-ascent glyph))
+		 (descent (lglyph-descent glyph))
+		 (rbearing (lglyph-rbearing glyph))
+		 (lbearing (lglyph-lbearing glyph))
+		 (center (/ (+ lbearing rbearing) 2))
+		 (gap (round (* (font-get (lgstring-font gstring) :size) 0.1))))
+	    (dotimes (i nchars)
+	      (setq glyph (lgstring-glyph gstring i))
+	      (when (> i 0)
+		(let* ((class (get-char-code-property
+			       (lglyph-char glyph) 'canonical-combining-class))
+		       (lb (lglyph-lbearing glyph))
+		       (rb (lglyph-rbearing glyph))
+		       (as (lglyph-ascent glyph))
+		       (de (lglyph-descent glyph))
+		       (ce (/ (+ lb rb) 2))
+		       xoff yoff)
+		  (when (and class (>= class 200) (<= class 240))
+		    (setq xoff 0 yoff 0)
+		    (cond
+		     ((= class 200)
+		      (setq xoff (- lbearing ce)
+			    yoff (if (> as 0) 0 (+ descent as))))
+		     ((= class 202)
+		      (if (> as 0) (setq as 0))
+		      (setq xoff (- center ce)
+			    yoff (if (> as 0) 0 (+ descent as))))
+		     ((= class 204)
+		      (if (> as 0) (setq as 0))
+		      (setq xoff (- rbearing ce)
+			    yoff (if (> as 0) 0 (+ descent as))))
+		     ((= class 208)
+		      (setq xoff (- lbearing rb)))
+		     ((= class 210)
+		      (setq xoff (- rbearing lb)))
+		     ((= class 212)
+		      (setq xoff (- lbearing ce)
+			    yoff (if (>= de 0) 0 (- (- ascent) de))))
+		     ((= class 214)
+		      (setq xoff (- center ce)
+			    yoff (if (>= de 0) 0 (- (- ascent) de))))
+		     ((= class 216)
+		      (setq xoff (- rbearing ce)
+			    yoff (if (>= de 0) 0 (- (- ascent) de))))
+		     ((= class 218)
+		      (setq xoff (- lbearing ce)
+			    yoff (if (> as 0) 0 (+ descent as gap))))
+		     ((= class 220)
+		      (setq xoff (- center ce)
+			    yoff (if (> as 0) 0 (+ descent as gap))))
+		     ((= class 222)
+		      (setq xoff (- rbearing ce)
+			    yoff (if (> as 0) 0 (+ descent as gap))))
+		     ((= class 224)
+		      (setq xoff (- lbearing rb)))
+		     ((= class 226)
+		      (setq xoff (- rbearing lb)))
+		     ((= class 228)
+		      (setq xoff (- lbearing ce)
+			    yoff (if (>= de 0) 0 (- (- ascent) de gap))))
+		     ((= class 230)
+		      (setq xoff (- center ce)
+			    yoff (if (>= de 0) 0 (- (- ascent) de gap))))
+		     ((= class 232)
+		      (setq xoff (- rbearing ce)
+			    yoff (if (>= de 0) 0 (- (+ ascent de) gap)))))
+		    (lglyph-set-adjustment glyph (- xoff width) yoff)
+		    (setq lb (+ lb xoff)
+			  rb (+ lb xoff)
+			  as (- as yoff)
+			  de (+ de yoff)))
+		  (if (< ascent as)
+		      (setq ascent as))
+		  (if (< descent de)
+		      (setq descent de))))))
+	  (let ((i 0))
+	    (while (and (< i nglyphs) (setq glyph (lgstring-glyph gstring i)))
+	      (lglyph-set-from-to glyph 0 (1- nchars))
+	      (setq i (1+ i))))
+	  gstring))))))
+
+(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
+	     [nil 0 compose-gstring-for-graphic])))
+  (map-char-table
+   #'(lambda (key val)
+       (if (memq val '(Mn Mc Me))
+	   (set-char-table-range composition-function-table key elt)))
+   unicode-category-table))
+
+(defun compose-gstring-for-terminal (gstring)
+  "Compose glyph string GSTRING for terminal display.
+Non-spacing characters are composed with the preceding base
+character.  If the preceding character is not a base character,
+each non-spacing character is composed as a spacing character by
+prepending a space before it."
+  (let ((nglyphs (lgstring-glyph-len gstring))
+        (i 0)
+        (coding (lgstring-font gstring))
+        glyph)
+    (while (and (< i nglyphs)
+		(setq glyph (lgstring-glyph gstring i)))
+      (if (not (char-charset (lglyph-char glyph) coding))
+	  (progn
+	    ;; As the terminal doesn't support this glyph, return a
+	    ;; gstring in which each glyph is its own grapheme-cluster
+	    ;; of width 1..
+	    (setq i 0)
+	    (while (and (< i nglyphs)
+			(setq glyph (lgstring-glyph gstring i)))
+	      (if (< (lglyph-width glyph) 1)
+		  (lglyph-set-width glyph 1))
+	      (lglyph-set-from-to glyph i i)
+	      (setq i (1+ i))))
+	(if (= (lglyph-width glyph) 0)
+	    (if (eq (get-char-code-property (lglyph-char glyph)
+					    'general-category)
+		    'Cf)
+		(progn
+		  ;; Compose by replacing with a space.
+		  (lglyph-set-char glyph 32)
+		  (lglyph-set-width glyph 1)
+		  (setq i (1+ i)))
+	      ;; Compose by prepending a space.
+	      (setq gstring (lgstring-insert-glyph gstring i
+						   (lglyph-copy glyph))
+		    nglyphs (lgstring-glyph-len gstring))
+	      (setq glyph (lgstring-glyph gstring i))
+	      (lglyph-set-char glyph 32)
+	      (lglyph-set-width glyph 1)
+	      (setq i (+ 2)))
+	  (let ((from (lglyph-from glyph))
+		(to (lglyph-to glyph))
+		(j (1+ i)))
+	    (while (and (< j nglyphs)
+			(setq glyph (lgstring-glyph gstring j))
+			(char-charset (lglyph-char glyph) coding)
+			(= (lglyph-width glyph) 0))
+	      (setq to (lglyph-to glyph)
+		    j (1+ j)))
+	    (while (< i j)
+	      (setq glyph (lgstring-glyph gstring i))
+	      (lglyph-set-from-to glyph from to)
+	      (setq i (1+ i)))))))
+    gstring))
+
+
+(defun auto-compose-chars (func from to font-object string)
+  "Compose the characters at FROM by FUNC.
+FUNC is called with one argument GSTRING which is built for characters
+in the region FROM (inclusive) and TO (exclusive).
+
+If the character are composed on a graphic display, FONT-OBJECT
+is a font to use.  Otherwise, FONT-OBJECT is nil, and the function
+`compose-gstring-for-terminal' is used instead of FUNC.
+
 If STRING is non-nil, it is a string, and FROM and TO are indices
 into the string.  In that case, compose characters in the string.
 
+The value is a gstring containing information for shaping the characters.
+
 This function is the default value of `auto-composition-function' (which see)."
-  (save-buffer-state nil
-    (save-excursion
-      (save-restriction
-	(save-match-data
-	  (let ((table (if (display-graphic-p)
-			   composition-function-table
-			 terminal-composition-function-table))
-		(start from))
-	    (setq to (or (text-property-any (1+ from) to 'auto-composed t
-					    string)
-			 to))
-	    (if string
-		(while (< from to)
-		  (let* ((ch (aref string from))
-			 (elt (aref table ch))
-			 font-obj newpos)
-		    (when elt
-		      (if window
-			  (setq font-obj (font-at from window string)))
-		      (if (functionp elt)
-			  (setq newpos (funcall elt from to font-obj string))
-			(while (and elt
-				    (or (not (eq (string-match (caar elt) string
-							       from)
-						 from))
-					(not (setq newpos
-						   (funcall (cdar elt) from
-							    (match-end 0)
-							    font-obj string)))))
-			  (setq elt (cdr elt)))))
-		    (if (and newpos (> newpos from))
-			(setq from newpos)
-		      (setq from (1+ from)))))
-	      (narrow-to-region from to)
-	      (while (< from to)
-		  (let* ((ch (char-after from))
-			 (elt (aref table ch))
-			 func pattern font-obj newpos)
-		    (when elt
-		      (if window
-			  (setq font-obj (font-at from window)))
-		      (if (functionp elt)
-			  (setq newpos (funcall elt from to font-obj nil))
-			(goto-char from)
-			(while (and elt
-				    (or (not (looking-at (caar elt)))
-					(not (setq newpos
-						   (funcall (cdar elt) from
-							    (match-end 0)
-							    font-obj nil)))))
-			  (setq elt (cdr elt)))))
-		    (if (and newpos (> newpos from))
-			(setq from newpos)
-		      (setq from (1+ from))))))
-	    (put-text-property start to 'auto-composed t string)))))))
+  (let ((gstring (composition-get-gstring from to font-object string)))
+    (if (lgstring-shaped-p gstring)
+	gstring
+      (or (fontp font-object 'font-object)
+	  (setq func 'compose-gstring-for-terminal))
+      (funcall func gstring))))
+
+(put 'auto-composition-mode 'permanent-local t)
 
 (make-variable-buffer-local 'auto-composition-function)
+(setq-default auto-composition-function 'auto-compose-chars)
 
 ;;;###autoload
 (define-minor-mode auto-composition-mode
-  "Toggle Auto Compostion mode.
-With arg, turn Auto Compostion mode off if and only if arg is a non-positive
-number; if arg is nil, toggle Auto Compostion mode; anything else turns Auto
-Compostion on.
+  "Toggle Auto Composition mode.
+With a prefix argument ARG, enable Auto Composition mode if ARG
+is positive, and disable it otherwise.  If called from Lisp,
+enable the mode if ARG is omitted or nil.
 
-When Auto Composition is enabled, text characters are automatically composed
-by functions registered in `composition-function-table' (which see).
+When Auto Composition mode is enabled, text characters are
+automatically composed by functions registered in
+`composition-function-table'.
 
-You can use Global Auto Composition mode to automagically turn on
+You can use `global-auto-composition-mode' to turn on
 Auto Composition mode in all buffers (this is the default)."
-  nil nil nil
-  (if noninteractive
-      (setq auto-composition-mode nil))
-  (cond (auto-composition-mode
-	 (add-hook 'after-change-functions 'auto-composition-after-change nil t)
-	 (setq auto-composition-function 'auto-compose-chars))
-	(t
-	 (remove-hook 'after-change-functions 'auto-composition-after-change t)
-	 (setq auto-composition-function nil)))
-  (save-buffer-state nil
-    (save-restriction
-      (widen)
-      (remove-text-properties (point-min) (point-max) '(auto-composed nil))
-      (decompose-region (point-min) (point-max)))))
-
-(defun auto-composition-after-change (start end old-len)
-  (save-buffer-state nil
-    (if (< start (point-min))
-	(setq start (point-min)))
-    (if (> end (point-max))
-	(setq end (point-max)))
-    (when (and auto-composition-mode (not memory-full))
-      (let (func1 func2)
-	(when (and (> start (point-min))
-		   (setq func2 (aref composition-function-table
-				     (char-after (1- start))))
-		   (or (= start (point-max))
-		       (not (setq func1 (aref composition-function-table
-					      (char-after start))))
-		       (eq func1 func2)))
-	  (setq start (1- start)
-		func1 func2)
-	  (while (eq func1 func2)
-	    (if (> start (point-min))
-		(setq start (1- start)
-		      func2 (aref composition-function-table
-				  (char-after start)))
-	      (setq func2 nil))))
-	(when (and (< end (point-max))
-		   (setq func2 (aref composition-function-table
-				     (char-after end)))
-		   (or (= end (point-min))
-		       (not (setq func1 (aref composition-function-table
-					      (char-after (1- end)))))
-		       (eq func1 func2)))
-	  (setq end (1+ end)
-		func1 func2)
-	  (while (eq func1 func2)
-	    (if (< end (point-max))
-		(setq func2 (aref composition-function-table
-				  (char-after end))
-		      end (1+ end))
-	      (setq func2 nil))))
-	(if (< start end)
-	    (remove-text-properties start end '(auto-composed nil)))))))
-
-(defun turn-on-auto-composition-if-enabled ()
-  (if enable-multibyte-characters
-      (auto-composition-mode 1)))
+  ;; It's defined in C, this stops the d-m-m macro defining it again.
+  :variable auto-composition-mode)
+;; It's not defined with DEFVAR_PER_BUFFER though.
+(make-variable-buffer-local 'auto-composition-mode)
 
 ;;;###autoload
-(define-global-minor-mode global-auto-composition-mode
-  auto-composition-mode turn-on-auto-composition-if-enabled
-  :extra-args (dummy)
-  :initialize 'custom-initialize-safe-default
-  :init-value (not noninteractive)
-  :group 'auto-composition
-  :version "23.1")
-
-(defun toggle-auto-composition (&optional arg)
-  "Change whether automatic character composition is enabled in this buffer.
-With arg, enable it iff arg is positive."
-  (interactive "P")
-  (let ((enable (if (null arg) (not auto-composition-function)
-		  (> (prefix-numeric-value arg) 0))))
-    (if enable
-	(kill-local-variable 'auto-composition-function)
-      (make-local-variable 'auto-composition-function)
-      (setq auto-composition-function nil)
-      (save-buffer-state nil
-	(save-restriction
-	  (widen)
-	  (decompose-region (point-min) (point-max)))))
-
-    (save-buffer-state nil
-      (save-restriction
-	(widen)
-	(remove-text-properties (point-min) (point-max)
-				'(auto-composed nil))))))
-
-(defun auto-compose-region (from to)
-  "Force automatic character composition on the region FROM and TO."
-  (save-excursion
-    (if (get-text-property from 'auto-composed)
-	(setq from (next-single-property-change from 'auto-composed nil to)))
-    (goto-char from)
-    (let ((modified-p (buffer-modified-p))
-	  (inhibit-read-only '(composition auto-composed))
-	  (stop (next-single-property-change (point) 'auto-composed nil to)))
-      (while (< (point) to)
-	(if (= (point) stop)
-	    (progn
-	      (goto-char (next-single-property-change (point)
-						      'auto-composed nil to))
-	      (setq stop (next-single-property-change (point)
-						      'auto-composed nil to)))
-	  (let ((func (aref composition-function-table (following-char)))
-		(pos (point)))
-	    (if (functionp func)
-		(goto-char (funcall func (point) nil)))
-	    (if (<= (point) pos)
-		(forward-char 1)))))
-      (put-text-property from to 'auto-composed t)
-      (set-buffer-modified-p modified-p))))
-
-
-;; The following codes are only for backward compatibility with Emacs
-;; 20.4 and earlier.
-
-(defun decompose-composite-char (char &optional type with-composition-rule)
-  "Convert CHAR to string.
+(define-minor-mode global-auto-composition-mode
+  "Toggle Auto Composition mode in all buffers.
+With a prefix argument ARG, enable it if ARG is positive, and
+disable it otherwise.  If called from Lisp, enable it if ARG is
+omitted or nil.
 
-If optional 2nd arg TYPE is non-nil, it is `string', `list', or
-`vector'.  In this case, CHAR is converted to string, list of CHAR, or
-vector of CHAR respectively.
-Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
-  (cond ((or (null type) (eq type 'string)) (char-to-string char))
-	((eq type 'list) (list char))
-	(t (vector char))))
+For more information on Auto Composition mode, see
+`auto-composition-mode' ."
+  :variable (default-value 'auto-composition-mode))
 
-(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
+(defalias 'toggle-auto-composition 'auto-composition-mode)
 
 
 
-;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
 ;;; composite.el ends here