Mercurial > emacs
changeset 101927:c63836b5986a
(describe-char-display): On terminal, if terminal
coding system is nil, assume us-ascii.
(describe-char): Don't show the composition informaiton if it is
trivial.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Tue, 10 Feb 2009 06:03:44 +0000 |
| parents | 8c2ab4af1a9d |
| children | d84789856fe7 |
| files | lisp/descr-text.el |
| diffstat | 1 files changed, 85 insertions(+), 42 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/descr-text.el Tue Feb 10 06:03:07 2009 +0000 +++ b/lisp/descr-text.el Tue Feb 10 06:03:44 2009 +0000 @@ -342,7 +342,7 @@ (format "%s:%s (#x%04X%04X)" type name (car code) (cdr code)))))) (let* ((charset (get-text-property pos 'charset)) - (coding (terminal-coding-system)) + (coding (or (terminal-coding-system) 'us-ascii)) (encoded (encode-coding-char char coding charset))) (if encoded (encoded-string-description encoded coding))))) @@ -411,6 +411,80 @@ (setq charset (char-charset char) code (encode-char char charset))) (setq code char)) + (when composition + ;; When the composition is trivial (i.e. composed only with the + ;; current character itself without any alternate characters), + ;; we don't show the composition information. Otherwise, store + ;; two descriptive strings in the first two elments of + ;; COMPOSITION. + (or (catch 'tag + (let ((from (car composition)) + (to (nth 1 composition)) + (next (1+ pos)) + (components (nth 2 composition)) + ch) + (if (and (vectorp components) (vectorp (aref components 0))) + (let ((idx (- pos from)) + (nglyphs (lgstring-glyph-len components)) + (i 0) j glyph glyph-from) + ;; COMPONENTS is a gstring. Find a grapheme + ;; cluster containing the current character. + (while (and (< i nglyphs) + (setq glyph (lgstring-glyph components i)) + (< (lglyph-to glyph) idx)) + (setq i (1+ i))) + (if (or (not glyph) (= i nglyphs)) + ;; The composition is broken. + (throw 'tag nil)) + (setq glyph-from (lglyph-from glyph) + to (+ from (lglyph-to glyph) 1) + from (+ from glyph-from) + j i) + (while (and (< j nglyphs) + (setq glyph (lgstring-glyph components j)) + (= (lglyph-from glyph) glyph-from)) + (setq j (1+ j))) + (if (and (= i (1- j)) + (setq glyph (lgstring-glyph components i)) + (= char (lglyph-char glyph))) + ;; The composition is trivial. + (throw 'tag nil)) + (nconc composition (list i (1- j)))) + (dotimes (i (length components)) + (if (integerp (setq ch (aref components i))) + (push (cons ch (describe-char-display pos ch)) + component-chars))) + (setq component-chars (nreverse component-chars))) + (if (< from pos) + (if (< (1+ pos) to) + (setcar composition + (concat + " with the surrounding characters \"" + (mapconcat 'describe-char-padded-string + (buffer-substring from pos) "") + "\" and \"" + (mapconcat 'describe-char-padded-string + (buffer-substring (1+ pos) to) "") + "\"")) + (setcar composition + (concat + " with the preceding character(s) \"" + (mapconcat 'describe-char-padded-string + (buffer-substring from pos) "") + "\""))) + (if (< (1+ pos) to) + (setcar composition + (concat + " with the following character(s) \"" + (mapconcat 'describe-char-padded-string + (buffer-substring (1+ pos) to) "") + "\"")) + (setcar composition nil))) + (setcar (cdr composition) + (format "composed to form \"%s\" (see below)" + (buffer-substring from to))))) + (setq composition nil))) + (setq item-list `(("character" ,(format "%s (%d, #o%o, #x%x)" @@ -497,22 +571,7 @@ (format "?%c" (glyph-char (car x)))) disp-vector " "))) (composition - (let ((from (car composition)) - (to (nth 1 composition)) - (next (1+ pos)) - (components (nth 2 composition)) - ch) - (setcar composition - (and (< from pos) (buffer-substring from pos))) - (setcar (cdr composition) - (and (< next to) (buffer-substring next to))) - (dotimes (i (length components)) - (if (integerp (setq ch (aref components i))) - (push (cons ch (describe-char-display pos ch)) - component-chars))) - (setq component-chars (nreverse component-chars)) - (format "composed to form \"%s\" (see below)" - (buffer-substring from to)))) + (cadr composition)) (t (let ((display (describe-char-display pos char))) (if (display-graphic-p (selected-frame)) @@ -606,29 +665,13 @@ (when composition (insert "\nComposed") (if (car composition) - (if (cadr composition) - (insert " with the surrounding characters \"" - (mapconcat 'describe-char-padded-string - (car composition) "") - "\" and \"" - (mapconcat 'describe-char-padded-string - (cadr composition) "") - "\"") - (insert " with the preceding character(s) \"" - (mapconcat 'describe-char-padded-string - (car composition) "") - "\"")) - (if (cadr composition) - (insert " with the following character(s) \"" - (mapconcat 'describe-char-padded-string - (cadr composition) "") - "\""))) + (insert (car composition))) (if (and (vectorp (nth 2 composition)) (vectorp (aref (nth 2 composition) 0))) (let* ((gstring (nth 2 composition)) (font (lgstring-font gstring)) - (nglyphs (lgstring-glyph-len gstring)) - (i 0) + (from (nth 3 composition)) + (to (nth 4 composition)) glyph) (if (fontp font) (progn @@ -637,16 +680,16 @@ ?: (aref (query-font font) 0) "\nby these glyphs:\n") - (while (and (< i nglyphs) - (setq glyph (lgstring-glyph gstring i))) + (while (and (<= from to) + (setq glyph (lgstring-glyph gstring from))) (insert (format " %S\n" glyph)) - (setq i (1+ i)))) + (setq from (1+ from)))) (insert " by these characters:\n") - (while (and (< i nglyphs) - (setq glyph (lgstring-glyph gstring i))) + (while (and (<= from to) + (setq glyph (lgstring-glyph gstring from))) (insert (format " %c (#x%d)\n" (lglyph-char glyph) (lglyph-char glyph))) - (setq i (1+ i))))) + (setq from (1+ from))))) (insert " by the rule:\n\t(") (let ((first t)) (mapc (lambda (x)