;;; composite.el --- support character composition
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; 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
;; 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:
;;; Code:
-;;;###autoload
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
(mid-left . 3) (mid-center . 10) (mid-right . 5))
"Alist of symbols vs integer codes of glyph reference points.
A glyph reference point symbol is to be used to specify a composition
-rule in COMPONENTS argument to such functions as `compose-region' and
-`make-composition'.
+rule in COMPONENTS argument to such functions as `compose-region'.
Meanings of glyph reference point codes are as follows:
| | new |
| |glyph|
+----+-----+ <--- new descent
-")
+
+A composition rule may have the form \(GLOBAL-REF-POINT
+NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies 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.")
;;;###autoload
(if (and (integerp rule) (< rule 144))
;; Already encoded.
rule
- (or (consp rule)
- (error "Invalid composition rule: %S" rule))
- (let ((gref (car rule))
- (nref (cdr rule)))
- (or (integerp gref)
- (setq gref (cdr (assq gref reference-point-alist))))
- (or (integerp nref)
- (setq nref (cdr (assq nref reference-point-alist))))
- (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
- (error "Invalid composition rule: %S" rule))
- (+ (* gref 12) nref))))
+ (if (consp rule)
+ (let ((gref (car rule))
+ (nref (cdr rule))
+ xoff yoff)
+ (if (consp nref) ; (GREF NREF XOFF YOFF)
+ (progn
+ (setq xoff (nth 1 nref)
+ yoff (nth 2 nref)
+ nref (car nref))
+ (or (and (>= xoff -100) (<= xoff 100)
+ (>= yoff -100) (<= yoff 100))
+ (error "Invalid composition rule: %s" rule))
+ (setq xoff (+ xoff 128) yoff (+ yoff 128)))
+ ;; (GREF . NREF)
+ (setq xoff 0 yoff 0))
+ (or (integerp gref)
+ (setq gref (cdr (assq gref reference-point-alist))))
+ (or (integerp nref)
+ (setq nref (cdr (assq nref reference-point-alist))))
+ (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
+ (error "Invalid composition rule: %S" rule))
+ (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref)))
+ (error "Invalid composition rule: %S" rule))))
;; Decode encoded composition rule RULE-CODE. The value is a cons of
;; global and new reference point symbols.
;; defined in composite.h.
(defun decode-composition-rule (rule-code)
- (or (and (natnump rule-code) (< rule-code 144))
+ (or (and (natnump rule-code) (< rule-code #x1000000))
(error "Invalid encoded composition rule: %S" rule-code))
- (let ((gref (car (rassq (/ rule-code 12) reference-point-alist)))
- (nref (car (rassq (% rule-code 12) reference-point-alist))))
+ (let ((xoff (lsh rule-code -16))
+ (yoff (logand (lsh rule-code -8) #xFF))
+ gref nref)
+ (setq rule-code (logand rule-code #xFF)
+ gref (car (rassq (/ rule-code 12) reference-point-alist))
+ nref (car (rassq (% rule-code 12) reference-point-alist)))
(or (and gref (symbolp gref) nref (symbolp nref))
(error "Invalid composition rule code: %S" rule-code))
- (cons gref nref)))
+ (if (and (= xoff 0) (= yoff 0))
+ (cons gref nref)
+ (setq xoff (- xoff 128) yoff (- yoff 128))
+ (list gref xoff yoff nref))))
;; Encode composition rules in composition components COMPONENTS. The
;; value is a copy of COMPONENTS, where composition rules (cons of
(setq i (+ i 2))))
components)
-;;;###autoload
(defun compose-region (start end &optional components modification-func)
"Compose characters in the current region.
First two arguments START and END are positions (integers or markers)
specifying the region.
-Optional 3rd argument COMPONENTS, if non-nil, is a character or a
-sequence (vector, list, or string) of integers. In this case,
-characters are composed not relatively but according to COMPONENTS.
+Optional 3rd argument COMPONENTS, if non-nil, is a character, a string
+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
+characer 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 rigth 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
(compose-region-internal start end components modification-func)
(restore-buffer-modified-p modified-p)))
-;;;###autoload
(defun decompose-region (start end)
"Decompose text in the current region.
(remove-text-properties start end '(composition nil))
(restore-buffer-modified-p modified-p)))
-;;;###autoload
(defun compose-string (string &optional start end components modification-func)
"Compose characters in string STRING.
-The return value is STRING where `composition' property is put on all
+The return value is STRING with the `composition' property put on all
the characters in it.
Optional 2nd and 3rd arguments START and END specify the range of
(compose-string-internal string start end components modification-func)
string)
-;;;###autoload
(defun decompose-string (string)
"Return STRING where `composition' property is removed."
(remove-text-properties 0 (length string) '(composition nil) string)
string)
-;;;###autoload
(defun compose-chars (&rest args)
"Return a string from arguments in which all characters are composed.
For relative composition, arguments are characters.
(setq str (concat args)))
(compose-string-internal str 0 (length str) components)))
-;;;###autoload
(defun find-composition (pos &optional limit string detail-p)
"Return information about a composition at or nearest to buffer position POS.
of FROM, TO, and 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.
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 Compostion 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 gstring
+the specify how the chunk is 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))
\f
-;;;###autoload
(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.
-
-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.
+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'.
-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 to the string.
+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))
-;;;###autoload
(defun compose-last-chars (args)
"Compose last characters.
The argument is a parameterized event of the form
(compose-region (- (point) chars) (point) (nth 2 args))
(compose-chars-after (- (point) chars) (point))))))
-;;;###autoload(global-set-key [compose-last-chars] 'compose-last-chars)
+(global-set-key [compose-last-chars] 'compose-last-chars)
+
+\f
+;;; Automatic character 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)
+
+;; 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) g)
+ (while (and (< i nglyphs) (setq g (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
+ ascent descent lbearing rbearing)
+ (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 lbearing rbearing)
+ (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 wadjust)
+ (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.
+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
+a padding space before and/or after the character.
+
+All non-spacing characters has this function in
+`composition-function-table' unless overwritten."
+ (let* ((header (lgstring-header gstring))
+ (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 wadjust)
+ (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)))
+ xoff yoff)
+ (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 '(["[[:alpha:]]\\c^+" 1 compose-gstring-for-graphic]
+ [nil 0 compose-gstring-for-graphic])))
+ (map-char-table
+ #'(lambda (key val)
+ (if (= val 0)
+ (set-char-table-range composition-function-table key elt)))
+ char-width-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
+a prepending a space before it."
+ (let* ((header (lgstring-header gstring))
+ (nchars (lgstring-char-len gstring))
+ (nglyphs (lgstring-glyph-len gstring))
+ (i 0)
+ glyph)
+ (while (and (< i nglyphs)
+ (setq glyph (lgstring-glyph gstring i)))
+ (if (= (lglyph-width glyph) 0)
+ (progn
+ ;; Compose by prepending a space.
+ (setq gstring (lgstring-insert-glyph gstring i (lglyph-copy glyph))
+ nglyphs (lgstring-glyph-len gstring))
+ (lglyph-set-char (lgstring-glyph gstring i) 32)
+ (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))
+ (= (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 fucntion
+`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)."
+ (let ((gstring (composition-get-gstring from to font-object string)))
+ (if (lgstring-shaped-p gstring)
+ gstring
+ (or font-object
+ (setq func 'compose-gstring-for-terminal))
+ (funcall func gstring))))
+
+(make-variable-buffer-local 'auto-composition-function)
+
+;;;###autoload
+(define-minor-mode auto-composition-mode
+ "Toggle Auto Composition mode.
+With ARG, turn Auto Composition mode off if and only if ARG is a non-positive
+number; if ARG is nil, toggle Auto Composition mode; anything else turns Auto
+Composition on.
+
+When Auto Composition is enabled, text characters are automatically composed
+by functions registered in `composition-function-table' (which see).
+
+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)))
+
+;;;###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 if and only if 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)))
+ (font-obj (and (display-multi-font-p)
+ (font-at (point) (selected-window))))
+ (pos (point)))
+ (if (and (functionp func) font-obj)
+ (goto-char (funcall func (point) to font-obj nil)))
+ (if (<= (point) pos)
+ (forward-char 1)))))
+ (put-text-property from to 'auto-composed t)
+ (set-buffer-modified-p modified-p))))
\f
;; The following codes are only for backward compatibility with Emacs
;; 20.4 and earlier.
-;;;###autoload
(defun decompose-composite-char (char &optional type with-composition-rule)
"Convert CHAR to string.
((eq type 'list) (list char))
(t (vector char))))
-;;;###autoload
(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
\f