;;; 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.
+;; Copyright (C) 1989, 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
-;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org>
+;; Daniel Pfeiffer <occitan@esperanto.org> (rewrite)
;; Keywords: help
+;; Package: emacs
;; This file is part of GNU Emacs.
;; Fixed bug, current-local-map can return nil.
;; Change, doesn't calculate key-bindings unless needed.
;; Added super-apropos capability, changed print functions.
-;;; Made fast-apropos and super-apropos share code.
-;;; Sped up fast-apropos again.
+;; Made fast-apropos and super-apropos share code.
+;; Sped up fast-apropos again.
;; Added apropos-do-all option.
-;;; Added fast-command-apropos.
+;; Added fast-command-apropos.
;; Changed doc strings to comments for helping functions.
-;;; Made doc file buffer read-only, buried it.
+;; Made doc file buffer read-only, buried it.
;; Only call substitute-command-keys if do-all set.
;; Optionally use configurable faces to make the output more legible.
;;; Code:
(require 'button)
-(eval-when-compile (require 'cl))
(defgroup apropos nil
"Apropos commands for users and programmers."
;; I see a degradation of maybe 10-20% only.
(defcustom apropos-do-all nil
- "Whether the apropos commands should do more.
-
-Slows them down more or less. Set this non-nil if you have a fast machine."
+ "Non nil means apropos commands will search more extensively.
+This may be slower. This option affects the following commands:
+
+`apropos-variable' will search all variables, not just user variables.
+`apropos-command' will also search non-interactive functions.
+`apropos' will search all symbols, not just functions, variables, faces,
+and those with property lists.
+`apropos-value' will also search in property lists and functions.
+`apropos-documentation' will search all documentation strings, not just
+those in the etc/DOC documentation file.
+
+This option only controls the default behavior. Each of the above
+commands also has an optional argument to request a more extensive search.
+
+Additionally, this option makes the function `apropos-library'
+include key-binding information in its output."
:group 'apropos
:type 'boolean)
+(defface apropos-symbol
+ '((t (:inherit bold)))
+ "Face for the symbol name in Apropos output."
+ :group 'apropos
+ :version "24.3")
-(defcustom apropos-symbol-face 'bold
- "Face for symbol name in Apropos output, or nil for none."
+(defface apropos-keybinding
+ '((t (:inherit underline)))
+ "Face for lists of keybinding in Apropos output."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-keybinding-face 'underline
- "Face for lists of keybinding in Apropos output, or nil for none."
+(defface apropos-property
+ '((t (:inherit font-lock-builtin-face)))
+ "Face for property name in apropos output, or nil for none."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-label-face '(italic variable-pitch)
- "Face for label (`Command', `Variable' ...) in Apropos output.
-A value of nil means don't use any special font for them, and also
-turns off mouse highlighting."
+(defface apropos-function-button
+ '((t (:inherit (font-lock-function-name-face button))))
+ "Button face indicating a function, macro, or command in Apropos."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-property-face 'bold-italic
- "Face for property name in apropos output, or nil for none."
+(defface apropos-variable-button
+ '((t (:inherit (font-lock-variable-name-face button))))
+ "Button face indicating a variable in Apropos."
:group 'apropos
- :type 'face)
+ :version "24.3")
+
+(defface apropos-misc-button
+ '((t (:inherit (font-lock-constant-face button))))
+ "Button face indicating a miscellaneous object type in Apropos."
+ :group 'apropos
+ :version "24.3")
(defcustom apropos-match-face 'match
"Face for matching text in Apropos documentation/value, or nil for none.
This applies when you look for matches in the documentation or variable value
for the pattern; the part that matches gets displayed in this font."
:group 'apropos
- :type 'face)
+ :version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
(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
(const :tag "show scores" verbose)))
(defvar apropos-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map button-buffer-map)
+ (let ((map (copy-keymap button-buffer-map)))
+ (set-keymap-parent map special-mode-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)
map)
"Keymap used in Apropos mode.")
"List of elc files already scanned in current run of `apropos-documentation'.")
(defvar apropos-accumulator ()
- "Alist of symbols already found in current apropos run.")
+ "Alist of symbols already found in current apropos run.
+Each element has the form
+
+ (SYMBOL SCORE FUN-DOC VAR-DOC PLIST WIDGET-DOC FACE-DOC CUS-GROUP-DOC)
+
+where SYMBOL is the symbol name, SCORE is its relevance score (a
+number), FUN-DOC is the function docstring, VAR-DOC is the
+variable docstring, PLIST is the list of the symbols names in the
+property list, WIDGET-DOC is the widget docstring, FACE-DOC is
+the face docstring, and CUS-GROUP-DOC is the custom group
+docstring. Each docstring is either nil or a string.")
(defvar apropos-item ()
"Current item in or for `apropos-accumulator'.")
;;; Button types used by apropos
(define-button-type 'apropos-symbol
- 'face apropos-symbol-face
+ 'face 'apropos-symbol
'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"
+ 'face 'apropos-function-button
'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"
+ 'face 'apropos-function-button
'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"
+ 'face 'apropos-function-button
'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"
+ 'face 'apropos-variable-button
'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"
+ 'face '(font-lock-variable-name-face button)
'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"
+ 'face 'apropos-misc-button
'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"
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this widget"
'follow-link t
'action (lambda (button)
(widget-browse-other-window (button-get button 'apropos-symbol))))
(define-button-type 'apropos-plist
- 'apropos-label "Plist"
+ 'apropos-label "Properties"
+ 'apropos-short-label "p"
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this plist"
'follow-link t
'action (lambda (button)
SUBJECT is a string that is included in the prompt to identify what
kind of objects to search."
(let ((pattern
- (read-string (concat "Apropos " subject " (word list or regexp): "))))
+ (read-string (concat "Search for " subject " (word list or regexp): "))))
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
- (split-string pattern "[ \t]+")
+ (split-string pattern "[ \t]+" t)
pattern)))
(defun apropos-parse-pattern (pattern)
"Return apropos score for documentation string DOC."
(let ((l (length doc)))
(if (> l 0)
- (let ((score 0) i)
- (when (setq i (string-match apropos-pattern-quoted doc))
+ (let ((score 0))
+ (when (string-match apropos-pattern-quoted doc)
(setq score 10000))
(dolist (s (apropos-calc-scores doc apropos-all-words) score)
(setq score (+ score 50 (/ (* (- l s) 50) l)))))
"Return t if DOC is really matched by the current keywords."
(apropos-true-hit doc apropos-all-words))
-(define-derived-mode apropos-mode fundamental-mode "Apropos"
+(define-derived-mode apropos-mode special-mode "Apropos"
"Major mode for following hyperlinks in output of apropos commands.
\\{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.
#'(lambda (symbol)
(and (boundp symbol)
(get symbol 'variable-documentation)))
- 'user-variable-p)))
+ 'custom-variable-p)))
;; For auld lang syne:
;;;###autoload
(apropos-parse-pattern pattern)
(let ((message
(let ((standard-output (get-buffer-create "*Apropos*")))
- (print-help-return-message 'identity))))
+ (help-print-return-message 'identity))))
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator
(apropos-internal apropos-regexp
(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))))
(let ((name (copy-sequence (symbol-name sym))))
(make-text-button name nil
'type 'apropos-library
- 'face apropos-symbol-face
+ 'face 'apropos-symbol
'apropos-symbol name)
name)))
(defun apropos-library (file)
"List the variables and functions defined by library FILE.
FILE should be one of the libraries currently loaded and should
-thus be found in `load-history'."
+thus be found in `load-history'. If `apropos-do-all' is non-nil,
+the output includes key-bindings of commands."
(interactive
- (let ((libs
- (nconc (delq nil
- (mapcar
- (lambda (l)
- (setq l (file-name-nondirectory l))
- (while
- (not (equal (setq l (file-name-sans-extension l))
- l)))
- l)
- (mapcar 'car load-history)))
- (mapcar 'car load-history))))
+ (let* ((libs (delq nil (mapcar 'car load-history)))
+ (libs
+ (nconc (delq nil
+ (mapcar
+ (lambda (l)
+ (setq l (file-name-nondirectory l))
+ (while
+ (not (equal (setq l (file-name-sans-extension l))
+ l)))
+ l)
+ libs))
+ libs)))
(list (completing-read "Describe library: " libs nil t))))
(let ((symbols nil)
;; (autoloads nil)
(re (concat "\\(?:\\`\\|[\\/]\\)" (regexp-quote file)
"\\(\\.\\|\\'\\)")))
(while (and lh (null lh-entry))
- (if (string-match re (caar lh))
+ (if (and (caar lh) (string-match re (caar lh)))
(setq lh-entry (car lh))
(setq lh (cdr lh)))))
(unless lh-entry (error "Unknown library `%s'" file)))
(dolist (x (cdr lh-entry))
- (case (car-safe x)
+ (pcase (car-safe x)
;; (autoload (push (cdr x) autoloads))
- (require (push (cdr x) requires))
- (provide (push (cdr x) provides))
- (t (push (or (cdr-safe x) x) symbols))))
+ (`require (push (cdr x) requires))
+ (`provide (push (cdr x) provides))
+ (_ (push (or (cdr-safe x) x) symbols))))
(let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
(apropos-symbols-internal
symbols apropos-do-all
"(not documented)"))
(when (boundp symbol)
(apropos-documentation-property
- symbol 'variable-documentation t))
- (when (setq properties (symbol-plist symbol))
- (setq doc (list (car properties)))
- (while (setq properties (cdr (cdr properties)))
- (setq doc (cons (car properties) doc)))
- (mapconcat #'symbol-name (nreverse doc) " "))
- (when (get symbol 'widget-type)
- (apropos-documentation-property
- symbol 'widget-documentation t))
- (when (facep symbol)
+ symbol 'variable-documentation t))
+ (when (setq properties (symbol-plist symbol))
+ (setq doc (list (car properties)))
+ (while (setq properties (cdr (cdr properties)))
+ (setq doc (cons (car properties) doc)))
+ (mapconcat #'symbol-name (nreverse doc) " "))
+ (when (get symbol 'widget-type)
(apropos-documentation-property
- symbol 'face-documentation t))
+ symbol 'widget-documentation t))
+ (when (facep symbol)
+ (let ((alias (get symbol 'face-alias)))
+ (if alias
+ (if (facep alias)
+ (format "%slias for the face `%s'."
+ (if (get symbol 'obsolete-face)
+ "Obsolete a"
+ "A")
+ alias)
+ ;; Never happens in practice because fails
+ ;; (facep symbol) test.
+ "(alias for undefined face)")
+ (apropos-documentation-property
+ symbol 'face-documentation t))))
(when (get symbol 'custom-group)
- (apropos-documentation-property
- symbol 'group-documentation t)))))
+ (apropos-documentation-property
+ symbol 'group-documentation t)))))
symbols)))
(apropos-print keys nil text)))
search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also looks
-at the function and at the names and values of properties.
+at function definitions (arguments, documentation and body) and at the
+names and values of properties.
+
Returns list of symbols and values found."
(interactive (list (apropos-read-pattern "value")
current-prefix-arg))
(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
search for matches for that word as a substring. If it is a list of words,
search for matches for any two (or more) of those words.
-With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also use
-documentation that is not stored in the documentation file and show key
-bindings.
+Note that by default this command only searches in the file specified by
+`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument] prefix,
+or if `apropos-do-all' is non-nil, it searches all currently defined
+documentation strings.
+
Returns list of symbols and documentation found."
+ ;; The doc used to say that DO-ALL includes key-bindings info in the
+ ;; output, but I cannot see that that is true.
(interactive (list (apropos-read-pattern "documentation")
current-prefix-arg))
(apropos-parse-pattern pattern)
(apropos-sort-by-scores apropos-documentation-sort-by-scores)
f v sf sv)
(unwind-protect
- (save-excursion
- (set-buffer standard-input)
+ (with-current-buffer standard-input
(apropos-documentation-check-doc-file)
(if do-all
(mapatoms
(while pl
(setq p (format "%s %S" (car pl) (nth 1 pl)))
(if (or (not compare) (string-match apropos-regexp p))
- (if apropos-property-face
- (put-text-property 0 (length (symbol-name (car pl)))
- 'face apropos-property-face p))
+ (put-text-property 0 (length (symbol-name (car pl)))
+ 'face 'apropos-property p)
(setq p nil))
(if p
(progn
;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name.
(defun apropos-documentation-check-doc-file ()
- (let (type symbol (sepa 2) sepb)
+ (let (type symbol (sepa 2) sepb doc)
(insert ?\^_)
(backward-char)
(insert-file-contents (concat doc-directory internal-doc-file-name))
3) ; variable documentation
symbol (read)
doc (buffer-substring (1+ (point)) (1- sepb)))
- (when (apropos-true-hit-doc doc)
+ (when (and (apropos-true-hit-doc doc)
+ ;; The DOC file lists all built-in funcs and vars.
+ ;; If any are not currently bound, they can
+ ;; only be platform-specific stuff (eg NS) not
+ ;; in use on the current platform.
+ ;; So we exclude them.
+ (cond ((= 3 type) (boundp symbol))
+ ((= 2 type) (fboundp symbol))))
(or (and (setq apropos-item (assq symbol apropos-accumulator))
(setcar (cdr apropos-item)
(apropos-score-doc doc)))
(setq function (if (byte-code-function-p function)
(if (> (length function) 4)
(aref function 4))
- (if (eq (car-safe function) 'autoload)
+ (if (autoloadp function)
(nth 2 function)
(if (eq (car-safe function) 'lambda)
(if (stringp (nth 2 function))
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*'.
(with-output-to-temp-buffer "*Apropos*"
(let ((p apropos-accumulator)
(old-buffer (current-buffer))
+ (inhibit-read-only t)
symbol item)
(set-buffer standard-output)
(apropos-mode)
- (if (display-mouse-p)
- (insert
- "If moving the mouse over text changes the text's color, "
- "you can click\n"
- "mouse-2 (second button from right) 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"))
+ (insert (substitute-command-keys "Type \\[apropos-follow] on ")
+ (if apropos-multi-type "a type label" "an entry")
+ " to view its full documentation.\n\n")
(if text (insert text "\n\n"))
(dolist (apropos-item p)
(when (and spacing (not (bobp)))
(cons nil (cdr apropos-item)))))
(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)
+ 'skip apropos-multi-type
+ 'face 'apropos-symbol)
(if (and (eq apropos-sort-by-scores 'verbose)
(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 anybody 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)))
+ (put-text-property 0 (length key)
+ 'face 'apropos-keybinding
+ key)
+ key)
+ item ", "))
+ (insert "M-x ... RET")
+ (put-text-property (- (point) 11) (- (point) 8)
+ 'face 'apropos-keybinding)
+ (put-text-property (- (point) 3) (point)
+ 'face 'apropos-keybinding)))
+ (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))
- (setq buffer-read-only t))))
+ (set (make-local-variable 'truncate-partial-width-windows) t)
+ (set (make-local-variable 'truncate-lines) t))))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
(consp (setq symbol
(symbol-function symbol)))
(or (eq (car symbol) 'macro)
- (if (eq (car symbol) 'autoload)
+ (if (autoloadp symbol)
(memq (nth 4 symbol)
'(macro t))))))
(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 ": ")
- (insert (if do-keys (substitute-command-keys i) i))
- (or (bolp) (terpri))))
-
+ (let ((doc (nth i apropos-item)))
+ (when (stringp doc)
+ (if apropos-compact-layout
+ (insert (propertize "\t" 'display '(space :align-to 32)) " ")
+ (insert " "))
+ (if apropos-multi-type
+ (let ((button-face (button-type-get type 'face)))
+ (unless (consp button-face)
+ (setq button-face (list button-face)))
+ (insert-text-button
+ (if apropos-compact-layout
+ (format "<%s>" (button-type-get type 'apropos-short-label))
+ (button-type-get type 'apropos-label))
+ 'type type
+ 'apropos-symbol (car apropos-item))
+ (insert (if apropos-compact-layout " " ": ")))
+
+ ;; 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)))
+
+ (let ((opoint (point))
+ (ocol (current-column)))
+ (cond ((equal doc "")
+ (setq doc "(not documented)"))
+ (do-keys
+ (setq doc (substitute-command-keys doc))))
+ (insert doc)
+ (if (equal doc "(not documented)")
+ (put-text-property opoint (point) 'font-lock-face 'shadow))
+ ;; The labeling buttons might make the line too long, so fill it if
+ ;; necessary.
+ (let ((fill-column (+ 5 (if (integerp emacs-lisp-docstring-fill-column)
+ emacs-lisp-docstring-fill-column
+ fill-column)))
+ (fill-prefix (make-string ocol ?\s)))
+ (fill-region opoint (point) nil t)))
+ (or (bolp) (terpri)))))
(defun apropos-follow ()
"Invokes any button at point, otherwise invokes the nearest label button."
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
- (help-setup-xref (list 'apropos-describe-plist symbol) (interactive-p))
+ (help-setup-xref (list 'apropos-describe-plist symbol)
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(set-buffer standard-output)
(princ "Symbol ")
(prin1 symbol)
(princ "'s plist is\n (")
- (if apropos-symbol-face
- (put-text-property (+ (point-min) 7) (- (point) 14)
- 'face apropos-symbol-face))
+ (put-text-property (+ (point-min) 7) (- (point) 14)
+ 'face 'apropos-symbol)
(insert (apropos-format-plist symbol "\n "))
(princ ")")))
(provide 'apropos)
-;; arch-tag: d56fa2ac-e56b-4ce3-84ff-852f9c0dc66e
;;; apropos.el ends here