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 c62ddc3dcd01b42b41dbfb11708746d53b851142..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


@@ -337,11 +339,12 @@ when help commands related to multilingual environment (e.g.,
 
 
 (defconst help-xref-info-regexp
 
 
 (defconst help-xref-info-regexp

-  (purecopy "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+`\\([^']+\\)'")
+  (purecopy
+   "\\<[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


@@ -384,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.


@@ -486,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


@@ -621,57 +614,9 @@ See `help-make-xrefs'."
 
 \f
 ;; Additional functions for (re-)creating types of help buffers.
 
 \f
 ;; Additional functions for (re-)creating types of help buffers.

-(defun help-xref-interned (symbol)
-  "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
-Both variable, function and face documentation are extracted into a single
-help buffer."
-  (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))))
-      (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)))))
+
+;;;###autoload
+(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")

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


@@ -721,14 +666,14 @@ help buffer."
   (interactive)
   (if help-xref-stack
       (help-xref-go-back (current-buffer))
   (interactive)
   (if help-xref-stack
       (help-xref-go-back (current-buffer))

-    (error "No previous help buffer")))
+    (user-error "No previous help buffer")))

 
 (defun help-go-forward ()
 
 (defun help-go-forward ()

-  "Go back to next topic in this help buffer."
+  "Go to the next topic in this help buffer."

   (interactive)
   (if help-xref-forward-stack
       (help-xref-go-forward (current-buffer))
   (interactive)
   (if help-xref-forward-stack
       (help-xref-go-forward (current-buffer))

-    (error "No next help buffer")))
+    (user-error "No next help buffer")))

 
 (defun help-do-xref (_pos function args)
   "Call the help cross-reference function FUNCTION with args ARGS.
 
 (defun help-do-xref (_pos function args)
   "Call the help cross-reference function FUNCTION with args ARGS.


@@ -736,7 +681,8 @@ Things are set up properly so that the resulting help-buffer has
 a proper [back] button."
   ;; There is a reference at point.  Follow it.
   (let ((help-xref-following t))
 a proper [back] button."
   ;; There is a reference at point.  Follow it.
   (let ((help-xref-following t))

-    (apply function args)))
+    (apply function (if (eq function 'info)
+                       (append args (list (generate-new-buffer-name "*info*"))) args))))

 
 ;; The doc string is meant to explain what buttons do.
 (defun help-follow-mouse ()
 
 ;; The doc string is meant to explain what buttons do.
 (defun help-follow-mouse ()


@@ -750,7 +696,7 @@ a proper [back] button."
 
 For the cross-reference format, see `help-make-xrefs'."
   (interactive)
 
 For the cross-reference format, see `help-make-xrefs'."
   (interactive)

-  (error "No cross-reference here"))
+  (user-error "No cross-reference here"))

 
 (defun help-follow-symbol (&optional pos)
   "In help buffer, show docs for symbol at POS, defaulting to point.
 
 (defun help-follow-symbol (&optional pos)
   "In help buffer, show docs for symbol at POS, defaulting to point.


@@ -769,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? "))