mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-17 10:27:41 +00:00
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).
This commit is contained in:
Chong Yidong
parent
224a3131ee
commit
4ef177aa26
2 changed files with 89 additions and 46 deletions
|
|
@ -1,3 +1,15 @@
|
|||
2011-04-24 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* 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 <lekktu@gmail.com>
|
||||
|
||||
* buff-menu.el (Buffer-menu--buffers): Fix typo in docstring (bug#8535).
|
||||
|
|
|
|||
123
lisp/apropos.el
123
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."
|
||||
|
|
|
|||
Loading…
Reference in a new issue