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

1 files changed, 85 insertions, 42 deletions

diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 89325cca22a..5234a4f9a9a 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -342,7 +342,7 @@ This function is semi-obsolete.  Use `get-char-code-property'."
                  (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 @@ as well as widgets, buttons, overlays, and text properties."
             (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 @@ as well as widgets, buttons, overlays, and text properties."
                              (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 @@ as well as widgets, buttons, overlays, and text properties."
         (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 @@ as well as widgets, buttons, overlays, and text properties."
                               ?:
                               (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)