[Emacs-diffs] master 824fc04: (describe-symbol): Rewrite describe-function-or-variable

[Stefan Monnier]

branch: master
commit 824fc04b660631e7ff976a36b7f70f7c3d5fc181
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    (describe-symbol): Rewrite describe-function-or-variable
    
    * lisp/help-fns.el (describe-symbol-backends): New var.
    (help-xref-stack-item): Declare.
    (describe-symbol): Rename from describe-function-or-variable.
    Rewrite using describe-symbol-backends instead of help-xref-interned.
    * lisp/help.el (help-map): Use it.
    * lisp/help-mode.el (help-symbol, help-follow-symbol): Use it.
    (help-xref-interned): Make it into an obsolete alias.
---
 etc/NEWS          |    2 +
 lisp/help-fns.el  |   73 ++++++++++++++++++++++++++++++++++++++++++----------
 lisp/help-mode.el |   57 ++---------------------------------------
 lisp/help.el      |    2 +-
 4 files changed, 65 insertions(+), 69 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7717fd0..3ef5f82 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -84,6 +84,8 @@ command line when `initial-buffer-choice' is non-nil.
 
 * Changes in Emacs 25.1
 
+** New doc command `describe-symbol'.  Works for functions, vars, faces, etc...
+
 ** `isearch' and `query-replace' now perform character folding in matches.
 This is analogous to case-folding, but applies between Unicode
 characters and their ASCII counterparts. This means many characters
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 9541d47..0a22c5e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -32,6 +32,8 @@
 
 ;;; Code:
 
+(require 'cl-lib)
+
 (defvar help-fns-describe-function-functions nil
   "List of functions to run in help buffer in `describe-function'.
 Those functions will be run after the header line and argument
@@ -968,13 +970,23 @@ file-local variable.\n")
              (buffer-string))))))))
 
 
