changeset 64495:524cffc1c27d

(describe-char): Create link buttons for `charset' and `code point'. Add the current input method name with a link button to `to input' field. Print face names of display table characters in `The display table entry is displayed by' section instead of printing face-id in the `display' field. Guess hardcoded faces and create a link button for them. Skip empty fields when calculating max-width. Treat `widget-create' specially while inserting strings from the collected field list. (describe-char-after): Made obsolete in version 22.1, not 21.5.

--- a/lisp/descr-text.el	Tue Jul 19 11:21:30 2005 +0000
+++ b/lisp/descr-text.el	Tue Jul 19 11:23:14 2005 +0000
@@ -479,13 +479,25 @@
 			 (format ", U+%04X" unicode)
 		       "")))
 	    ("charset"
-	     ,(symbol-name charset)
+	     ,`(widget-create 'link
+			      :notify (lambda (&rest ignore)
+					(describe-character-set ',charset))
+			      ,(symbol-name charset))
 	     ,(format "(%s)" (charset-description charset)))
 	    ("code point"
 	     ,(let ((split (split-char char)))
-		(if (= (charset-dimension charset) 1)
-		    (format "%d" (nth 1 split))
-		  (format "%d %d" (nth 1 split) (nth 2 split)))))
+		`(widget-create
+		  'link
+		  :notify (lambda (&rest ignore)
+			    (list-charset-chars ',charset)
+			    (with-selected-window
+				(get-buffer-window "*Character List*")
+			      (goto-char (point-min))
+			      (search-forward ,(char-to-string char)
+					      nil t)))
+		  ,(if (= (charset-dimension charset) 1)
+		       (format "%d" (nth 1 split))
+		     (format "%d %d" (nth 1 split) (nth 2 split))))))
 	    ("syntax"
 	     ,(let ((syntax (syntax-after pos)))
 		(with-temp-buffer
@@ -512,7 +524,14 @@
 		 (if (consp key-list)
 		     (list "type"
 			   (mapconcat #'(lambda (x) (concat "\"" x "\""))
-				      key-list " or ")))))
+				      key-list " or ")
+			   "with"
+			   `(widget-create
+			     'link
+			     :notify (lambda (&rest ignore)
+				       (describe-input-method
+					',current-input-method))
+			     ,(format "%s" current-input-method))))))
 	    ("buffer code"
 	     ,(encoded-string-description
 	       (string-as-unibyte (char-to-string char)) nil))
@@ -536,11 +555,7 @@
 		(format "by display table entry [%s] (see below)"
 			(mapconcat
 			 #'(lambda (x)
-			     (if (> (car x) #x7ffff)
-				 (format "?%c<face-id=%s>"
-					 (logand (car x) #x7ffff)
-					 (lsh (car x) -19))
-			       (format "?%c" (car x))))
+			     (format "?%c" (logand (car x) #x7ffff)))
 			 disp-vector " ")))
 	       (composition
 		(let ((from (car composition))
@@ -571,11 +586,31 @@
 		    (if display
 			(format "terminal code %s" display)
 		      "not encodable for terminal"))))))
+	    ,@(let ((face
+		     (if (not (or disp-vector composition))
+			 (cond
+			  ((and show-trailing-whitespace
+				(save-excursion (goto-char pos)
+						(looking-at "[ \t]+$")))
+			   'trailing-whitespace)
+			  ((and nobreak-char-display unicode (eq unicode '#xa0))
+			   'nobreak-space)
+			  ((and nobreak-char-display unicode (eq unicode '#xad))
+			   'escape-glyph)
+			  ((and (< char 32) (not (memq char '(9 10))))
+			   'escape-glyph)))))
+		(if face (list (list "hardcoded face"
+				     `(widget-create
+				       'link
+				       :notify (lambda (&rest ignore)
+						 (describe-face ',face))
+				       ,(format "%s" face))))))
 	    ,@(let ((unicodedata (and unicode
 				      (describe-char-unicode-data unicode))))
 		(if unicodedata
 		    (cons (list "Unicode data" " ") unicodedata)))))
-    (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
+    (setq max-width (apply #'max (mapcar #'(lambda (x)
+					     (if (cadr x) (length (car x)) 0))
 					 item-list)))
     (with-output-to-temp-buffer "*Help*"
       (with-current-buffer standard-output
@@ -585,13 +620,16 @@
 	    (when (cadr elt)
 	      (insert (format formatter (car elt)))
 	      (dolist (clm (cdr elt))
-		(when (>= (+ (current-column)
-			     (or (string-match "\n" clm)
-				 (string-width clm)) 1)
-			  (window-width))
-		  (insert "\n")
-		  (indent-to (1+ max-width)))
-		(insert " " clm))
+		(if (eq (car-safe clm) 'widget-create)
+		    (progn (insert " ") (eval clm))
+		  (when (>= (+ (current-column)
+			       (or (string-match "\n" clm)
+				   (string-width clm))
+			       1)
+			    (window-width))
+		    (insert "\n")
+		    (indent-to (1+ max-width)))
+		  (insert " " clm)))
 	      (insert "\n"))))
 
 	(save-excursion
@@ -619,7 +657,21 @@
 			      (format "%s (0x%02X)" (cadr (aref disp-vector i))
 				      (cddr (aref disp-vector i)))
 			    "-- no font --")
-			  "\n ")))
+			  "\n")
+		  (when (> (car (aref disp-vector i)) #x7ffff)
+		    (let* ((face-id (lsh (car (aref disp-vector i)) -19))
+			   (face (car (delq nil (mapcar (lambda (face)
+							  (and (eq (face-id face)
+								   face-id) face))
+							(face-list))))))
+		      (when face
+			(insert (propertize " " 'display '(space :align-to 5))
+				"face: ")
+			(widget-create 'link
+				       :notify `(lambda (&rest ignore)
+						  (describe-face ',face))
+				       (format "%S" face))
+			(insert "\n"))))))
 	    (insert "these terminal codes:\n")
 	    (dotimes (i (length disp-vector))
 	      (insert (car (aref disp-vector i))
@@ -667,7 +719,7 @@
 	(describe-text-mode)))))
 
 (defalias 'describe-char-after 'describe-char)
-(make-obsolete 'describe-char-after 'describe-char "21.5")
+(make-obsolete 'describe-char-after 'describe-char "22.1")
 
 (provide 'descr-text)