;;; composite.el --- support character composition
+;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
+
;; 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.
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
| | 7:bc or bottom-center
6----7----8 <---- descent 8:br or bottom-right
-Glyph reference point symbols are to be used to specify composition
-rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where
+Glyph reference point symbols are to be used to specify a composition
+rule of the form (GLOBAL-REF-POINT . NEW-REF-POINT), where
GLOBAL-REF-POINT is a reference point in the overall glyphs already
composed, and NEW-REF-POINT is a reference point in the new glyph to
be added.
| | |
| global| |
| glyph | |
- -- | | |-- <--- baseline \(doesn't change)
+ -- | | |-- <--- baseline (doesn't change)
+----+--*--+
| | 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
+A composition rule may have the form (GLOBAL-REF-POINT
+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.")
(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.
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
+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 rigth padding
+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
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
(defun compose-chars (&rest args)
"Return a string from arguments in which all characters are composed.
For relative composition, arguments are characters.
-For rule-based composition, Mth \(where M is odd) arguments are
-characters, and Nth \(where N is even) arguments are composition rules.
+For rule-based composition, Mth (where M is odd) arguments are
+characters, and Nth (where N is even) arguments are composition rules.
A composition rule is a cons of glyph reference points of the form
\(GLOBAL-REF-POINT . NEW-REF-POINT). See the documentation of
`reference-point-alist' for more detail."
(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)))
(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.
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.
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))
(defun compose-last-chars (args)
"Compose last characters.
The argument is a parameterized event of the form
- \(compose-last-chars N COMPONENTS),
+ (compose-last-chars N COMPONENTS),
where N is the number of characters before point to compose,
COMPONENTS, if non-nil, is the same as the argument to `compose-region'
\(which see). If it is nil, `compose-chars-after' is called,
\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 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))))
(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)))
+ (i idx))
+ (while (and (< i nglyphs) (lgstring-glyph gstring i))
(setq i (1+ i)))
(if (= i nglyphs)
(setq gstring (vconcat gstring (vector glyph)))
(defun compose-glyph-string (gstring from to)
(let ((glyph (lgstring-glyph gstring from))
- from-pos to-pos
- ascent descent lbearing rbearing)
+ 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)
(let ((font-object (lgstring-font gstring))
(glyph (lgstring-glyph gstring from))
from-pos to-pos
- ascent descent lbearing rbearing)
+ ascent descent)
(if gap
(setq gap (floor (* (font-get font-object :size) gap)))
(setq gap 0))
(lglyph-set-from-to glyph from-pos to-pos)
(let ((this-ascent (lglyph-ascent glyph))
(this-descent (lglyph-descent glyph))
- xoff yoff wadjust)
+ xoff yoff)
(setq xoff (if (<= (lglyph-rbearing glyph) 0) 0
(- (lglyph-width glyph))))
(if (> this-ascent 0)
(defun compose-gstring-for-graphic (gstring)
"Compose glyph-string GSTRING for graphic display.
-Non-spacing characters are composed with the preceding base
+Combining 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
+each combining 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
+All non-spacing characters have 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)))
+ (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 wadjust)
+ xoff)
(if (< lbearing 0)
(setq xoff (- lbearing))
(setq xoff 0 lbearing 0))
(rbearing (lglyph-rbearing glyph))
(lbearing (lglyph-lbearing glyph))
(center (/ (+ lbearing rbearing) 2))
- (gap (round (* (font-get (lgstring-font gstring) :size) 0.1)))
- xoff yoff)
+ ;; Artificial vertical gap between the glyphs.
+ (gap (round (* (font-get (lgstring-font gstring) :size) 0.1))))
+ (if (= gap 0)
+ ;; Assure at least 1 pixel vertical gap.
+ (setq gap 1))
(dotimes (i nchars)
(setq glyph (lgstring-glyph gstring i))
(when (> i 0)
(as (lglyph-ascent glyph))
(de (lglyph-descent glyph))
(ce (/ (+ lb rb) 2))
+ (w (lglyph-width glyph))
xoff yoff)
- (if (and
- class (>= class 200) (<= class 240)
- (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))))))
+ (cond
+ ((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)))
+ ((and (= class 0)
+ (eq (get-char-code-property (lglyph-char glyph)
+ 'general-category) 'Me))
+ ;; Artificially laying out glyphs in an enclosing
+ ;; mark is difficult. All we can do is to adjust
+ ;; the x-offset and width of the base glyph to
+ ;; align it at the center of the glyph of the
+ ;; enclosing mark hoping that the enclosing mark
+ ;; is big enough. We also have to adjust the
+ ;; x-offset and width of the mark ifself properly
+ ;; depending on how the glyph is designed.
+
+ ;; (non-spacing or not). For instance, when we
+ ;; have these glyphs:
+ ;; X position |
+ ;; base: <-*-> lbearing=0 rbearing=5 width=5
+ ;; mark: <----------.> lb=-11 rb=2 w=0
+ ;; we get a correct layout by moving them as this:
+ ;; base: <-*-> XOFF=4 WAD=9
+ ;; mark: <----------.> xoff=2 wad=4
+ ;; we have moved the base to the left by 4-pixel
+ ;; and make its width 9-pixel, then move the mark
+ ;; to the left 2-pixel and make its width 4-pixel.
+ (let* (;; Adjustment for the base glyph
+ (XOFF (/ (- rb lb width) 2))
+ (WAD (+ width XOFF))
+ ;; Adjustment for the enclosing mark glyph
+ (xoff (- (+ lb WAD)))
+ (wad (- rb lb WAD)))
+ (lglyph-set-adjustment glyph xoff 0 wad)
+ (setq glyph (lgstring-glyph gstring 0))
+ (lglyph-set-adjustment glyph XOFF 0 WAD))))
+ (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 '(["\\C^\\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-dotted-circle (gstring)
+ (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
+ (dc-id (lglyph-code dc))
+ (fc (lgstring-glyph gstring 1)) ; glyph of the following char
+ (fc-id (lglyph-code fc))
+ (gstr (and nil (font-shape-gstring gstring))))
+ (if (and gstr
+ (or (= (lgstring-glyph-len gstr) 1)
+ (and (= (lgstring-glyph-len gstr) 2)
+ (= (lglyph-to (lgstring-glyph gstr 0))
+ (lglyph-to (lgstring-glyph gstr 1))))))
+ ;; It seems that font-shape-gstring has composed glyphs.
+ gstr
+ ;; Artificially compose the following glyph with the preceding
+ ;; dotted-circle.
+ (setq dc (lgstring-glyph gstring 0)
+ fc (lgstring-glyph gstring 1))
+ (let ((dc-width (lglyph-width dc))
+ (fc-width (- (lglyph-rbearing fc) (lglyph-lbearing fc)))
+ (from (lglyph-from dc))
+ (to (lglyph-to fc))
+ (xoff 0) (yoff 0) (width 0))
+ (if (and (< (lglyph-descent fc) 0)
+ (> (lglyph-ascent dc) (- (lglyph-descent fc))))
+ ;; Set YOFF so that the following glyph is put on top of
+ ;; the dotted-circle.
+ (setq yoff (- (- (lglyph-descent fc)) (lglyph-ascent dc))))
+ (if (> (lglyph-width fc) 0)
+ (setq xoff (- (lglyph-rbearing fc))))
+ (if (< dc-width fc-width)
+ ;; The following glyph is wider, but we don't know how to
+ ;; align both glyphs. So, try the easiet method;
+ ;; i.e. align left edges of the glyphs.
+ (setq xoff (- xoff (- dc-width) (- (lglyph-lbearing fc )))
+ width (- fc-width dc-width)))
+ (if (or (/= xoff 0) (/= yoff 0) (/= width 0) (/= (lglyph-width fc) 0))
+ (lglyph-set-adjustment fc xoff yoff width))
+ (lglyph-set-from-to dc from to)
+ (lglyph-set-from-to fc from to))
+ (if (> (lgstring-glyph-len gstring) 2)
+ (lgstring-set-glyph gstring 2 nil))
+ gstring)))
+
+;; Allow for bootstrapping without uni-*.el.
+(when unicode-category-table
+ (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))
+ ;; for dotted-circle
+ (aset composition-function-table #x25CC
+ `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])))
(defun compose-gstring-for-terminal (gstring)
- "Compose glyph string GSTRING for terminal display.
+ "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)
+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 (= (lglyph-width glyph) 0)
+ (if (not (char-charset (lglyph-char glyph) coding))
(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))))))
+ ;; 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))
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
+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
(let ((gstring (composition-get-gstring from to font-object string)))
(if (lgstring-shaped-p gstring)
gstring
- (or font-object
+ (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 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.
+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 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 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.
-
-(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)
\f
-;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
;;; composite.el ends here