;;; 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, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;;; Code:
-(eval-when-compile (require 'cl))
-
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
| | 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
+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
(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)))
(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,
(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)
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)
- (when (and class (>= class 200) (<= class 240))
+ (cond
+ ((and class (>= class 200) (<= class 240))
(setq xoff 0 yoff 0)
(cond
((= class 200)
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 i (1+ i))))
gstring))))))
-(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
- [nil 0 compose-gstring-for-graphic])))
- (map-char-table
- #'(lambda (key val)
- (if (memq val '(Mn Mc Me))
- (set-char-table-range composition-function-table key elt)))
- unicode-category-table))
+;; 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)))
(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
prepending a space before it."
- (let* ((header (lgstring-header gstring))
- (nchars (lgstring-char-len gstring))
- (nglyphs (lgstring-glyph-len gstring))
- (i 0)
- (coding (lgstring-font gstring))
- glyph)
+ (let ((nglyphs (lgstring-glyph-len gstring))
+ (i 0)
+ (coding (lgstring-font gstring))
+ glyph)
(while (and (< i nglyphs)
(setq glyph (lgstring-glyph gstring i)))
(if (not (char-charset (lglyph-char glyph) coding))
(progn
;; As the terminal doesn't support this glyph, return a
- ;; gstring in which each glyph is its own graphme-cluster
+ ;; gstring in which each glyph is its own grapheme-cluster
;; of width 1..
(setq i 0)
(while (and (< i nglyphs)
;;;###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)."
;;;###autoload
(define-minor-mode global-auto-composition-mode
- "Toggle Auto-Composition mode in every possible buffer.
-With prefix arg, turn Global-Auto-Composition mode on if and only if arg
-is positive.
-See `auto-composition-mode' for more information on 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.
+
+For more information on Auto Composition mode, see
+`auto-composition-mode' ."
:variable (default-value 'auto-composition-mode))
(defalias 'toggle-auto-composition 'auto-composition-mode)
HCoop / bpt / emacs.git / blobdiff