*** empty log message ***

[gnu-emacs] / lisp / descr-text.el

diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 75ce294dad6ec4b2325d12d4a9c79c8af9553368..726d3e6e5d8482226d2a8bf46a568fee82bbb52a 100644 (file)
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -1,6 +1,7 @@
 ;;; descr-text.el --- describe text mode
 
-;; Copyright (c) 1994, 95, 96, 2001, 02, 03, 04 Free Software Foundation, Inc.
+;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2003, 2004
+;;           Free Software Foundation, Inc.
 
 ;; Author: Boris Goldowsky <boris@gnu.org>
 ;; Keywords: faces
@@ -103,23 +104,11 @@ The `category', `face' and `font-lock-face' properties are made
 into widget buttons that call `describe-text-category' or
 `describe-face' when pushed."
   ;; Sort the properties by the size of their value.
-  (dolist (elt (sort (let ((ret nil)
-                          (key nil)
-                          (val nil)
-                          (len nil))
+  (dolist (elt (sort (let (ret)
                       (while properties
-                        (setq key (pop properties)
-                              val (pop properties)
-                              len 0)
-                        (unless (or (memq key '(category face font-lock-face))
-                                    (widgetp val))
-                          (setq val (pp-to-string val)
-                                len (length val)))
-                        (push (list key val len) ret))
+                        (push (list (pop properties) (pop properties)) ret))
                       ret)
-                    (lambda (a b)
-                      (< (nth 2 a)
-                         (nth 2 b)))))
+                    (lambda (a b) (string< (nth 0 a) (nth 0 b)))))
     (let ((key (nth 0 elt))
          (value (nth 1 elt)))
       (widget-insert (propertize (format "  %-20s " key)
@@ -129,15 +118,15 @@ into widget buttons that call `describe-text-category' or
                            :notify `(lambda (&rest ignore)
                                       (describe-text-category ',value))
                            (format "%S" value)))
-            ((memq key '(face font-lock-face))
+            ((memq key '(face font-lock-face mouse-face))
             (widget-create 'link
                            :notify `(lambda (&rest ignore)
                                       (describe-face ',value))
                            (format "%S" value)))
-           ((widgetp value)
+            ((widgetp value)
             (describe-text-widget value))
            (t
-            (widget-insert value))))
+            (describe-text-sexp value))))
     (widget-insert "\n")))
 \f
 ;;; Describe-Text Commands.
@@ -167,11 +156,12 @@ otherwise."
       (describe-text-properties-1 pos output-buffer)
     (if (not (or (text-properties-at pos) (overlays-at pos)))
        (message "This is plain text.")
-      (let ((buffer (current-buffer)))
-       (when (eq buffer (get-buffer "*Help*"))
-         (error "Can't do self inspection"))
+      (let ((buffer (current-buffer))
+           (target-buffer "*Help*"))
+       (when (eq buffer (get-buffer target-buffer))
+         (setq target-buffer "*Help-2*"))
        (save-excursion
-         (with-output-to-temp-buffer "*Help*"
+         (with-output-to-temp-buffer target-buffer
            (set-buffer standard-output)
            (setq output-buffer (current-buffer))
            (widget-insert "Text content at position " (format "%d" pos) ":\n\n")
@@ -476,7 +466,7 @@ as well as widgets, buttons, overlays, and text properties."
                          (encode-char char 'ucs))))
     (setq item-list
          `(("character"
-           ,(format "%s (0%o, %d, 0x%x%s)" 
+           ,(format "%s (0%o, %d, 0x%x%s)"
                     (apply 'propertize (if (not multibyte-p)
                                            (single-key-description char)
                                          (if (< char 128)
@@ -516,7 +506,8 @@ as well as widgets, buttons, overlays, and text properties."
                    (push (format "%s;" (pop props)) ps))
                  (list (cons "Properties" (nreverse ps)))))
            ("to input"
-            ,@(let ((key-list (and current-input-method
+            ,@(let ((key-list (and (eq input-method-function
+                                       'quail-input-method)
                                    (quail-find-key char))))
                 (if (consp key-list)
                     (list "type"
@@ -540,10 +531,17 @@ as well as widgets, buttons, overlays, and text properties."
                (dotimes (i (length disp-vector))
                  (setq char (aref disp-vector i))
                  (aset disp-vector i
-                       (cons char (describe-char-display pos char))))
+                       (cons char (describe-char-display
+                                   pos (logand char #x7ffff)))))
                (format "by display table entry [%s] (see below)"
-                       (mapconcat #'(lambda (x) (format "?%c" (car x)))
-                                  disp-vector " ")))
+                       (mapconcat
+                        #'(lambda (x)
+                            (if (> (car x) #x7ffff)
+                                (format "?%c<face-id=%s>"
+                                        (logand (car x) #x7ffff)
+                                        (lsh (car x) -19))
+                              (format "?%c" (car x))))
+                        disp-vector " ")))
               (composition
                (let ((from (car composition))
                      (to (nth 1 composition))
@@ -598,7 +596,7 @@ as well as widgets, buttons, overlays, and text properties."
 
        (save-excursion
          (goto-char (point-min))
-         (search-forward "character: ")
+         (re-search-forward "character:[ \t\n]+")
          (setq pos (point)))
        (if overlays
            (mapc #'(lambda (props)
@@ -615,7 +613,7 @@ as well as widgets, buttons, overlays, and text properties."
              (progn
                (insert "these fonts (glyph codes):\n")
                (dotimes (i (length disp-vector))
-                 (insert (car (aref disp-vector i)) ?:
+                 (insert (logand (car (aref disp-vector i)) #x7ffff) ?:
                          (propertize " " 'display '(space :align-to 5))
                          (if (cdr (aref disp-vector i))
                              (format "%s (0x%02X)" (cadr (aref disp-vector i))
@@ -673,5 +671,5 @@ as well as widgets, buttons, overlays, and text properties."
 
 (provide 'descr-text)
 
-;;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
+;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1
 ;;; descr-text.el ends here