mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Improve 'C-u C-x =' for ligatures of ASCII characters
* lisp/composite.el (composition-find-pos-glyph): New function. * lisp/descr-text.el (describe-char): Use it to get the font glyph code of "trivial" compositions. (describe-char-display): Accept an additional optional argument and use it as the font glyph code for the character.
This commit is contained in:
parent
172e35afce
commit
098fe4b73b
2 changed files with 31 additions and 6 deletions
|
|
@ -493,6 +493,24 @@ by `find-composition'."
|
||||||
(setq idx (1+ idx)))))
|
(setq idx (1+ idx)))))
|
||||||
(or found endpos)))
|
(or found endpos)))
|
||||||
|
|
||||||
|
(defun composition-find-pos-glyph (composition pos)
|
||||||
|
"Find in COMPOSITION a glyph that corresponds to character at position POS.
|
||||||
|
COMPOSITION is as returned by `find-composition'."
|
||||||
|
(let* ((from-pos (car composition))
|
||||||
|
(to-pos (nth 1 composition))
|
||||||
|
(gstring (nth 2 composition))
|
||||||
|
(nglyphs (lgstring-glyph-len gstring))
|
||||||
|
(idx 0)
|
||||||
|
glyph found)
|
||||||
|
(if (and (>= pos from-pos) (< pos to-pos))
|
||||||
|
(while (and (not found) (< idx nglyphs))
|
||||||
|
(setq glyph (lgstring-glyph gstring idx))
|
||||||
|
(if (and (>= pos (+ from-pos (lglyph-from glyph)))
|
||||||
|
(<= pos (+ from-pos (lglyph-to glyph))))
|
||||||
|
(setq found (lglyph-code glyph)))
|
||||||
|
(setq idx (1+ idx))))
|
||||||
|
found))
|
||||||
|
|
||||||
(defun compose-glyph-string (gstring from to)
|
(defun compose-glyph-string (gstring from to)
|
||||||
(let ((glyph (lgstring-glyph gstring from))
|
(let ((glyph (lgstring-glyph gstring from))
|
||||||
from-pos to-pos)
|
from-pos to-pos)
|
||||||
|
|
|
||||||
|
|
@ -318,13 +318,13 @@ This function is semi-obsolete. Use `get-char-code-property'."
|
||||||
;; GLYPH-CODE is a hexadigit string representing the glyph-ID.
|
;; GLYPH-CODE is a hexadigit string representing the glyph-ID.
|
||||||
;; Otherwise, return a string describing the terminal codes for the
|
;; Otherwise, return a string describing the terminal codes for the
|
||||||
;; character.
|
;; character.
|
||||||
(defun describe-char-display (pos char)
|
(defun describe-char-display (pos char &optional glyph-code)
|
||||||
(if (display-graphic-p (selected-frame))
|
(if (display-graphic-p (selected-frame))
|
||||||
(let ((char-font-info (internal-char-font pos char)))
|
(let ((char-font-info (internal-char-font pos char)))
|
||||||
(if char-font-info
|
(if char-font-info
|
||||||
(let ((type (font-get (car char-font-info) :type))
|
(let ((type (font-get (car char-font-info) :type))
|
||||||
(name (font-xlfd-name (car char-font-info)))
|
(name (font-xlfd-name (car char-font-info)))
|
||||||
(code (cdr char-font-info)))
|
(code (or glyph-code (cdr char-font-info))))
|
||||||
(if (integerp code)
|
(if (integerp code)
|
||||||
(format "%s:%s (#x%02X)" type name code)
|
(format "%s:%s (#x%02X)" type name code)
|
||||||
(format "%s:%s (#x%04X%04X)"
|
(format "%s:%s (#x%04X%04X)"
|
||||||
|
|
@ -420,7 +420,7 @@ The character information includes:
|
||||||
(describe-text-properties pos tmp-buf)
|
(describe-text-properties pos tmp-buf)
|
||||||
(with-current-buffer tmp-buf (buffer-string)))
|
(with-current-buffer tmp-buf (buffer-string)))
|
||||||
(kill-buffer tmp-buf))))
|
(kill-buffer tmp-buf))))
|
||||||
item-list max-width code)
|
item-list max-width code glyph-code trivial-p)
|
||||||
|
|
||||||
(if multibyte-p
|
(if multibyte-p
|
||||||
(or (setq code (encode-char char charset))
|
(or (setq code (encode-char char charset))
|
||||||
|
|
@ -489,7 +489,8 @@ The character information includes:
|
||||||
(if (and (= to (1+ from))
|
(if (and (= to (1+ from))
|
||||||
(= i (1- j))
|
(= i (1- j))
|
||||||
(setq glyph (lgstring-glyph components i))
|
(setq glyph (lgstring-glyph components i))
|
||||||
(= char (lglyph-char glyph)))
|
(= char (lglyph-char glyph))
|
||||||
|
(setq trivial-p t))
|
||||||
;; The composition is trivial.
|
;; The composition is trivial.
|
||||||
(throw 'tag nil))
|
(throw 'tag nil))
|
||||||
(nconc composition (list i (1- j))))
|
(nconc composition (list i (1- j))))
|
||||||
|
|
@ -527,7 +528,13 @@ The character information includes:
|
||||||
(format "composed to form \"%s\" (see below)"
|
(format "composed to form \"%s\" (see below)"
|
||||||
(setq composition-string
|
(setq composition-string
|
||||||
(buffer-substring from to))))))
|
(buffer-substring from to))))))
|
||||||
(setq composition nil)))
|
;; For "trivial" compositions, such as ligatures of ASCII
|
||||||
|
;; characters, at least show the correct font glyph number.
|
||||||
|
(setq glyph-code (if (and composition
|
||||||
|
trivial-p
|
||||||
|
(display-graphic-p (selected-frame)))
|
||||||
|
(composition-find-pos-glyph composition pos))
|
||||||
|
composition nil)))
|
||||||
|
|
||||||
(setq item-list
|
(setq item-list
|
||||||
`(("position"
|
`(("position"
|
||||||
|
|
@ -664,7 +671,7 @@ The character information includes:
|
||||||
(composition
|
(composition
|
||||||
(cadr composition))
|
(cadr composition))
|
||||||
(t
|
(t
|
||||||
(let ((display (describe-char-display pos char)))
|
(let ((display (describe-char-display pos char glyph-code)))
|
||||||
(if (display-graphic-p (selected-frame))
|
(if (display-graphic-p (selected-frame))
|
||||||
(if display
|
(if display
|
||||||
(concat "by this font (glyph code):\n " display)
|
(concat "by this font (glyph code):\n " display)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue