]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
Merge branch 'master' into cairo
[gnu-emacs] / lisp / help-fns.el
index 248e505ad79790c4281e2dbe34c1fbed17817ae1..4982ee54f467fa58ee4d1df7d2ecc4c57876cb7c 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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
@@ -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)))))
-  (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.
@@ -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.
-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
@@ -194,9 +195,10 @@ suitable file is found, return nil."
   (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'
@@ -329,7 +331,7 @@ suitable file is found, return nil."
 
       (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)
@@ -352,7 +354,9 @@ suitable file is found, return nil."
       (insert ".\n"))))
 
 (defun help-fns--signature (function doc real-def real-function)
-  (unless (keymapp function)    ; If definition is a keymap, skip arglist note.
+  "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)))
@@ -452,6 +456,18 @@ FILE is the file where FUNCTION was probably defined."
                          (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)
@@ -465,7 +481,8 @@ FILE is the file where FUNCTION was probably defined."
              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.
@@ -478,6 +495,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)
@@ -543,7 +563,7 @@ FILE is the file where FUNCTION was probably defined."
        ;; 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)))
+                (help-fns-short-filename file-name)))
        (princ "'")
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
@@ -564,12 +584,12 @@ FILE is the file where FUNCTION was probably defined."
                         help-enable-auto-load
                         (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
                                       doc-raw)
-                        (load (cadr real-def) t))
+                        (autoload-do-load real-def))
                    (substitute-command-keys doc-raw))))
 
         (help-fns--key-bindings function)
         (with-current-buffer standard-output
-          (setq doc (help-fns--signature function doc real-def real-function))
+          (setq doc (help-fns--signature function doc sig-key real-function))
          (run-hook-with-args 'help-fns-describe-function-functions function)
           (insert "\n"
                   (or doc "Not documented.")))))))
@@ -917,6 +937,37 @@ file-local variable.\n")
              (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.