X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e61d39cddfd015032a6419ce75c36ecdf1e9fe9f..c7510f6e94a232aae19e07b7203ac068ef00773c:/lisp/apropos.el diff --git a/lisp/apropos.el b/lisp/apropos.el index 88d5602a02..2cba65e955 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -1,6 +1,7 @@ ;;; apropos.el --- apropos commands for users and programmers -;; Copyright (C) 1989, 1994-1995, 2001-2012 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1994-1995, 2001-2014 Free Software Foundation, +;; Inc. ;; Author: Joe Wells ;; Daniel Pfeiffer (rewrite) @@ -68,7 +69,7 @@ "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-user-option' will search all variables, not just user options. `apropos-command' will also search non-interactive functions. `apropos' will search all symbols, not just functions, variables, faces, and those with property lists. @@ -98,7 +99,7 @@ include key-binding information in its output." (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") @@ -114,6 +115,12 @@ include key-binding information in its output." :group 'apropos :version "24.3") +(defface apropos-user-option-button + '((t (:inherit (font-lock-variable-name-face button)))) + "Button face indicating a user option in Apropos." + :group 'apropos + :version "24.4") + (defface apropos-misc-button '((t (:inherit (font-lock-constant-face button)))) "Button face indicating a miscellaneous object type in Apropos." @@ -124,6 +131,7 @@ include key-binding information in its output." "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") @@ -174,7 +182,7 @@ If value is `verbose', the computed score is shown for each match." "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'.") @@ -260,6 +268,15 @@ term, and the rest of the words are alternative terms.") 'action (lambda (button) (describe-variable (button-get button 'apropos-symbol)))) +(define-button-type 'apropos-user-option + 'apropos-label "User option" + 'apropos-short-label "o" + 'face 'apropos-user-option-button + 'help-echo "mouse-2, RET: Display more help on this user option" + 'follow-link t + 'action (lambda (button) + (describe-variable (button-get button 'apropos-symbol)))) + (define-button-type 'apropos-face 'apropos-label "Face" 'apropos-short-label "F" @@ -325,16 +342,21 @@ before finding a label." (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) @@ -348,7 +370,8 @@ kind of objects to search." (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) @@ -388,7 +411,6 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted', 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." @@ -432,7 +454,7 @@ 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)) @@ -460,15 +482,15 @@ This requires that at least 2 keywords (unless only one was given)." 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. +(defun apropos-user-option (pattern &optional do-all) + "Show user options that match PATTERN. PATTERN can be a word, a list of words (separated by spaces), or a regexp (using some regexp special characters). If it is a word, 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 show -normal variables." +variables, not just user options." (interactive (list (apropos-read-pattern (if (or current-prefix-arg apropos-do-all) "variable" "user option")) @@ -480,6 +502,17 @@ normal variables." (get symbol 'variable-documentation))) 'custom-variable-p))) +;;;###autoload +(defun apropos-variable (pattern &optional do-not-all) + "Show variables that match PATTERN. +When DO-NOT-ALL is non-nil, 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)) + (let ((apropos-do-all (if do-not-all nil t))) + (apropos-user-option pattern))) + ;; For auld lang syne: ;;;###autoload (defalias 'command-apropos 'apropos-command) @@ -973,8 +1006,7 @@ Returns list of symbols and documentation found." "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) @@ -1005,14 +1037,12 @@ 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 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)) @@ -1022,6 +1052,7 @@ If non-nil TEXT is a string that will be printed as a heading." (let ((p apropos-accumulator) (old-buffer (current-buffer)) (inhibit-read-only t) + (button-end 0) symbol item) (set-buffer standard-output) (apropos-mode) @@ -1039,10 +1070,12 @@ If non-nil TEXT is a string that will be printed as a heading." (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)) ") ")) @@ -1094,11 +1127,15 @@ If non-nil TEXT is a string that will be printed as a heading." (apropos-print-doc 2 (if (commandp symbol) 'apropos-command - (if (apropos-macrop symbol) + (if (macrop symbol) 'apropos-macro 'apropos-function)) (not nosubst)) - (apropos-print-doc 3 'apropos-variable (not nosubst)) + (apropos-print-doc 3 + (if (custom-variable-p symbol) + 'apropos-user-option + 'apropos-variable) + (not nosubst)) (apropos-print-doc 7 'apropos-group t) (apropos-print-doc 6 'apropos-face t) (apropos-print-doc 5 'apropos-widget t) @@ -1108,17 +1145,6 @@ If non-nil TEXT is a string that will be printed as a heading." (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)