Mercurial > emacs
comparison lisp/descr-text.el @ 101304:83173cd662ed
(describe-char): Improve description of eight-bit
char in a unibyte buffer.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Tue, 20 Jan 2009 02:14:58 +0000 |
| parents | 017ab5339c4c |
| children | 7d00428842ae |
comparison
equal
deleted
inserted
replaced
| 101303:0dafb06ce90e | 101304:83173cd662ed |
|---|---|
| 377 as well as widgets, buttons, overlays, and text properties." | 377 as well as widgets, buttons, overlays, and text properties." |
| 378 (interactive "d") | 378 (interactive "d") |
| 379 (if (>= pos (point-max)) | 379 (if (>= pos (point-max)) |
| 380 (error "No character follows specified position")) | 380 (error "No character follows specified position")) |
| 381 (let* ((char (char-after pos)) | 381 (let* ((char (char-after pos)) |
| 382 (charset (or (get-text-property pos 'charset) (char-charset char))) | 382 (eight-bit-p (and (not enable-multibyte-characters) (>= char 128))) |
| 383 (charset (if eight-bit-p 'eight-bit | |
| 384 (or (get-text-property pos 'charset) (char-charset char)))) | |
| 383 (composition (find-composition pos nil nil t)) | 385 (composition (find-composition pos nil nil t)) |
| 384 (component-chars nil) | 386 (component-chars nil) |
| 385 (display-table (or (window-display-table) | 387 (display-table (or (window-display-table) |
| 386 buffer-display-table | 388 buffer-display-table |
| 387 standard-display-table)) | 389 standard-display-table)) |
| 402 (describe-text-properties pos tmp-buf) | 404 (describe-text-properties pos tmp-buf) |
| 403 (with-current-buffer tmp-buf (buffer-string))) | 405 (with-current-buffer tmp-buf (buffer-string))) |
| 404 (kill-buffer tmp-buf)))) | 406 (kill-buffer tmp-buf)))) |
| 405 item-list max-width code) | 407 item-list max-width code) |
| 406 | 408 |
| 407 (or (setq code (encode-char char charset)) | 409 (if multibyte-p |
| 408 (setq charset (char-charset char) | 410 (or (setq code (encode-char char charset)) |
| 409 code (encode-char char charset))) | 411 (setq charset (char-charset char) |
| 412 code (encode-char char charset))) | |
| 413 (setq code char)) | |
| 410 (setq item-list | 414 (setq item-list |
| 411 `(("character" | 415 `(("character" |
| 412 ,(format "%s (%d, #o%o, #x%x)" | 416 ,(format "%s (%d, #o%o, #x%x)" |
| 413 (apply 'propertize char-description | 417 (apply 'propertize char-description |
| 414 (text-properties-at pos)) | 418 (text-properties-at pos)) |
| 442 ,(let ((syntax (syntax-after pos))) | 446 ,(let ((syntax (syntax-after pos))) |
| 443 (with-temp-buffer | 447 (with-temp-buffer |
| 444 (internal-describe-syntax-value syntax) | 448 (internal-describe-syntax-value syntax) |
| 445 (buffer-string)))) | 449 (buffer-string)))) |
| 446 ("category" | 450 ("category" |
| 447 ,@(let ((category-set (char-category-set char))) | 451 ,@(if (not eight-bit-p) |
| 448 (if category-set | 452 (let ((category-set (char-category-set char))) |
| 449 (describe-char-categories category-set) | 453 (if category-set |
| 450 '("-- none --")))) | 454 (describe-char-categories category-set) |
| 455 '("-- none --"))))) | |
| 451 ("to input" | 456 ("to input" |
| 452 ,@(let ((key-list (and (eq input-method-function | 457 ,@(if (not eight-bit-p) |
| 453 'quail-input-method) | 458 (let ((key-list (and (eq input-method-function |
| 454 (quail-find-key char)))) | 459 'quail-input-method) |
| 455 (if (consp key-list) | 460 (quail-find-key char)))) |
| 456 (list "type" | 461 (if (consp key-list) |
| 457 (mapconcat #'(lambda (x) (concat "\"" x "\"")) | 462 (list "type" |
| 458 key-list " or ") | 463 (mapconcat #'(lambda (x) (concat "\"" x "\"")) |
| 459 "with" | 464 key-list " or ") |
| 460 `(insert-text-button | 465 "with" |
| 461 ,current-input-method | 466 `(insert-text-button |
| 462 'type 'help-input-method | 467 ,current-input-method |
| 463 'help-args '(,current-input-method)))))) | 468 'type 'help-input-method |
| 469 'help-args '(,current-input-method))))))) | |
| 464 ("buffer code" | 470 ("buffer code" |
| 465 ,(encoded-string-description | 471 ,(if multibyte-p |
| 466 (string-as-unibyte (char-to-string char)) nil)) | 472 (encoded-string-description |
| 473 (string-as-unibyte (char-to-string char)) nil) | |
| 474 (format "#x%02X" char))) | |
| 467 ("file code" | 475 ("file code" |
| 468 ,@(let* ((coding buffer-file-coding-system) | 476 ,@(if multibyte-p |
| 469 (encoded (encode-coding-char char coding charset))) | 477 (let* ((coding buffer-file-coding-system) |
| 470 (if encoded | 478 (encoded (encode-coding-char char coding charset))) |
| 471 (list (encoded-string-description encoded coding) | 479 (if encoded |
| 472 (format "(encoded by coding system %S)" coding)) | 480 (list (encoded-string-description encoded coding) |
| 473 (list "not encodable by coding system" | 481 (format "(encoded by coding system %S)" coding)) |
| 474 (symbol-name coding))))) | 482 (list "not encodable by coding system" |
| 483 (symbol-name coding)))) | |
| 484 (list (format "#x%02X" char)))) | |
| 475 ("display" | 485 ("display" |
| 476 ,(cond | 486 ,(cond |
| 477 (disp-vector | 487 (disp-vector |
| 478 (setq disp-vector (copy-sequence disp-vector)) | 488 (setq disp-vector (copy-sequence disp-vector)) |
| 479 (dotimes (i (length disp-vector)) | 489 (dotimes (i (length disp-vector)) |
| 527 'escape-glyph))))) | 537 'escape-glyph))))) |
| 528 (if face (list (list "hardcoded face" | 538 (if face (list (list "hardcoded face" |
| 529 `(insert-text-button | 539 `(insert-text-button |
| 530 ,(symbol-name face) | 540 ,(symbol-name face) |
| 531 'type 'help-face 'help-args '(,face)))))) | 541 'type 'help-face 'help-args '(,face)))))) |
| 532 ,@(let ((unicodedata (describe-char-unicode-data char))) | 542 ,@(if (not eight-bit-p) |
| 533 (if unicodedata | 543 (let ((unicodedata (describe-char-unicode-data char))) |
| 534 (cons (list "Unicode data" " ") unicodedata))))) | 544 (if unicodedata |
| 545 (cons (list "Unicode data" " ") unicodedata)))))) | |
| 535 (setq max-width (apply #'max (mapcar #'(lambda (x) | 546 (setq max-width (apply #'max (mapcar #'(lambda (x) |
| 536 (if (cadr x) (length (car x)) 0)) | 547 (if (cadr x) (length (car x)) 0)) |
| 537 item-list))) | 548 item-list))) |
| 538 (help-setup-xref nil (interactive-p)) | 549 (help-setup-xref nil (interactive-p)) |
| 539 (with-help-window (help-buffer) | 550 (with-help-window (help-buffer) |
| 663 (propertize " " 'display '(space :align-to 4)) | 674 (propertize " " 'display '(space :align-to 4)) |
| 664 (or (cdr elt) "-- not encodable --")))) | 675 (or (cdr elt) "-- not encodable --")))) |
| 665 (insert "\nSee the variable `reference-point-alist' for " | 676 (insert "\nSee the variable `reference-point-alist' for " |
| 666 "the meaning of the rule.\n"))) | 677 "the meaning of the rule.\n"))) |
| 667 | 678 |
| 668 (insert (if (not describe-char-unidata-list) | 679 (unless eight-bit-p |
| 669 "\nCharacter code properties are not shown: " | 680 (insert (if (not describe-char-unidata-list) |
| 670 "\nCharacter code properties: ")) | 681 "\nCharacter code properties are not shown: " |
| 671 (insert-text-button | 682 "\nCharacter code properties: ")) |
| 672 "customize what to show" | 683 (insert-text-button |
| 673 'action (lambda (&rest ignore) | 684 "customize what to show" |
| 674 (customize-variable | 685 'action (lambda (&rest ignore) |
| 675 'describe-char-unidata-list))) | 686 (customize-variable |
| 676 (insert "\n") | 687 'describe-char-unidata-list))) |
| 677 (dolist (elt (if (eq describe-char-unidata-list t) | 688 (insert "\n") |
| 678 (nreverse (mapcar 'car char-code-property-alist)) | 689 (dolist (elt (if (eq describe-char-unidata-list t) |
| 679 describe-char-unidata-list)) | 690 (nreverse (mapcar 'car char-code-property-alist)) |
| 680 (let ((val (get-char-code-property char elt)) | 691 describe-char-unidata-list)) |
| 681 description) | 692 (let ((val (get-char-code-property char elt)) |
| 682 (when val | 693 description) |
| 683 (setq description (char-code-property-description elt val)) | 694 (when val |
| 684 (insert (if description | 695 (setq description (char-code-property-description elt val)) |
| 685 (format " %s: %s (%s)\n" elt val description) | 696 (insert (if description |
| 686 (format " %s: %s\n" elt val)))))) | 697 (format " %s: %s (%s)\n" elt val description) |
| 698 (format " %s: %s\n" elt val))))))) | |
| 687 | 699 |
| 688 (if text-props-desc (insert text-props-desc)) | 700 (if text-props-desc (insert text-props-desc)) |
| 689 (setq help-xref-stack-item (list 'help-insert-string (buffer-string))) | 701 (setq help-xref-stack-item (list 'help-insert-string (buffer-string))) |
| 690 (toggle-read-only 1))))) | 702 (toggle-read-only 1))))) |
| 691 | 703 |