Add online-help support to describe types

[gnu-emacs] / lisp / help-mode.el

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 3fc0ad2b4039e802932cd885168cfb2a4528fc34..e1fc9fd1984810e757dd0c53d2a7ce44ffa8c02e 100644 (file)
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (require 'button)
 ;;; Code:
 
 (require 'button)

+(require 'cl-lib)

 (eval-when-compile (require 'easymenu))
 
 (defvar help-mode-map
 (eval-when-compile (require 'easymenu))
 
 (defvar help-mode-map


@@ -148,7 +149,7 @@ The format is (FUNCTION ARGS...).")
 
 (define-button-type 'help-symbol
   :supertype 'help-xref
 
 (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
   'help-echo (purecopy "mouse-2, RET: describe this symbol"))
 
 (define-button-type 'help-back


@@ -216,7 +217,8 @@ The format is (FUNCTION ARGS...).")
                         (goto-char (point-min))
                         (if (re-search-forward
                              (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s"
                         (goto-char (point-min))
                         (if (re-search-forward
                              (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s"

-                                     (regexp-quote (symbol-name fun))) nil t)
+                                     (regexp-quote (symbol-name fun)))
+                              nil t)

                             (forward-line 0)
                           (message "Unable to find location in file")))
                     (message "Unable to find file")))
                             (forward-line 0)
                           (message "Unable to find location in file")))
                     (message "Unable to find file")))


@@ -322,7 +324,7 @@ Commands:
                    "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
                    "[ \t\n]+\\)?"
                    ;; Note starting with word-syntax character:
                    "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
                    "[ \t\n]+\\)?"
                    ;; Note starting with word-syntax character:

-                   "[`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]"))
+                   "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]"))

   "Regexp matching doc string references to symbols.
 
 The words preceding the quoted symbol can be used in doc strings to
   "Regexp matching doc string references to symbols.
 
 The words preceding the quoted symbol can be used in doc strings to


@@ -338,11 +340,11 @@ when help commands related to multilingual environment (e.g.,
 
 (defconst help-xref-info-regexp
   (purecopy
 
 (defconst help-xref-info-regexp
   (purecopy

-   "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+[`‘]\\([^'’]+\\)['’]")
+   "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]")

   "Regexp matching doc string references to an Info node.")
 
 (defconst help-xref-url-regexp
   "Regexp matching doc string references to an Info node.")
 
 (defconst help-xref-url-regexp

-  (purecopy "\\<[Uu][Rr][Ll][ \t\n]+[`‘]\\([^'’]+\\)['’]")
+  (purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]")

   "Regexp matching doc string references to a URL.")
 
 ;;;###autoload
   "Regexp matching doc string references to a URL.")
 
 ;;;###autoload


@@ -385,6 +387,15 @@ it does not already exist."
        (error "Current buffer is not in Help mode"))
      (current-buffer))))
 
        (error "Current buffer is not in Help mode"))
      (current-buffer))))
 

+(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)))
+

 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.
 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.


@@ -487,28 +498,9 @@ that."
                             ;;       (pop-to-buffer (car location))
                             ;;         (goto-char (cdr location))))
                             (help-xref-button 8 'help-function-def sym))
                             ;;       (pop-to-buffer (car location))
                             ;;         (goto-char (cdr location))))
                             (help-xref-button 8 'help-function-def sym))

-                           ((and
-                             (facep sym)
-                             (save-match-data (looking-at "[ \t\n]+face\\W")))
-                            (help-xref-button 8 'help-face sym))
-                           ((and (or (boundp sym)
-                                     (get sym 'variable-documentation))
-                                 (fboundp sym))
-                            ;; We can't intuit whether to use the
-                            ;; variable or function doc -- supply both.
-                            (help-xref-button 8 'help-symbol sym))
-                           ((and
-                             (or (boundp sym)
-                                 (get sym 'variable-documentation))
-                             (or
-                              (documentation-property
-                               sym 'variable-documentation)
-                              (documentation-property
-                               (indirect-variable sym)
-                               'variable-documentation)))
-                            (help-xref-button 8 'help-variable sym))
-                           ((fboundp sym)
-                            (help-xref-button 8 'help-function sym)))))))
+                           ((cl-some (lambda (x) (funcall (nth 1 x) sym))
+                                     describe-symbol-backends)
+                            (help-xref-button 8 'help-symbol sym)))))))

                 ;; An obvious case of a key substitution:
                 (save-excursion
                   (while (re-search-forward
                 ;; An obvious case of a key substitution:
                 (save-excursion
                   (while (re-search-forward


@@ -624,58 +616,7 @@ See `help-make-xrefs'."
 ;; Additional functions for (re-)creating types of help buffers.
 
 ;;;###autoload
 ;; 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")

 
 \f
 ;; Navigation/hyperlinking with xrefs
 
 \f
 ;; Navigation/hyperlinking with xrefs


@@ -774,7 +715,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))
     (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? "))
 
 (defun help-mode-revert-buffer (_ignore-auto noconfirm)
   (when (or noconfirm (yes-or-no-p "Revert help buffer? "))