mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-30 19:53:09 +00:00
Fix Bug#17739.
* composite.el: Setup composition-function-table for dotted circle. (compose-gstring-for-dotted-circle): New function. * international/characters.el: Add category "^" to all non-spacing characters.
This commit is contained in:
parent
5335a8ced5
commit
1fc00e5c9e
@ -1,3 +1,13 @@
|
||||
2014-06-28 K. Handa <handa@gnu.org>
|
||||
|
||||
Fix Bug#17739.
|
||||
|
||||
* composite.el: Setup composition-function-table for dotted circle.
|
||||
(compose-gstring-for-dotted-circle): New function.
|
||||
|
||||
* international/characters.el: Add category "^" to all
|
||||
non-spacing characters.
|
||||
|
||||
2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* ses.el: Miscellaneous cleanups; use lexical-binding; avoid
|
||||
|
@ -671,6 +671,49 @@ All non-spacing characters have this function in
|
||||
(setq i (1+ i))))
|
||||
gstring))))))
|
||||
|
||||
(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]
|
||||
@ -679,7 +722,10 @@ All non-spacing characters have this function in
|
||||
#'(lambda (key val)
|
||||
(if (memq val '(Mn Mc Me))
|
||||
(set-char-table-range composition-function-table key elt)))
|
||||
unicode-category-table)))
|
||||
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.
|
||||
|
@ -1359,11 +1359,13 @@ Setup char-width-table appropriate for non-CJK language environment."
|
||||
(when (setq unicode-category-table
|
||||
(unicode-property-table-internal 'general-category))
|
||||
(map-char-table #'(lambda (key val)
|
||||
(if (and val
|
||||
(or (and (/= (aref (symbol-name val) 0) ?M)
|
||||
(/= (aref (symbol-name val) 0) ?C))
|
||||
(eq val 'Zs)))
|
||||
(modify-category-entry key ?.)))
|
||||
(if val
|
||||
(cond ((or (and (/= (aref (symbol-name val) 0) ?M)
|
||||
(/= (aref (symbol-name val) 0) ?C))
|
||||
(eq val 'Zs))
|
||||
(modify-category-entry key ?.))
|
||||
((eq val 'Mn)
|
||||
(modify-category-entry key ?^)))))
|
||||
unicode-category-table))
|
||||
|
||||
(optimize-char-table (standard-category-table))
|
||||
|
Loading…
Reference in New Issue
Block a user