From 4ef177aa26537bdbbe9d60cc87b973435390c271 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 23 Apr 2011 20:15:26 -0400 Subject: [PATCH] Improve apropos buffer highlighting. * lisp/apropos.el (apropos-label-face): Avoid variable-pitch face. (apropos-accumulator): Doc fix. (apropos-function, apropos-macro, apropos-command) (apropos-variable, apropos-face, apropos-group, apropos-widget) (apropos-plist): Add face property. (apropos-symbols-internal): Fix indentation. (apropos-print): Simplify help, and recognize apropos-multi-type. (apropos-print-doc): Use button-type-get to extract the button's face property. Fill docstring (Bug#8352). --- lisp/ChangeLog | 12 +++++ lisp/apropos.el | 123 ++++++++++++++++++++++++++++++------------------ 2 files changed, 89 insertions(+), 46 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index af58ef47b28..4b8389877a2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-04-24 Chong Yidong + + * apropos.el (apropos-label-face): Avoid variable-pitch face. + (apropos-accumulator): Doc fix. + (apropos-function, apropos-macro, apropos-command) + (apropos-variable, apropos-face, apropos-group, apropos-widget) + (apropos-plist): Add face property. + (apropos-symbols-internal): Fix indentation. + (apropos-print): Simplify help, and recognize apropos-multi-type. + (apropos-print-doc): Use button-type-get to extract the button's + face property. Fill docstring (Bug#8352). + 2011-04-23 Juanma Barranquero * buff-menu.el (Buffer-menu--buffers): Fix typo in docstring (bug#8535). diff --git a/lisp/apropos.el b/lisp/apropos.el index 35a3ac3c09a..f1baee8dafe 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -83,7 +83,7 @@ Slows them down more or less. Set this non-nil if you have a fast machine." :group 'apropos :type 'face) -(defcustom apropos-label-face '(italic variable-pitch) +(defcustom apropos-label-face '(italic) "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." @@ -155,7 +155,17 @@ If value is `verbose', the computed score is shown for each match." "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'.") @@ -187,6 +197,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-function 'apropos-label "Function" 'apropos-short-label "f" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this function" 'follow-link t 'action (lambda (button) @@ -195,6 +206,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-macro 'apropos-label "Macro" 'apropos-short-label "m" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this macro" 'follow-link t 'action (lambda (button) @@ -203,6 +215,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-command 'apropos-label "Command" 'apropos-short-label "c" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this command" 'follow-link t 'action (lambda (button) @@ -216,6 +229,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-variable 'apropos-label "Variable" 'apropos-short-label "v" + 'face '(font-lock-variable-name-face button) 'help-echo "mouse-2, RET: Display more help on this variable" 'follow-link t 'action (lambda (button) @@ -224,6 +238,7 @@ term, and the rest of the words are alternative terms.") (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) @@ -232,6 +247,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-group 'apropos-label "Group" 'apropos-short-label "g" + 'face '(font-lock-builtin-face button) 'help-echo "mouse-2, RET: Display more help on this group" 'follow-link t 'action (lambda (button) @@ -241,14 +257,16 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-widget 'apropos-label "Widget" 'apropos-short-label "w" + 'face '(font-lock-builtin-face 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 '(font-lock-keyword-face button) 'help-echo "mouse-2, RET: Display more help on this plist" 'follow-link t 'action (lambda (button) @@ -636,15 +654,15 @@ thus be found in `load-history'." "(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)) + 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) (let ((alias (get symbol 'face-alias))) (if alias @@ -660,8 +678,8 @@ thus be found in `load-history'." (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))) @@ -976,15 +994,9 @@ If non-nil TEXT is a string that will be printed as a heading." 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" - "or press return 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))) @@ -1082,30 +1094,49 @@ If non-nil TEXT is a string that will be printed as a heading." (defun apropos-print-doc (i type do-keys) - (when (stringp (setq i (nth i apropos-item))) - (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 + (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 + ;; Can't use the default button face, since user may have changed the + ;; variable! Just say `no' to variables containing faces! + 'face (append button-face apropos-label-face) + '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)) - (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)))) + '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 emacs-lisp-docstring-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." -- 2.39.2