]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
Add online-help support to describe types
[gnu-emacs] / lisp / help-fns.el
index 90200377428a2af7d858897d14e8f734ea85dfff..1c7a68abdecd9a511eac391055cce9d16ea0dd3d 100644 (file)
@@ -32,6 +32,9 @@
 
 ;;; Code:
 
+(require 'cl-lib)
+(require 'help-mode)
+
 (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
@@ -135,7 +138,7 @@ if the variable `help-downcase-arguments' is non-nil."
                          "\\)"
                          "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
                          "\\(?:-[a-z0-9-]+\\)?"  ; for ARG-xxx, ARG-n
-                         "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
+                         "\\(?:-[{([<`\"‘].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x', ‘x’
                          "\\>")                  ; end of word
                  (help-highlight-arg arg)
                  doc t t 1)))
@@ -306,7 +309,9 @@ suitable file is found, return nil."
             (when remapped
               (princ "Its keys are remapped to ")
               (princ (if (symbolp remapped)
-                        (concat "`" (symbol-name remapped) "'")
+                        (concat (substitute-command-keys "‘")
+                                (symbol-name remapped)
+                                (substitute-command-keys "’"))
                       "an anonymous command"))
               (princ ".\n"))
 
@@ -340,20 +345,22 @@ suitable file is found, return nil."
       (insert "\nThis function has a compiler macro")
       (if (symbolp handler)
           (progn
-            (insert (format " `%s'" handler))
+            (insert (format (substitute-command-keys " ‘%s’") handler))
             (save-excursion
-              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’")
+                                  nil t)
               (help-xref-button 1 'help-function handler)))
         ;; FIXME: Obsolete since 24.4.
         (let ((lib (get function 'compiler-macro-file)))
           (when (stringp lib)
-            (insert (format " in `%s'" lib))
+            (insert (format (substitute-command-keys " in ‘%s’") lib))
             (save-excursion
-              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’")
+                                  nil t)
               (help-xref-button 1 'help-function-cmacro function lib)))))
       (insert ".\n"))))
 
-(defun help-fns--signature (function doc real-def real-function)
+(defun help-fns--signature (function doc real-def real-function raw)
   "Insert usage at point and return docstring.  With highlighting."
   (if (keymapp function)
       doc                       ; If definition is a keymap, skip arglist note.
@@ -365,7 +372,7 @@ suitable file is found, return nil."
       (let* ((use (cond
                    ((and usage (not (listp advertised))) (car usage))
                    ((listp arglist)
-                    (format "%S" (help-make-usage function arglist)))
+                    (help--make-usage-docstring function arglist))
                    ((stringp arglist) arglist)
                    ;; Maybe the arglist is in the docstring of a symbol
                    ;; this one is aliased to.
@@ -379,13 +386,24 @@ suitable file is found, return nil."
                     (car usage))
                    ((or (stringp real-def)
                         (vectorp real-def))
-                    (format "\nMacro: %s" (format-kbd-macro real-def)))
+                    (format "\nMacro: %s"
+                            (help--docstring-quote
+                             (format-kbd-macro real-def))))
                    (t "[Missing arglist.  Please make a bug report.]")))
-             (high (help-highlight-arguments use doc)))
-        (let ((fill-begin (point)))
-          (insert (car high) "\n")
-          (fill-region fill-begin (point)))
-        (cdr high)))))
+             ;; Insert "`X", not "(\` X)", when documenting `X.
+             (use1 (replace-regexp-in-string
+                    "\\`(\\\\=\\\\\\\\=` \\([^\n ]*\\))\\'"
+                    "\\\\=`\\1" use t))
+             (high (if raw
+                       (cons use1 doc)
+                     (help-highlight-arguments (substitute-command-keys use1)
+                                               (substitute-command-keys doc)))))
+        (let ((fill-begin (point))
+              (high-usage (car high))
+              (high-doc (cdr high)))
+          (insert high-usage "\n")
+          (fill-region fill-begin (point))
+          high-doc)))))
 
 (defun help-fns--parent-mode (function)
   ;; If this is a derived mode, link to the parent.
@@ -393,13 +411,13 @@ suitable file is found, return nil."
                           (get function
                                'derived-mode-parent))))
     (when parent-mode
-      (insert "\nParent mode: `")
+      (insert (substitute-command-keys "\nParent mode: ‘"))
       (let ((beg (point)))
         (insert (format "%s" parent-mode))
         (make-text-button beg (point)
                           'type 'help-function
                           'help-args (list parent-mode)))
-      (insert "'.\n"))))
+      (insert (substitute-command-keys "’.\n")))))
 
 (defun help-fns--obsolete (function)
   ;; Ignore lambda constructs, keyboard macros, etc.
@@ -415,7 +433,9 @@ suitable file is found, return nil."
       (when (nth 2 obsolete)
         (insert (format " since %s" (nth 2 obsolete))))
       (insert (cond ((stringp use) (concat ";\n" use))
-                    (use (format ";\nuse `%s' instead." use))
+                    (use (format (substitute-command-keys
+                                  ";\nuse ‘%s’ instead.")
+                                 use))
                     (t "."))
               "\n"))))
 
