;;; apropos.el --- apropos commands for users and programmers
-;; Copyright (C) 1989, 1994-1995, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1989, 1994-1995, 2001-2016 Free Software Foundation,
;; Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
(defface apropos-property
'((t (:inherit font-lock-builtin-face)))
- "Face for property name in apropos output, or nil for none."
+ "Face for property name in Apropos output, or nil for none."
:group 'apropos
:version "24.3")
"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."
+ :type '(choice (const nil) face)
:group 'apropos
:version "24.3")
"Regexp used in current apropos run.")
(defvar apropos-all-words-regexp nil
- "Regexp matching apropos-all-words.")
+ "Regexp matching `apropos-all-words'.")
(defvar apropos-files-scanned ()
"List of elc files already scanned in current run of `apropos-documentation'.")
\f
(defun apropos-words-to-regexp (words wild)
- "Make regexp matching any two of the words in WORDS."
- (concat "\\("
- (mapconcat 'identity words "\\|")
- "\\)"
- (if (cdr words)
- (concat wild
- "\\("
- (mapconcat 'identity words "\\|")
- "\\)")
- "")))
+ "Make regexp matching any two of the words in WORDS.
+WILD should be a subexpression matching wildcards between matches."
+ (setq words (delete-dups (copy-sequence words)))
+ (if (null (cdr words))
+ (car words)
+ (mapconcat
+ (lambda (w)
+ (concat "\\(?:" w "\\)" ;; parens for synonyms
+ wild "\\(?:"
+ (mapconcat 'identity
+ (delq w (copy-sequence words))
+ "\\|")
+ "\\)"))
+ words
+ "\\|")))
;;;###autoload
(defun apropos-read-pattern (subject)
(read-string (concat "Search for " subject " (word list or regexp): "))))
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
- (split-string pattern "[ \t]+" t)
+ (or (split-string pattern "[ \t]+" t)
+ (user-error "No word list given"))
pattern)))
(defun apropos-parse-pattern (pattern)
apropos-pattern pattern
apropos-regexp pattern)))
-
(defun apropos-calc-scores (str words)
"Return apropos scores for string STR matching WORDS.
Value is a list of offsets of the words into the string."
(defun apropos-true-hit (str words)
"Return t if STR is a genuine hit.
This may fail if only one of the keywords is matched more than once.
-This requires that at least 2 keywords (unless only one was given)."
+This requires at least two keywords (unless only one was given)."
(or (not str)
(not words)
(not (cdr words))
;;;###autoload
(defun apropos-variable (pattern &optional do-not-all)
"Show variables that match PATTERN.
-When DO-NOT-ALL is not-nil, show user options only, i.e. behave
-like `apropos-user-option'."
+With the optional argument DO-NOT-ALL non-nil (or when called
+interactively with the prefix \\[universal-argument]), show user
+options only, i.e. behave like `apropos-user-option'."
(interactive (list (apropos-read-pattern
(if current-prefix-arg "user option" "variable"))
current-prefix-arg))
;; (autoload (push (cdr x) autoloads))
(`require (push (cdr x) requires))
(`provide (push (cdr x) provides))
+ (`t nil) ; Skip "was an autoload" entries.
+ ;; FIXME: Print information about each individual method: both
+ ;; its docstring and specializers (bug#21422).
+ (`cl-defmethod (push (cadr 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
(concat
- (format "Library `%s' provides: %s\nand requires: %s"
+ (format-message
+ "Library `%s' provides: %s\nand requires: %s"
file
(mapconcat 'apropos-library-button
(or provides '(nil)) " and ")
(setq doc (list (car properties)))
(while (setq properties (cdr (cdr properties)))
(setq doc (cons (car properties) doc)))
- (mapconcat #'symbol-name (nreverse doc) " "))
+ (mapconcat (lambda (p) (format "%s" p)) (nreverse doc) " "))
(when (get symbol 'widget-type)
(apropos-documentation-property
symbol 'widget-documentation t))
(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)
+ (format-message
+ "%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)")
(lambda (symbol)
(setq f (apropos-safe-documentation symbol)
v (get symbol 'variable-documentation))
- (if (integerp v) (setq v))
+ (if (integerp v) (setq v nil))
(setq f (apropos-documentation-internal f)
v (apropos-documentation-internal v))
(setq sf (apropos-score-doc f)
symbol)))))
(defun apropos-documentation-internal (doc)
- (if (consp doc)
- (apropos-documentation-check-elc-file (car doc))
- (if (and doc
- (string-match apropos-all-words-regexp doc)
- (apropos-true-hit-doc doc))
- (when apropos-match-face
- (setq doc (substitute-command-keys (copy-sequence doc)))
- (if (or (string-match apropos-pattern-quoted doc)
- (string-match apropos-all-words-regexp doc))
- (put-text-property (match-beginning 0)
- (match-end 0)
- 'face apropos-match-face doc))
- doc))))
+ (cond
+ ((consp doc)
+ (apropos-documentation-check-elc-file (car doc)))
+ ((and doc
+ ;; Sanity check in case bad data sneaked into the
+ ;; documentation slot.
+ (stringp doc)
+ (string-match apropos-all-words-regexp doc)
+ (apropos-true-hit-doc doc))
+ (when apropos-match-face
+ (setq doc (substitute-command-keys (copy-sequence doc)))
+ (if (or (string-match apropos-pattern-quoted doc)
+ (string-match apropos-all-words-regexp doc))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face apropos-match-face doc))
+ doc))))
(defun apropos-format-plist (pl sep &optional compare)
(setq pl (symbol-plist pl))
"Like `documentation', except it avoids calling `get_doc_string'.
Will return nil instead."
(while (and function (symbolp function))
- (setq function (if (fboundp function)
- (symbol-function function))))
+ (setq function (symbol-function function)))
(if (eq (car-safe function) 'macro)
(setq function (cdr function)))
(setq function (if (byte-code-function-p function)
The return value is the list that was in `apropos-accumulator', sorted
alphabetically by symbol name; but this function also sets
`apropos-accumulator' to nil before returning.
-
-If SPACING is non-nil, it should be a string; separate items with that string.
-If non-nil TEXT is a string that will be printed as a heading."
+If DO-KEYS is non-nil, output the key bindings. If NOSUBST is
+nil, substitute \"ASCII quotes\" (i.e., grace accent and
+apostrophe) with curly quotes), and if non-nil, leave them alone.
+If SPACING is non-nil, it should be a string; separate items with
+that string. If non-nil, TEXT is a string that will be printed
+as a heading."
(if (null apropos-accumulator)
(message "No apropos matches for `%s'" apropos-pattern)
(setq apropos-accumulator
(sort apropos-accumulator
(lambda (a b)
- ;; Don't sort by score if user can't see the score.
- ;; It would be confusing. -- rms.
(if apropos-sort-by-scores
(or (> (cadr a) (cadr b))
(and (= (cadr a) (cadr b))
(let ((p apropos-accumulator)
(old-buffer (current-buffer))
(inhibit-read-only t)
+ (button-end 0)
symbol item)
(set-buffer standard-output)
(apropos-mode)
(setq apropos-item
(cons (car apropos-item)
(cons nil (cdr apropos-item)))))
+ (when (= (point) button-end) (terpri))
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
'skip apropos-multi-type
'face 'apropos-symbol)
+ (setq button-end (point))
(if (and (eq apropos-sort-by-scores 'verbose)
(cadr apropos-item))
(insert " (" (number-to-string (cadr apropos-item)) ") "))
(apropos-print-doc 2
(if (commandp symbol)
'apropos-command
- (if (apropos-macrop symbol)
+ (if (macrop symbol)
'apropos-macro
'apropos-function))
(not nosubst))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
-(defun apropos-macrop (symbol)
- "Return t if SYMBOL is a Lisp macro."
- (and (fboundp symbol)
- (consp (setq symbol
- (symbol-function symbol)))
- (or (eq (car symbol) 'macro)
- (if (autoloadp symbol)
- (memq (nth 4 symbol)
- '(macro t))))))
-
-
(defun apropos-print-doc (i type do-keys)
(let ((doc (nth i apropos-item)))
(when (stringp doc)
(set-buffer standard-output)
(princ "Symbol ")
(prin1 symbol)
- (princ "'s plist is\n (")
+ (princ (substitute-command-keys "'s plist is\n ("))
(put-text-property (+ (point-min) 7) (- (point) 14)
'face 'apropos-symbol)
(insert (apropos-format-plist symbol "\n "))