1
0
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:
Kenichi Handa 2014-06-28 10:34:17 +09:00
parent 5335a8ced5
commit 1fc00e5c9e
3 changed files with 64 additions and 6 deletions

View File

@ -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

View File

@ -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.

View File

@ -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))