1 |
;;; descr-text.el --- describe text mode |
;;; descr-text.el --- describe text mode |
2 |
|
|
3 |
;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc. |
;; Copyright (c) 1994, 1995, 1996, 2001, 02, 03 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Boris Goldowsky <boris@gnu.org> |
;; Author: Boris Goldowsky <boris@gnu.org> |
6 |
;; Keywords: faces |
;; Keywords: faces |
28 |
|
|
29 |
;;; Code: |
;;; Code: |
30 |
|
|
31 |
|
(eval-when-compile (require 'button)) |
32 |
|
|
33 |
(defun describe-text-done () |
(defun describe-text-done () |
34 |
"Delete the current window or bury the current buffer." |
"Delete the current window or bury the current buffer." |
35 |
(interactive) |
(interactive) |
219 |
(widget-insert "There are text properties here:\n") |
(widget-insert "There are text properties here:\n") |
220 |
(describe-property-list properties))))) |
(describe-property-list properties))))) |
221 |
|
|
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 |
|
|
431 |
;;;###autoload |
;;;###autoload |
432 |
(defun describe-char (pos) |
(defun describe-char (pos) |
433 |
"Describe the character after POS (interactively, the character after point). |
"Describe the character after POS (interactively, the character after point). |
445 |
(composed (if composition (buffer-substring (car composition) |
(composed (if composition (buffer-substring (car composition) |
446 |
(nth 1 composition)))) |
(nth 1 composition)))) |
447 |
(multibyte-p enable-multibyte-characters) |
(multibyte-p enable-multibyte-characters) |
448 |
item-list max-width) |
item-list max-width unicode) |
449 |
(if (eq charset 'unknown) |
(if (eq charset 'unknown) |
450 |
(setq item-list |
(setq item-list |
451 |
`(("character" |
`(("character" |
454 |
(single-key-description char) |
(single-key-description char) |
455 |
(char-to-string char)) |
(char-to-string char)) |
456 |
char char char)))) |
char char char)))) |
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)))) |
463 |
(setq item-list |
(setq item-list |
464 |
`(("character" |
`(("character" |
465 |
,(format "%s (0%o, %d, 0x%x)" (if (< char 256) |
,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256) |
466 |
(single-key-description char) |
(single-key-description char) |
467 |
(char-to-string char)) |
(char-to-string char)) |
468 |
char char char)) |
char char char |
469 |
|
(if unicode |
470 |
|
(format ", U+%04X" (encode-char char 'ucs)) |
471 |
|
""))) |
472 |
("charset" |
("charset" |
473 |
,(symbol-name charset) |
,(symbol-name charset) |
474 |
,(format "(%s)" (charset-description charset))) |
,(format "(%s)" (charset-description charset))) |
507 |
(format "(encoded by coding system %S)" coding)) |
(format "(encoded by coding system %S)" coding)) |
508 |
(list "not encodable by coding system" |
(list "not encodable by coding system" |
509 |
(symbol-name coding))))) |
(symbol-name coding))))) |
|
,@(if (or (memq 'mule-utf-8 |
|
|
(find-coding-systems-region pos (1+ pos))) |
|
|
(get-char-property pos 'untranslated-utf-8)) |
|
|
(let ((uc (or (get-char-property pos 'untranslated-utf-8) |
|
|
(encode-char char 'ucs)))) |
|
|
(if uc |
|
|
(list (list "Unicode" |
|
|
(format "%04X" uc)))))) |
|
510 |
,(if (display-graphic-p (selected-frame)) |
,(if (display-graphic-p (selected-frame)) |
511 |
(list "font" (or (internal-char-font pos) |
(list "font" (or (internal-char-font pos) |
512 |
"-- none --")) |
"-- none --")) |
515 |
(encoded (encode-coding-char char coding))) |
(encoded (encode-coding-char char coding))) |
516 |
(if encoded |
(if encoded |
517 |
(encoded-string-description encoded coding) |
(encoded-string-description encoded coding) |
518 |
"not encodable"))))))) |
"not encodable")))) |
519 |
|
,@(let ((unicodedata (and unicode |
520 |
|
(unicode-data unicode)))) |
521 |
|
(if unicodedata |
522 |
|
(cons (list "Unicode data" " ") unicodedata)))))) |
523 |
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) |
524 |
item-list))) |
item-list))) |
525 |
(when (eq (current-buffer) (get-buffer "*Help*")) |
(when (eq (current-buffer) (get-buffer "*Help*")) |
526 |
(error "Can't do self inspection")) |
(error "Can't describe char in Help buffer")) |
527 |
(with-output-to-temp-buffer "*Help*" |
(with-output-to-temp-buffer "*Help*" |
528 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
529 |
(set-buffer-multibyte multibyte-p) |
(set-buffer-multibyte multibyte-p) |
530 |
(let ((formatter (format "%%%ds:" max-width))) |
(let ((formatter (format "%%%ds:" max-width))) |
531 |
(dolist (elt item-list) |
(dolist (elt item-list) |
532 |
(insert (format formatter (car elt))) |
(when (cadr elt) |
533 |
(dolist (clm (cdr elt)) |
(insert (format formatter (car elt))) |
534 |
(when (>= (+ (current-column) |
(dolist (clm (cdr elt)) |
535 |
(or (string-match "\n" clm) |
(when (>= (+ (current-column) |
536 |
(string-width clm)) 1) |
(or (string-match "\n" clm) |
537 |
(frame-width)) |
(string-width clm)) 1) |
538 |
(insert "\n") |
(frame-width)) |
539 |
(indent-to (1+ max-width))) |
(insert "\n") |
540 |
(insert " " clm)) |
(indent-to (1+ max-width))) |
541 |
(insert "\n"))) |
(insert " " clm)) |
542 |
|
(insert "\n")))) |
543 |
(when composition |
(when composition |
544 |
(insert "\nComposed with the " |
(insert "\nComposed with the " |
545 |
(cond |
(cond |
571 |
(describe-text-properties pos output)) |
(describe-text-properties pos output)) |
572 |
(describe-text-mode)))))) |
(describe-text-mode)))))) |
573 |
|
|
574 |
|
(defalias 'describe-char-after 'describe-char) |
575 |
|
(make-obsolete 'describe-char-after 'describe-char "21.5") |
576 |
|
|
577 |
(provide 'descr-text) |
(provide 'descr-text) |
578 |
|
|
579 |
;;; descr-text.el ends here |
;;; descr-text.el ends here |