aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2002-04-30 04:59:24 +0000
committerRichard M. Stallman2002-04-30 04:59:24 +0000
commit641c04b9f0c1774f91ad8e2e1d0fe969ce762832 (patch)
treef9e2c7eca9042bd88aa631a8dee38b2f0edbd223
parentbd421bc2ddb2115709d2a51f31fbd0847e317dea (diff)
downloademacs-641c04b9f0c1774f91ad8e2e1d0fe969ce762832.tar.gz
emacs-641c04b9f0c1774f91ad8e2e1d0fe969ce762832.zip
(describe-text-at and stuff): Moved to descr-text.el.
-rw-r--r--lisp/facemenu.el158
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}
487Entry to this mode calls the value of `describe-text-mode-hook'
488if 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.
533PROPERTIES should be a list of overlay or text properties.
534The `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."