]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
Some generic support for multi-mode indentation.
[gnu-emacs] / lisp / help-fns.el
index 248e505ad79790c4281e2dbe34c1fbed17817ae1..80f30e88fa4104f1b1fe459b65f1e9312c78a07d 100644 (file)
@@ -1,7 +1,7 @@
 ;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
 
 ;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2014
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
+;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: help, internal
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: help, internal
@@ -54,20 +54,22 @@ The functions will receive the function name as argument.")
                                (and fn (symbol-name fn))))
      (list (if (equal val "")
               fn (intern val)))))
                                (and fn (symbol-name fn))))
      (list (if (equal val "")
               fn (intern val)))))
-  (if (null function)
-      (message "You didn't specify a function")
-    (help-setup-xref (list #'describe-function function)
-                    (called-interactively-p 'interactive))
-    (save-excursion
-      (with-help-window (help-buffer)
-       (prin1 function)
-       ;; Use " is " instead of a colon so that
-       ;; it is easier to get out the function name using forward-sexp.
-       (princ " is ")
-       (describe-function-1 function)
-       (with-current-buffer standard-output
-         ;; Return the text we displayed.
-         (buffer-string))))))
+  (or (and function (symbolp function))
+      (user-error "You didn't specify a function symbol"))
+  (or (fboundp function)
+      (user-error "Symbol's function definition is void: %s" function))
+  (help-setup-xref (list #'describe-function function)
+                   (called-interactively-p 'interactive))
+  (save-excursion
+    (with-help-window (help-buffer)
+      (prin1 function)
+      ;; Use " is " instead of a colon so that
+      ;; it is easier to get out the function name using forward-sexp.
+      (princ " is ")
+      (describe-function-1 function)
+      (with-current-buffer standard-output
+        ;; Return the text we displayed.
+        (buffer-string)))))
 
 
 ;; Could be this, if we make symbol-file do the work below.
 
 
 ;; Could be this, if we make symbol-file do the work below.
@@ -133,7 +135,7 @@ if the variable `help-downcase-arguments' is non-nil."
                          "\\)"
                          "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
                          "\\(?:-[a-z0-9-]+\\)?"  ; for ARG-xxx, ARG-n
                          "\\)"
                          "\\(?: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)))
                          "\\>")                  ; end of word
                  (help-highlight-arg arg)
                  doc t t 1)))
@@ -183,8 +185,7 @@ OBJECT should be a symbol associated with a function, variable, or face;
   alternatively, it can be a function definition.
 If TYPE is `defvar', search for a variable definition.
 If TYPE is `defface', search for a face definition.
   alternatively, it can be a function definition.
 If TYPE is `defvar', search for a variable definition.
 If TYPE is `defface', search for a face definition.
-If TYPE is the value returned by `symbol-function' for a function symbol,
- search for a function definition.
+If TYPE is not a symbol, search for a function definition.
 
 The return value is the absolute name of a readable file where OBJECT is
 defined.  If several such files exist, preference is given to a file
 
 The return value is the absolute name of a readable file where OBJECT is
 defined.  If several such files exist, preference is given to a file
@@ -194,9 +195,10 @@ suitable file is found, return nil."
   (let* ((autoloaded (autoloadp type))
         (file-name (or (and autoloaded (nth 1 type))
                        (symbol-file
   (let* ((autoloaded (autoloadp type))
         (file-name (or (and autoloaded (nth 1 type))
                        (symbol-file
-                        object (if (memq type (list 'defvar 'defface))
-                                   type
-                                 'defun)))))
+                         ;; FIXME: Why do we have this weird "If TYPE is the
+                         ;; value returned by `symbol-function' for a function
+                         ;; symbol" exception?
+                        object (or (if (symbolp type) type) 'defun)))))
     (cond
      (autoloaded
       ;; An autoloaded function: Locate the file since `symbol-function'
     (cond
      (autoloaded
       ;; An autoloaded function: Locate the file since `symbol-function'
@@ -304,7 +306,7 @@ suitable file is found, return nil."
             (when remapped
               (princ "Its keys are remapped to ")
               (princ (if (symbolp remapped)
             (when remapped
               (princ "Its keys are remapped to ")
               (princ (if (symbolp remapped)
-                        (concat "`" (symbol-name remapped) "'")
+                        (concat "‘" (symbol-name remapped) "’")
                       "an anonymous command"))
               (princ ".\n"))
 
                       "an anonymous command"))
               (princ ".\n"))
 
@@ -329,7 +331,7 @@ suitable file is found, return nil."
 
       (with-current-buffer standard-output
         (fill-region-as-paragraph pt2 (point))
 
       (with-current-buffer standard-output
         (fill-region-as-paragraph pt2 (point))
-        (unless (looking-back "\n\n")
+        (unless (looking-back "\n\n" (- (point) 2))
           (terpri))))))
 
 (defun help-fns--compiler-macro (function)
           (terpri))))))
 
 (defun help-fns--compiler-macro (function)
@@ -338,21 +340,23 @@ suitable file is found, return nil."
       (insert "\nThis function has a compiler macro")
       (if (symbolp handler)
           (progn
       (insert "\nThis function has a compiler macro")
       (if (symbolp handler)
           (progn
-            (insert (format " `%s'" handler))
+            (insert (format " ‘%s’" handler))
             (save-excursion
             (save-excursion
-              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (re-search-backward "‘\\([^‘’]+\\)’" nil t)
               (help-xref-button 1 'help-function handler)))
         ;; FIXME: Obsolete since 24.4.
         (let ((lib (get function 'compiler-macro-file)))
           (when (stringp lib)
               (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 " in ‘%s’" lib))
             (save-excursion
             (save-excursion
-              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (re-search-backward "‘\\([^‘’]+\\)’" nil t)
               (help-xref-button 1 'help-function-cmacro function lib)))))
       (insert ".\n"))))
 
               (help-xref-button 1 'help-function-cmacro function lib)))))
       (insert ".\n"))))
 
-(defun help-fns--signature (function doc real-def real-function)
-  (unless (keymapp function)    ; If definition is a keymap, skip arglist note.
+(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.
     (let* ((advertised (gethash real-def advertised-signature-table t))
            (arglist (if (listp advertised)
                         advertised (help-function-arglist real-def)))
     (let* ((advertised (gethash real-def advertised-signature-table t))
            (arglist (if (listp advertised)
                         advertised (help-function-arglist real-def)))
@@ -361,7 +365,7 @@ suitable file is found, return nil."
       (let* ((use (cond
                    ((and usage (not (listp advertised))) (car usage))
                    ((listp arglist)
       (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.
                    ((stringp arglist) arglist)
                    ;; Maybe the arglist is in the docstring of a symbol
                    ;; this one is aliased to.
@@ -375,13 +379,24 @@ suitable file is found, return nil."
                     (car usage))
                    ((or (stringp real-def)
                         (vectorp real-def))
                     (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.]")))
                    (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.
 
 (defun help-fns--parent-mode (function)
   ;; If this is a derived mode, link to the parent.
@@ -389,13 +404,13 @@ suitable file is found, return nil."
                           (get function
                                'derived-mode-parent))))
     (when parent-mode
                           (get function
                                'derived-mode-parent))))
     (when parent-mode
-      (insert "\nParent mode: `")
+      (insert "\nParent mode: ")
       (let ((beg (point)))
         (insert (format "%s" parent-mode))
         (make-text-button beg (point)
                           'type 'help-function
                           'help-args (list parent-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 ".\n"))))
 
 (defun help-fns--obsolete (function)
   ;; Ignore lambda constructs, keyboard macros, etc.
 
 (defun help-fns--obsolete (function)
   ;; Ignore lambda constructs, keyboard macros, etc.
@@ -411,7 +426,7 @@ suitable file is found, return nil."
       (when (nth 2 obsolete)
         (insert (format " since %s" (nth 2 obsolete))))
       (insert (cond ((stringp use) (concat ";\n" use))
       (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 ";\nuse ‘%s’ instead." use))
                     (t "."))
               "\n"))))
 
                     (t "."))
               "\n"))))
 
@@ -447,11 +462,23 @@ 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 %s" interactive-only))
                          ((and (symbolp 'interactive-only)
                                (not (eq interactive-only t)))
-                          (format ";\nin Lisp code use `%s' instead."
+                          (format ";\nin Lisp code use ‘%s’ instead."
                                   interactive-only))
                          (t "."))
                    "\n")))))
 
                                   interactive-only))
                          (t "."))
                    "\n")))))
 
+(defun help-fns-short-filename (filename)
+  (let* ((abbrev (abbreviate-file-name filename))
+         (short abbrev))
+    (dolist (dir load-path)
+      (let ((rel (file-relative-name filename dir)))
+        (if (< (length rel) (length short))
+            (setq short rel)))
+      (let ((rel (file-relative-name abbrev dir)))
+        (if (< (length rel) (length short))
+            (setq short rel))))
+    short))
+
 ;;;###autoload
 (defun describe-function-1 (function)
   (let* ((advised (and (symbolp function)
 ;;;###autoload
 (defun describe-function-1 (function)
   (let* ((advised (and (symbolp function)
@@ -465,7 +492,8 @@ FILE is the file where FUNCTION was probably defined."
              function))
         ;; Get the real definition.
         (def (if (symbolp real-function)
              function))
         ;; Get the real definition.
         (def (if (symbolp real-function)
-                 (symbol-function real-function)
+                 (or (symbol-function real-function)
+                     (signal 'void-function (list real-function)))
                real-function))
         (aliased (or (symbolp def)
                      ;; Advised & aliased function.
                real-function))
         (aliased (or (symbolp def)
                      ;; Advised & aliased function.
@@ -478,6 +506,9 @@ FILE is the file where FUNCTION was probably defined."
                               f))
                    ((subrp def) (intern (subr-name def)))
                    (t def)))
                               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)
         (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)
@@ -500,7 +531,7 @@ FILE is the file where FUNCTION was probably defined."
                 ;; Aliases are Lisp functions, so we need to check
                 ;; aliases before functions.
                 (aliased
                 ;; Aliases are Lisp functions, so we need to check
                 ;; aliases before functions.
                 (aliased
-                 (format "an alias for `%s'" real-def))
+                 (format "an alias for ‘%s’" real-def))
                 ((autoloadp def)
                  (format "%s autoloaded %s"
                          (if (commandp def) "an interactive" "an")
                 ((autoloadp def)
                  (format "%s autoloaded %s"
                          (if (commandp def) "an interactive" "an")
@@ -534,21 +565,21 @@ FILE is the file where FUNCTION was probably defined."
       (with-current-buffer standard-output
        (save-excursion
          (save-match-data
       (with-current-buffer standard-output
        (save-excursion
          (save-match-data
-           (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
+           (when (re-search-backward "alias for ‘\\([^‘’]+\\)’" nil t)
              (help-xref-button 1 'help-function real-def)))))
 
       (when file-name
              (help-xref-button 1 'help-function real-def)))))
 
       (when file-name
-       (princ " in `")
+       (princ " 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"
        ;; 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"
-                (file-name-nondirectory file-name)))
-       (princ "'")
+                (help-fns-short-filename file-name)))
+       (princ "")
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
          (save-excursion
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
          (save-excursion
-           (re-search-backward "`\\([^`']+\\)'" nil t)
+           (re-search-backward "‘\\([^‘’]+\\)’" nil t)
            (help-xref-button 1 'help-function-def function file-name))))
       (princ ".")
       (with-current-buffer (help-buffer)
            (help-xref-button 1 'help-function-def function file-name))))
       (princ ".")
       (with-current-buffer (help-buffer)
@@ -556,23 +587,22 @@ FILE is the file where FUNCTION was probably defined."
                                  (point)))
       (terpri)(terpri)
 
                                  (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)
-                        (load (cadr real-def) t))
-                   (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
 
         (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)
 
 ;; Add defaults to `help-fns-describe-function-functions'.
 (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
@@ -682,14 +712,14 @@ it is displayed along with the global value."
 
              (if file-name
                  (progn
 
              (if file-name
                  (progn
-                   (princ " is a variable defined in `")
+                   (princ " is a variable defined in ")
                    (princ (if (eq file-name 'C-source)
                               "C source code"
                             (file-name-nondirectory file-name)))
                    (princ (if (eq file-name 'C-source)
                               "C source code"
                             (file-name-nondirectory file-name)))
-                   (princ "'.\n")
+                   (princ ".\n")
                    (with-current-buffer standard-output
                      (save-excursion
                    (with-current-buffer standard-output
                      (save-excursion
-                       (re-search-backward "`\\([^`']+\\)'" nil t)
+                       (re-search-backward "‘\\([^‘’]+\\)’" nil t)
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
                    (if valvoid
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
                    (if valvoid
@@ -819,7 +849,8 @@ if it is given a local binding.\n")))
              ;; Mention if it's an alias.
               (unless (eq alias variable)
                 (setq extra-line t)
              ;; 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 "  This variable is an alias for ‘%s’.\n"
+                               alias)))
 
               (when obsolete
                 (setq extra-line t)
 
               (when obsolete
                 (setq extra-line t)
@@ -827,7 +858,8 @@ 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))
                 (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 ";\n  use ‘%s’ instead."
+                                          (car obsolete)))
                             (t ".")))
                 (terpri))
 
                             (t ".")))
                 (terpri))
 
@@ -858,13 +890,13 @@ if it is given a local binding.\n")))
                               (setq file (car file)
                                     dir-file nil)))
                        (princ (if dir-file
                               (setq file (car file)
                                     dir-file nil)))
                        (princ (if dir-file
-                                  "by the file\n  `"
-                                "for the directory\n  `"))
+                                  "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)))
                        (with-current-buffer standard-output
                          (insert-text-button
                           file 'type 'help-dir-local-var-def
                           'help-args (list variable file)))
-                       (princ "'.\n")))
+                       (princ ".\n")))
                  (princ "  This variable's value is file-local.\n")))
 
              (when (memq variable ignored-local-variables)
                  (princ "  This variable's value is file-local.\n")))
 
              (when (memq variable ignored-local-variables)
@@ -879,7 +911,7 @@ variable.\n"))
 file-local variable.\n")
                (when (assq variable safe-local-variable-values)
                  (princ "  However, you have added it to \
 file-local variable.\n")
                (when (assq variable safe-local-variable-values)
                  (princ "  However, you have added it to \
-`safe-local-variable-values'.\n")))
+‘safe-local-variable-values’.\n")))
 
              (when safe-var
                 (setq extra-line t)
 
              (when safe-var
                 (setq extra-line t)
@@ -887,7 +919,7 @@ 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"
                (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 "‘%s’.\n" safe-var))))
 
               (if extra-line (terpri))
              (princ "Documentation:\n")
 
               (if extra-line (terpri))
              (princ "Documentation:\n")
@@ -917,6 +949,37 @@ file-local variable.\n")
              (buffer-string))))))))
 
 
              (buffer-string))))))))
 
 
+;;;###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."
+  (interactive
+   (let* ((v-or-f (variable-at-point))
+          (found (symbolp v-or-f))
+          (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
+                                   (format
+                                        "Describe function or variable (default %s): " v-or-f)
+                                 "Describe function or variable: ")
+                               obarray
+                               (lambda (vv)
+                                 (or (fboundp vv)
+                                     (get vv 'variable-documentation)
+                                     (and (boundp vv) (not (keywordp vv)))))
+                               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)))
+
 ;;;###autoload
 (defun describe-syntax (&optional buffer)
   "Describe the syntax specifications in the syntax table of BUFFER.
 ;;;###autoload
 (defun describe-syntax (&optional buffer)
   "Describe the syntax specifications in the syntax table of BUFFER.