Mercurial > emacs
annotate lisp/descr-text.el @ 51260:a51376ab4a2e
(global-map): Bind M-S-<backspace to
kill-whole-line.
author | Kai Großjohann <kgrossjo@eu.uu.net> |
---|---|
date | Tue, 27 May 2003 13:57:22 +0000 |
parents | d68739c97632 |
children | 7192dc1bfcf4 |
rev | line source |
---|---|
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
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49398
diff
changeset
|
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
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49398
diff
changeset
|
45 |
45022 | 46 (defcustom describe-text-mode-hook nil |
47 "List of hook functions ran by `describe-text-mode'." | |
49398
e84990b6ae01
(describe-text-mode-hook): Add a group.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
47601
diff
changeset
|
48 :type 'hook |
e84990b6ae01
(describe-text-mode-hook): Add a group.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
47601
diff
changeset
|
49 :group 'facemenu) |
45022 | 50 |
51 (defun describe-text-mode () | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
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>
parents:
45996
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
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49398
diff
changeset
|
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
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
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
d57daf0a986a
(describe-property-list): Make sure there's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45868
diff
changeset
|
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>
parents:
45057
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>
parents:
45057
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>
parents:
45057
diff
changeset
|
106 (key nil) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
107 (val nil) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
108 (len nil)) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
109 (while properties |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
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>
parents:
45057
diff
changeset
|
111 val (pop properties) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
112 len 0) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
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>
parents:
45057
diff
changeset
|
114 (widgetp val)) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
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>
parents:
45057
diff
changeset
|
116 len (length val))) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
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>
parents:
45057
diff
changeset
|
118 ret) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
119 (lambda (a b) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
120 (< (nth 2 a) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
diff
changeset
|
121 (nth 2 b))))) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
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>
parents:
45057
diff
changeset
|
123 (value (nth 1 elt))) |
45996
d57daf0a986a
(describe-property-list): Make sure there's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45868
diff
changeset
|
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>
parents:
45057
diff
changeset
|
125 'font-lock-face 'italic)) |
45022 | 126 (cond ((eq key 'category) |
45996
d57daf0a986a
(describe-property-list): Make sure there's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45868
diff
changeset
|
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>
parents:
45057
diff
changeset
|
134 (widget-insert value)))) |
234b16d90545
(describe-text-properties): Sort the output by the size of the values.
Colin Walters <walters@gnu.org>
parents:
45057
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>
parents:
47379
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>
parents:
47379
diff
changeset
|
144 (set-buffer standard-output) |
45022 | 145 (widget-insert "Category " (format "%S" category) ":\n\n") |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
146 (describe-property-list (symbol-plist category)) |
45022 | 147 (describe-text-mode) |
148 (goto-char (point-min))))) | |
149 | |
150 ;;;###autoload | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
151 (defun describe-text-properties (pos &optional output-buffer) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
152 "Describe widgets, buttons, overlays and text properties at POS. |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
153 Interactively, describe them for the character after point. |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
154 If optional second argument OUTPUT-BUFFER is non-nil, |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
155 insert the output into that buffer, and don't initialize or clear it |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
156 otherwise." |
45022 | 157 (interactive "d") |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
158 (if (>= pos (point-max)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
159 (error "No character follows specified position")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
160 (if output-buffer |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
161 (describe-text-properties-1 pos output-buffer) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
162 (if (not (or (text-properties-at pos) (overlays-at pos))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
163 (message "This is plain text.") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
164 (let ((buffer (current-buffer))) |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
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>
parents:
47379
diff
changeset
|
166 (error "Can't do self inspection")) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
167 (save-excursion |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
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>
parents:
47379
diff
changeset
|
169 (set-buffer standard-output) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
170 (setq output-buffer (current-buffer)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
171 (widget-insert "Text content at position " (format "%d" pos) ":\n\n") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
172 (with-current-buffer buffer |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
173 (describe-text-properties-1 pos output-buffer)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
174 (describe-text-mode) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
175 (goto-char (point-min)))))))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
176 |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
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
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
189 (with-current-buffer output-buffer |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
190 ;; Widgets |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
191 (when (widgetp widget) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
192 (newline) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
193 (widget-insert (cond (wid-field "This is an editable text area") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
194 (wid-button "This is an active area") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
195 (wid-doc "This is documentation text"))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
196 (widget-insert " of a ") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
197 (describe-text-widget widget) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
198 (widget-insert ".\n\n")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
199 ;; Buttons |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
200 (when (and button (not (widgetp wid-button))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
201 (newline) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49398
diff
changeset
|
202 (widget-insert "Here is a " (format "%S" button-type) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
203 " button labeled `" button-label "'.\n\n")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
204 ;; Overlays |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
205 (when overlays |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
206 (newline) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
207 (if (eq (length overlays) 1) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
208 (widget-insert "There is an overlay here:\n") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
209 (widget-insert "There are " (format "%d" (length overlays)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
210 " overlays here:\n")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
211 (dolist (overlay overlays) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49398
diff
changeset
|
212 (widget-insert " From " (format "%d" (overlay-start overlay)) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
213 " to " (format "%d" (overlay-end overlay)) "\n") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
214 (describe-property-list (overlay-properties overlay))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
215 (widget-insert "\n")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
216 ;; Text properties |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
217 (when properties |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
218 (newline) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
219 (widget-insert "There are text properties here:\n") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
220 (describe-property-list properties))))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
221 |
51127 | 222 (defcustom unicodedata-file nil |
223 "Location of Unicode data file. | |
224 This is the UnicodeData.txt file from the Unicode consortium, used for | |
225 diagnostics. If it is non-nil `describe-char-after' will print data | |
226 looked up from it. This facility is mostly of use to people doing | |
227 multilingual development. | |
228 | |
229 This is a fairly large file, not typically present on GNU systems. At | |
230 the time of writing it is at | |
231 <URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>." | |
232 :group 'mule | |
233 :version "21.5" | |
234 :type '(choice (const :tag "None" nil) | |
235 file)) | |
236 | |
237 ;; We could convert the unidata file into a Lispy form once-for-all | |
238 ;; and distribute it for loading on demand. It might be made more | |
239 ;; space-efficient by splitting strings word-wise and replacing them | |
240 ;; with lists of symbols interned in a private obarray, e.g. | |
241 ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A). | |
242 | |
243 ;; Fixme: Check whether this needs updating for Unicode 4. | |
244 (defun unicode-data (char) | |
245 "Return a list of Unicode data for unicode CHAR. | |
246 Each element is a list of a property description and the property value. | |
247 The list is null if CHAR isn't found in `unicodedata-file'." | |
248 (when unicodedata-file | |
249 (unless (file-exists-p unicodedata-file) | |
250 (error "`unicodedata-file' %s not found" unicodedata-file)) | |
251 (save-excursion | |
252 ;; Find file in fundamental mode to avoid, e.g. flyspell turned | |
253 ;; on for .txt. Don't use RAWFILE arg in case of DOS line endings. | |
254 (set-buffer (let ((auto-mode-alist)) | |
255 (find-file-noselect unicodedata-file))) | |
256 (goto-char (point-min)) | |
257 (let ((hex (format "%04X" char)) | |
258 found first last) | |
259 (if (re-search-forward (concat "^" hex) nil t) | |
260 (setq found t) | |
261 ;; It's not listed explicitly. Look for ranges, e.g. CJK | |
262 ;; ideographs, and check whether it's in one of them. | |
263 (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t) | |
264 (>= char (setq first | |
265 (string-to-number (match-string 1) 16))) | |
266 (progn | |
267 (forward-line 1) | |
268 (looking-at "^\\([^;]+\\);[^;]+Last>;") | |
269 (> char | |
270 (setq last | |
271 (string-to-number (match-string 1) 16)))))) | |
272 (if (and (>= char first) | |
273 (<= char last)) | |
274 (setq found t))) | |
275 (if found | |
276 (let ((fields (mapcar (lambda (elt) | |
277 (if (> (length elt) 0) | |
278 elt)) | |
279 (cdr (split-string | |
280 (buffer-substring | |
281 (line-beginning-position) | |
282 (line-end-position)) | |
283 ";"))))) | |
284 ;; The length depends on whether the last field was empty. | |
285 (unless (or (= 13 (length fields)) | |
286 (= 14 (length fields))) | |
287 (error "Invalid contents in %s" unicodedata-file)) | |
288 ;; The field names and values lists are slightly | |
289 ;; modified from Mule-UCS unidata.el. | |
290 (list | |
291 (list "Name" (let ((name (nth 0 fields))) | |
292 ;; Check for <..., First>, <..., Last> | |
293 (if (string-match "\\`\\(<[^,]+\\)," name) | |
294 (concat (match-string 1 name) ">") | |
295 name))) | |
296 (list "Category" | |
297 (cdr (assoc | |
298 (nth 1 fields) | |
299 '(("Lu" . "uppercase letter") | |
300 ("Ll" . "lowercase letter") | |
301 ("Lt" . "titlecase letter") | |
302 ("Mn" . "non-spacing mark") | |
303 ("Mc" . "spacing-combining mark") | |
304 ("Me" . "enclosing mark") | |
305 ("Nd" . "decimal digit") | |
306 ("Nl" . "letter number") | |
307 ("No" . "other number") | |
308 ("Zs" . "space separator") | |
309 ("Zl" . "line separator") | |
310 ("Zp" . "paragraph separator") | |
311 ("Cc" . "other control") | |
312 ("Cf" . "other format") | |
313 ("Cs" . "surrogate") | |
314 ("Co" . "private use") | |
315 ("Cn" . "not assigned") | |
316 ("Lm" . "modifier letter") | |
317 ("Lo" . "other letter") | |
318 ("Pc" . "connector punctuation") | |
319 ("Pd" . "dash punctuation") | |
320 ("Ps" . "open punctuation") | |
321 ("Pe" . "close punctuation") | |
322 ("Pi" . "initial-quotation punctuation") | |
323 ("Pf" . "final-quotation punctuation") | |
324 ("Po" . "other punctuation") | |
325 ("Sm" . "math symbol") | |
326 ("Sc" . "currency symbol") | |
327 ("Sk" . "modifier symbol") | |
328 ("So" . "other symbol"))))) | |
329 (list "Combining class" | |
330 (cdr (assoc | |
331 (string-to-number (nth 2 fields)) | |
332 '((0 . "Spacing") | |
333 (1 . "Overlays and interior") | |
334 (7 . "Nuktas") | |
335 (8 . "Hiragana/Katakana voicing marks") | |
336 (9 . "Viramas") | |
337 (10 . "Start of fixed position classes") | |
338 (199 . "End of fixed position classes") | |
339 (200 . "Below left attached") | |
340 (202 . "Below attached") | |
341 (204 . "Below right attached") | |
342 (208 . "Left attached (reordrant around \ | |
343 single base character)") | |
344 (210 . "Right attached") | |
345 (212 . "Above left attached") | |
346 (214 . "Above attached") | |
347 (216 . "Above right attached") | |
348 (218 . "Below left") | |
349 (220 . "Below") | |
350 (222 . "Below right") | |
351 (224 . "Left (reordrant around single base \ | |
352 character)") | |
353 (226 . "Right") | |
354 (228 . "Above left") | |
355 (230 . "Above") | |
356 (232 . "Above right") | |
357 (233 . "Double below") | |
358 (234 . "Double above") | |
359 (240 . "Below (iota subscript)"))))) | |
360 (list "Bidi category" | |
361 (cdr (assoc | |
362 (nth 3 fields) | |
363 '(("L" . "Left-to-Right") | |
364 ("LRE" . "Left-to-Right Embedding") | |
365 ("LRO" . "Left-to-Right Override") | |
366 ("R" . "Right-to-Left") | |
367 ("AL" . "Right-to-Left Arabic") | |
368 ("RLE" . "Right-to-Left Embedding") | |
369 ("RLO" . "Right-to-Left Override") | |
370 ("PDF" . "Pop Directional Format") | |
371 ("EN" . "European Number") | |
372 ("ES" . "European Number Separator") | |
373 ("ET" . "European Number Terminator") | |
374 ("AN" . "Arabic Number") | |
375 ("CS" . "Common Number Separator") | |
376 ("NSM" . "Non-Spacing Mark") | |
377 ("BN" . "Boundary Neutral") | |
378 ("B" . "Paragraph Separator") | |
379 ("S" . "Segment Separator") | |
380 ("WS" . "Whitespace") | |
381 ("ON" . "Other Neutrals"))))) | |
382 (list | |
383 "Decomposition" | |
384 (if (nth 4 fields) | |
385 (let* ((parts (split-string (nth 4 fields))) | |
386 (info (car parts))) | |
387 (if (string-match "\\`<\\(.+\\)>\\'" info) | |
388 (setq info (match-string 1 info)) | |
389 (setq info nil)) | |
390 (if info (setq parts (cdr parts))) | |
391 ;; Maybe printing ? for unrepresentable unicodes | |
392 ;; here and below should be changed? | |
393 (setq parts (mapconcat | |
394 (lambda (arg) | |
395 (string (or (decode-char | |
396 'ucs | |
397 (string-to-number arg 16)) | |
398 ??))) | |
399 parts " ")) | |
400 (concat info parts)))) | |
401 (list "Decimal digit value" | |
402 (nth 5 fields)) | |
403 (list "Digit value" | |
404 (nth 6 fields)) | |
405 (list "Numeric value" | |
406 (nth 7 fields)) | |
407 (list "Mirrored" | |
408 (if (equal "Y" (nth 8 fields)) | |
409 "yes")) | |
410 (list "Old name" (nth 9 fields)) | |
411 (list "ISO 10646 comment" (nth 10 fields)) | |
412 (list "Uppercase" (and (nth 11 fields) | |
413 (string (or (decode-char | |
414 'ucs | |
415 (string-to-number | |
416 (nth 11 fields) 16)) | |
417 ??)))) | |
418 (list "Lowercase" (and (nth 12 fields) | |
419 (string (or (decode-char | |
420 'ucs | |
421 (string-to-number | |
422 (nth 12 fields) 16)) | |
423 ??)))) | |
424 (list "Titlecase" (and (nth 13 fields) | |
425 (string (or (decode-char | |
426 'ucs | |
427 (string-to-number | |
428 (nth 13 fields) 16)) | |
429 ??))))))))))) | |
430 | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
431 ;;;###autoload |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
432 (defun describe-char (pos) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
433 "Describe the character after POS (interactively, the character after point). |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
434 The information includes character code, charset and code points in it, |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
435 syntax, category, how the character is encoded in a file, |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
436 character composition information (if relevant), |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
437 as well as widgets, buttons, overlays, and text properties." |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
438 (interactive "d") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
439 (if (>= pos (point-max)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
440 (error "No character follows specified position")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
441 (let* ((char (char-after pos)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
442 (charset (char-charset char)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
443 (buffer (current-buffer)) |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
444 (composition (find-composition pos nil nil t)) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
445 (composed (if composition (buffer-substring (car composition) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
446 (nth 1 composition)))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
447 (multibyte-p enable-multibyte-characters) |
51127 | 448 item-list max-width unicode) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
449 (if (eq charset 'unknown) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
450 (setq item-list |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
451 `(("character" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
452 ,(format "%s (0%o, %d, 0x%x) -- invalid character code" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
453 (if (< char 256) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
454 (single-key-description char) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
455 (char-to-string char)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
456 char char char)))) |
51127 | 457 |
458 (if (or (< (char-after) 256) | |
459 (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) | |
460 (get-char-property pos 'untranslated-utf-8)) | |
461 (setq unicode (or (get-char-property pos 'untranslated-utf-8) | |
462 (encode-char char 'ucs)))) | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
463 (setq item-list |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
464 `(("character" |
51127 | 465 ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
466 (single-key-description char) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
467 (char-to-string char)) |
51127 | 468 char char char |
469 (if unicode | |
470 (format ", U+%04X" (encode-char char 'ucs)) | |
471 ""))) | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
472 ("charset" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
473 ,(symbol-name charset) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
474 ,(format "(%s)" (charset-description charset))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
475 ("code point" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
476 ,(let ((split (split-char char))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
477 (if (= (charset-dimension charset) 1) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
478 (format "%d" (nth 1 split)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
479 (format "%d %d" (nth 1 split) (nth 2 split))))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
480 ("syntax" |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
481 ,(let ((syntax (syntax-after pos))) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
482 (with-temp-buffer |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
483 (internal-describe-syntax-value syntax) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
484 (buffer-string)))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
485 ("category" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
486 ,@(let ((category-set (char-category-set char))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
487 (if (not category-set) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
488 '("-- none --") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
489 (mapcar #'(lambda (x) (format "%c:%s " |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
490 x (category-docstring x))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
491 (category-set-mnemonics category-set))))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
492 ,@(let ((props (aref char-code-property-table char)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
493 ps) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
494 (when props |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
495 (while props |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
496 (push (format "%s:" (pop props)) ps) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
497 (push (format "%s;" (pop props)) ps)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
498 (list (cons "Properties" (nreverse ps))))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
499 ("buffer code" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
500 ,(encoded-string-description |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
501 (string-as-unibyte (char-to-string char)) nil)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
502 ("file code" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
503 ,@(let* ((coding buffer-file-coding-system) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
504 (encoded (encode-coding-char char coding))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
505 (if encoded |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
506 (list (encoded-string-description encoded coding) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
507 (format "(encoded by coding system %S)" coding)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
508 (list "not encodable by coding system" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
509 (symbol-name coding))))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
510 ,(if (display-graphic-p (selected-frame)) |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
511 (list "font" (or (internal-char-font pos) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
512 "-- none --")) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
513 (list "terminal code" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
514 (let* ((coding (terminal-coding-system)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
515 (encoded (encode-coding-char char coding))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
516 (if encoded |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
517 (encoded-string-description encoded coding) |
51127 | 518 "not encodable")))) |
519 ,@(let ((unicodedata (and unicode | |
520 (unicode-data unicode)))) | |
521 (if unicodedata | |
522 (cons (list "Unicode data" " ") unicodedata)))))) | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
523 (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
524 item-list))) |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
525 (when (eq (current-buffer) (get-buffer "*Help*")) |
51127 | 526 (error "Can't describe char in Help buffer")) |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
527 (with-output-to-temp-buffer "*Help*" |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
528 (with-current-buffer standard-output |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
529 (set-buffer-multibyte multibyte-p) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
530 (let ((formatter (format "%%%ds:" max-width))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
531 (dolist (elt item-list) |
51127 | 532 (when (cadr elt) |
533 (insert (format formatter (car elt))) | |
534 (dolist (clm (cdr elt)) | |
535 (when (>= (+ (current-column) | |
536 (or (string-match "\n" clm) | |
537 (string-width clm)) 1) | |
538 (frame-width)) | |
539 (insert "\n") | |
540 (indent-to (1+ max-width))) | |
541 (insert " " clm)) | |
542 (insert "\n")))) | |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
543 (when composition |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
544 (insert "\nComposed with the " |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
545 (cond |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
546 ((eq pos (car composition)) "following ") |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
547 ((eq (1+ pos) (cadr composition)) "preceding ") |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
548 (t "")) |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
549 "character(s) `" |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
550 (cond |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
551 ((eq pos (car composition)) (substring composed 1)) |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
552 ((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>
parents:
47379
diff
changeset
|
553 (t (concat (substring composed 0 (- pos (car composition))) |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
554 "' and `" |
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
555 (substring composed (- (1+ pos) (car composition)))))) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49398
diff
changeset
|
556 |
47601
7d00d911e8b9
(describe-text-category): Use *Help*. Don't kill-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47379
diff
changeset
|
557 "' to form `" composed "'") |
45868
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
558 (if (nth 3 composition) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
559 (insert ".\n") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
560 (insert "\nby the rule (" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
561 (mapconcat (lambda (x) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
562 (format (if (consp x) "%S" "?%c") x)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
563 (nth 2 composition) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
564 " ") |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
565 ").\n" |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
566 "See the variable `reference-point-alist' for " |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
567 "the meaning of the rule.\n"))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
568 |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
569 (let ((output (current-buffer))) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
570 (with-current-buffer buffer |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
571 (describe-text-properties pos output)) |
97041c98624e
(describe-char): Moved from mule-diag.el, renamed
Richard M. Stallman <rms@gnu.org>
parents:
45700
diff
changeset
|
572 (describe-text-mode)))))) |
45022 | 573 |
51127 | 574 (defalias 'describe-char-after 'describe-char) |
575 (make-obsolete 'describe-char-after 'describe-char "21.5") | |
576 | |
45700
a54155344566
(toplevel): Provide `descr-text'.
Colin Walters <walters@gnu.org>
parents:
45697
diff
changeset
|
577 (provide 'descr-text) |
a54155344566
(toplevel): Provide `descr-text'.
Colin Walters <walters@gnu.org>
parents:
45697
diff
changeset
|
578 |
45022 | 579 ;;; descr-text.el ends here |