diff options
| author | Richard M. Stallman | 2002-04-30 04:59:24 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2002-04-30 04:59:24 +0000 |
| commit | 641c04b9f0c1774f91ad8e2e1d0fe969ce762832 (patch) | |
| tree | f9e2c7eca9042bd88aa631a8dee38b2f0edbd223 | |
| parent | bd421bc2ddb2115709d2a51f31fbd0847e317dea (diff) | |
| download | emacs-641c04b9f0c1774f91ad8e2e1d0fe969ce762832.tar.gz emacs-641c04b9f0c1774f91ad8e2e1d0fe969ce762832.zip | |
(describe-text-at and stuff): Moved to descr-text.el.
| -rw-r--r-- | lisp/facemenu.el | 158 |
1 files changed, 0 insertions, 158 deletions
diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 7a407ffd8d2..96c73e77bbd 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el | |||
| @@ -461,164 +461,6 @@ These special properties include `invisible', `intangible' and `read-only'." | |||
| 461 | (remove-text-properties | 461 | (remove-text-properties |
| 462 | start end '(invisible nil intangible nil read-only nil)))) | 462 | start end '(invisible nil intangible nil read-only nil)))) |
| 463 | 463 | ||
| 464 | ;;; Describe-Text Mode. | ||
| 465 | |||
| 466 | (defun describe-text-done () | ||
| 467 | "Delete the current window or bury the current buffer." | ||
| 468 | (interactive) | ||
| 469 | (if (> (count-windows) 1) | ||
| 470 | (delete-window) | ||
| 471 | (bury-buffer))) | ||
| 472 | |||
| 473 | (defvar describe-text-mode-map | ||
| 474 | (let ((map (make-sparse-keymap))) | ||
| 475 | (set-keymap-parent map widget-keymap) | ||
| 476 | map) | ||
| 477 | "Keymap for `describe-text-mode'.") | ||
| 478 | |||
| 479 | (defcustom describe-text-mode-hook nil | ||
| 480 | "List of hook functions ran by `describe-text-mode'." | ||
| 481 | :type 'hook) | ||
| 482 | |||
| 483 | (defun describe-text-mode () | ||
| 484 | "Major mode for buffers created by `describe-text-at'. | ||
| 485 | |||
| 486 | \\{describe-text-mode-map} | ||
| 487 | Entry to this mode calls the value of `describe-text-mode-hook' | ||
| 488 | if that value is non-nil." | ||
| 489 | (kill-all-local-variables) | ||
| 490 | (setq major-mode 'describe-text-mode | ||
| 491 | mode-name "Describe-Text") | ||
| 492 | (use-local-map describe-text-mode-map) | ||
| 493 | (widget-setup) | ||
| 494 | (run-hooks 'describe-text-mode-hook)) | ||
| 495 | |||
| 496 | ;;; Describe-Text Utilities. | ||
| 497 | |||
| 498 | (defun describe-text-widget (widget) | ||
| 499 | "Insert text to describe WIDGET in the current buffer." | ||
| 500 | (widget-create 'link | ||
| 501 | :notify `(lambda (&rest ignore) | ||
| 502 | (widget-browse ',widget)) | ||
| 503 | (format "%S" (if (symbolp widget) | ||
| 504 | widget | ||
| 505 | (car widget)))) | ||
| 506 | (widget-insert " ") | ||
| 507 | (widget-create 'info-link :tag "widget" "(widget)Top")) | ||
| 508 | |||
| 509 | (defun describe-text-sexp (sexp) | ||
| 510 | "Insert a short description of SEXP in the current buffer." | ||
| 511 | (let ((pp (condition-case signal | ||
| 512 | (pp-to-string sexp) | ||
| 513 | (error (prin1-to-string signal))))) | ||
| 514 | (when (string-match "\n\\'" pp) | ||
| 515 | (setq pp (substring pp 0 (1- (length pp))))) | ||
| 516 | (if (cond ((string-match "\n" pp) | ||
| 517 | nil) | ||
| 518 | ((> (length pp) (- (window-width) (current-column))) | ||
| 519 | nil) | ||
| 520 | (t t)) | ||
| 521 | (widget-insert pp) | ||
| 522 | (widget-create 'push-button | ||
| 523 | :tag "show" | ||
| 524 | :action (lambda (widget &optional event) | ||
| 525 | (with-output-to-temp-buffer | ||
| 526 | "*Pp Eval Output*" | ||
| 527 | (princ (widget-get widget :value)))) | ||
| 528 | pp)))) | ||
| 529 | |||
| 530 | |||
| 531 | (defun describe-text-properties (properties) | ||
| 532 | "Insert a description of PROPERTIES in the current buffer. | ||
| 533 | PROPERTIES should be a list of overlay or text properties. | ||
| 534 | The `category' property is made into a widget button that call | ||
| 535 | `describe-text-category' when pushed." | ||
| 536 | (while properties | ||
| 537 | (widget-insert (format " %-20s " (car properties))) | ||
| 538 | (let ((key (nth 0 properties)) | ||
| 539 | (value (nth 1 properties))) | ||
| 540 | (cond ((eq key 'category) | ||
| 541 | (widget-create 'link | ||
| 542 | :notify `(lambda (&rest ignore) | ||
| 543 | (describe-text-category ',value)) | ||
| 544 | (format "%S" value))) | ||
| 545 | ((widgetp value) | ||
| 546 | (describe-text-widget value)) | ||
| 547 | (t | ||
| 548 | (describe-text-sexp value)))) | ||
| 549 | (widget-insert "\n") | ||
| 550 | (setq properties (cdr (cdr properties))))) | ||
| 551 | |||
| 552 | ;;; Describe-Text Commands. | ||
| 553 | |||
| 554 | (defun describe-text-category (category) | ||
| 555 | "Describe a text property category." | ||
| 556 | (interactive "S") | ||
| 557 | (when (get-buffer "*Text Category*") | ||
| 558 | (kill-buffer "*Text Category*")) | ||
| 559 | (save-excursion | ||
| 560 | (with-output-to-temp-buffer "*Text Category*" | ||
| 561 | (set-buffer "*Text Category*") | ||
| 562 | (widget-insert "Category " (format "%S" category) ":\n\n") | ||
| 563 | (describe-text-properties (symbol-plist category)) | ||
| 564 | (describe-text-mode) | ||
| 565 | (goto-char (point-min))))) | ||
| 566 | |||
| 567 | ;;;###autoload | ||
| 568 | (defun describe-text-at (pos) | ||
| 569 | "Describe widgets, buttons, overlays and text properties at POS." | ||
| 570 | (interactive "d") | ||
| 571 | (when (eq (current-buffer) (get-buffer "*Text Description*")) | ||
| 572 | (error "Can't do self inspection")) | ||
| 573 | (let* ((properties (text-properties-at pos)) | ||
| 574 | (overlays (overlays-at pos)) | ||
| 575 | overlay | ||
| 576 | (wid-field (get-char-property pos 'field)) | ||
| 577 | (wid-button (get-char-property pos 'button)) | ||
| 578 | (wid-doc (get-char-property pos 'widget-doc)) | ||
| 579 | ;; If button.el is not loaded, we have no buttons in the text. | ||
| 580 | (button (and (fboundp 'button-at) (button-at pos))) | ||
| 581 | (button-type (and button (button-type button))) | ||
| 582 | (button-label (and button (button-label button))) | ||
| 583 | (widget (or wid-field wid-button wid-doc))) | ||
| 584 | (if (not (or properties overlays)) | ||
| 585 | (message "This is plain text.") | ||
| 586 | (when (get-buffer "*Text Description*") | ||
| 587 | (kill-buffer "*Text Description*")) | ||
| 588 | (save-excursion | ||
| 589 | (with-output-to-temp-buffer "*Text Description*" | ||
| 590 | (set-buffer "*Text Description*") | ||
| 591 | (widget-insert "Text content at position " (format "%d" pos) ":\n\n") | ||
| 592 | ;; Widgets | ||
| 593 | (when (widgetp widget) | ||
| 594 | (widget-insert (cond (wid-field "This is an editable text area") | ||
| 595 | (wid-button "This is an active area") | ||
| 596 | (wid-doc "This is documentation text"))) | ||
| 597 | (widget-insert " of a ") | ||
| 598 | (describe-text-widget widget) | ||
| 599 | (widget-insert ".\n\n")) | ||
| 600 | ;; Buttons | ||
| 601 | (when (and button (not (widgetp wid-button))) | ||
| 602 | (widget-insert "Here is a " (format "%S" button-type) | ||
| 603 | " button labeled `" button-label "'.\n\n")) | ||
| 604 | ;; Overlays | ||
| 605 | (when overlays | ||
| 606 | (if (eq (length overlays) 1) | ||
| 607 | (widget-insert "There is an overlay here:\n") | ||
| 608 | (widget-insert "There are " (format "%d" (length overlays)) | ||
| 609 | " overlays here:\n")) | ||
| 610 | (dolist (overlay overlays) | ||
| 611 | (widget-insert " From " (format "%d" (overlay-start overlay)) | ||
| 612 | " to " (format "%d" (overlay-end overlay)) "\n") | ||
| 613 | (describe-text-properties (overlay-properties overlay))) | ||
| 614 | (widget-insert "\n")) | ||
| 615 | ;; Text properties | ||
| 616 | (when properties | ||
| 617 | (widget-insert "There are text properties here:\n") | ||
| 618 | (describe-text-properties properties)) | ||
| 619 | (describe-text-mode) | ||
| 620 | (goto-char (point-min))))))) | ||
| 621 | |||
| 622 | ;;;###autoload | 464 | ;;;###autoload |
| 623 | (defun facemenu-read-color (&optional prompt) | 465 | (defun facemenu-read-color (&optional prompt) |
| 624 | "Read a color using the minibuffer." | 466 | "Read a color using the minibuffer." |