;;; apropos.el --- apropos commands for users and programmers
;; Copyright (C) 1989, 1994, 1995, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org>
(const :tag "show scores" verbose)))
(defcustom apropos-documentation-sort-by-scores t
- "*Non-nil means sort matches by scores; best match is shown first.
+ "Non-nil means sort matches by scores; best match is shown first.
This applies to `apropos-documentation' only.
If value is `verbose', the computed score is shown for each match."
:group 'apropos
'face apropos-symbol-face
'help-echo "mouse-2, RET: Display more help on this symbol"
'follow-link t
- 'action #'apropos-symbol-button-display-help
- 'skip t)
+ 'action #'apropos-symbol-button-display-help)
(defun apropos-symbol-button-display-help (button)
"Display further help for the `apropos-symbol' button BUTTON."
(define-button-type 'apropos-function
'apropos-label "Function"
+ 'apropos-short-label "f"
'help-echo "mouse-2, RET: Display more help on this function"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-macro
'apropos-label "Macro"
+ 'apropos-short-label "m"
'help-echo "mouse-2, RET: Display more help on this macro"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-command
'apropos-label "Command"
+ 'apropos-short-label "c"
'help-echo "mouse-2, RET: Display more help on this command"
'follow-link t
'action (lambda (button)
;; Likewise for `customize-face-other-window'.
(define-button-type 'apropos-variable
'apropos-label "Variable"
+ 'apropos-short-label "v"
'help-echo "mouse-2, RET: Display more help on this variable"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-face
'apropos-label "Face"
+ 'apropos-short-label "F"
'help-echo "mouse-2, RET: Display more help on this face"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-group
'apropos-label "Group"
+ 'apropos-short-label "g"
'help-echo "mouse-2, RET: Display more help on this group"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-widget
'apropos-label "Widget"
+ 'apropos-short-label "w"
'help-echo "mouse-2, RET: Display more help on this widget"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-plist
'apropos-label "Plist"
+ 'apropos-short-label "p"
'help-echo "mouse-2, RET: Display more help on this plist"
'follow-link t
'action (lambda (button)
\\{apropos-mode-map}")
+(defvar apropos-multi-type t
+ "If non-nil, this apropos query concerns multiple types.
+This is used to decide whether to print the result's type or not.")
+
;;;###autoload
(defun apropos-variable (pattern &optional do-all)
"Show user variables that match PATTERN.
(setq score (apropos-score-symbol symbol))
(unless var-predicate
(if (fboundp symbol)
- (if (setq doc (documentation symbol t))
- (progn
+ (if (setq doc (condition-case nil
+ (documentation symbol t)
+ (error 'error)))
+ ;; Eg alias to undefined function.
+ (if (eq doc 'error)
+ "(documentation error)"
(setq score (+ score (apropos-score-doc doc)))
(substring doc 0 (string-match "\n" doc)))
"(not documented)")))
(string-match "\n" doc)))))))
(setcar (cdr (car p)) score)
(setq p (cdr p))))
- (and (apropos-print t nil nil t)
+ (and (let ((apropos-multi-type do-all))
+ (apropos-print t nil nil t))
message
(message "%s" message))))
(apropos-score-str p))
f v p)
apropos-accumulator))))))
- (apropos-print nil "\n----------------\n"))
+ (let ((apropos-multi-type do-all))
+ (apropos-print nil "\n----------------\n")))
;;;###autoload
nil
function))
+(defcustom apropos-compact-layout nil
+ "If non-nil, use a single line per binding."
+ :type 'boolean)
(defun apropos-print (do-keys spacing &optional text nosubst)
"Output result of apropos searching into buffer `*Apropos*'.
(cons nil (cdr apropos-item)))))
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
+ 'skip apropos-multi-type
;; Can't use default, since user may have
;; changed the variable!
;; Just say `no' to variables containing faces!
(cadr apropos-item))
(insert " (" (number-to-string (cadr apropos-item)) ") "))
;; Calculate key-bindings if we want them.
- (and do-keys
- (commandp symbol)
- (not (eq symbol 'self-insert-command))
- (indent-to 30 1)
- (if (let ((keys
- (with-current-buffer old-buffer
- (where-is-internal symbol)))
- filtered)
- ;; Copy over the list of key sequences,
- ;; omitting any that contain a buffer or a frame.
- ;; FIXME: Why omit keys that contain buffers and
- ;; frames? This looks like a bad workaround rather
- ;; than a proper fix. Does anybod know what problem
- ;; this is trying to address? --Stef
- (dolist (key keys)
- (let ((i 0)
- loser)
- (while (< i (length key))
- (if (or (framep (aref key i))
- (bufferp (aref key i)))
- (setq loser t))
- (setq i (1+ i)))
- (or loser
- (push key filtered))))
- (setq item filtered))
- ;; Convert the remaining keys to a string and insert.
- (insert
- (mapconcat
- (lambda (key)
- (setq key (condition-case ()
- (key-description key)
- (error)))
- (if apropos-keybinding-face
- (put-text-property 0 (length key)
- 'face apropos-keybinding-face
- key))
- key)
- item ", "))
- (insert "M-x ... RET")
- (when apropos-keybinding-face
- (put-text-property (- (point) 11) (- (point) 8)
- 'face apropos-keybinding-face)
- (put-text-property (- (point) 3) (point)
- 'face apropos-keybinding-face))))
- (terpri)
+ (unless apropos-compact-layout
+ (and do-keys
+ (commandp symbol)
+ (not (eq symbol 'self-insert-command))
+ (indent-to 30 1)
+ (if (let ((keys
+ (with-current-buffer old-buffer
+ (where-is-internal symbol)))
+ filtered)
+ ;; Copy over the list of key sequences,
+ ;; omitting any that contain a buffer or a frame.
+ ;; FIXME: Why omit keys that contain buffers and
+ ;; frames? This looks like a bad workaround rather
+ ;; than a proper fix. Does anybod know what problem
+ ;; this is trying to address? --Stef
+ (dolist (key keys)
+ (let ((i 0)
+ loser)
+ (while (< i (length key))
+ (if (or (framep (aref key i))
+ (bufferp (aref key i)))
+ (setq loser t))
+ (setq i (1+ i)))
+ (or loser
+ (push key filtered))))
+ (setq item filtered))
+ ;; Convert the remaining keys to a string and insert.
+ (insert
+ (mapconcat
+ (lambda (key)
+ (setq key (condition-case ()
+ (key-description key)
+ (error)))
+ (if apropos-keybinding-face
+ (put-text-property 0 (length key)
+ 'face apropos-keybinding-face
+ key))
+ key)
+ item ", "))
+ (insert "M-x ... RET")
+ (when apropos-keybinding-face
+ (put-text-property (- (point) 11) (- (point) 8)
+ 'face apropos-keybinding-face)
+ (put-text-property (- (point) 3) (point)
+ 'face apropos-keybinding-face))))
+ (terpri))
(apropos-print-doc 2
(if (commandp symbol)
'apropos-command
(apropos-print-doc 6 'apropos-face t)
(apropos-print-doc 5 'apropos-widget t)
(apropos-print-doc 4 'apropos-plist nil))
+ (set (make-local-variable 'truncate-partial-width-windows) t)
+ (set (make-local-variable 'truncate-lines) t)
(setq buffer-read-only t))))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
(defun apropos-print-doc (i type do-keys)
(when (stringp (setq i (nth i apropos-item)))
- (insert " ")
- (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 ": ")
+ (if apropos-compact-layout
+ (insert (propertize "\t" 'display '(space :align-to 32)) " ")
+ (insert " "))
+ (if (null apropos-multi-type)
+ ;; If the query is only for a single type, there's no point
+ ;; writing it over and over again. Insert a blank button, and
+ ;; put the 'apropos-label property there (needed by
+ ;; apropos-symbol-button-display-help).
+ (insert-text-button
+ " " 'type type 'skip t
+ 'face 'default 'apropos-symbol (car apropos-item))
+ (insert-text-button
+ (if apropos-compact-layout
+ (format "<%s>" (button-type-get type 'apropos-short-label))
+ (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 (if apropos-compact-layout " " ": ")))
(insert (if do-keys (substitute-command-keys i) i))
(or (bolp) (terpri))))
-
(defun apropos-follow ()
"Invokes any button at point, otherwise invokes the nearest label button."
(interactive)