# HG changeset patch # User Juri Linkov # Date 1121772194 0 # Node ID 524cffc1c27d965ddd3455259079667b12a35de0 # Parent ca001bc998df3353eceb3c4bf671eb627e67d64f (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. diff -r ca001bc998df -r 524cffc1c27d lisp/descr-text.el --- 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" - (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)