[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103981: Improve apropos buffer highl
From: |
Chong Yidong |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103981: Improve apropos buffer highlighting. |
Date: |
Sat, 23 Apr 2011 20:15:26 -0400 |
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 103981
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2011-04-23 20:15:26 -0400
message:
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).
modified:
lisp/ChangeLog
lisp/apropos.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-04-23 03:07:16 +0000
+++ b/lisp/ChangeLog 2011-04-24 00:15:26 +0000
@@ -1,3 +1,15 @@
+2011-04-24 Chong Yidong <address@hidden>
+
+ * 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 <address@hidden>
* buff-menu.el (Buffer-menu--buffers): Fix typo in docstring (bug#8535).
=== modified file 'lisp/apropos.el'
--- a/lisp/apropos.el 2011-04-19 13:44:55 +0000
+++ b/lisp/apropos.el 2011-04-24 00:15:26 +0000
@@ -83,7 +83,7 @@
: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 @@
"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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
"(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 @@
(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 @@
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 @@
(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."
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103981: Improve apropos buffer highlighting.,
Chong Yidong <=