Commit | Line | Data |
---|---|---|
dcb90b5f | 1 | ;;; descr-text.el --- describe text mode |
2a1e884e | 2 | |
0d30b337 | 3 | ;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004, |
409cc4a3 | 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
2a1e884e RS |
5 | |
6 | ;; Author: Boris Goldowsky <boris@gnu.org> | |
57d79b99 | 7 | ;; Maintainer: FSF |
2d65673f | 8 | ;; Keywords: faces, i18n, Unicode, multilingual |
2a1e884e RS |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
b4aa6026 | 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
2a1e884e RS |
15 | ;; any later version. |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
086add15 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
2a1e884e RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
29 | ;;; Describe-Text Mode. | |
30 | ||
31 | ;;; Code: | |
32 | ||
e5a5c80c NR |
33 | (eval-when-compile (require 'quail)) |
34 | (require 'help-fns) | |
2a1e884e RS |
35 | |
36 | ;;; Describe-Text Utilities. | |
37 | ||
38 | (defun describe-text-widget (widget) | |
39 | "Insert text to describe WIDGET in the current buffer." | |
57d79b99 NR |
40 | (insert-text-button |
41 | (symbol-name (if (symbolp widget) widget (car widget))) | |
42 | 'action `(lambda (&rest ignore) | |
e5a5c80c NR |
43 | (widget-browse ',widget)) |
44 | 'help-echo "mouse-2, RET: browse this widget") | |
57d79b99 | 45 | (insert " ") |
e5a5c80c NR |
46 | (insert-text-button |
47 | "(widget)Top" 'type 'help-info 'help-args '("(widget)Top"))) | |
2a1e884e RS |
48 | |
49 | (defun describe-text-sexp (sexp) | |
50 | "Insert a short description of SEXP in the current buffer." | |
51 | (let ((pp (condition-case signal | |
52 | (pp-to-string sexp) | |
53 | (error (prin1-to-string signal))))) | |
54 | (when (string-match "\n\\'" pp) | |
55 | (setq pp (substring pp 0 (1- (length pp))))) | |
56 | (if (cond ((string-match "\n" pp) | |
57 | nil) | |
58 | ((> (length pp) (- (window-width) (current-column))) | |
59 | nil) | |
60 | (t t)) | |
57d79b99 NR |
61 | (insert pp) |
62 | (insert-text-button | |
2fd54bf8 | 63 | "[Show]" 'action `(lambda (&rest ignore) |
57d79b99 NR |
64 | (with-output-to-temp-buffer |
65 | "*Pp Eval Output*" | |
66 | (princ ',pp))) | |
67 | 'help-echo "mouse-2, RET: pretty print value in another buffer")))) | |
2a1e884e | 68 | |
4adb7c09 | 69 | (defun describe-property-list (properties) |
2a1e884e RS |
70 | "Insert a description of PROPERTIES in the current buffer. |
71 | PROPERTIES should be a list of overlay or text properties. | |
7fb0741b | 72 | The `category', `face' and `font-lock-face' properties are made |
57d79b99 | 73 | into help buttons that call `describe-text-category' or |
7fb0741b | 74 | `describe-face' when pushed." |
e2fa2f6e | 75 | ;; Sort the properties by the size of their value. |
8b18fb8f | 76 | (dolist (elt (sort (let (ret) |
e2fa2f6e | 77 | (while properties |
8b18fb8f | 78 | (push (list (pop properties) (pop properties)) ret)) |
e2fa2f6e | 79 | ret) |
d502fc06 RS |
80 | (lambda (a b) (string< (prin1-to-string (nth 0 a) t) |
81 | (prin1-to-string (nth 0 b) t))))) | |
e2fa2f6e CW |
82 | (let ((key (nth 0 elt)) |
83 | (value (nth 1 elt))) | |
57d79b99 | 84 | (insert (propertize (format " %-20s " key) |
e5a5c80c | 85 | 'face 'help-argument-name)) |
2a1e884e | 86 | (cond ((eq key 'category) |
e5a5c80c NR |
87 | (insert-text-button |
88 | (symbol-name value) | |
89 | 'action `(lambda (&rest ignore) | |
90 | (describe-text-category ',value)) | |
91 | 'help-echo "mouse-2, RET: describe this category")) | |
8b18fb8f | 92 | ((memq key '(face font-lock-face mouse-face)) |
2fd54bf8 JL |
93 | (insert-text-button |
94 | (format "%S" value) | |
95 | 'type 'help-face 'help-args (list value))) | |
f13cc97d | 96 | ((widgetp value) |
2a1e884e RS |
97 | (describe-text-widget value)) |
98 | (t | |
8b18fb8f | 99 | (describe-text-sexp value)))) |
57d79b99 | 100 | (insert "\n"))) |
2a1e884e RS |
101 | \f |
102 | ;;; Describe-Text Commands. | |
103 | ||
104 | (defun describe-text-category (category) | |
105 | "Describe a text property category." | |
e5a5c80c NR |
106 | (interactive "SCategory: ") |
107 | (help-setup-xref (list #'describe-text-category category) (interactive-p)) | |
2a1e884e | 108 | (save-excursion |
ca9088e7 SM |
109 | (with-output-to-temp-buffer "*Help*" |
110 | (set-buffer standard-output) | |
57d79b99 | 111 | (insert "Category " (format "%S" category) ":\n\n") |
4adb7c09 | 112 | (describe-property-list (symbol-plist category)) |
2a1e884e RS |
113 | (goto-char (point-min))))) |
114 | ||
115 | ;;;###autoload | |
4adb7c09 RS |
116 | (defun describe-text-properties (pos &optional output-buffer) |
117 | "Describe widgets, buttons, overlays and text properties at POS. | |
118 | Interactively, describe them for the character after point. | |
119 | If optional second argument OUTPUT-BUFFER is non-nil, | |
120 | insert the output into that buffer, and don't initialize or clear it | |
121 | otherwise." | |
2a1e884e | 122 | (interactive "d") |
4adb7c09 RS |
123 | (if (>= pos (point-max)) |
124 | (error "No character follows specified position")) | |
125 | (if output-buffer | |
126 | (describe-text-properties-1 pos output-buffer) | |
127 | (if (not (or (text-properties-at pos) (overlays-at pos))) | |
128 | (message "This is plain text.") | |
0911ac26 KS |
129 | (let ((buffer (current-buffer)) |
130 | (target-buffer "*Help*")) | |
131 | (when (eq buffer (get-buffer target-buffer)) | |
e217c04e | 132 | (setq target-buffer "*Help*<2>")) |
4adb7c09 | 133 | (save-excursion |
0911ac26 | 134 | (with-output-to-temp-buffer target-buffer |
ca9088e7 | 135 | (set-buffer standard-output) |
4adb7c09 | 136 | (setq output-buffer (current-buffer)) |
57d79b99 | 137 | (insert "Text content at position " (format "%d" pos) ":\n\n") |
4adb7c09 RS |
138 | (with-current-buffer buffer |
139 | (describe-text-properties-1 pos output-buffer)) | |
4adb7c09 RS |
140 | (goto-char (point-min)))))))) |
141 | ||
142 | (defun describe-text-properties-1 (pos output-buffer) | |
2a1e884e RS |
143 | (let* ((properties (text-properties-at pos)) |
144 | (overlays (overlays-at pos)) | |
2a1e884e RS |
145 | (wid-field (get-char-property pos 'field)) |
146 | (wid-button (get-char-property pos 'button)) | |
147 | (wid-doc (get-char-property pos 'widget-doc)) | |
148 | ;; If button.el is not loaded, we have no buttons in the text. | |
149 | (button (and (fboundp 'button-at) (button-at pos))) | |
150 | (button-type (and button (button-type button))) | |
151 | (button-label (and button (button-label button))) | |
152 | (widget (or wid-field wid-button wid-doc))) | |
4adb7c09 RS |
153 | (with-current-buffer output-buffer |
154 | ;; Widgets | |
155 | (when (widgetp widget) | |
156 | (newline) | |
57d79b99 NR |
157 | (insert (cond (wid-field "This is an editable text area") |
158 | (wid-button "This is an active area") | |
159 | (wid-doc "This is documentation text"))) | |
160 | (insert " of a ") | |
4adb7c09 | 161 | (describe-text-widget widget) |
57d79b99 | 162 | (insert ".\n\n")) |
4adb7c09 RS |
163 | ;; Buttons |
164 | (when (and button (not (widgetp wid-button))) | |
165 | (newline) | |
2fd54bf8 JL |
166 | (insert "Here is a `" (format "%S" button-type) |
167 | "' button labeled `" button-label "'.\n\n")) | |
4adb7c09 RS |
168 | ;; Overlays |
169 | (when overlays | |
170 | (newline) | |
171 | (if (eq (length overlays) 1) | |
57d79b99 NR |
172 | (insert "There is an overlay here:\n") |
173 | (insert "There are " (format "%d" (length overlays)) | |
4adb7c09 RS |
174 | " overlays here:\n")) |
175 | (dolist (overlay overlays) | |
57d79b99 | 176 | (insert " From " (format "%d" (overlay-start overlay)) |
4adb7c09 RS |
177 | " to " (format "%d" (overlay-end overlay)) "\n") |
178 | (describe-property-list (overlay-properties overlay))) | |
57d79b99 | 179 | (insert "\n")) |
4adb7c09 RS |
180 | ;; Text properties |
181 | (when properties | |
182 | (newline) | |
57d79b99 | 183 | (insert "There are text properties here:\n") |
4adb7c09 | 184 | (describe-property-list properties))))) |
d6c135fb | 185 | \f |
f1f194de KH |
186 | (defcustom describe-char-unidata-list nil |
187 | "List of Unicode-based character property names shown by `describe-char'." | |
188 | :group 'mule | |
8589dc17 | 189 | :version "23.1" |
f1f194de KH |
190 | :type '(set |
191 | (const :tag "Unicode Name" name) | |
192 | (const :tag "Unicode general category " general-category) | |
193 | (const :tag "Unicode canonical combining class" | |
194 | canonical-combining-class) | |
195 | (const :tag "Unicode bidi class" bidi-class) | |
196 | (const :tag "Unicode decomposition mapping" decomposition) | |
197 | (const :tag "Unicode decimal digit value" decimal-digit-value) | |
198 | (const :tag "Unicode digit value" digit-value) | |
199 | (const :tag "Unicode numeric value" numeric-value) | |
200 | (const :tag "Unicode mirrored" mirrored) | |
201 | (const :tag "Unicode old name" old-name) | |
202 | (const :tag "Unicode ISO 10646 comment" iso-10646-comment) | |
203 | (const :tag "Unicode simple uppercase mapping" uppercase) | |
204 | (const :tag "Unicode simple lowercase mapping" lowercase) | |
205 | (const :tag "Unicode simple titlecase mapping" titlecase))) | |
206 | ||
49c2a2dc SM |
207 | (defcustom describe-char-unicodedata-file nil |
208 | "Location of Unicode data file. | |
2acb13b1 | 209 | This is the UnicodeData.txt file from the Unicode Consortium, used for |
2a4960f9 | 210 | diagnostics. If it is non-nil `describe-char' will print data |
49c2a2dc SM |
211 | looked up from it. This facility is mostly of use to people doing |
212 | multilingual development. | |
4adb7c09 | 213 | |
2acb13b1 JB |
214 | This is a fairly large file, not typically present on GNU systems. |
215 | At the time of writing it is at the URL | |
57d79b99 | 216 | `http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'." |
49c2a2dc | 217 | :group 'mule |
bf247b6e | 218 | :version "22.1" |
49c2a2dc SM |
219 | :type '(choice (const :tag "None" nil) |
220 | file)) | |
831ccfa6 | 221 | |
49c2a2dc SM |
222 | ;; We could convert the unidata file into a Lispy form once-for-all |
223 | ;; and distribute it for loading on demand. It might be made more | |
224 | ;; space-efficient by splitting strings word-wise and replacing them | |
225 | ;; with lists of symbols interned in a private obarray, e.g. | |
226 | ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A). | |
831ccfa6 | 227 | |
49c2a2dc SM |
228 | ;; Fixme: Check whether this needs updating for Unicode 4. |
229 | (defun describe-char-unicode-data (char) | |
230 | "Return a list of Unicode data for unicode CHAR. | |
231 | Each element is a list of a property description and the property value. | |
f1f194de KH |
232 | The list is null if CHAR isn't found in `describe-char-unicodedata-file'. |
233 | This function is semi-obsolete. Use `get-char-code-property'." | |
49c2a2dc SM |
234 | (when describe-char-unicodedata-file |
235 | (unless (file-exists-p describe-char-unicodedata-file) | |
236 | (error "`unicodedata-file' %s not found" describe-char-unicodedata-file)) | |
def7167b JB |
237 | (with-current-buffer (get-buffer-create " *Unicode Data*") |
238 | (when (zerop (buffer-size)) | |
239 | ;; Don't use -literally in case of DOS line endings. | |
240 | (insert-file-contents describe-char-unicodedata-file)) | |
49c2a2dc SM |
241 | (goto-char (point-min)) |
242 | (let ((hex (format "%04X" char)) | |
243 | found first last) | |
244 | (if (re-search-forward (concat "^" hex) nil t) | |
245 | (setq found t) | |
246 | ;; It's not listed explicitly. Look for ranges, e.g. CJK | |
247 | ;; ideographs, and check whether it's in one of them. | |
248 | (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t) | |
249 | (>= char (setq first | |
250 | (string-to-number (match-string 1) 16))) | |
251 | (progn | |
252 | (forward-line 1) | |
253 | (looking-at "^\\([^;]+\\);[^;]+Last>;") | |
254 | (> char | |
255 | (setq last | |
256 | (string-to-number (match-string 1) 16)))))) | |
257 | (if (and (>= char first) | |
258 | (<= char last)) | |
259 | (setq found t))) | |
260 | (if found | |
261 | (let ((fields (mapcar (lambda (elt) | |
262 | (if (> (length elt) 0) | |
263 | elt)) | |
264 | (cdr (split-string | |
265 | (buffer-substring | |
266 | (line-beginning-position) | |
267 | (line-end-position)) | |
268 | ";"))))) | |
269 | ;; The length depends on whether the last field was empty. | |
270 | (unless (or (= 13 (length fields)) | |
271 | (= 14 (length fields))) | |
272 | (error "Invalid contents in %s" describe-char-unicodedata-file)) | |
273 | ;; The field names and values lists are slightly | |
274 | ;; modified from Mule-UCS unidata.el. | |
275 | (list | |
276 | (list "Name" (let ((name (nth 0 fields))) | |
277 | ;; Check for <..., First>, <..., Last> | |
278 | (if (string-match "\\`\\(<[^,]+\\)," name) | |
279 | (concat (match-string 1 name) ">") | |
280 | name))) | |
281 | (list "Category" | |
f1f194de KH |
282 | (let ((val (nth 1 fields))) |
283 | (or (char-code-property-description | |
284 | 'general-category (intern val)) | |
285 | val))) | |
49c2a2dc | 286 | (list "Combining class" |
f1f194de KH |
287 | (let ((val (nth 1 fields))) |
288 | (or (char-code-property-description | |
289 | 'canonical-combining-class (intern val)) | |
290 | val))) | |
49c2a2dc | 291 | (list "Bidi category" |
f1f194de KH |
292 | (let ((val (nth 1 fields))) |
293 | (or (char-code-property-description | |
294 | 'bidi-class (intern val)) | |
295 | val))) | |
49c2a2dc SM |
296 | (list |
297 | "Decomposition" | |
298 | (if (nth 4 fields) | |
299 | (let* ((parts (split-string (nth 4 fields))) | |
300 | (info (car parts))) | |
301 | (if (string-match "\\`<\\(.+\\)>\\'" info) | |
302 | (setq info (match-string 1 info)) | |
303 | (setq info nil)) | |
304 | (if info (setq parts (cdr parts))) | |
49c2a2dc SM |
305 | (setq parts (mapconcat |
306 | (lambda (arg) | |
f1f194de | 307 | (string (string-to-number arg 16))) |
49c2a2dc SM |
308 | parts " ")) |
309 | (concat info parts)))) | |
310 | (list "Decimal digit value" | |
311 | (nth 5 fields)) | |
312 | (list "Digit value" | |
313 | (nth 6 fields)) | |
314 | (list "Numeric value" | |
315 | (nth 7 fields)) | |
316 | (list "Mirrored" | |
317 | (if (equal "Y" (nth 8 fields)) | |
318 | "yes")) | |
319 | (list "Old name" (nth 9 fields)) | |
320 | (list "ISO 10646 comment" (nth 10 fields)) | |
321 | (list "Uppercase" (and (nth 11 fields) | |
f1f194de KH |
322 | (string (string-to-number |
323 | (nth 11 fields) 16)))) | |
49c2a2dc | 324 | (list "Lowercase" (and (nth 12 fields) |
f1f194de KH |
325 | (string (string-to-number |
326 | (nth 12 fields) 16)))) | |
49c2a2dc | 327 | (list "Titlecase" (and (nth 13 fields) |
f1f194de KH |
328 | (string (string-to-number |
329 | (nth 13 fields) 16))))))))))) | |
7fb0741b KH |
330 | |
331 | ;; Return information about how CHAR is displayed at the buffer | |
332 | ;; position POS. If the selected frame is on a graphic display, | |
333 | ;; return a cons (FONTNAME . GLYPH-CODE). Otherwise, return a string | |
334 | ;; describing the terminal codes for the character. | |
335 | (defun describe-char-display (pos char) | |
336 | (if (display-graphic-p (selected-frame)) | |
337 | (internal-char-font pos char) | |
338 | (let* ((coding (terminal-coding-system)) | |
339 | (encoded (encode-coding-char char coding))) | |
340 | (if encoded | |
341 | (encoded-string-description encoded coding))))) | |
342 | ||
d6c135fb | 343 | \f |
4adb7c09 RS |
344 | ;;;###autoload |
345 | (defun describe-char (pos) | |
346 | "Describe the character after POS (interactively, the character after point). | |
347 | The information includes character code, charset and code points in it, | |
348 | syntax, category, how the character is encoded in a file, | |
349 | character composition information (if relevant), | |
350 | as well as widgets, buttons, overlays, and text properties." | |
351 | (interactive "d") | |
4adb7c09 RS |
352 | (if (>= pos (point-max)) |
353 | (error "No character follows specified position")) | |
354 | (let* ((char (char-after pos)) | |
355 | (charset (char-charset char)) | |
ca9088e7 | 356 | (composition (find-composition pos nil nil t)) |
7fb0741b KH |
357 | (component-chars nil) |
358 | (display-table (or (window-display-table) | |
359 | buffer-display-table | |
360 | standard-display-table)) | |
361 | (disp-vector (and display-table (aref display-table char))) | |
4adb7c09 | 362 | (multibyte-p enable-multibyte-characters) |
6482d093 KH |
363 | (overlays (mapcar #'(lambda (o) (overlay-properties o)) |
364 | (overlays-at pos))) | |
6398b88f AS |
365 | (char-description (if (not multibyte-p) |
366 | (single-key-description char) | |
367 | (if (< char 128) | |
368 | (single-key-description char) | |
369 | (string-to-multibyte | |
370 | (char-to-string char))))) | |
e5a5c80c NR |
371 | (text-props-desc |
372 | (let ((tmp-buf (generate-new-buffer " *text-props*"))) | |
373 | (unwind-protect | |
374 | (progn | |
375 | (describe-text-properties pos tmp-buf) | |
376 | (with-current-buffer tmp-buf (buffer-string))) | |
377 | (kill-buffer tmp-buf)))) | |
327719ee | 378 | item-list max-width code) |
831ccfa6 | 379 | |
327719ee | 380 | (setq code (encode-char char charset)) |
ed441285 KH |
381 | (setq item-list |
382 | `(("character" | |
41882805 | 383 | ,(format "%s (%d, #o%o, #x%x)" |
e5a5c80c NR |
384 | (apply 'propertize char-description |
385 | (text-properties-at pos)) | |
41882805 | 386 | char char char)) |
327719ee | 387 | ("preferred charset" |
57d79b99 | 388 | ,`(insert-text-button |
e5a5c80c NR |
389 | ,(symbol-name charset) |
390 | 'type 'help-character-set 'help-args '(,charset)) | |
ed441285 KH |
391 | ,(format "(%s)" (charset-description charset))) |
392 | ("code point" | |
879dfc97 KH |
393 | ,(let ((str (if (integerp code) |
394 | (format (if (< code 256) "0x%02X" "0x%04X") code) | |
395 | (format "0x%04X%04X" (car code) (cdr code))))) | |
396 | (if (<= (charset-dimension charset) 2) | |
41882805 MB |
397 | `(insert-text-button |
398 | ,str | |
399 | 'action (lambda (&rest ignore) | |
879dfc97 KH |
400 | (list-charset-chars ',charset) |
401 | (with-selected-window | |
402 | (get-buffer-window "*Character List*" 0) | |
403 | (goto-char (point-min)) | |
404 | (forward-line 2) ;Skip the header. | |
405 | (let ((case-fold-search nil)) | |
406 | (if (search-forward ,(char-to-string char) | |
407 | nil t) | |
408 | (goto-char (match-beginning 0)))))) | |
41882805 MB |
409 | 'help-echo |
410 | "mouse-2, RET: show this character in its character set") | |
879dfc97 | 411 | str))) |
ed441285 | 412 | ("syntax" |
d8ac3d27 | 413 | ,(let ((syntax (syntax-after pos))) |
ed441285 KH |
414 | (with-temp-buffer |
415 | (internal-describe-syntax-value syntax) | |
416 | (buffer-string)))) | |
417 | ("category" | |
418 | ,@(let ((category-set (char-category-set char))) | |
419 | (if (not category-set) | |
420 | '("-- none --") | |
9f40939d | 421 | (mapcar #'(lambda (x) (format "%c:%s" |
ed441285 KH |
422 | x (category-docstring x))) |
423 | (category-set-mnemonics category-set))))) | |
309473d0 | 424 | ("to input" |
22259c93 KH |
425 | ,@(let ((key-list (and (eq input-method-function |
426 | 'quail-input-method) | |
309473d0 KH |
427 | (quail-find-key char)))) |
428 | (if (consp key-list) | |
429 | (list "type" | |
430 | (mapconcat #'(lambda (x) (concat "\"" x "\"")) | |
fedbc8e5 JL |
431 | key-list " or ") |
432 | "with" | |
57d79b99 | 433 | `(insert-text-button |
2fd54bf8 | 434 | ,current-input-method |
e5a5c80c NR |
435 | 'type 'help-input-method |
436 | 'help-args '(,current-input-method)))))) | |
ed441285 KH |
437 | ("buffer code" |
438 | ,(encoded-string-description | |
439 | (string-as-unibyte (char-to-string char)) nil)) | |
440 | ("file code" | |
441 | ,@(let* ((coding buffer-file-coding-system) | |
442 | (encoded (encode-coding-char char coding))) | |
443 | (if encoded | |
444 | (list (encoded-string-description encoded coding) | |
445 | (format "(encoded by coding system %S)" coding)) | |
446 | (list "not encodable by coding system" | |
447 | (symbol-name coding))))) | |
448 | ("display" | |
449 | ,(cond | |
450 | (disp-vector | |
451 | (setq disp-vector (copy-sequence disp-vector)) | |
452 | (dotimes (i (length disp-vector)) | |
453 | (setq char (aref disp-vector i)) | |
454 | (aset disp-vector i | |
8b18fb8f | 455 | (cons char (describe-char-display |
da55bb96 | 456 | pos (glyph-char char))))) |
ed441285 | 457 | (format "by display table entry [%s] (see below)" |
8b18fb8f JL |
458 | (mapconcat |
459 | #'(lambda (x) | |
da55bb96 | 460 | (format "?%c" (glyph-char (car x)))) |
8b18fb8f | 461 | disp-vector " "))) |
ed441285 KH |
462 | (composition |
463 | (let ((from (car composition)) | |
464 | (to (nth 1 composition)) | |
465 | (next (1+ pos)) | |
466 | (components (nth 2 composition)) | |
467 | ch) | |
468 | (setcar composition | |
469 | (and (< from pos) (buffer-substring from pos))) | |
470 | (setcar (cdr composition) | |
471 | (and (< next to) (buffer-substring next to))) | |
472 | (dotimes (i (length components)) | |
473 | (if (integerp (setq ch (aref components i))) | |
474 | (push (cons ch (describe-char-display pos ch)) | |
475 | component-chars))) | |
476 | (setq component-chars (nreverse component-chars)) | |
477 | (format "composed to form \"%s\" (see below)" | |
478 | (buffer-substring from to)))) | |
479 | (t | |
480 | (let ((display (describe-char-display pos char))) | |
481 | (if (display-graphic-p (selected-frame)) | |
7fb0741b | 482 | (if display |
ed441285 KH |
483 | (concat |
484 | "by this font (glyph code)\n" | |
9f40939d | 485 | (format " %s (#x%02X)" |
ed441285 KH |
486 | (car display) (cdr display))) |
487 | "no font available") | |
488 | (if display | |
489 | (format "terminal code %s" display) | |
490 | "not encodable for terminal")))))) | |
879dfc97 KH |
491 | ,@(let ((face |
492 | (if (not (or disp-vector composition)) | |
493 | (cond | |
494 | ((and show-trailing-whitespace | |
495 | (save-excursion (goto-char pos) | |
496 | (looking-at "[ \t]+$"))) | |
497 | 'trailing-whitespace) | |
498 | ((and nobreak-char-display char (eq char '#xa0)) | |
499 | 'nobreak-space) | |
500 | ((and nobreak-char-display char (eq char '#xad)) | |
501 | 'escape-glyph) | |
502 | ((and (< char 32) (not (memq char '(9 10)))) | |
503 | 'escape-glyph))))) | |
504 | (if face (list (list "hardcoded face" | |
2fd54bf8 JL |
505 | `(insert-text-button |
506 | ,(symbol-name face) | |
507 | 'type 'help-face 'help-args '(,face)))))) | |
180505d5 | 508 | ,@(let ((unicodedata (describe-char-unicode-data char))) |
ed441285 KH |
509 | (if unicodedata |
510 | (cons (list "Unicode data" " ") unicodedata))))) | |
879dfc97 KH |
511 | (setq max-width (apply #'max (mapcar #'(lambda (x) |
512 | (if (cadr x) (length (car x)) 0)) | |
4adb7c09 | 513 | item-list))) |
bfd94110 | 514 | (help-setup-xref nil (interactive-p)) |
3db0e8bf | 515 | (with-help-window (help-buffer) |
ca9088e7 | 516 | (with-current-buffer standard-output |
4adb7c09 RS |
517 | (set-buffer-multibyte multibyte-p) |
518 | (let ((formatter (format "%%%ds:" max-width))) | |
519 | (dolist (elt item-list) | |
831ccfa6 DL |
520 | (when (cadr elt) |
521 | (insert (format formatter (car elt))) | |
522 | (dolist (clm (cdr elt)) | |
57d79b99 | 523 | (if (eq (car-safe clm) 'insert-text-button) |
fedbc8e5 JL |
524 | (progn (insert " ") (eval clm)) |
525 | (when (>= (+ (current-column) | |
526 | (or (string-match "\n" clm) | |
527 | (string-width clm)) | |
528 | 1) | |
529 | (window-width)) | |
530 | (insert "\n") | |
531 | (indent-to (1+ max-width))) | |
532 | (insert " " clm))) | |
831ccfa6 | 533 | (insert "\n")))) |
7fb0741b | 534 | |
086c5b2b KH |
535 | (when overlays |
536 | (save-excursion | |
537 | (goto-char (point-min)) | |
538 | (re-search-forward "character:[ \t\n]+") | |
539 | (let* ((end (+ (point) (length char-description)))) | |
6398b88f | 540 | (mapc #'(lambda (props) |
086c5b2b | 541 | (let ((o (make-overlay (point) end))) |
6398b88f AS |
542 | (while props |
543 | (overlay-put o (car props) (nth 1 props)) | |
544 | (setq props (cddr props))))) | |
086c5b2b | 545 | overlays)))) |
ed441285 | 546 | |
7fb0741b KH |
547 | (when disp-vector |
548 | (insert | |
549 | "\nThe display table entry is displayed by ") | |
550 | (if (display-graphic-p (selected-frame)) | |
551 | (progn | |
552 | (insert "these fonts (glyph codes):\n") | |
553 | (dotimes (i (length disp-vector)) | |
da55bb96 | 554 | (insert (glyph-char (car (aref disp-vector i))) ?: |
7fb0741b KH |
555 | (propertize " " 'display '(space :align-to 5)) |
556 | (if (cdr (aref disp-vector i)) | |
9f40939d | 557 | (format "%s (#x%02X)" (cadr (aref disp-vector i)) |
7fb0741b KH |
558 | (cddr (aref disp-vector i))) |
559 | "-- no font --") | |
fedbc8e5 | 560 | "\n") |
da55bb96 KS |
561 | (let ((face (glyph-face (car (aref disp-vector i))))) |
562 | (when face | |
563 | (insert (propertize " " 'display '(space :align-to 5)) | |
564 | "face: ") | |
565 | (insert (concat "`" (symbol-name face) "'")) | |
566 | (insert "\n"))))) | |
7fb0741b KH |
567 | (insert "these terminal codes:\n") |
568 | (dotimes (i (length disp-vector)) | |
569 | (insert (car (aref disp-vector i)) | |
570 | (propertize " " 'display '(space :align-to 5)) | |
571 | (or (cdr (aref disp-vector i)) "-- not encodable --") | |
572 | "\n")))) | |
573 | ||
4adb7c09 | 574 | (when composition |
7fb0741b KH |
575 | (insert "\nComposed") |
576 | (if (car composition) | |
577 | (if (cadr composition) | |
578 | (insert " with the surrounding characters \"" | |
579 | (car composition) "\" and \"" | |
580 | (cadr composition) "\"") | |
581 | (insert " with the preceding character(s) \"" | |
582 | (car composition) "\"")) | |
583 | (if (cadr composition) | |
584 | (insert " with the following character(s) \"" | |
585 | (cadr composition) "\""))) | |
3f8b1daa KH |
586 | (if (and (vectorp (nth 2 composition)) |
587 | (vectorp (aref (nth 2 composition) 0))) | |
7fb0741b | 588 | (progn |
b2c6a479 KH |
589 | (insert " using this font:\n " |
590 | (aref (query-font (aref (aref (nth 2 composition) 0) 0)) | |
591 | 0) | |
592 | "\nby these glyphs:\n") | |
3f8b1daa KH |
593 | (mapc (lambda (x) (insert (format " %S\n" x))) |
594 | (nth 2 composition))) | |
595 | (insert " by the rule:\n\t(" | |
596 | (mapconcat (lambda (x) | |
597 | (if (consp x) (format "%S" x) | |
598 | (if (= x ?\t) | |
599 | (single-key-description x) | |
600 | (string ?? x)))) | |
601 | (nth 2 composition) | |
602 | " ") | |
603 | ")") | |
604 | (insert "\nThe component character(s) are displayed by ") | |
605 | (if (display-graphic-p (selected-frame)) | |
606 | (progn | |
607 | (insert "these fonts (glyph codes):") | |
608 | (dolist (elt component-chars) | |
609 | (if (/= (car elt) ?\t) | |
610 | (insert "\n " (car elt) ?: | |
611 | (propertize " " 'display '(space :align-to 5)) | |
612 | (if (cdr elt) | |
613 | (format "%s (#x%02X)" (cadr elt) (cddr elt)) | |
614 | "-- no font --"))))) | |
615 | (insert "these terminal codes:") | |
616 | (dolist (elt component-chars) | |
617 | (insert "\n " (car elt) ":" | |
618 | (propertize " " 'display '(space :align-to 4)) | |
619 | (or (cdr elt) "-- not encodable --")))) | |
620 | (insert "\nSee the variable `reference-point-alist' for " | |
621 | "the meaning of the rule.\n"))) | |
3a73f428 | 622 | |
f1f194de KH |
623 | (if (not describe-char-unidata-list) |
624 | (insert "\nCharacter code properties are not shown: ") | |
625 | (insert "\nCharacter code properties: ")) | |
3424774b KH |
626 | (insert-text-button |
627 | "customize what to show" | |
628 | 'action (lambda (&rest ignore) | |
629 | (customize-variable | |
630 | 'describe-char-unidata-list))) | |
f1f194de KH |
631 | (insert "\n") |
632 | (dolist (elt describe-char-unidata-list) | |
633 | (let ((val (get-char-code-property char elt)) | |
634 | description) | |
635 | (when val | |
636 | (setq description (char-code-property-description elt val)) | |
637 | (if description | |
638 | (insert (format " %s: %s (%s)\n" elt val description)) | |
639 | (insert (format " %s: %s\n" elt val)))))) | |
640 | ||
25a3c9d1 | 641 | (if text-props-desc (insert text-props-desc)) |
2fd54bf8 | 642 | (setq help-xref-stack-item (list 'help-insert-string (buffer-string))) |
3db0e8bf | 643 | (toggle-read-only 1))))) |
4adb7c09 | 644 | |
831ccfa6 | 645 | (defalias 'describe-char-after 'describe-char) |
fedbc8e5 | 646 | (make-obsolete 'describe-char-after 'describe-char "22.1") |
831ccfa6 | 647 | |
288395a7 CW |
648 | (provide 'descr-text) |
649 | ||
d8ac3d27 | 650 | ;; arch-tag: fc55a498-f3e9-4312-b5bd-98cc02480af1 |
2a1e884e | 651 | ;;; descr-text.el ends here |