Function: compose-gstring-for-graphic
compose-gstring-for-graphic is a byte-compiled function defined in
composite.el.gz.
Signature
(compose-gstring-for-graphic GSTRING DIRECTION)
Documentation
Compose glyph-string GSTRING under bidi DIRECTION for graphic display.
DIRECTION is either L2R or R2L, or nil if unknown. Combining characters are composed with the preceding base character. If the preceding character is not a base character, each combining character is composed as a spacing character by a padding space before and/or after the character.
All non-spacing characters have this function in
composition-function-table unless overwritten.
Source Code
;; Defined in /usr/src/emacs/lisp/composite.el.gz
(defun compose-gstring-for-graphic (gstring direction)
"Compose glyph-string GSTRING under bidi DIRECTION for graphic display.
DIRECTION is either L2R or R2L, or nil if unknown.
Combining characters are composed with the preceding base
character. If the preceding character is not a base character,
each combining character is composed as a spacing character by
a padding space before and/or after the character.
All non-spacing characters have this function in
`composition-function-table' unless overwritten."
(let ((nchars (lgstring-char-len gstring))
(nglyphs (lgstring-glyph-len gstring))
(glyph (lgstring-glyph gstring 0)))
(cond
;; A non-spacing character not following a proper base character.
((= nchars 1)
(let ((lbearing (lglyph-lbearing glyph))
(rbearing (lglyph-rbearing glyph))
(width (lglyph-width glyph))
xoff)
(if (< lbearing 0)
(setq xoff (- lbearing))
(setq xoff 0 lbearing 0))
(if (< rbearing width)
(setq rbearing width))
(lglyph-set-adjustment glyph xoff 0 (- rbearing lbearing))
gstring))
;; This sequence doesn't start with a proper base character.
((memq (get-char-code-property (lgstring-char gstring 0)
'general-category)
;; "Improper" base characters are of the following general
;; categories:
;; Mark (nonspacing, combining, enclosing)
;; Separator (line, paragraph)
;; Other (control, format, surrogate)
'(Mn Mc Me Zl Zp Cc Cf Cs))
nil)
;; A base character and the following non-spacing characters.
(t
(let ((gstr (font-shape-gstring gstring direction)))
(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))
;; 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)
(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)
(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)
;; Me = enclosing mark
'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 itself 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))))))