+(defvar describe-symbol-backends
+  `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
+    ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
+    (nil
+     ,(lambda (symbol)
+        (or (and (boundp symbol) (not (keywordp symbol)))
+            (get symbol 'variable-documentation)))
+     ,#'describe-variable)))
+
+(defvar help-xref-stack-item)
+
 ;;;###autoload
-(defun describe-function-or-variable (symbol &optional buffer frame)
-  "Display the full documentation of the function or variable SYMBOL.
-If SYMBOL is a variable and has a buffer-local value in BUFFER or FRAME
-\(default to the current buffer and current frame), it is displayed along
-with the global value."
+(defun describe-symbol (symbol &optional buffer frame)
+  "Display the full documentation of SYMBOL.
+Will show the info of SYMBOL as a function, variable, and/or face."
   (interactive
+   ;; FIXME: also let the user enter a face name.
    (let* ((v-or-f (variable-at-point))
           (found (symbolp v-or-f))
           (v-or-f (if found v-or-f (function-called-at-point)))
@@ -983,21 +995,54 @@ with the global value."
           val)
      (setq val (completing-read (if found
                                    (format
-                                        "Describe function or variable 
(default %s): " v-or-f)
-                                 "Describe function or variable: ")
+                                        "Describe symbol (default %s): " 
v-or-f)
+                                 "Describe symbol: ")
                                obarray
                                (lambda (vv)
-                                 (or (fboundp vv)
-                                     (get vv 'variable-documentation)
-                                     (and (boundp vv) (not (keywordp vv)))))
+                                  (cl-some (lambda (x) (funcall (nth 1 x) vv))
+                                           describe-symbol-backends))
                                t nil nil
                                (if found (symbol-name v-or-f))))
      (list (if (equal val "")
               v-or-f (intern val)))))
-  (if (not (symbolp symbol)) (message "You didn't specify a function or 
variable")
-    (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
-    (unless (frame-live-p frame) (setq frame (selected-frame)))
-    (help-xref-interned symbol buffer frame)))
+  (if (not (symbolp symbol))
+      (user-error "You didn't specify a function or variable"))
+  (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+  (unless (frame-live-p frame) (setq frame (selected-frame)))
+  (with-current-buffer (help-buffer)
+    ;; Push the previous item on the stack before clobbering the output buffer.
+    (help-setup-xref nil nil)
+    (let* ((docs
+            (nreverse
+             (delq nil
+                   (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
+                             (when (funcall testfn symbol)
+                               ;; Don't record the current entry in the stack.
+                               (setq help-xref-stack-item nil)
+                               (cons name
+                                     (funcall descfn symbol buffer frame))))
+                           describe-symbol-backends))))
+           (single (null (cdr docs))))
+      (while (cdr docs)
+        (goto-char (point-min))
+        (let ((inhibit-read-only t)
+              (name (caar docs))        ;Name of doc currently at BOB.
+              (doc (cdr (cadr docs))))  ;Doc to add at BOB.
+          (insert doc)
+          (delete-region (point) (progn (skip-chars-backward " \t\n") (point)))
+          (insert "\n\n"
+                  (eval-when-compile
+                    (propertize "\n" 'face '(:height 0.1 :inverse-video t)))
+                  "\n")
+          (when name
+            (insert (symbol-name symbol)
+                    " is also a " name "." "\n\n")))
+        (setq docs (cdr docs)))
+      (unless single
+        ;; Don't record the `describe-variable' item in the stack.
+        (setq help-xref-stack-item nil)
+        (help-setup-xref (list #'describe-symbol symbol) nil))
+      (goto-char (point-min)))))
 
 ;;;###autoload
 (defun describe-syntax (&optional buffer)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 6454eed..cdddd54 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -148,7 +148,7 @@ The format is (FUNCTION ARGS...).")
 
 (define-button-type 'help-symbol
   :supertype 'help-xref
-  'help-function #'help-xref-interned
+  'help-function #'describe-symbol
   'help-echo (purecopy "mouse-2, RET: describe this symbol"))
 
 (define-button-type 'help-back
@@ -624,58 +624,7 @@ See `help-make-xrefs'."
 ;; Additional functions for (re-)creating types of help buffers.
 
 ;;;###autoload
-(defun help-xref-interned (symbol &optional buffer frame)
-  "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
-Both variable, function and face documentation are extracted into a single
-help buffer. If SYMBOL is a variable, include buffer-local value for optional
-BUFFER or FRAME."
-  (with-current-buffer (help-buffer)
-    ;; Push the previous item on the stack before clobbering the output buffer.
-    (help-setup-xref nil nil)
-    (let ((facedoc (when (facep symbol)
-                    ;; Don't record the current entry in the stack.
-                    (setq help-xref-stack-item nil)
-                    (describe-face symbol)))
-         (fdoc (when (fboundp symbol)
-                 ;; Don't record the current entry in the stack.
-                 (setq help-xref-stack-item nil)
-                 (describe-function symbol)))
-         (sdoc (when (or (boundp symbol)
-                         (get symbol 'variable-documentation))
-                 ;; Don't record the current entry in the stack.
-                 (setq help-xref-stack-item nil)
-                 (describe-variable symbol buffer frame))))
-      (cond
-       (sdoc
-       ;; We now have a help buffer on the variable.
-       ;; Insert the function and face text before it.
-       (when (or fdoc facedoc)
-         (goto-char (point-min))
-         (let ((inhibit-read-only t))
-           (when fdoc
-             (insert fdoc "\n\n")
-             (when facedoc
-               (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
-                       " is also a " "face." "\n\n")))
-           (when facedoc
-             (insert facedoc "\n\n"))
-           (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
-                   " is also a " "variable." "\n\n"))
-         ;; Don't record the `describe-variable' item in the stack.
-         (setq help-xref-stack-item nil)
-         (help-setup-xref (list #'help-xref-interned symbol) nil)))
-       (fdoc
-       ;; We now have a help buffer on the function.
-       ;; Insert face text before it.
-       (when facedoc
-         (goto-char (point-max))
-         (let ((inhibit-read-only t))
-           (insert "\n\n" (make-string 30 ?-) "\n\n" (symbol-name symbol)
-                   " is also a " "face." "\n\n" facedoc))
-         ;; Don't record the `describe-function' item in the stack.
-         (setq help-xref-stack-item nil)
-         (help-setup-xref (list #'help-xref-interned symbol) nil))))
-      (goto-char (point-min)))))
+(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
 
 
 ;; Navigation/hyperlinking with xrefs
@@ -774,7 +723,7 @@ Show all docs for that symbol as either a variable, 
function or face."
     (when (or (boundp sym)
              (get sym 'variable-documentation)
              (fboundp sym) (facep sym))
-      (help-do-xref pos #'help-xref-interned (list sym)))))
+      (help-do-xref pos #'describe-symbol (list sym)))))
 
 (defun help-mode-revert-buffer (_ignore-auto noconfirm)
   (when (or noconfirm (yes-or-no-p "Revert help buffer? "))
diff --git a/lisp/help.el b/lisp/help.el
index 7a3460c..1826cb7 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -95,7 +95,7 @@
     (define-key map "k" 'describe-key)
     (define-key map "l" 'view-lossage)
     (define-key map "m" 'describe-mode)
-    (define-key map "o" 'describe-function-or-variable)
+    (define-key map "o" 'describe-symbol)
     (define-key map "n" 'view-emacs-news)
     (define-key map "p" 'finder-by-keyword)
     (define-key map "P" 'describe-package)