|
45057
|
1 ;;; descr-text.el --- describe text mode
|
|
45022
|
2
|
|
51127
|
3 ;; Copyright (c) 1994, 1995, 1996, 2001, 02, 03 Free Software Foundation, Inc.
|
|
45022
|
4
|
|
|
5 ;; Author: Boris Goldowsky <boris@gnu.org>
|
|
|
6 ;; Keywords: faces
|
|
|
7
|
|
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
|
27 ;;; Describe-Text Mode.
|
|
|
28
|
|
|
29 ;;; Code:
|
|
|
30
|
|
51127
|
31 (eval-when-compile (require 'button))
|
|
|
32
|
|
45022
|
33 (defun describe-text-done ()
|
|
|
34 "Delete the current window or bury the current buffer."
|
|
|
35 (interactive)
|
|
|
36 (if (> (count-windows) 1)
|
|
|
37 (delete-window)
|
|
|
38 (bury-buffer)))
|
|
|
39
|
|
49588
|
40 (defvar describe-text-mode-map
|
|
45022
|
41 (let ((map (make-sparse-keymap)))
|
|
|
42 (set-keymap-parent map widget-keymap)
|
|
|
43 map)
|
|
|
44 "Keymap for `describe-text-mode'.")
|
|
49588
|
45
|
|
45022
|
46 (defcustom describe-text-mode-hook nil
|
|
|
47 "List of hook functions ran by `describe-text-mode'."
|
|
49398
|
48 :type 'hook
|
|
|
49 :group 'facemenu)
|
|
45022
|
50
|
|
|
51 (defun describe-text-mode ()
|
|
45868
|
52 "Major mode for buffers created by `describe-char'.
|
|
45022
|
53
|
|
|
54 \\{describe-text-mode-map}
|
|
|
55 Entry to this mode calls the value of `describe-text-mode-hook'
|
|
|
56 if that value is non-nil."
|
|
|
57 (kill-all-local-variables)
|
|
|
58 (setq major-mode 'describe-text-mode
|
|
|
59 mode-name "Describe-Text")
|
|
|
60 (use-local-map describe-text-mode-map)
|
|
|
61 (widget-setup)
|
47379
0c38024f4c40
(describe-text-mode): Add font-lock-defontify to change-major-mode-hook.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
62 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
|
|
45022
|
63 (run-hooks 'describe-text-mode-hook))
|
|
|
64
|
|
|
65 ;;; Describe-Text Utilities.
|
|
|
66
|
|
|
67 (defun describe-text-widget (widget)
|
|
|
68 "Insert text to describe WIDGET in the current buffer."
|
|
|
69 (widget-create 'link
|
|
|
70 :notify `(lambda (&rest ignore)
|
|
|
71 (widget-browse ',widget))
|
|
49588
|
72 (format "%S" (if (symbolp widget)
|
|
45022
|
73 widget
|
|
|
74 (car widget))))
|
|
|
75 (widget-insert " ")
|
|
|
76 (widget-create 'info-link :tag "widget" "(widget)Top"))
|
|
|
77
|
|
|
78 (defun describe-text-sexp (sexp)
|
|
|
79 "Insert a short description of SEXP in the current buffer."
|
|
|
80 (let ((pp (condition-case signal
|
|
|
81 (pp-to-string sexp)
|
|
|
82 (error (prin1-to-string signal)))))
|
|
|
83 (when (string-match "\n\\'" pp)
|
|
|
84 (setq pp (substring pp 0 (1- (length pp)))))
|
|
|
85 (if (cond ((string-match "\n" pp)
|
|
|
86 nil)
|
|
|
87 ((> (length pp) (- (window-width) (current-column)))
|
|
|
88 nil)
|
|
|
89 (t t))
|
|
|
90 (widget-insert pp)
|
|
|
91 (widget-create 'push-button
|
|
|
92 :tag "show"
|
|
|
93 :action (lambda (widget &optional event)
|
|
|
94 (with-output-to-temp-buffer
|
|
|
95 "*Pp Eval Output*"
|
|
|
96 (princ (widget-get widget :value))))
|
|
|
97 pp))))
|
|
|
98
|
|
45868
|
99 (defun describe-property-list (properties)
|
|
45022
|
100 "Insert a description of PROPERTIES in the current buffer.
|
|
|
101 PROPERTIES should be a list of overlay or text properties.
|
|
45996
|
102 The `category' property is made into a widget button that call
|
|
45022
|
103 `describe-text-category' when pushed."
|
45697
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
104 ;; Sort the properties by the size of their value.
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
105 (dolist (elt (sort (let ((ret nil)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
106 (key nil)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
107 (val nil)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
108 (len nil))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
109 (while properties
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
110 (setq key (pop properties)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
111 val (pop properties)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
112 len 0)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
113 (unless (or (eq key 'category)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
114 (widgetp val))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
115 (setq val (pp-to-string val)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
116 len (length val)))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
117 (push (list key val len) ret))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
118 ret)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
119 (lambda (a b)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
120 (< (nth 2 a)
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
121 (nth 2 b)))))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
122 (let ((key (nth 0 elt))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
123 (value (nth 1 elt)))
|
|
45996
|
124 (widget-insert (propertize (format " %-20s " key)
|
45697
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
125 'font-lock-face 'italic))
|
|
45022
|
126 (cond ((eq key 'category)
|
|
45996
|
127 (widget-create 'link
|
|
45022
|
128 :notify `(lambda (&rest ignore)
|
|
|
129 (describe-text-category ',value))
|
|
|
130 (format "%S" value)))
|
|
|
131 ((widgetp value)
|
|
|
132 (describe-text-widget value))
|
|
|
133 (t
|
45697
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
134 (widget-insert value))))
|
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
diff
changeset
|
135 (widget-insert "\n")))
|
|
45022
|
136
|
|
|
137 ;;; Describe-Text Commands.
|
|
|
138
|
|
|
139 (defun describe-text-category (category)
|
|
|
140 "Describe a text property category."
|
|
|
141 (interactive "S")
|
|
|
142 (save-excursion
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
143 (with-output-to-temp-buffer "*Help*"
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
144 (set-buffer standard-output)
|
|
45022
|
145 (widget-insert "Category " (format "%S" category) ":\n\n")
|
|
45868
|
146 (describe-property-list (symbol-plist category))
|
|
45022
|
147 (describe-text-mode)
|
|
|
148 (goto-char (point-min)))))
|
|
|
149
|
|
|
150 ;;;###autoload
|
|
45868
|
151 (defun describe-text-properties (pos &optional output-buffer)
|
|
|
152 "Describe widgets, buttons, overlays and text properties at POS.
|
|
|
153 Interactively, describe them for the character after point.
|
|
|
154 If optional second argument OUTPUT-BUFFER is non-nil,
|
|
|
155 insert the output into that buffer, and don't initialize or clear it
|
|
|
156 otherwise."
|
|
45022
|
157 (interactive "d")
|
|
45868
|
158 (if (>= pos (point-max))
|
|
|
159 (error "No character follows specified position"))
|
|
|
160 (if output-buffer
|
|
|
161 (describe-text-properties-1 pos output-buffer)
|
|
|
162 (if (not (or (text-properties-at pos) (overlays-at pos)))
|
|
|
163 (message "This is plain text.")
|
|
|
164 (let ((buffer (current-buffer)))
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
165 (when (eq buffer (get-buffer "*Help*"))
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
166 (error "Can't do self inspection"))
|
|
45868
|
167 (save-excursion
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
168 (with-output-to-temp-buffer "*Help*"
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
169 (set-buffer standard-output)
|
|
45868
|
170 (setq output-buffer (current-buffer))
|
|
|
171 (widget-insert "Text content at position " (format "%d" pos) ":\n\n")
|
|
|
172 (with-current-buffer buffer
|
|
|
173 (describe-text-properties-1 pos output-buffer))
|
|
|
174 (describe-text-mode)
|
|
|
175 (goto-char (point-min))))))))
|
|
|
176
|
|
|
177 (defun describe-text-properties-1 (pos output-buffer)
|
|
45022
|
178 (let* ((properties (text-properties-at pos))
|
|
|
179 (overlays (overlays-at pos))
|
|
|
180 overlay
|
|
|
181 (wid-field (get-char-property pos 'field))
|
|
|
182 (wid-button (get-char-property pos 'button))
|
|
|
183 (wid-doc (get-char-property pos 'widget-doc))
|
|
|
184 ;; If button.el is not loaded, we have no buttons in the text.
|
|
|
185 (button (and (fboundp 'button-at) (button-at pos)))
|
|
|
186 (button-type (and button (button-type button)))
|
|
|
187 (button-label (and button (button-label button)))
|
|
|
188 (widget (or wid-field wid-button wid-doc)))
|
|
45868
|
189 (with-current-buffer output-buffer
|
|
|
190 ;; Widgets
|
|
|
191 (when (widgetp widget)
|
|
|
192 (newline)
|
|
|
193 (widget-insert (cond (wid-field "This is an editable text area")
|
|
|
194 (wid-button "This is an active area")
|
|
|
195 (wid-doc "This is documentation text")))
|
|
|
196 (widget-insert " of a ")
|
|
|
197 (describe-text-widget widget)
|
|
|
198 (widget-insert ".\n\n"))
|
|
|
199 ;; Buttons
|
|
|
200 (when (and button (not (widgetp wid-button)))
|
|
|
201 (newline)
|
|
49588
|
202 (widget-insert "Here is a " (format "%S" button-type)
|
|
45868
|
203 " button labeled `" button-label "'.\n\n"))
|
|
|
204 ;; Overlays
|
|
|
205 (when overlays
|
|
|
206 (newline)
|
|
|
207 (if (eq (length overlays) 1)
|
|
|
208 (widget-insert "There is an overlay here:\n")
|
|
|
209 (widget-insert "There are " (format "%d" (length overlays))
|
|
|
210 " overlays here:\n"))
|
|
|
211 (dolist (overlay overlays)
|
|
49588
|
212 (widget-insert " From " (format "%d" (overlay-start overlay))
|
|
45868
|
213 " to " (format "%d" (overlay-end overlay)) "\n")
|
|
|
214 (describe-property-list (overlay-properties overlay)))
|
|
|
215 (widget-insert "\n"))
|
|
|
216 ;; Text properties
|
|
|
217 (when properties
|
|
|
218 (newline)
|
|
|
219 (widget-insert "There are text properties here:\n")
|
|
|
220 (describe-property-list properties)))))
|
|
51278
|
221
|
|
|
222 ;;; We cannot use the UnicodeData.txt file as such; it is not free.
|
|
|
223 ;;; We can turn that info a different format and release the result
|
|
|
224 ;;; as free data. When that is done, we could reinstate the code below.
|
|
|
225 ;;; For the mean time, here is a dummy placeholder.
|
|
|
226 ;;; -- rms
|
|
|
227 (defun describe-char-unicode-data (char) nil)
|
|
51127
|
228
|
|
51278
|
229 ;;; (defcustom describe-char-unicodedata-file nil
|
|
|
230 ;;; "Location of Unicode data file.
|
|
|
231 ;;; This is the UnicodeData.txt file from the Unicode consortium, used for
|
|
|
232 ;;; diagnostics. If it is non-nil `describe-char-after' will print data
|
|
|
233 ;;; looked up from it. This facility is mostly of use to people doing
|
|
|
234 ;;; multilingual development.
|
|
51127
|
235
|
|
51278
|
236 ;;; This is a fairly large file, not typically present on GNU systems. At
|
|
|
237 ;;; the time of writing it is at
|
|
|
238 ;;; <URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>."
|
|
|
239 ;;; :group 'mule
|
|
|
240 ;;; :version "21.5"
|
|
|
241 ;;; :type '(choice (const :tag "None" nil)
|
|
|
242 ;;; file))
|
|
|
243
|
|
|
244 ;;; ;; We could convert the unidata file into a Lispy form once-for-all
|
|
|
245 ;;; ;; and distribute it for loading on demand. It might be made more
|
|
|
246 ;;; ;; space-efficient by splitting strings word-wise and replacing them
|
|
|
247 ;;; ;; with lists of symbols interned in a private obarray, e.g.
|
|
|
248 ;;; ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A).
|
|
51127
|
249
|
|
51278
|
250 ;;; ;; Fixme: Check whether this needs updating for Unicode 4.
|
|
|
251 ;;; (defun describe-char-unicode-data (char)
|
|
|
252 ;;; "Return a list of Unicode data for unicode CHAR.
|
|
|
253 ;;; Each element is a list of a property description and the property value.
|
|
|
254 ;;; The list is null if CHAR isn't found in `describe-char-unicodedata-file'."
|
|
|
255 ;;; (when describe-char-unicodedata-file
|
|
|
256 ;;; (unless (file-exists-p describe-char-unicodedata-file)
|
|
|
257 ;;; (error "`unicodedata-file' %s not found" describe-char-unicodedata-file))
|
|
|
258 ;;; (save-excursion
|
|
|
259 ;;; ;; Find file in fundamental mode to avoid, e.g. flyspell turned
|
|
|
260 ;;; ;; on for .txt. Don't use RAWFILE arg in case of DOS line endings.
|
|
|
261 ;;; (set-buffer (let ((auto-mode-alist))
|
|
|
262 ;;; (find-file-noselect describe-char-unicodedata-file)))
|
|
|
263 ;;; (goto-char (point-min))
|
|
|
264 ;;; (let ((hex (format "%04X" char))
|
|
|
265 ;;; found first last)
|
|
|
266 ;;; (if (re-search-forward (concat "^" hex) nil t)
|
|
|
267 ;;; (setq found t)
|
|
|
268 ;;; ;; It's not listed explicitly. Look for ranges, e.g. CJK
|
|
|
269 ;;; ;; ideographs, and check whether it's in one of them.
|
|
|
270 ;;; (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t)
|
|
|
271 ;;; (>= char (setq first
|
|
|
272 ;;; (string-to-number (match-string 1) 16)))
|
|
|
273 ;;; (progn
|
|
|
274 ;;; (forward-line 1)
|
|
|
275 ;;; (looking-at "^\\([^;]+\\);[^;]+Last>;")
|
|
|
276 ;;; (> char
|
|
|
277 ;;; (setq last
|
|
|
278 ;;; (string-to-number (match-string 1) 16))))))
|
|
|
279 ;;; (if (and (>= char first)
|
|
|
280 ;;; (<= char last))
|
|
|
281 ;;; (setq found t)))
|
|
|
282 ;;; (if found
|
|
|
283 ;;; (let ((fields (mapcar (lambda (elt)
|
|
|
284 ;;; (if (> (length elt) 0)
|
|
|
285 ;;; elt))
|
|
|
286 ;;; (cdr (split-string
|
|
|
287 ;;; (buffer-substring
|
|
|
288 ;;; (line-beginning-position)
|
|
|
289 ;;; (line-end-position))
|
|
|
290 ;;; ";")))))
|
|
|
291 ;;; ;; The length depends on whether the last field was empty.
|
|
|
292 ;;; (unless (or (= 13 (length fields))
|
|
|
293 ;;; (= 14 (length fields)))
|
|
|
294 ;;; (error "Invalid contents in %s" describe-char-unicodedata-file))
|
|
|
295 ;;; ;; The field names and values lists are slightly
|
|
|
296 ;;; ;; modified from Mule-UCS unidata.el.
|
|
|
297 ;;; (list
|
|
|
298 ;;; (list "Name" (let ((name (nth 0 fields)))
|
|
|
299 ;;; ;; Check for <..., First>, <..., Last>
|
|
|
300 ;;; (if (string-match "\\`\\(<[^,]+\\)," name)
|
|
|
301 ;;; (concat (match-string 1 name) ">")
|
|
|
302 ;;; name)))
|
|
|
303 ;;; (list "Category"
|
|
|
304 ;;; (cdr (assoc
|
|
|
305 ;;; (nth 1 fields)
|
|
|
306 ;;; '(("Lu" . "uppercase letter")
|
|
|
307 ;;; ("Ll" . "lowercase letter")
|
|
|
308 ;;; ("Lt" . "titlecase letter")
|
|
|
309 ;;; ("Mn" . "non-spacing mark")
|
|
|
310 ;;; ("Mc" . "spacing-combining mark")
|
|
|
311 ;;; ("Me" . "enclosing mark")
|
|
|
312 ;;; ("Nd" . "decimal digit")
|
|
|
313 ;;; ("Nl" . "letter number")
|
|
|
314 ;;; ("No" . "other number")
|
|
|
315 ;;; ("Zs" . "space separator")
|
|
|
316 ;;; ("Zl" . "line separator")
|
|
|
317 ;;; ("Zp" . "paragraph separator")
|
|
|
318 ;;; ("Cc" . "other control")
|
|
|
319 ;;; ("Cf" . "other format")
|
|
|
320 ;;; ("Cs" . "surrogate")
|
|
|
321 ;;; ("Co" . "private use")
|
|
|
322 ;;; ("Cn" . "not assigned")
|
|
|
323 ;;; ("Lm" . "modifier letter")
|
|
|
324 ;;; ("Lo" . "other letter")
|
|
|
325 ;;; ("Pc" . "connector punctuation")
|
|
|
326 ;;; ("Pd" . "dash punctuation")
|
|
|
327 ;;; ("Ps" . "open punctuation")
|
|
|
328 ;;; ("Pe" . "close punctuation")
|
|
|
329 ;;; ("Pi" . "initial-quotation punctuation")
|
|
|
330 ;;; ("Pf" . "final-quotation punctuation")
|
|
|
331 ;;; ("Po" . "other punctuation")
|
|
|
332 ;;; ("Sm" . "math symbol")
|
|
|
333 ;;; ("Sc" . "currency symbol")
|
|
|
334 ;;; ("Sk" . "modifier symbol")
|
|
|
335 ;;; ("So" . "other symbol")))))
|
|
|
336 ;;; (list "Combining class"
|
|
|
337 ;;; (cdr (assoc
|
|
|
338 ;;; (string-to-number (nth 2 fields))
|
|
|
339 ;;; '((0 . "Spacing")
|
|
|
340 ;;; (1 . "Overlays and interior")
|
|
|
341 ;;; (7 . "Nuktas")
|
|
|
342 ;;; (8 . "Hiragana/Katakana voicing marks")
|
|
|
343 ;;; (9 . "Viramas")
|
|
|
344 ;;; (10 . "Start of fixed position classes")
|
|
|
345 ;;; (199 . "End of fixed position classes")
|
|
|
346 ;;; (200 . "Below left attached")
|
|
|
347 ;;; (202 . "Below attached")
|
|
|
348 ;;; (204 . "Below right attached")
|
|
|
349 ;;; (208 . "Left attached (reordrant around \
|
|
|
350 ;;; single base character)")
|
|
|
351 ;;; (210 . "Right attached")
|
|
|
352 ;;; (212 . "Above left attached")
|
|
|
353 ;;; (214 . "Above attached")
|
|
|
354 ;;; (216 . "Above right attached")
|
|
|
355 ;;; (218 . "Below left")
|
|
|
356 ;;; (220 . "Below")
|
|
|
357 ;;; (222 . "Below right")
|
|
|
358 ;;; (224 . "Left (reordrant around single base \
|
|
|
359 ;;; character)")
|
|
|
360 ;;; (226 . "Right")
|
|
|
361 ;;; (228 . "Above left")
|
|
|
362 ;;; (230 . "Above")
|
|
|
363 ;;; (232 . "Above right")
|
|
|
364 ;;; (233 . "Double below")
|
|
|
365 ;;; (234 . "Double above")
|
|
|
366 ;;; (240 . "Below (iota subscript)")))))
|
|
|
367 ;;; (list "Bidi category"
|
|
|
368 ;;; (cdr (assoc
|
|
|
369 ;;; (nth 3 fields)
|
|
|
370 ;;; '(("L" . "Left-to-Right")
|
|
|
371 ;;; ("LRE" . "Left-to-Right Embedding")
|
|
|
372 ;;; ("LRO" . "Left-to-Right Override")
|
|
|
373 ;;; ("R" . "Right-to-Left")
|
|
|
374 ;;; ("AL" . "Right-to-Left Arabic")
|
|
|
375 ;;; ("RLE" . "Right-to-Left Embedding")
|
|
|
376 ;;; ("RLO" . "Right-to-Left Override")
|
|
|
377 ;;; ("PDF" . "Pop Directional Format")
|
|
|
378 ;;; ("EN" . "European Number")
|
|
|
379 ;;; ("ES" . "European Number Separator")
|
|
|
380 ;;; ("ET" . "European Number Terminator")
|
|
|
381 ;;; ("AN" . "Arabic Number")
|
|
|
382 ;;; ("CS" . "Common Number Separator")
|
|
|
383 ;;; ("NSM" . "Non-Spacing Mark")
|
|
|
384 ;;; ("BN" . "Boundary Neutral")
|
|
|
385 ;;; ("B" . "Paragraph Separator")
|
|
|
386 ;;; ("S" . "Segment Separator")
|
|
|
387 ;;; ("WS" . "Whitespace")
|
|
|
388 ;;; ("ON" . "Other Neutrals")))))
|
|
|
389 ;;; (list
|
|
|
390 ;;; "Decomposition"
|
|
|
391 ;;; (if (nth 4 fields)
|
|
|
392 ;;; (let* ((parts (split-string (nth 4 fields)))
|
|
|
393 ;;; (info (car parts)))
|
|
|
394 ;;; (if (string-match "\\`<\\(.+\\)>\\'" info)
|
|
|
395 ;;; (setq info (match-string 1 info))
|
|
|
396 ;;; (setq info nil))
|
|
|
397 ;;; (if info (setq parts (cdr parts)))
|
|
|
398 ;;; ;; Maybe printing ? for unrepresentable unicodes
|
|
|
399 ;;; ;; here and below should be changed?
|
|
|
400 ;;; (setq parts (mapconcat
|
|
|
401 ;;; (lambda (arg)
|
|
|
402 ;;; (string (or (decode-char
|
|
|
403 ;;; 'ucs
|
|
|
404 ;;; (string-to-number arg 16))
|
|
|
405 ;;; ??)))
|
|
|
406 ;;; parts " "))
|
|
|
407 ;;; (concat info parts))))
|
|
|
408 ;;; (list "Decimal digit value"
|
|
|
409 ;;; (nth 5 fields))
|
|
|
410 ;;; (list "Digit value"
|
|
|
411 ;;; (nth 6 fields))
|
|
|
412 ;;; (list "Numeric value"
|
|
|
413 ;;; (nth 7 fields))
|
|
|
414 ;;; (list "Mirrored"
|
|
|
415 ;;; (if (equal "Y" (nth 8 fields))
|
|
|
416 ;;; "yes"))
|
|
|
417 ;;; (list "Old name" (nth 9 fields))
|
|
|
418 ;;; (list "ISO 10646 comment" (nth 10 fields))
|
|
|
419 ;;; (list "Uppercase" (and (nth 11 fields)
|
|
|
420 ;;; (string (or (decode-char
|
|
|
421 ;;; 'ucs
|
|
|
422 ;;; (string-to-number
|
|
|
423 ;;; (nth 11 fields) 16))
|
|
|
424 ;;; ??))))
|
|
|
425 ;;; (list "Lowercase" (and (nth 12 fields)
|
|
|
426 ;;; (string (or (decode-char
|
|
|
427 ;;; 'ucs
|
|
|
428 ;;; (string-to-number
|
|
|
429 ;;; (nth 12 fields) 16))
|
|
|
430 ;;; ??))))
|
|
|
431 ;;; (list "Titlecase" (and (nth 13 fields)
|
|
|
432 ;;; (string (or (decode-char
|
|
|
433 ;;; 'ucs
|
|
|
434 ;;; (string-to-number
|
|
|
435 ;;; (nth 13 fields) 16))
|
|
|
436 ;;; ??)))))))))))
|
|
|
437
|
|
45868
|
438 ;;;###autoload
|
|
|
439 (defun describe-char (pos)
|
|
|
440 "Describe the character after POS (interactively, the character after point).
|
|
|
441 The information includes character code, charset and code points in it,
|
|
|
442 syntax, category, how the character is encoded in a file,
|
|
|
443 character composition information (if relevant),
|
|
|
444 as well as widgets, buttons, overlays, and text properties."
|
|
|
445 (interactive "d")
|
|
|
446 (if (>= pos (point-max))
|
|
|
447 (error "No character follows specified position"))
|
|
|
448 (let* ((char (char-after pos))
|
|
|
449 (charset (char-charset char))
|
|
|
450 (buffer (current-buffer))
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
451 (composition (find-composition pos nil nil t))
|
|
45868
|
452 (composed (if composition (buffer-substring (car composition)
|
|
|
453 (nth 1 composition))))
|
|
|
454 (multibyte-p enable-multibyte-characters)
|
|
51127
|
455 item-list max-width unicode)
|
|
45868
|
456 (if (eq charset 'unknown)
|
|
|
457 (setq item-list
|
|
|
458 `(("character"
|
|
|
459 ,(format "%s (0%o, %d, 0x%x) -- invalid character code"
|
|
|
460 (if (< char 256)
|
|
|
461 (single-key-description char)
|
|
|
462 (char-to-string char))
|
|
|
463 char char char))))
|
|
51127
|
464
|
|
51308
|
465 (if (or (< char 256)
|
|
51127
|
466 (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
|
|
|
467 (get-char-property pos 'untranslated-utf-8))
|
|
|
468 (setq unicode (or (get-char-property pos 'untranslated-utf-8)
|
|
|
469 (encode-char char 'ucs))))
|
|
45868
|
470 (setq item-list
|
|
|
471 `(("character"
|
|
51127
|
472 ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256)
|
|
45868
|
473 (single-key-description char)
|
|
|
474 (char-to-string char))
|
|
51127
|
475 char char char
|
|
|
476 (if unicode
|
|
51308
|
477 (format ", U+%04X" unicode)
|
|
51127
|
478 "")))
|
|
45868
|
479 ("charset"
|
|
|
480 ,(symbol-name charset)
|
|
|
481 ,(format "(%s)" (charset-description charset)))
|
|
|
482 ("code point"
|
|
|
483 ,(let ((split (split-char char)))
|
|
|
484 (if (= (charset-dimension charset) 1)
|
|
|
485 (format "%d" (nth 1 split))
|
|
|
486 (format "%d %d" (nth 1 split) (nth 2 split)))))
|
|
|
487 ("syntax"
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
488 ,(let ((syntax (syntax-after pos)))
|
|
45868
|
489 (with-temp-buffer
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
490 (internal-describe-syntax-value syntax)
|
|
45868
|
491 (buffer-string))))
|
|
|
492 ("category"
|
|
|
493 ,@(let ((category-set (char-category-set char)))
|
|
|
494 (if (not category-set)
|
|
|
495 '("-- none --")
|
|
|
496 (mapcar #'(lambda (x) (format "%c:%s "
|
|
|
497 x (category-docstring x)))
|
|
|
498 (category-set-mnemonics category-set)))))
|
|
|
499 ,@(let ((props (aref char-code-property-table char))
|
|
|
500 ps)
|
|
|
501 (when props
|
|
|
502 (while props
|
|
|
503 (push (format "%s:" (pop props)) ps)
|
|
|
504 (push (format "%s;" (pop props)) ps))
|
|
|
505 (list (cons "Properties" (nreverse ps)))))
|
|
|
506 ("buffer code"
|
|
|
507 ,(encoded-string-description
|
|
|
508 (string-as-unibyte (char-to-string char)) nil))
|
|
|
509 ("file code"
|
|
|
510 ,@(let* ((coding buffer-file-coding-system)
|
|
|
511 (encoded (encode-coding-char char coding)))
|
|
|
512 (if encoded
|
|
|
513 (list (encoded-string-description encoded coding)
|
|
|
514 (format "(encoded by coding system %S)" coding))
|
|
|
515 (list "not encodable by coding system"
|
|
|
516 (symbol-name coding)))))
|
|
|
517 ,(if (display-graphic-p (selected-frame))
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
518 (list "font" (or (internal-char-font pos)
|
|
45868
|
519 "-- none --"))
|
|
|
520 (list "terminal code"
|
|
|
521 (let* ((coding (terminal-coding-system))
|
|
|
522 (encoded (encode-coding-char char coding)))
|
|
|
523 (if encoded
|
|
|
524 (encoded-string-description encoded coding)
|
|
51127
|
525 "not encodable"))))
|
|
|
526 ,@(let ((unicodedata (and unicode
|
|
51278
|
527 (describe-char-unicode-data unicode))))
|
|
51127
|
528 (if unicodedata
|
|
|
529 (cons (list "Unicode data" " ") unicodedata))))))
|
|
45868
|
530 (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
|
|
|
531 item-list)))
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
532 (when (eq (current-buffer) (get-buffer "*Help*"))
|
|
51127
|
533 (error "Can't describe char in Help buffer"))
|
|
45868
|
534 (with-output-to-temp-buffer "*Help*"
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
535 (with-current-buffer standard-output
|
|
45868
|
536 (set-buffer-multibyte multibyte-p)
|
|
|
537 (let ((formatter (format "%%%ds:" max-width)))
|
|
|
538 (dolist (elt item-list)
|
|
51127
|
539 (when (cadr elt)
|
|
|
540 (insert (format formatter (car elt)))
|
|
|
541 (dolist (clm (cdr elt))
|
|
|
542 (when (>= (+ (current-column)
|
|
|
543 (or (string-match "\n" clm)
|
|
|
544 (string-width clm)) 1)
|
|
|
545 (frame-width))
|
|
|
546 (insert "\n")
|
|
|
547 (indent-to (1+ max-width)))
|
|
|
548 (insert " " clm))
|
|
|
549 (insert "\n"))))
|
|
45868
|
550 (when composition
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
551 (insert "\nComposed with the "
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
552 (cond
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
553 ((eq pos (car composition)) "following ")
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
554 ((eq (1+ pos) (cadr composition)) "preceding ")
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
555 (t ""))
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
556 "character(s) `"
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
557 (cond
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
558 ((eq pos (car composition)) (substring composed 1))
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
559 ((eq (1+ pos) (cadr composition)) (substring composed 0 -1))
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
560 (t (concat (substring composed 0 (- pos (car composition)))
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
561 "' and `"
|
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
562 (substring composed (- (1+ pos) (car composition))))))
|
|
49588
|
563
|
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
564 "' to form `" composed "'")
|
|
45868
|
565 (if (nth 3 composition)
|
|
|
566 (insert ".\n")
|
|
|
567 (insert "\nby the rule ("
|
|
|
568 (mapconcat (lambda (x)
|
|
|
569 (format (if (consp x) "%S" "?%c") x))
|
|
|
570 (nth 2 composition)
|
|
|
571 " ")
|
|
|
572 ").\n"
|
|
|
573 "See the variable `reference-point-alist' for "
|
|
|
574 "the meaning of the rule.\n")))
|
|
|
575
|
|
|
576 (let ((output (current-buffer)))
|
|
|
577 (with-current-buffer buffer
|
|
|
578 (describe-text-properties pos output))
|
|
|
579 (describe-text-mode))))))
|
|
45022
|
580
|
|
51127
|
581 (defalias 'describe-char-after 'describe-char)
|
|
|
582 (make-obsolete 'describe-char-after 'describe-char "21.5")
|
|
|
583
|
|
45700
|
584 (provide 'descr-text)
|
|
|
585
|
|
45022
|
586 ;;; descr-text.el ends here
|
