46 |
:type 'hook) |
:type 'hook) |
47 |
|
|
48 |
(defun describe-text-mode () |
(defun describe-text-mode () |
49 |
"Major mode for buffers created by `describe-text-at'. |
"Major mode for buffers created by `describe-char'. |
50 |
|
|
51 |
\\{describe-text-mode-map} |
\\{describe-text-mode-map} |
52 |
Entry to this mode calls the value of `describe-text-mode-hook' |
Entry to this mode calls the value of `describe-text-mode-hook' |
92 |
(princ (widget-get widget :value)))) |
(princ (widget-get widget :value)))) |
93 |
pp)))) |
pp)))) |
94 |
|
|
95 |
(defun describe-text-properties (properties) |
(defun describe-property-list (properties) |
96 |
"Insert a description of PROPERTIES in the current buffer. |
"Insert a description of PROPERTIES in the current buffer. |
97 |
PROPERTIES should be a list of overlay or text properties. |
PROPERTIES should be a list of overlay or text properties. |
98 |
The `category' property is made into a widget button that call |
The `category' property is made into a widget button that call |
141 |
(with-output-to-temp-buffer "*Text Category*" |
(with-output-to-temp-buffer "*Text Category*" |
142 |
(set-buffer "*Text Category*") |
(set-buffer "*Text Category*") |
143 |
(widget-insert "Category " (format "%S" category) ":\n\n") |
(widget-insert "Category " (format "%S" category) ":\n\n") |
144 |
(describe-text-properties (symbol-plist category)) |
(describe-property-list (symbol-plist category)) |
145 |
(describe-text-mode) |
(describe-text-mode) |
146 |
(goto-char (point-min))))) |
(goto-char (point-min))))) |
147 |
|
|
148 |
;;;###autoload |
;;;###autoload |
149 |
(defun describe-text-at (pos) |
(defun describe-text-properties (pos &optional output-buffer) |
150 |
"Describe widgets, buttons, overlays and text properties at POS." |
"Describe widgets, buttons, overlays and text properties at POS. |
151 |
|
Interactively, describe them for the character after point. |
152 |
|
If optional second argument OUTPUT-BUFFER is non-nil, |
153 |
|
insert the output into that buffer, and don't initialize or clear it |
154 |
|
otherwise." |
155 |
(interactive "d") |
(interactive "d") |
156 |
(when (eq (current-buffer) (get-buffer "*Text Description*")) |
(when (eq (current-buffer) (get-buffer "*Text Description*")) |
157 |
(error "Can't do self inspection")) |
(error "Can't do self inspection")) |
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 |
|
(when (get-buffer "*Text Description*") |
165 |
|
(kill-buffer "*Text Description*")) |
166 |
|
(let ((buffer (current-buffer))) |
167 |
|
(save-excursion |
168 |
|
(with-output-to-temp-buffer "*Text Description*" |
169 |
|
(set-buffer "*Text Description*") |
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) |
178 |
(let* ((properties (text-properties-at pos)) |
(let* ((properties (text-properties-at pos)) |
179 |
(overlays (overlays-at pos)) |
(overlays (overlays-at pos)) |
180 |
overlay |
overlay |
186 |
(button-type (and button (button-type button))) |
(button-type (and button (button-type button))) |
187 |
(button-label (and button (button-label button))) |
(button-label (and button (button-label button))) |
188 |
(widget (or wid-field wid-button wid-doc))) |
(widget (or wid-field wid-button wid-doc))) |
189 |
(if (not (or properties overlays)) |
(with-current-buffer output-buffer |
190 |
(message "This is plain text.") |
;; Widgets |
191 |
(when (get-buffer "*Text Description*") |
(when (widgetp widget) |
192 |
(kill-buffer "*Text Description*")) |
(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) |
202 |
|
(widget-insert "Here is a " (format "%S" button-type) |
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) |
212 |
|
(widget-insert " From " (format "%d" (overlay-start overlay)) |
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))))) |
221 |
|
|
222 |
|
;;;###autoload |
223 |
|
(defun describe-char (pos) |
224 |
|
"Describe the character after POS (interactively, the character after point). |
225 |
|
The information includes character code, charset and code points in it, |
226 |
|
syntax, category, how the character is encoded in a file, |
227 |
|
character composition information (if relevant), |
228 |
|
as well as widgets, buttons, overlays, and text properties." |
229 |
|
(interactive "d") |
230 |
|
(when (eq (current-buffer) (get-buffer "*Text Description*")) |
231 |
|
(error "Can't do self inspection")) |
232 |
|
(if (>= pos (point-max)) |
233 |
|
(error "No character follows specified position")) |
234 |
|
(let* ((char (char-after pos)) |
235 |
|
(charset (char-charset char)) |
236 |
|
(buffer (current-buffer)) |
237 |
|
(composition (find-composition (point) nil nil t)) |
238 |
|
(composed (if composition (buffer-substring (car composition) |
239 |
|
(nth 1 composition)))) |
240 |
|
(multibyte-p enable-multibyte-characters) |
241 |
|
item-list max-width) |
242 |
|
(if (eq charset 'unknown) |
243 |
|
(setq item-list |
244 |
|
`(("character" |
245 |
|
,(format "%s (0%o, %d, 0x%x) -- invalid character code" |
246 |
|
(if (< char 256) |
247 |
|
(single-key-description char) |
248 |
|
(char-to-string char)) |
249 |
|
char char char)))) |
250 |
|
(setq item-list |
251 |
|
`(("character" |
252 |
|
,(format "%s (0%o, %d, 0x%x)" (if (< char 256) |
253 |
|
(single-key-description char) |
254 |
|
(char-to-string char)) |
255 |
|
char char char)) |
256 |
|
("charset" |
257 |
|
,(symbol-name charset) |
258 |
|
,(format "(%s)" (charset-description charset))) |
259 |
|
("code point" |
260 |
|
,(let ((split (split-char char))) |
261 |
|
(if (= (charset-dimension charset) 1) |
262 |
|
(format "%d" (nth 1 split)) |
263 |
|
(format "%d %d" (nth 1 split) (nth 2 split))))) |
264 |
|
("syntax" |
265 |
|
,(let ((syntax (get-char-property (point) 'syntax-table))) |
266 |
|
(with-temp-buffer |
267 |
|
(internal-describe-syntax-value |
268 |
|
(if (consp syntax) syntax |
269 |
|
(aref (or syntax (syntax-table)) char))) |
270 |
|
(buffer-string)))) |
271 |
|
("category" |
272 |
|
,@(let ((category-set (char-category-set char))) |
273 |
|
(if (not category-set) |
274 |
|
'("-- none --") |
275 |
|
(mapcar #'(lambda (x) (format "%c:%s " |
276 |
|
x (category-docstring x))) |
277 |
|
(category-set-mnemonics category-set))))) |
278 |
|
,@(let ((props (aref char-code-property-table char)) |
279 |
|
ps) |
280 |
|
(when props |
281 |
|
(while props |
282 |
|
(push (format "%s:" (pop props)) ps) |
283 |
|
(push (format "%s;" (pop props)) ps)) |
284 |
|
(list (cons "Properties" (nreverse ps))))) |
285 |
|
("buffer code" |
286 |
|
,(encoded-string-description |
287 |
|
(string-as-unibyte (char-to-string char)) nil)) |
288 |
|
("file code" |
289 |
|
,@(let* ((coding buffer-file-coding-system) |
290 |
|
(encoded (encode-coding-char char coding))) |
291 |
|
(if encoded |
292 |
|
(list (encoded-string-description encoded coding) |
293 |
|
(format "(encoded by coding system %S)" coding)) |
294 |
|
(list "not encodable by coding system" |
295 |
|
(symbol-name coding))))) |
296 |
|
,@(if (or (memq 'mule-utf-8 |
297 |
|
(find-coding-systems-region (point) (1+ (point)))) |
298 |
|
(get-char-property (point) 'untranslated-utf-8)) |
299 |
|
(let ((uc (or (get-char-property (point) |
300 |
|
'untranslated-utf-8) |
301 |
|
(encode-char (char-after) 'ucs)))) |
302 |
|
(if uc |
303 |
|
(list (list "Unicode" |
304 |
|
(format "%04X" uc)))))) |
305 |
|
,(if (display-graphic-p (selected-frame)) |
306 |
|
(list "font" (or (internal-char-font (point)) |
307 |
|
"-- none --")) |
308 |
|
(list "terminal code" |
309 |
|
(let* ((coding (terminal-coding-system)) |
310 |
|
(encoded (encode-coding-char char coding))) |
311 |
|
(if encoded |
312 |
|
(encoded-string-description encoded coding) |
313 |
|
"not encodable"))))))) |
314 |
|
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |
315 |
|
item-list))) |
316 |
|
(when (get-buffer "*Help*") |
317 |
|
(kill-buffer "*Help*")) |
318 |
|
(with-output-to-temp-buffer "*Help*" |
319 |
(save-excursion |
(save-excursion |
320 |
(with-output-to-temp-buffer "*Text Description*" |
(set-buffer standard-output) |
321 |
(set-buffer "*Text Description*") |
(set-buffer-multibyte multibyte-p) |
322 |
(widget-insert "Text content at position " (format "%d" pos) ":\n\n") |
(let ((formatter (format "%%%ds:" max-width))) |
323 |
;; Widgets |
(dolist (elt item-list) |
324 |
(when (widgetp widget) |
(insert (format formatter (car elt))) |
325 |
(widget-insert (cond (wid-field "This is an editable text area") |
(dolist (clm (cdr elt)) |
326 |
(wid-button "This is an active area") |
(when (>= (+ (current-column) |
327 |
(wid-doc "This is documentation text"))) |
(or (string-match "\n" clm) |
328 |
(widget-insert " of a ") |
(string-width clm)) 1) |
329 |
(describe-text-widget widget) |
(frame-width)) |
330 |
(widget-insert ".\n\n")) |
(insert "\n") |
331 |
;; Buttons |
(indent-to (1+ max-width))) |
332 |
(when (and button (not (widgetp wid-button))) |
(insert " " clm)) |
333 |
(widget-insert "Here is a " (format "%S" button-type) |
(insert "\n"))) |
334 |
" button labeled `" button-label "'.\n\n")) |
(when composition |
335 |
;; Overlays |
(insert "\nComposed with the following character(s) " |
336 |
(when overlays |
(mapconcat (lambda (x) (format "`%c'" x)) |
337 |
(if (eq (length overlays) 1) |
(substring composed 1) |
338 |
(widget-insert "There is an overlay here:\n") |
", ") |
339 |
(widget-insert "There are " (format "%d" (length overlays)) |
" to form `" composed "'") |
340 |
" overlays here:\n")) |
(if (nth 3 composition) |
341 |
(dolist (overlay overlays) |
(insert ".\n") |
342 |
(widget-insert " From " (format "%d" (overlay-start overlay)) |
(insert "\nby the rule (" |
343 |
" to " (format "%d" (overlay-end overlay)) "\n") |
(mapconcat (lambda (x) |
344 |
(describe-text-properties (overlay-properties overlay))) |
(format (if (consp x) "%S" "?%c") x)) |
345 |
(widget-insert "\n")) |
(nth 2 composition) |
346 |
;; Text properties |
" ") |
347 |
(when properties |
").\n" |
348 |
(widget-insert "There are text properties here:\n") |
"See the variable `reference-point-alist' for " |
349 |
(describe-text-properties properties)) |
"the meaning of the rule.\n"))) |
350 |
(describe-text-mode) |
|
351 |
(goto-char (point-min))))))) |
(let ((output (current-buffer))) |
352 |
|
(with-current-buffer buffer |
353 |
|
(describe-text-properties pos output)) |
354 |
|
(describe-text-mode)))))) |
355 |
|
|
356 |
(provide 'descr-text) |
(provide 'descr-text) |
357 |
|
|