;;; apropos.el --- apropos commands for users and programmers
-;; Copyright (C) 1989, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994, 1995, 2001 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org>
;;; Code:
+(require 'button)
+
(defgroup apropos nil
"Apropos commands for users and programmers"
:group 'help
(defvar apropos-mode-map
(let ((map (make-sparse-keymap)))
+ (set-keymap-parent map button-buffer-map)
+ ;; Use `apropos-follow' instead of just using the button
+ ;; definition of RET, so that users can use it anywhere in an
+ ;; apropos item, not just on top of a button.
(define-key map "\C-m" 'apropos-follow)
(define-key map " " 'scroll-up)
(define-key map "\177" 'scroll-down)
(define-key map "q" 'quit-window)
- (define-key map [mouse-2] 'apropos-mouse-follow)
- (define-key map [down-mouse-2] nil)
map)
"Keymap used in Apropos mode.")
(defvar apropos-item ()
"Current item in or for `apropos-accumulator'.")
+
+\f
+;;; Button types used by apropos
+
+(define-button-type 'apropos-symbol
+ 'face apropos-symbol-face
+ 'help-echo "mouse-2, RET: Display more help on this symbol"
+ 'action #'apropos-symbol-button-display-help
+ 'skip t)
+
+(defun apropos-symbol-button-display-help (button)
+ "Display further help for the `apropos-symbol' button BUTTON."
+ (button-activate
+ (or (apropos-next-label-button (button-start button))
+ (error "There is nothing to follow for `%s'" (button-label button)))))
+
+(define-button-type 'apropos-function
+ 'apropos-label "Function"
+ 'action (lambda (button)
+ (describe-function (button-get button 'apropos-symbol)))
+ 'help-echo "mouse-2, RET: Display more help on this function")
+(define-button-type 'apropos-macro
+ 'apropos-label "Macro"
+ 'action (lambda (button)
+ (describe-function (button-get button 'apropos-symbol)))
+ 'help-echo "mouse-2, RET: Display more help on this macro")
+(define-button-type 'apropos-command
+ 'apropos-label "Command"
+ 'action (lambda (button)
+ (describe-function (button-get button 'apropos-symbol)))
+ 'help-echo "mouse-2, RET: Display more help on this command")
+
+;; We used to use `customize-variable-other-window' instead for a
+;; customizable variable, but that is slow. It is better to show an
+;; ordinary help buffer and let the user click on the customization
+;; button in that buffer, if he wants to.
+;; Likewise for `customize-face-other-window'.
+(define-button-type 'apropos-variable
+ 'apropos-label "Variable"
+ 'help-echo "mouse-2, RET: Display more help on this variable"
+ 'action (lambda (button)
+ (describe-variable (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-face
+ 'apropos-label "Face"
+ 'help-echo "mouse-2, RET: Display more help on this face"
+ 'action (lambda (button)
+ (describe-face (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-group
+ 'apropos-label "Group"
+ 'help-echo "mouse-2, RET: Display more help on this group"
+ 'action (lambda (button)
+ (customize-variable-other-window
+ (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-widget
+ 'apropos-label "Widget"
+ 'help-echo "mouse-2, RET: Display more help on this widget"
+ 'action (lambda (button)
+ (widget-browse-other-window (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-plist
+ 'apropos-label "Plist"
+ 'help-echo "mouse-2, RET: Display more help on this plist"
+ 'action (lambda (button)
+ (apropos-describe-plist (button-get button 'apropos-symbol))))
+
+(defun apropos-next-label-button (pos)
+ "Returns the next apropos label button after POS, or nil if there's none.
+Will also return nil if more than one `apropos-symbol' button is encountered
+before finding a label."
+ (let* ((button (next-button pos t))
+ (already-hit-symbol nil)
+ (label (and button (button-get button 'apropos-label)))
+ (type (and button (button-get button 'type))))
+ (while (and button
+ (not label)
+ (or (not (eq type 'apropos-symbol))
+ (not already-hit-symbol)))
+ (when (eq type 'apropos-symbol)
+ (setq already-hit-symbol t))
+ (setq button (next-button (button-start button)))
+ (when button
+ (setq label (button-get button 'apropos-label))
+ (setq type (button-get button 'type))))
+ (and label button)))
+
\f
;;;###autoload
(define-derived-mode apropos-mode fundamental-mode "Apropos"
function))
-
-(defvar apropos-label-properties nil
- "List of face properties to use for a label.
-Bound by `apropos-print' for use by `apropos-print-doc'.")
-
(defun apropos-print (do-keys spacing)
"Output result of apropos searching into buffer `*Apropos*'.
The value of `apropos-accumulator' is the list of items to output.
(setq apropos-accumulator
(sort apropos-accumulator (lambda (a b)
(string-lessp (car a) (car b)))))
- (setq apropos-label-properties
- (if (and apropos-label-face
- (symbolp apropos-label-face))
- `(face ,apropos-label-face
- mouse-face highlight
- help-echo "mouse-2: display help on this item")))
(with-output-to-temp-buffer "*Apropos*"
(let ((p apropos-accumulator)
(old-buffer (current-buffer))
- symbol item point1 point2)
+ symbol item)
(set-buffer standard-output)
(apropos-mode)
(if (display-mouse-p)
(insert "If moving the mouse over text changes the text's color,\n"
(substitute-command-keys
- "you can click \\[apropos-mouse-follow] on that text to get more information.\n")))
- (insert "In this buffer, go to the name of the command, or function"
+ "you can click \\[push-button] on that text to get more information.\n")))
+ (insert "In this buffer, go to the name of the command, or function,"
" or variable,\n"
(substitute-command-keys
"and type \\[apropos-follow] to get full documentation.\n\n"))
(or (not spacing) (bobp) (terpri))
(setq apropos-item (car p)
symbol (car apropos-item)
- p (cdr p)
- point1 (point))
- (princ symbol) ; print symbol name
- (setq point2 (point))
+ p (cdr p))
+ (insert-text-button (symbol-name symbol)
+ 'type 'apropos-symbol
+ ;; Can't use default, since user may have
+ ;; changed the variable!
+ ;; Just say `no' to variables containing faces!
+ 'face apropos-symbol-face)
;; Calculate key-bindings if we want them.
(and do-keys
(commandp symbol)
(put-text-property (- (point) 3) (point)
'face apropos-keybinding-face)))
(terpri)
- ;; only now so we don't propagate text attributes all over
- (put-text-property point1 point2 'item
- (if (eval `(or ,@(cdr apropos-item)))
- (car apropos-item)
- apropos-item))
- (if apropos-symbol-face
- (put-text-property point1 point2 'face apropos-symbol-face))
- (apropos-print-doc 'describe-function 1
+ (apropos-print-doc 1
(if (commandp symbol)
- "Command"
+ 'apropos-command
(if (apropos-macrop symbol)
- "Macro"
- "Function"))
+ 'apropos-macro
+ 'apropos-function))
t)
- ;; We used to use `customize-variable-other-window' instead
- ;; for a customizable variable, but that is slow.
- ;; It is better to show an ordinary help buffer
- ;; and let the user click on the customization button
- ;; in that buffer, if he wants to.
- ;; Likewise for `customize-face-other-window'.
- (apropos-print-doc 'describe-variable 2 "Variable" t)
- (apropos-print-doc 'customize-group-other-window 6 "Group" t)
- (apropos-print-doc 'describe-face 5 "Face" t)
- (apropos-print-doc 'widget-browse-other-window 4 "Widget" t)
- (apropos-print-doc 'apropos-describe-plist 3
- "Plist" nil))
+ (apropos-print-doc 2 'apropos-variable t)
+ (apropos-print-doc 6 'apropos-group t)
+ (apropos-print-doc 5 'apropos-face t)
+ (apropos-print-doc 4 'apropos-widget t)
+ (apropos-print-doc 3 'apropos-plist nil))
(setq buffer-read-only t))))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
'(macro t))))))
-(defun apropos-print-doc (action i str do-keys)
+(defun apropos-print-doc (i type do-keys)
(if (stringp (setq i (nth i apropos-item)))
(progn
(insert " ")
- (put-text-property (- (point) 2) (1- (point))
- 'action action)
- (insert str ": ")
- (if apropos-label-properties
- (add-text-properties (- (point) (length str) 2)
- (1- (point))
- apropos-label-properties))
+ (insert-text-button (button-type-get type 'apropos-label)
+ 'type type
+ ;; Can't use the default button face, since
+ ;; user may have changed the variable!
+ ;; Just say `no' to variables containing faces!
+ 'face apropos-label-face
+ 'apropos-symbol (car apropos-item))
+ (insert ": ")
(insert (if do-keys (substitute-command-keys i) i))
(or (bolp) (terpri)))))
-(defun apropos-mouse-follow (event)
- (interactive "e")
- (let ((other (if (eq (current-buffer) (get-buffer "*Apropos*"))
- ()
- (current-buffer))))
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-start event))))
- (goto-char (posn-point (event-start event)))
- (or (and (not (eobp)) (get-text-property (point) 'mouse-face))
- (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (error "There is nothing to follow here"))
- (apropos-follow other))))
-
-
-(defun apropos-follow (&optional other)
+(defun apropos-follow ()
+ "Invokes any button at point, otherwise invokes the nearest label button."
(interactive)
- (let* (;; Properties are always found at the beginning of the line.
- (bol (save-excursion (beginning-of-line) (point)))
- ;; If there is no `item' property here, look behind us.
- (item (get-text-property bol 'item))
- (item-at (if item nil (previous-single-property-change bol 'item)))
- ;; Likewise, if there is no `action' property here, look in front.
- (action (get-text-property bol 'action))
- (action-at (if action nil (next-single-property-change bol 'action))))
- (and (null item) item-at
- (setq item (get-text-property (1- item-at) 'item)))
- (and (null action) action-at
- (setq action (get-text-property action-at 'action)))
- (if (not (and item action))
- (error "There is nothing to follow here"))
- (if (consp item) (error "There is nothing to follow in `%s'" (car item)))
- (if other (set-buffer other))
- (funcall action item)))
-
+ (button-activate
+ (or (apropos-next-label-button (line-beginning-position))
+ (error "There is nothing to follow here"))))
(defun apropos-describe-plist (symbol)
(princ ")")
(print-help-return-message)))
+
(provide 'apropos)
;;; apropos.el ends here
HCoop / bpt / emacs.git / blobdiff