@@ -451,7 +471,8 @@ FILE is the file where FUNCTION was probably defined."
                           (format ";\nin Lisp code %s" interactive-only))
                          ((and (symbolp 'interactive-only)
                                (not (eq interactive-only t)))
-                          (format ";\nin Lisp code use `%s' instead."
+                          (format (substitute-command-keys
+                                   ";\nin Lisp code use ‘%s’ instead.")
                                   interactive-only))
                          (t "."))
                    "\n")))))
@@ -495,6 +516,9 @@ FILE is the file where FUNCTION was probably defined."
                               f))
                    ((subrp def) (intern (subr-name def)))
                    (t def)))
+        (sig-key (if (subrp def)
+                      (indirect-function real-def)
+                    real-def))
         (file-name (find-lisp-object-file-name function def))
          (pt1 (with-current-buffer (help-buffer) (point)))
         (beg (if (and (or (byte-code-function-p def)
@@ -517,7 +541,8 @@ FILE is the file where FUNCTION was probably defined."
                 ;; Aliases are Lisp functions, so we need to check
                 ;; aliases before functions.
                 (aliased
-                 (format "an alias for `%s'" real-def))
+                 (format (substitute-command-keys "an alias for ‘%s’")
+                          real-def))
                 ((autoloadp def)
                  (format "%s autoloaded %s"
                          (if (commandp def) "an interactive" "an")
@@ -551,21 +576,24 @@ FILE is the file where FUNCTION was probably defined."
       (with-current-buffer standard-output
        (save-excursion
          (save-match-data
-           (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
+           (when (re-search-backward (substitute-command-keys
+                                       "alias for ‘\\([^‘’]+\\)’")
+                                      nil t)
              (help-xref-button 1 'help-function real-def)))))
 
       (when file-name
-       (princ " in `")
+       (princ (substitute-command-keys " in ‘"))
        ;; We used to add .el to the file name,
        ;; but that's completely wrong when the user used load-file.
        (princ (if (eq file-name 'C-source)
                   "C source code"
                 (help-fns-short-filename file-name)))
-       (princ "'")
+       (princ (substitute-command-keys "’"))
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
          (save-excursion
-           (re-search-backward "`\\([^`']+\\)'" nil t)
+           (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’")
+                                nil t)
            (help-xref-button 1 'help-function-def function file-name))))
       (princ ".")
       (with-current-buffer (help-buffer)
@@ -573,23 +601,22 @@ FILE is the file where FUNCTION was probably defined."
                                  (point)))
       (terpri)(terpri)
 
-      (let* ((doc-raw (documentation function t))
-            ;; If the function is autoloaded, and its docstring has
-            ;; key substitution constructs, load the library.
-            (doc (progn
-                   (and (autoloadp real-def) doc-raw
-                        help-enable-auto-load
-                        (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
-                                      doc-raw)
-                        (autoload-do-load real-def))
-                   (substitute-command-keys doc-raw))))
+      (let ((doc-raw (documentation function t)))
+
+       ;; If the function is autoloaded, and its docstring has
+       ;; key substitution constructs, load the library.
+       (and (autoloadp real-def) doc-raw
+            help-enable-auto-load
+            (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
+            (autoload-do-load real-def))
 
         (help-fns--key-bindings function)
         (with-current-buffer standard-output
-          (setq doc (help-fns--signature function doc real-def real-function))
-         (run-hook-with-args 'help-fns-describe-function-functions function)
-          (insert "\n"
-                  (or doc "Not documented.")))))))
+         (let ((doc (help-fns--signature function doc-raw sig-key
+                                          real-function nil)))
+           (run-hook-with-args 'help-fns-describe-function-functions function)
+           (insert "\n"
+                   (or doc "Not documented."))))))))
 
 ;; Add defaults to `help-fns-describe-function-functions'.
 (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
@@ -699,14 +726,17 @@ it is displayed along with the global value."
 
              (if file-name
                  (progn
-                   (princ " is a variable defined in `")
+                   (princ (substitute-command-keys
+                            " is a variable defined in ‘"))
                    (princ (if (eq file-name 'C-source)
                               "C source code"
                             (file-name-nondirectory file-name)))
-                   (princ "'.\n")
+                   (princ (substitute-command-keys "’.\n"))
                    (with-current-buffer standard-output
                      (save-excursion
-                       (re-search-backward "`\\([^`']+\\)'" nil t)
+                       (re-search-backward (substitute-command-keys
+                                             "‘\\([^‘’]+\\)’")
+                                            nil t)
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
                    (if valvoid
@@ -836,7 +866,9 @@ if it is given a local binding.\n")))
              ;; Mention if it's an alias.
               (unless (eq alias variable)
                 (setq extra-line t)
-                (princ (format "  This variable is an alias for `%s'.\n" alias)))
+                (princ (format (substitute-command-keys
+                                "  This variable is an alias for ‘%s’.\n")
+                               alias)))
 
               (when obsolete
                 (setq extra-line t)
@@ -844,7 +876,9 @@ if it is given a local binding.\n")))
                 (if (nth 2 obsolete)
                     (princ (format " since %s" (nth 2 obsolete))))
                (princ (cond ((stringp use) (concat ";\n  " use))
-                            (use (format ";\n  use `%s' instead." (car obsolete)))
+                            (use (format (substitute-command-keys
+                                           ";\n  use ‘%s’ instead.")
+                                          (car obsolete)))
                             (t ".")))
                 (terpri))
 
@@ -874,14 +908,15 @@ if it is given a local binding.\n")))
                               ;; Otherwise, assume it was set directly.
                               (setq file (car file)
                                     dir-file nil)))
-                       (princ (if dir-file
-                                  "by the file\n  `"
-                                "for the directory\n  `"))
+                       (princ (substitute-command-keys
+                                (if dir-file
+                                    "by the file\n  ‘"
+                                  "for the directory\n  ‘")))
                        (with-current-buffer standard-output
                          (insert-text-button
                           file 'type 'help-dir-local-var-def
                           'help-args (list variable file)))
-                       (princ "'.\n")))
+                       (princ (substitute-command-keys "’.\n"))))
                  (princ "  This variable's value is file-local.\n")))
 
              (when (memq variable ignored-local-variables)
@@ -895,8 +930,9 @@ variable.\n"))
                (princ "  This variable may be risky if used as a \
 file-local variable.\n")
                (when (assq variable safe-local-variable-values)
-                 (princ "  However, you have added it to \
-`safe-local-variable-values'.\n")))
+                 (princ (substitute-command-keys
+                          "  However, you have added it to \
+‘safe-local-variable-values’.\n"))))
 
              (when safe-var
                 (setq extra-line t)
@@ -904,7 +940,8 @@ file-local variable.\n")
                (princ "if its value\n  satisfies the predicate ")
                (princ (if (byte-code-function-p safe-var)
                           "which is a byte-compiled expression.\n"
-                        (format "`%s'.\n" safe-var))))
+                        (format (substitute-command-keys "‘%s’.\n")
+                                 safe-var))))
 
               (if extra-line (terpri))
              (princ "Documentation:\n")
@@ -934,36 +971,69 @@ file-local variable.\n")
              (buffer-string))))))))
 
 
+(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
-   (let* ((v-or-f (variable-at-point))
-          (found (symbolp v-or-f))
+   (let* ((v-or-f (symbol-at-point))
+          (found (cl-some (lambda (x) (funcall (nth 1 x) v-or-f))
+                          describe-symbol-backends))
           (v-or-f (if found v-or-f (function-called-at-point)))
           (found (or found v-or-f))
           (enable-recursive-minibuffers t)
-          val)
-     (setq val (completing-read (if found
+          (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))))
+                               (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)