2001-07-15 19:53:53 +00:00
|
|
|
|
;;; composite.el --- support character composition
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2008-01-07 02:45:14 +00:00
|
|
|
|
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
|
2009-01-05 03:18:22 +00:00
|
|
|
|
;; 2008, 2009
|
2005-12-19 07:04:44 +00:00
|
|
|
|
;; National Institute of Advanced Industrial Science and Technology (AIST)
|
|
|
|
|
;; Registration Number H14PRO021
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2009-01-10 21:56:18 +00:00
|
|
|
|
;; Author: Kenichi HANDA <handa@etl.go.jp>
|
|
|
|
|
;; (according to ack.texi)
|
1999-12-15 00:28:11 +00:00
|
|
|
|
;; Keywords: mule, multilingual, character composition
|
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1999-12-15 00:28:11 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2001-07-15 19:53:53 +00:00
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
1999-12-15 00:28:11 +00:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(defconst reference-point-alist
|
|
|
|
|
'((tl . 0) (tc . 1) (tr . 2)
|
|
|
|
|
(Bl . 3) (Bc . 4) (Br . 5)
|
|
|
|
|
(bl . 6) (bc . 7) (br . 8)
|
|
|
|
|
(cl . 9) (cc . 10) (cr . 11)
|
|
|
|
|
(top-left . 0) (top-center . 1) (top-right . 2)
|
|
|
|
|
(base-left . 3) (base-center . 4) (base-right . 5)
|
|
|
|
|
(bottom-left . 6) (bottom-center . 7) (bottom-right . 8)
|
|
|
|
|
(center-left . 9) (center-center . 10) (center-right . 11)
|
|
|
|
|
;; For backward compatibility...
|
|
|
|
|
(ml . 3) (mc . 10) (mr . 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
|
2003-09-11 09:24:56 +00:00
|
|
|
|
rule in COMPONENTS argument to such functions as `compose-region'.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
Meanings of glyph reference point codes are as follows:
|
|
|
|
|
|
|
|
|
|
0----1----2 <---- ascent 0:tl or top-left
|
|
|
|
|
| | 1:tc or top-center
|
|
|
|
|
| | 2:tr or top-right
|
|
|
|
|
| | 3:Bl or base-left 9:cl or center-left
|
|
|
|
|
9 10 11 <---- center 4:Bc or base-center 10:cc or center-center
|
|
|
|
|
| | 5:Br or base-right 11:cr or center-right
|
|
|
|
|
--3----4----5-- <-- baseline 6:bl or bottom-left
|
|
|
|
|
| | 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
|
|
|
|
|
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.
|
|
|
|
|
|
|
|
|
|
For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and
|
2001-04-06 01:22:03 +00:00
|
|
|
|
NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as
|
1999-12-15 00:28:11 +00:00
|
|
|
|
follows (the point `*' corresponds to both reference points):
|
|
|
|
|
|
|
|
|
|
+-------+--+ <--- new ascent
|
|
|
|
|
| | |
|
|
|
|
|
| global| |
|
|
|
|
|
| glyph | |
|
|
|
|
|
-- | | |-- <--- baseline \(doesn't change)
|
|
|
|
|
+----+--*--+
|
|
|
|
|
| | new |
|
|
|
|
|
| |glyph|
|
|
|
|
|
+----+-----+ <--- new descent
|
2004-01-23 08:43:36 +00:00
|
|
|
|
|
|
|
|
|
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.")
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
|
2004-09-08 07:18:13 +00:00
|
|
|
|
;;;###autoload
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(defun encode-composition-rule (rule)
|
2004-09-08 07:18:13 +00:00
|
|
|
|
"Encode composition rule RULE into an integer value.
|
|
|
|
|
RULE is a cons of global and new reference point symbols
|
2005-07-20 13:03:40 +00:00
|
|
|
|
\(see `reference-point-alist')."
|
2004-09-08 07:18:13 +00:00
|
|
|
|
|
|
|
|
|
;; This must be compatible with C macro COMPOSITION_ENCODE_RULE
|
|
|
|
|
;; defined in composite.h.
|
|
|
|
|
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(if (and (integerp rule) (< rule 144))
|
|
|
|
|
;; Already encoded.
|
|
|
|
|
rule
|
2004-01-23 08:43:36 +00:00
|
|
|
|
(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))
|
2008-02-21 07:53:55 +00:00
|
|
|
|
(error "Invalid composition rule: %s" rule))
|
2004-01-23 08:43:36 +00:00
|
|
|
|
(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))))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
;; Decode encoded composition rule RULE-CODE. The value is a cons of
|
|
|
|
|
;; global and new reference point symbols.
|
|
|
|
|
;; This must be compatible with C macro COMPOSITION_DECODE_RULE
|
|
|
|
|
;; defined in composite.h.
|
|
|
|
|
|
|
|
|
|
(defun decode-composition-rule (rule-code)
|
2004-01-23 08:43:36 +00:00
|
|
|
|
(or (and (natnump rule-code) (< rule-code #x1000000))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(error "Invalid encoded composition rule: %S" rule-code))
|
2004-01-23 08:43:36 +00:00
|
|
|
|
(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)))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(or (and gref (symbolp gref) nref (symbolp nref))
|
|
|
|
|
(error "Invalid composition rule code: %S" rule-code))
|
2004-01-23 08:43:36 +00:00
|
|
|
|
(if (and (= xoff 0) (= yoff 0))
|
|
|
|
|
(cons gref nref)
|
|
|
|
|
(setq xoff (- xoff 128) yoff (- yoff 128))
|
|
|
|
|
(list gref xoff yoff nref))))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
;; Encode composition rules in composition components COMPONENTS. The
|
|
|
|
|
;; value is a copy of COMPONENTS, where composition rules (cons of
|
|
|
|
|
;; global and new glyph reference point symbols) are replaced with
|
|
|
|
|
;; encoded composition rules. Optional 2nd argument NOCOPY non-nil
|
|
|
|
|
;; means don't make a copy but modify COMPONENTS directly.
|
|
|
|
|
|
|
|
|
|
(defun encode-composition-components (components &optional nocopy)
|
|
|
|
|
(or nocopy
|
|
|
|
|
(setq components (copy-sequence components)))
|
|
|
|
|
(if (vectorp components)
|
|
|
|
|
(let ((len (length components))
|
|
|
|
|
(i 1))
|
|
|
|
|
(while (< i len)
|
|
|
|
|
(aset components i
|
|
|
|
|
(encode-composition-rule (aref components i)))
|
|
|
|
|
(setq i (+ i 2))))
|
|
|
|
|
(let ((tail (cdr components)))
|
|
|
|
|
(while tail
|
|
|
|
|
(setcar tail
|
|
|
|
|
(encode-composition-rule (car tail)))
|
|
|
|
|
(setq tail (nthcdr 2 tail)))))
|
|
|
|
|
components)
|
|
|
|
|
|
|
|
|
|
;; Decode composition rule codes in composition components COMPONENTS.
|
|
|
|
|
;; The value is a copy of COMPONENTS, where composition rule codes are
|
|
|
|
|
;; replaced with composition rules (cons of global and new glyph
|
|
|
|
|
;; reference point symbols). Optional 2nd argument NOCOPY non-nil
|
|
|
|
|
;; means don't make a copy but modify COMPONENTS directly.
|
|
|
|
|
;; It is assumed that COMPONENTS is a vector and is for rule-base
|
|
|
|
|
;; composition, thus (2N+1)th elements are rule codes.
|
|
|
|
|
|
|
|
|
|
(defun decode-composition-components (components &optional nocopy)
|
|
|
|
|
(or nocopy
|
|
|
|
|
(setq components (copy-sequence components)))
|
|
|
|
|
(let ((len (length components))
|
|
|
|
|
(i 1))
|
|
|
|
|
(while (< i len)
|
|
|
|
|
(aset components i
|
|
|
|
|
(decode-composition-rule (aref components i)))
|
|
|
|
|
(setq i (+ i 2))))
|
|
|
|
|
components)
|
|
|
|
|
|
|
|
|
|
(defun compose-region (start end &optional components modification-func)
|
|
|
|
|
"Compose characters in the current region.
|
|
|
|
|
|
2009-06-16 00:33:58 +00:00
|
|
|
|
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.
|
2002-08-20 00:34:28 +00:00
|
|
|
|
|
1999-12-15 00:28:11 +00:00
|
|
|
|
When called from a program, expects these four arguments.
|
|
|
|
|
|
|
|
|
|
First two arguments START and END are positions (integers or markers)
|
|
|
|
|
specifying the region.
|
|
|
|
|
|
2003-09-11 09:24:56 +00:00
|
|
|
|
Optional 3rd argument COMPONENTS, if non-nil, is a character, a string
|
|
|
|
|
or a vector or list of integers and rules.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
If it is a character, it is an alternate character to display instead
|
|
|
|
|
of the text in the region.
|
|
|
|
|
|
2008-06-29 14:44:12 +00:00
|
|
|
|
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.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
elements are composition rules to specify how to compose (2N+2)th
|
|
|
|
|
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.
|
|
|
|
|
|
|
|
|
|
Optional 4th argument MODIFICATION-FUNC is a function to call to
|
|
|
|
|
adjust the composition when it gets invalid because of a change of
|
|
|
|
|
text in the composition."
|
|
|
|
|
(interactive "r")
|
|
|
|
|
(let ((modified-p (buffer-modified-p))
|
2007-05-25 16:14:21 +00:00
|
|
|
|
(inhibit-read-only t))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(if (or (vectorp components) (listp components))
|
|
|
|
|
(setq components (encode-composition-components components)))
|
|
|
|
|
(compose-region-internal start end components modification-func)
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(restore-buffer-modified-p modified-p)))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
(defun decompose-region (start end)
|
|
|
|
|
"Decompose text in the current region.
|
|
|
|
|
|
|
|
|
|
When called from a program, expects two arguments,
|
|
|
|
|
positions (integers or markers) specifying the region."
|
|
|
|
|
(interactive "r")
|
|
|
|
|
(let ((modified-p (buffer-modified-p))
|
2007-05-25 16:14:21 +00:00
|
|
|
|
(inhibit-read-only t))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(remove-text-properties start end '(composition nil))
|
2007-05-25 16:14:21 +00:00
|
|
|
|
(restore-buffer-modified-p modified-p)))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
(defun compose-string (string &optional start end components modification-func)
|
|
|
|
|
"Compose characters in string STRING.
|
|
|
|
|
|
2002-06-27 21:59:18 +00:00
|
|
|
|
The return value is STRING with the `composition' property put on all
|
1999-12-15 00:28:11 +00:00
|
|
|
|
the characters in it.
|
|
|
|
|
|
|
|
|
|
Optional 2nd and 3rd arguments START and END specify the range of
|
2002-06-27 21:59:18 +00:00
|
|
|
|
STRING to be composed. They default to the beginning and the end of
|
1999-12-15 00:28:11 +00:00
|
|
|
|
STRING respectively.
|
|
|
|
|
|
|
|
|
|
Optional 4th argument COMPONENTS, if non-nil, is a character or a
|
|
|
|
|
sequence (vector, list, or string) of integers. See the function
|
|
|
|
|
`compose-region' for more detail.
|
|
|
|
|
|
|
|
|
|
Optional 5th argument MODIFICATION-FUNC is a function to call to
|
|
|
|
|
adjust the composition when it gets invalid because of a change of
|
|
|
|
|
text in the composition."
|
|
|
|
|
(if (or (vectorp components) (listp components))
|
|
|
|
|
(setq components (encode-composition-components components)))
|
|
|
|
|
(or start (setq start 0))
|
|
|
|
|
(or end (setq end (length string)))
|
|
|
|
|
(compose-string-internal string start end components modification-func)
|
|
|
|
|
string)
|
|
|
|
|
|
|
|
|
|
(defun decompose-string (string)
|
|
|
|
|
"Return STRING where `composition' property is removed."
|
|
|
|
|
(remove-text-properties 0 (length string) '(composition nil) string)
|
|
|
|
|
string)
|
|
|
|
|
|
|
|
|
|
(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.
|
|
|
|
|
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)))
|
|
|
|
|
|
|
|
|
|
(while tail
|
|
|
|
|
(setq str (cons (car tail) str))
|
|
|
|
|
(setq tail (nthcdr 2 tail)))
|
|
|
|
|
(setq str (concat (nreverse str))
|
|
|
|
|
components args))
|
|
|
|
|
;; Relative composition.
|
|
|
|
|
(setq str (concat args)))
|
|
|
|
|
(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.
|
|
|
|
|
|
|
|
|
|
If the character at POS has `composition' property, the value is a list
|
|
|
|
|
of FROM, TO, and VALID-P.
|
|
|
|
|
|
|
|
|
|
FROM and TO specify the range of text that has the same `composition'
|
2008-09-05 00:53:00 +00:00
|
|
|
|
property, VALID-P is t if this composition is valid, and nil if not.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
If there's no composition at POS, and the optional 2nd argument LIMIT
|
|
|
|
|
is non-nil, search for a composition toward LIMIT.
|
|
|
|
|
|
|
|
|
|
If no composition is found, return nil.
|
|
|
|
|
|
|
|
|
|
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.
|
|
|
|
|
|
|
|
|
|
COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
|
|
|
|
|
|
|
|
|
|
RELATIVE-P is t if the composition method is relative, else nil.
|
|
|
|
|
|
|
|
|
|
If RELATIVE-P is t, COMPONENTS is a vector of characters to be
|
|
|
|
|
composed. If RELATIVE-P is nil, COMPONENTS is a vector of characters
|
|
|
|
|
and composition rules as described in `compose-region'.
|
|
|
|
|
|
|
|
|
|
MOD-FUNC is a modification function of the composition.
|
|
|
|
|
|
2008-09-05 00:53:00 +00:00
|
|
|
|
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."
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(let ((result (find-composition-internal pos limit string detail-p)))
|
2008-09-05 00:53:00 +00:00
|
|
|
|
(if (and detail-p (> (length result) 3) (nth 2 result) (not (nth 3 result)))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
;; This is a valid rule-base composition.
|
|
|
|
|
(decode-composition-components (nth 2 result) 'nocopy))
|
|
|
|
|
result))
|
|
|
|
|
|
|
|
|
|
|
2000-11-06 12:40:34 +00:00
|
|
|
|
(defun compose-chars-after (pos &optional limit object)
|
1999-12-15 00:28:11 +00:00
|
|
|
|
"Compose characters in current buffer after position POS.
|
|
|
|
|
|
2008-02-21 03:35:31 +00:00
|
|
|
|
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 characters to compose.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2000-11-06 12:40:34 +00:00
|
|
|
|
Optional 3rd arg OBJECT, if non-nil, is a string that contains the
|
2003-09-11 09:24:56 +00:00
|
|
|
|
text to compose. In that case, POS and LIMIT index into the string.
|
2000-11-06 12:40:34 +00:00
|
|
|
|
|
1999-12-15 00:28:11 +00:00
|
|
|
|
This function is the default value of `compose-chars-after-function'."
|
|
|
|
|
(let ((tail (aref composition-function-table (char-after pos)))
|
2008-02-21 03:35:31 +00:00
|
|
|
|
(font-obj (and (display-multi-font-p)
|
|
|
|
|
(and (not (stringp object))
|
|
|
|
|
(font-at pos (selected-window)))))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
pattern func result)
|
2008-02-21 03:35:31 +00:00
|
|
|
|
(or limit
|
|
|
|
|
(setq limit (if (stringp object) (length object) (point-max))))
|
2008-05-14 01:56:07 +00:00
|
|
|
|
(when (and font-obj tail)
|
2000-07-27 05:37:42 +00:00
|
|
|
|
(save-match-data
|
|
|
|
|
(save-excursion
|
2008-02-21 03:35:31 +00:00
|
|
|
|
(while tail
|
|
|
|
|
(if (functionp (car tail))
|
|
|
|
|
(setq pattern nil func (car tail))
|
|
|
|
|
(setq pattern (car (car tail))
|
|
|
|
|
func (cdr (car tail))))
|
2000-07-27 05:37:42 +00:00
|
|
|
|
(goto-char pos)
|
2008-02-21 03:35:31 +00:00
|
|
|
|
(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))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
(defun compose-last-chars (args)
|
|
|
|
|
"Compose last characters.
|
2001-01-05 05:29:56 +00:00
|
|
|
|
The argument is a parameterized event of the form
|
|
|
|
|
\(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,
|
2005-07-20 13:03:40 +00:00
|
|
|
|
and that function finds a proper rule to compose the target characters.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
This function is intended to be used from input methods.
|
|
|
|
|
The global keymap binds special event `compose-last-chars' to this
|
2001-01-05 05:29:56 +00:00
|
|
|
|
function. Input method may generate an event (compose-last-chars N COMPONENTS)
|
2005-07-20 13:03:40 +00:00
|
|
|
|
after a sequence of character events."
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(interactive "e")
|
|
|
|
|
(let ((chars (nth 1 args)))
|
|
|
|
|
(if (and (numberp chars)
|
|
|
|
|
(>= (- (point) (point-min)) chars))
|
2001-01-05 05:29:56 +00:00
|
|
|
|
(if (nth 2 args)
|
|
|
|
|
(compose-region (- (point) chars) (point) (nth 2 args))
|
|
|
|
|
(compose-chars-after (- (point) chars) (point))))))
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2002-11-07 06:27:27 +00:00
|
|
|
|
(global-set-key [compose-last-chars] 'compose-last-chars)
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2002-11-07 06:27:27 +00:00
|
|
|
|
|
|
|
|
|
;;; 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."
|
2002-11-07 07:32:07 +00:00
|
|
|
|
`(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))))
|
2003-09-11 09:24:56 +00:00
|
|
|
|
;; Fixme: This makes bootstrapping fail with this error.
|
2002-11-07 07:32:07 +00:00
|
|
|
|
;; Symbol's function definition is void: eval-defun
|
|
|
|
|
;;(def-edebug-spec save-buffer-state let)
|
|
|
|
|
)
|
2002-11-07 06:27:27 +00:00
|
|
|
|
|
2003-11-23 07:33:48 +00:00
|
|
|
|
(put 'save-buffer-state 'lisp-indent-function 1)
|
|
|
|
|
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
;; 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))
|
2008-12-30 23:32:55 +00:00
|
|
|
|
(defsubst lglyph-set-code (glyph code) (aset glyph 3 code))
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
(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)
|
2008-09-10 05:49:38 +00:00
|
|
|
|
(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))))))
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
(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))))))
|
|
|
|
|
|
2009-11-12 06:55:39 +00:00
|
|
|
|
(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
[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)
|
2009-02-04 02:00:34 +00:00
|
|
|
|
(coding (lgstring-font gstring))
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
glyph)
|
|
|
|
|
(while (and (< i nglyphs)
|
|
|
|
|
(setq glyph (lgstring-glyph gstring i)))
|
2009-02-04 02:00:34 +00:00
|
|
|
|
(if (not (char-charset (lglyph-char glyph) coding))
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
(progn
|
2009-02-04 02:00:34 +00:00
|
|
|
|
;; As the terminal doesn't support this glyph, return a
|
|
|
|
|
;; gstring in which each glyph is its own graphme-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)
|
2009-06-10 00:35:08 +00:00
|
|
|
|
(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)))
|
2009-02-04 02:00:34 +00:00
|
|
|
|
;; 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)))))))
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
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
|
2009-03-25 12:02:15 +00:00
|
|
|
|
is a font to use. Otherwise, FONT-OBJECT is nil, and the function
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
`compose-gstring-for-terminal' is used instead of FUNC.
|
|
|
|
|
|
2007-12-25 10:49:50 +00:00
|
|
|
|
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.
|
2002-11-07 06:27:27 +00:00
|
|
|
|
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
The value is a gstring containing information for shaping the characters.
|
|
|
|
|
|
2002-11-07 06:27:27 +00:00
|
|
|
|
This function is the default value of `auto-composition-function' (which see)."
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
(let ((gstring (composition-get-gstring from to font-object string)))
|
|
|
|
|
(if (lgstring-shaped-p gstring)
|
|
|
|
|
gstring
|
2009-02-04 02:00:34 +00:00
|
|
|
|
(or (fontp font-object 'font-object)
|
(composition-function-table): Declaration moved to
composite.c.
(terminal-composition-base-character-p): Delete it.
(terminal-composition-function): Delete it.
(terminal-composition-function-table): Delete it.
(lgstring-header, lgstring-set-header, lgstring-font)
(lgstring-char, lgstring-char-len, lgstring-shaped-p)
(lgstring-set-id, lgstring-glyph, lgstring-glyph-len)
(lgstring-set-glyph, lglyph-from, lglyph-to, lglyph-char)
(lglyph-code, lglyph-width, lglyph-lbearing, lglyph-rbearing)
(lglyph-ascent, lglyph-descent, lglyph-adjustment)
(lglyph-set-from-to, lglyph-copy, lgstring-insert-glyph)
(compose-glyph-string, compose-glyph-string-relative)
(compose-gstring-for-graphic, compose-gstring-for-terminal): New
functions.
(auto-compose-chars): Argument changed.
2008-08-29 07:59:03 +00:00
|
|
|
|
(setq func 'compose-gstring-for-terminal))
|
|
|
|
|
(funcall func gstring))))
|
2002-11-07 06:27:27 +00:00
|
|
|
|
|
2006-02-21 10:15:48 +00:00
|
|
|
|
(make-variable-buffer-local 'auto-composition-function)
|
|
|
|
|
|
2006-02-21 10:45:21 +00:00
|
|
|
|
;;;###autoload
|
2006-02-21 10:15:48 +00:00
|
|
|
|
(define-minor-mode auto-composition-mode
|
2008-02-21 07:53:55 +00:00
|
|
|
|
"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.
|
2006-02-21 10:15:48 +00:00
|
|
|
|
|
|
|
|
|
When Auto Composition is enabled, text characters are automatically composed
|
|
|
|
|
by functions registered in `composition-function-table' (which see).
|
|
|
|
|
|
2008-02-21 07:53:55 +00:00
|
|
|
|
You can use `global-auto-composition-mode' to turn on
|
2006-02-21 10:15:48 +00:00
|
|
|
|
Auto Composition mode in all buffers (this is the default)."
|
|
|
|
|
nil nil nil
|
|
|
|
|
(if noninteractive
|
|
|
|
|
(setq auto-composition-mode nil))
|
|
|
|
|
(cond (auto-composition-mode
|
|
|
|
|
(setq auto-composition-function 'auto-compose-chars))
|
|
|
|
|
(t
|
2009-02-23 01:37:34 +00:00
|
|
|
|
(setq auto-composition-function nil))))
|
2006-02-21 10:15:48 +00:00
|
|
|
|
|
|
|
|
|
(defun turn-on-auto-composition-if-enabled ()
|
2006-02-24 06:32:07 +00:00
|
|
|
|
(if enable-multibyte-characters
|
|
|
|
|
(auto-composition-mode 1)))
|
2006-02-21 10:15:48 +00:00
|
|
|
|
|
2006-02-21 10:45:21 +00:00
|
|
|
|
;;;###autoload
|
2006-02-21 10:15:48 +00:00
|
|
|
|
(define-global-minor-mode global-auto-composition-mode
|
|
|
|
|
auto-composition-mode turn-on-auto-composition-if-enabled
|
2009-09-13 00:52:55 +00:00
|
|
|
|
;; This :extra-args' appears to be the result of a naive copy&paste
|
|
|
|
|
;; from global-font-lock-mode.
|
|
|
|
|
;; :extra-args (dummy)
|
|
|
|
|
:initialize 'custom-initialize-delay
|
2006-10-23 06:20:04 +00:00
|
|
|
|
:init-value (not noninteractive)
|
2006-02-21 10:15:48 +00:00
|
|
|
|
:group 'auto-composition
|
|
|
|
|
:version "23.1")
|
2002-11-07 06:27:27 +00:00
|
|
|
|
|
2009-02-23 01:37:34 +00:00
|
|
|
|
(defalias 'toggle-auto-composition 'auto-composition-mode)
|
2003-09-26 11:24:10 +00:00
|
|
|
|
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2007-05-25 16:14:21 +00:00
|
|
|
|
;; The following codes are only for backward compatibility with Emacs
|
|
|
|
|
;; 20.4 and earlier.
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
|
|
|
|
(defun decompose-composite-char (char &optional type with-composition-rule)
|
|
|
|
|
"Convert CHAR to string.
|
|
|
|
|
|
|
|
|
|
If optional 2nd arg TYPE is non-nil, it is `string', `list', or
|
2003-01-29 08:56:40 +00:00
|
|
|
|
`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."
|
1999-12-15 00:28:11 +00:00
|
|
|
|
(cond ((or (null type) (eq type 'string)) (char-to-string char))
|
|
|
|
|
((eq type 'list) (list char))
|
|
|
|
|
(t (vector char))))
|
|
|
|
|
|
2000-06-09 02:14:39 +00:00
|
|
|
|
(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
|
|
|
|
|
|
1999-12-15 00:28:11 +00:00
|
|
|
|
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
2007-05-25 16:14:21 +00:00
|
|
|
|
;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33
|
1999-12-15 00:28:11 +00:00
|
|
|
|
;;; composite.el ends here
|