Mercurial > emacs

comparison lisp/descr-text.el @ 90261:7beb78bc1f8e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-97 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 616-696) - Add lisp/mh-e/.arch-inventory - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords. - lisp/gnus/ChangeLog: Remove duplicate entry * gnus--rel--5.10 (patch 147-181) - Update from CVS - Merge from emacs--cvs-trunk--0 - Update from CVS: lisp/mml.el (mml-preview): Doc fix. - Update from CVS: texi/message.texi: Fix default values. - Update from CVS: texi/gnus.texi (RSS): Addition.
author Miles Bader <miles@gnu.org>
date Mon, 16 Jan 2006 08:37:27 +0000
parents 10fe5fadaf89 f94acc1b8bc2
children 50eb9e2ff05f
comparison
equal deleted inserted replaced
90260:0ca0d9181b5e 90261:7beb78bc1f8e
2 2
3 ;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004, 3 ;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc. 4 ;; 2005 Free Software Foundation, Inc.
5 5
6 ;; Author: Boris Goldowsky <boris@gnu.org> 6 ;; Author: Boris Goldowsky <boris@gnu.org>
7 ;; Maintainer: FSF
7 ;; Keywords: faces, i18n, Unicode, multilingual 8 ;; Keywords: faces, i18n, Unicode, multilingual
8 9
9 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
10 11
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
27 28
28 ;;; Describe-Text Mode. 29 ;;; Describe-Text Mode.
29 30
30 ;;; Code: 31 ;;; Code:
31 32
32 (eval-when-compile (require 'button) (require 'quail)) 33 (eval-when-compile (require 'quail))
33 34 (require 'help-fns)
34 (defun describe-text-done ()
35 "Delete the current window or bury the current buffer."
36 (interactive)
37 (if (> (count-windows) 1)
38 (delete-window)
39 (bury-buffer)))
40
41 (defvar describe-text-mode-map
42 (let ((map (make-sparse-keymap)))
43 (set-keymap-parent map widget-keymap)
44 map)
45 "Keymap for `describe-text-mode'.")
46
47 (defcustom describe-text-mode-hook nil
48 "List of hook functions ran by `describe-text-mode'."
49 :type 'hook
50 :group 'facemenu)
51
52 (defun describe-text-mode ()
53 "Major mode for buffers created by `describe-char'.
54
55 \\{describe-text-mode-map}
56 Entry to this mode calls the value of `describe-text-mode-hook'
57 if that value is non-nil."
58 (kill-all-local-variables)
59 (setq major-mode 'describe-text-mode
60 mode-name "Describe-Text")
61 (use-local-map describe-text-mode-map)
62 (widget-setup)
63 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
64 (run-mode-hooks 'describe-text-mode-hook))
65 35
66 ;;; Describe-Text Utilities. 36 ;;; Describe-Text Utilities.
67 37
68 (defun describe-text-widget (widget) 38 (defun describe-text-widget (widget)
69 "Insert text to describe WIDGET in the current buffer." 39 "Insert text to describe WIDGET in the current buffer."
70 (widget-create 'link 40 (insert-text-button
71 :notify `(lambda (&rest ignore) 41 (symbol-name (if (symbolp widget) widget (car widget)))
72 (widget-browse ',widget)) 42 'action `(lambda (&rest ignore)
73 (format "%S" (if (symbolp widget) 43 (widget-browse ',widget))
74 widget 44 'help-echo "mouse-2, RET: browse this widget")
75 (car widget)))) 45 (insert " ")
76 (widget-insert " ") 46 (insert-text-button
77 (widget-create 'info-link :tag "widget" "(widget)Top")) 47 "(widget)Top" 'type 'help-info 'help-args '("(widget)Top")))
78 48
79 (defun describe-text-sexp (sexp) 49 (defun describe-text-sexp (sexp)
80 "Insert a short description of SEXP in the current buffer." 50 "Insert a short description of SEXP in the current buffer."
81 (let ((pp (condition-case signal 51 (let ((pp (condition-case signal
82 (pp-to-string sexp) 52 (pp-to-string sexp)
86 (if (cond ((string-match "\n" pp) 56 (if (cond ((string-match "\n" pp)
87 nil) 57 nil)
88 ((> (length pp) (- (window-width) (current-column))) 58 ((> (length pp) (- (window-width) (current-column)))
89 nil) 59 nil)
90 (t t)) 60 (t t))
91 (widget-insert pp) 61 (insert pp)
92 (widget-create 'push-button 62 (insert-text-button
93 :tag "show" 63 "[Show]" 'action `(lambda (&rest ignore)
94 :action (lambda (widget &optional event) 64 (with-output-to-temp-buffer
95 (with-output-to-temp-buffer 65 "*Pp Eval Output*"
96 "*Pp Eval Output*" 66 (princ ',pp)))
97 (princ (widget-get widget :value)))) 67 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
98 pp))))
99 68
100 (defun describe-property-list (properties) 69 (defun describe-property-list (properties)
101 "Insert a description of PROPERTIES in the current buffer. 70 "Insert a description of PROPERTIES in the current buffer.
102 PROPERTIES should be a list of overlay or text properties. 71 PROPERTIES should be a list of overlay or text properties.
103 The `category', `face' and `font-lock-face' properties are made 72 The `category', `face' and `font-lock-face' properties are made
104 into widget buttons that call `describe-text-category' or 73 into help buttons that call `describe-text-category' or
105 `describe-face' when pushed." 74 `describe-face' when pushed."
106 ;; Sort the properties by the size of their value. 75 ;; Sort the properties by the size of their value.
107 (dolist (elt (sort (let (ret) 76 (dolist (elt (sort (let (ret)
108 (while properties 77 (while properties
109 (push (list (pop properties) (pop properties)) ret)) 78 (push (list (pop properties) (pop properties)) ret))
110 ret) 79 ret)
111 (lambda (a b) (string< (prin1-to-string (nth 0 a) t) 80 (lambda (a b) (string< (prin1-to-string (nth 0 a) t)
112 (prin1-to-string (nth 0 b) t))))) 81 (prin1-to-string (nth 0 b) t)))))
113 (let ((key (nth 0 elt)) 82 (let ((key (nth 0 elt))
114 (value (nth 1 elt))) 83 (value (nth 1 elt)))
115 (widget-insert (propertize (format " %-20s " key) 84 (insert (propertize (format " %-20s " key)
116 'font-lock-face 'italic)) 85 'face 'help-argument-name))
117 (cond ((eq key 'category) 86 (cond ((eq key 'category)
118 (widget-create 'link 87 (insert-text-button
119 :notify `(lambda (&rest ignore) 88 (symbol-name value)
120 (describe-text-category ',value)) 89 'action `(lambda (&rest ignore)
121 (format "%S" value))) 90 (describe-text-category ',value))
91 'help-echo "mouse-2, RET: describe this category"))
122 ((memq key '(face font-lock-face mouse-face)) 92 ((memq key '(face font-lock-face mouse-face))
123 (widget-create 'link 93 (insert-text-button
124 :notify `(lambda (&rest ignore) 94 (format "%S" value)
125 (describe-face ',value)) 95 'type 'help-face 'help-args (list value)))
126 (format "%S" value)))
127 ((widgetp value) 96 ((widgetp value)
128 (describe-text-widget value)) 97 (describe-text-widget value))
129 (t 98 (t
130 (describe-text-sexp value)))) 99 (describe-text-sexp value))))
131 (widget-insert "\n"))) 100 (insert "\n")))
132 101
133 ;;; Describe-Text Commands. 102 ;;; Describe-Text Commands.
134 103
135 (defun describe-text-category (category) 104 (defun describe-text-category (category)
136 "Describe a text property category." 105 "Describe a text property category."
137 (interactive "S") 106 (interactive "SCategory: ")
107 (help-setup-xref (list #'describe-text-category category) (interactive-p))
138 (save-excursion 108 (save-excursion
139 (with-output-to-temp-buffer "*Help*" 109 (with-output-to-temp-buffer "*Help*"
140 (set-buffer standard-output) 110 (set-buffer standard-output)
141 (widget-insert "Category " (format "%S" category) ":\n\n") 111 (insert "Category " (format "%S" category) ":\n\n")
142 (describe-property-list (symbol-plist category)) 112 (describe-property-list (symbol-plist category))
143 (describe-text-mode)
144 (goto-char (point-min))))) 113 (goto-char (point-min)))))
145 114
146 ;;;###autoload 115 ;;;###autoload
147 (defun describe-text-properties (pos &optional output-buffer) 116 (defun describe-text-properties (pos &optional output-buffer)
148 "Describe widgets, buttons, overlays and text properties at POS. 117 "Describe widgets, buttons, overlays and text properties at POS.
158 (if (not (or (text-properties-at pos) (overlays-at pos))) 127 (if (not (or (text-properties-at pos) (overlays-at pos)))
159 (message "This is plain text.") 128 (message "This is plain text.")
160 (let ((buffer (current-buffer)) 129 (let ((buffer (current-buffer))
161 (target-buffer "*Help*")) 130 (target-buffer "*Help*"))
162 (when (eq buffer (get-buffer target-buffer)) 131 (when (eq buffer (get-buffer target-buffer))
163 (setq target-buffer "*Help-2*")) 132 (setq target-buffer "*Help*<2>"))
164 (save-excursion 133 (save-excursion
165 (with-output-to-temp-buffer target-buffer 134 (with-output-to-temp-buffer target-buffer
166 (set-buffer standard-output) 135 (set-buffer standard-output)
167 (setq output-buffer (current-buffer)) 136 (setq output-buffer (current-buffer))
168 (widget-insert "Text content at position " (format "%d" pos) ":\n\n") 137 (insert "Text content at position " (format "%d" pos) ":\n\n")
169 (with-current-buffer buffer 138 (with-current-buffer buffer
170 (describe-text-properties-1 pos output-buffer)) 139 (describe-text-properties-1 pos output-buffer))
171 (describe-text-mode)
172 (goto-char (point-min)))))))) 140 (goto-char (point-min))))))))
173 141
174 (defun describe-text-properties-1 (pos output-buffer) 142 (defun describe-text-properties-1 (pos output-buffer)
175 (let* ((properties (text-properties-at pos)) 143 (let* ((properties (text-properties-at pos))
176 (overlays (overlays-at pos)) 144 (overlays (overlays-at pos))
184 (widget (or wid-field wid-button wid-doc))) 152 (widget (or wid-field wid-button wid-doc)))
185 (with-current-buffer output-buffer 153 (with-current-buffer output-buffer
186 ;; Widgets 154 ;; Widgets
187 (when (widgetp widget) 155 (when (widgetp widget)
188 (newline) 156 (newline)
189 (widget-insert (cond (wid-field "This is an editable text area") 157 (insert (cond (wid-field "This is an editable text area")
190 (wid-button "This is an active area") 158 (wid-button "This is an active area")
191 (wid-doc "This is documentation text"))) 159 (wid-doc "This is documentation text")))
192 (widget-insert " of a ") 160 (insert " of a ")
193 (describe-text-widget widget) 161 (describe-text-widget widget)
194 (widget-insert ".\n\n")) 162 (insert ".\n\n"))
195 ;; Buttons 163 ;; Buttons
196 (when (and button (not (widgetp wid-button))) 164 (when (and button (not (widgetp wid-button)))
197 (newline) 165 (newline)
198 (widget-insert "Here is a " (format "%S" button-type) 166 (insert "Here is a `" (format "%S" button-type)
199 " button labeled `" button-label "'.\n\n")) 167 "' button labeled `" button-label "'.\n\n"))
200 ;; Overlays 168 ;; Overlays
201 (when overlays 169 (when overlays
202 (newline) 170 (newline)
203 (if (eq (length overlays) 1) 171 (if (eq (length overlays) 1)
204 (widget-insert "There is an overlay here:\n") 172 (insert "There is an overlay here:\n")
205 (widget-insert "There are " (format "%d" (length overlays)) 173 (insert "There are " (format "%d" (length overlays))
206 " overlays here:\n")) 174 " overlays here:\n"))
207 (dolist (overlay overlays) 175 (dolist (overlay overlays)
208 (widget-insert " From " (format "%d" (overlay-start overlay)) 176 (insert " From " (format "%d" (overlay-start overlay))
209 " to " (format "%d" (overlay-end overlay)) "\n") 177 " to " (format "%d" (overlay-end overlay)) "\n")
210 (describe-property-list (overlay-properties overlay))) 178 (describe-property-list (overlay-properties overlay)))
211 (widget-insert "\n")) 179 (insert "\n"))
212 ;; Text properties 180 ;; Text properties
213 (when properties 181 (when properties
214 (newline) 182 (newline)
215 (widget-insert "There are text properties here:\n") 183 (insert "There are text properties here:\n")
216 (describe-property-list properties))))) 184 (describe-property-list properties)))))
217 185
218 (defcustom describe-char-unidata-list nil 186 (defcustom describe-char-unidata-list nil
219 "List of Unicode-based character property names shown by `describe-char'." 187 "List of Unicode-based character property names shown by `describe-char'."
220 :group 'mule 188 :group 'mule
242 diagnostics. If it is non-nil `describe-char' will print data 210 diagnostics. If it is non-nil `describe-char' will print data
243 looked up from it. This facility is mostly of use to people doing 211 looked up from it. This facility is mostly of use to people doing
244 multilingual development. 212 multilingual development.
245 213
246 This is a fairly large file, not typically present on GNU systems. At 214 This is a fairly large file, not typically present on GNU systems. At
247 the time of writing it is at 215 the time of writing it is at the URL
248 <URL:http://www.unicode.org/Public/UNIDATA/UnicodeData.txt>." 216 `http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
249 :group 'mule 217 :group 'mule
250 :version "22.1" 218 :version "22.1"
251 :type '(choice (const :tag "None" nil) 219 :type '(choice (const :tag "None" nil)
252 file)) 220 file))
253 221
393 standard-display-table)) 361 standard-display-table))
394 (disp-vector (and display-table (aref display-table char))) 362 (disp-vector (and display-table (aref display-table char)))
395 (multibyte-p enable-multibyte-characters) 363 (multibyte-p enable-multibyte-characters)
396 (overlays (mapcar #'(lambda (o) (overlay-properties o)) 364 (overlays (mapcar #'(lambda (o) (overlay-properties o))
397 (overlays-at pos))) 365 (overlays-at pos)))
366 (char-description (if (not multibyte-p)
367 (single-key-description char)
368 (if (< char 128)
369 (single-key-description char)
370 (string-to-multibyte
371 (char-to-string char)))))
372 (text-props-desc
373 (let ((tmp-buf (generate-new-buffer " *text-props*")))
374 (unwind-protect
375 (progn
376 (describe-text-properties pos tmp-buf)
377 (with-current-buffer tmp-buf (buffer-string)))
378 (kill-buffer tmp-buf))))
398 item-list max-width code) 379 item-list max-width code)
399 380
400 (setq code (encode-char char charset)) 381 (setq code (encode-char char charset))
401 (setq item-list 382 (setq item-list
402 `(("character" 383 `(("character"
403 ,(format "%s (0%o, %d, 0x%x)" 384 ,(format "%s (%d, #o%o, #x%x)"
404 (apply 'propertize (if (not multibyte-p) 385 (apply 'propertize char-description
405 (single-key-description char) 386 (text-properties-at pos))
406 (if (< char 128) 387 char char char))
407 (single-key-description char)
408 (string-to-multibyte
409 (char-to-string char))))
410 (text-properties-at pos))
411 char char char))
412 ("preferred charset" 388 ("preferred charset"
413 ,`(widget-create 'link 389 ,`(insert-text-button
414 :notify (lambda (&rest ignore) 390 ,(symbol-name charset)
415 (describe-character-set ',charset)) 391 'type 'help-character-set 'help-args '(,charset))
416 ,(symbol-name charset))
417 ,(format "(%s)" (charset-description charset))) 392 ,(format "(%s)" (charset-description charset)))
418 ("code point" 393 ("code point"
419 ,(let ((str (if (integerp code) 394 ,(let ((str (if (integerp code)
420 (format (if (< code 256) "0x%02X" "0x%04X") code) 395 (format (if (< code 256) "0x%02X" "0x%04X") code)
421 (format "0x%04X%04X" (car code) (cdr code))))) 396 (format "0x%04X%04X" (car code) (cdr code)))))
422 (if (<= (charset-dimension charset) 2) 397 (if (<= (charset-dimension charset) 2)
423 `(widget-create 398 `(insert-text-button
424 'link 399 ,str
425 :notify (lambda (&rest ignore) 400 'action (lambda (&rest ignore)
426 (list-charset-chars ',charset) 401 (list-charset-chars ',charset)
427 (with-selected-window 402 (with-selected-window
428 (get-buffer-window "*Character List*" 0) 403 (get-buffer-window "*Character List*" 0)
429 (goto-char (point-min)) 404 (goto-char (point-min))
430 (forward-line 2) ;Skip the header. 405 (forward-line 2) ;Skip the header.
431 (let ((case-fold-search nil)) 406 (let ((case-fold-search nil))
432 (if (search-forward ,(char-to-string char) 407 (if (search-forward ,(char-to-string char)
433 nil t) 408 nil t)
434 (goto-char (match-beginning 0)))))) 409 (goto-char (match-beginning 0))))))
435 ,str) 410 'help-echo
411 "mouse-2, RET: show this character in its character set")
436 str))) 412 str)))
437 ("syntax" 413 ("syntax"
438 ,(let ((syntax (syntax-after pos))) 414 ,(let ((syntax (syntax-after pos)))
439 (with-temp-buffer 415 (with-temp-buffer
440 (internal-describe-syntax-value syntax) 416 (internal-describe-syntax-value syntax)
441 (buffer-string)))) 417 (buffer-string))))
442 ("category" 418 ("category"
443 ,@(let ((category-set (char-category-set char))) 419 ,@(let ((category-set (char-category-set char)))
444 (if (not category-set) 420 (if (not category-set)
445 '("-- none --") 421 '("-- none --")
446 (mapcar #'(lambda (x) (format "%c:%s " 422 (mapcar #'(lambda (x) (format "%c:%s"
447 x (category-docstring x))) 423 x (category-docstring x)))
448 (category-set-mnemonics category-set))))) 424 (category-set-mnemonics category-set)))))
449 ("to input" 425 ("to input"
450 ,@(let ((key-list (and (eq input-method-function 426 ,@(let ((key-list (and (eq input-method-function
451 'quail-input-method) 427 'quail-input-method)
453 (if (consp key-list) 429 (if (consp key-list)
454 (list "type" 430 (list "type"
455 (mapconcat #'(lambda (x) (concat "\"" x "\"")) 431 (mapconcat #'(lambda (x) (concat "\"" x "\""))
456 key-list " or ") 432 key-list " or ")
457 "with" 433 "with"
458 `(widget-create 434 `(insert-text-button
459 'link 435 ,current-input-method
460 :notify (lambda (&rest ignore) 436 'type 'help-input-method
461 (describe-input-method 437 'help-args '(,current-input-method))))))
462 ',current-input-method))
463 ,(format "%s" current-input-method))))))
464 ("buffer code" 438 ("buffer code"
465 ,(encoded-string-description 439 ,(encoded-string-description
466 (string-as-unibyte (char-to-string char)) nil)) 440 (string-as-unibyte (char-to-string char)) nil))
467 ("file code" 441 ("file code"
468 ,@(let* ((coding buffer-file-coding-system) 442 ,@(let* ((coding buffer-file-coding-system)
507 (let ((display (describe-char-display pos char))) 481 (let ((display (describe-char-display pos char)))
508 (if (display-graphic-p (selected-frame)) 482 (if (display-graphic-p (selected-frame))
509 (if display 483 (if display
510 (concat 484 (concat
511 "by this font (glyph code)\n" 485 "by this font (glyph code)\n"
512 (format " %s (0x%02X)" 486 (format " %s (#x%02X)"
513 (car display) (cdr display))) 487 (car display) (cdr display)))
514 "no font available") 488 "no font available")
515 (if display 489 (if display
516 (format "terminal code %s" display) 490 (format "terminal code %s" display)
517 "not encodable for terminal")))))) 491 "not encodable for terminal"))))))
527 ((and nobreak-char-display char (eq char '#xad)) 501 ((and nobreak-char-display char (eq char '#xad))
528 'escape-glyph) 502 'escape-glyph)
529 ((and (< char 32) (not (memq char '(9 10)))) 503 ((and (< char 32) (not (memq char '(9 10))))
530 'escape-glyph))))) 504 'escape-glyph)))))
531 (if face (list (list "hardcoded face" 505 (if face (list (list "hardcoded face"
532 `(widget-create 506 `(insert-text-button
533 'link 507 ,(symbol-name face)
534 :notify (lambda (&rest ignore) 508 'type 'help-face 'help-args '(,face))))))
535 (describe-face ',face)) 509 ,@(let ((unicodedata (and unicode
536 ,(format "%s" face)))))) 510 (describe-char-unicode-data unicode))))
537 ,@(let ((unicodedata (describe-char-unicode-data char)))
538 (if unicodedata 511 (if unicodedata
539 (cons (list "Unicode data" " ") unicodedata))))) 512 (cons (list "Unicode data" " ") unicodedata)))))
540 (setq max-width (apply #'max (mapcar #'(lambda (x) 513 (setq max-width (apply #'max (mapcar #'(lambda (x)
541 (if (cadr x) (length (car x)) 0)) 514 (if (cadr x) (length (car x)) 0))
542 item-list))) 515 item-list)))
543 (with-output-to-temp-buffer "*Help*" 516 (help-setup-xref nil (interactive-p))
517 (with-output-to-temp-buffer (help-buffer)
544 (with-current-buffer standard-output 518 (with-current-buffer standard-output
545 (set-buffer-multibyte multibyte-p) 519 (set-buffer-multibyte multibyte-p)
546 (let ((formatter (format "%%%ds:" max-width))) 520 (let ((formatter (format "%%%ds:" max-width)))
547 (dolist (elt item-list) 521 (dolist (elt item-list)
548 (when (cadr elt) 522 (when (cadr elt)
549 (insert (format formatter (car elt))) 523 (insert (format formatter (car elt)))
550 (dolist (clm (cdr elt)) 524 (dolist (clm (cdr elt))
551 (if (eq (car-safe clm) 'widget-create) 525 (if (eq (car-safe clm) 'insert-text-button)
552 (progn (insert " ") (eval clm)) 526 (progn (insert " ") (eval clm))
553 (when (>= (+ (current-column) 527 (when (>= (+ (current-column)
554 (or (string-match "\n" clm) 528 (or (string-match "\n" clm)
555 (string-width clm)) 529 (string-width clm))
556 1) 530 1)
558 (insert "\n") 532 (insert "\n")
559 (indent-to (1+ max-width))) 533 (indent-to (1+ max-width)))
560 (insert " " clm))) 534 (insert " " clm)))
561 (insert "\n")))) 535 (insert "\n"))))
562 536
563 (save-excursion 537 (when overlays
564 (goto-char (point-min)) 538 (save-excursion
565 (re-search-forward "character:[ \t\n]+") 539 (goto-char (point-min))
566 (setq pos (point))) 540 (re-search-forward "character:[ \t\n]+")
567 (if overlays 541 (let* ((end (+ (point) (length char-description))))
568 (mapc #'(lambda (props) 542 (mapc #'(lambda (props)
569 (let ((o (make-overlay pos (1+ pos)))) 543 (let ((o (make-overlay (point) end)))
570 (while props 544 (while props
571 (overlay-put o (car props) (nth 1 props)) 545 (overlay-put o (car props) (nth 1 props))
572 (setq props (cddr props))))) 546 (setq props (cddr props)))))
573 overlays)) 547 overlays))))
574 548
575 (when disp-vector 549 (when disp-vector
576 (insert 550 (insert
577 "\nThe display table entry is displayed by ") 551 "\nThe display table entry is displayed by ")
578 (if (display-graphic-p (selected-frame)) 552 (if (display-graphic-p (selected-frame))
580 (insert "these fonts (glyph codes):\n") 554 (insert "these fonts (glyph codes):\n")
581 (dotimes (i (length disp-vector)) 555 (dotimes (i (length disp-vector))
582 (insert (logand (car (aref disp-vector i)) #x7ffff) ?: 556 (insert (logand (car (aref disp-vector i)) #x7ffff) ?:
583 (propertize " " 'display '(space :align-to 5)) 557 (propertize " " 'display '(space :align-to 5))
584 (if (cdr (aref disp-vector i)) 558 (if (cdr (aref disp-vector i))
585 (format "%s (0x%02X)" (cadr (aref disp-vector i)) 559 (format "%s (#x%02X)" (cadr (aref disp-vector i))
586 (cddr (aref disp-vector i))) 560 (cddr (aref disp-vector i)))
587 "-- no font --") 561 "-- no font --")
588 "\n") 562 "\n")
589 (when (> (car (aref disp-vector i)) #x7ffff) 563 (when (> (car (aref disp-vector i)) #x7ffff)
590 (let* ((face-id (lsh (car (aref disp-vector i)) -19)) 564 (let* ((face-id (lsh (car (aref disp-vector i)) -19))
591 (face (car (delq nil (mapcar (lambda (face) 565 (face (car (delq nil (mapcar
592 (and (eq (face-id face) 566 (lambda (face)
593 face-id) face)) 567 (and (eq (face-id face)
594 (face-list)))))) 568 face-id) face))
569 (face-list))))))
595 (when face 570 (when face
596 (insert (propertize " " 'display '(space :align-to 5)) 571 (insert (propertize " " 'display '(space :align-to 5))
597 "face: ") 572 "face: ")
598 (widget-create 'link 573 (insert (concat "`" (symbol-name face) "'"))
599 :notify `(lambda (&rest ignore)
600 (describe-face ',face))
601 (format "%S" face))
602 (insert "\n")))))) 574 (insert "\n"))))))
603 (insert "these terminal codes:\n") 575 (insert "these terminal codes:\n")
604 (dotimes (i (length disp-vector)) 576 (dotimes (i (length disp-vector))
605 (insert (car (aref disp-vector i)) 577 (insert (car (aref disp-vector i))
606 (propertize " " 'display '(space :align-to 5)) 578 (propertize " " 'display '(space :align-to 5))
631 (insert "these fonts (glyph codes):") 603 (insert "these fonts (glyph codes):")
632 (dolist (elt component-chars) 604 (dolist (elt component-chars)
633 (insert "\n " (car elt) ?: 605 (insert "\n " (car elt) ?:
634 (propertize " " 'display '(space :align-to 5)) 606 (propertize " " 'display '(space :align-to 5))
635 (if (cdr elt) 607 (if (cdr elt)
636 (format "%s (0x%02X)" (cadr elt) (cddr elt)) 608 (format "%s (#x%02X)" (cadr elt) (cddr elt))
637 "-- no font --")))) 609 "-- no font --"))))
638 (insert "these terminal codes:") 610 (insert "these terminal codes:")
639 (dolist (elt component-chars) 611 (dolist (elt component-chars)
640 (insert "\n " (car elt) ":" 612 (insert "\n " (car elt) ":"
641 (propertize " " 'display '(space :align-to 5)) 613 (propertize " " 'display '(space :align-to 5))
659 (setq description (char-code-property-description elt val)) 631 (setq description (char-code-property-description elt val))
660 (if description 632 (if description
661 (insert (format " %s: %s (%s)\n" elt val description)) 633 (insert (format " %s: %s (%s)\n" elt val description))
662 (insert (format " %s: %s\n" elt val)))))) 634 (insert (format " %s: %s\n" elt val))))))
663 635
664 (describe-text-properties pos (current-buffer)) 636 (if text-props-desc (insert text-props-desc))
665 (describe-text-mode))))) 637 (setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
638 (toggle-read-only 1)
639 (print-help-return-message)))))
666 640
667 (defalias 'describe-char-after 'describe-char) 641 (defalias 'describe-char-after 'describe-char)
668 (make-obsolete 'describe-char-after 'describe-char "22.1") 642 (make-obsolete 'describe-char-after 'describe-char "22.1")
669 643
670 (provide 'descr-text) 644 (provide 'descr-text)