;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, internal
;; Package: emacs
;; Return the text we displayed.
(buffer-string))))))
-(defun help-split-fundoc (docstring def)
- "Split a function DOCSTRING into the actual doc and the usage info.
-Return (USAGE . DOC) or nil if there's no usage info, where USAGE info
-is a string describing the argument list of DEF, such as
-\"(apply FUNCTION &rest ARGUMENTS)\".
-DEF is the function whose usage we're looking for in DOCSTRING."
- ;; Functions can get the calling sequence at the end of the doc string.
- ;; In cases where `function' has been fset to a subr we can't search for
- ;; function's name in the doc string so we use `fn' as the anonymous
- ;; function name instead.
- (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
- (cons (format "(%s%s"
- ;; Replace `fn' with the actual function name.
- (if (symbolp def) def "anonymous")
- (match-string 1 docstring))
- (unless (zerop (match-beginning 0))
- (substring docstring 0 (match-beginning 0))))))
-
-;; FIXME: Move to subr.el?
-(defun help-add-fundoc-usage (docstring arglist)
- "Add the usage info to DOCSTRING.
-If DOCSTRING already has a usage info, then just return it unchanged.
-The usage info is built from ARGLIST. DOCSTRING can be nil.
-ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
- (unless (stringp docstring) (setq docstring ""))
- (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)
- (eq arglist t))
- docstring
- (concat docstring
- (if (string-match "\n?\n\\'" docstring)
- (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
- "\n\n")
- (if (and (stringp arglist)
- (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
- (concat "(fn" (match-string 1 arglist) ")")
- (format "%S" (help-make-usage 'fn arglist))))))
-
-;; FIXME: Move to subr.el?
-(defun help-function-arglist (def &optional preserve-names)
- "Return a formal argument list for the function DEF.
-IF PRESERVE-NAMES is non-nil, return a formal arglist that uses
-the same names as used in the original source code, when possible."
- ;; Handle symbols aliased to other symbols.
- (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
- ;; If definition is a macro, find the function inside it.
- (if (eq (car-safe def) 'macro) (setq def (cdr def)))
- (cond
- ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
- ((eq (car-safe def) 'lambda) (nth 1 def))
- ((eq (car-safe def) 'closure) (nth 2 def))
- ((or (and (byte-code-function-p def) (integerp (aref def 0)))
- (subrp def))
- (or (when preserve-names
- (let* ((doc (condition-case nil (documentation def) (error nil)))
- (docargs (if doc (car (help-split-fundoc doc nil))))
- (arglist (if docargs
- (cdar (read-from-string (downcase docargs)))))
- (valid t))
- ;; Check validity.
- (dolist (arg arglist)
- (unless (and (symbolp arg)
- (let ((name (symbol-name arg)))
- (if (eq (aref name 0) ?&)
- (memq arg '(&rest &optional))
- (not (string-match "\\." name)))))
- (setq valid nil)))
- (when valid arglist)))
- (let* ((args-desc (if (not (subrp def))
- (aref def 0)
- (let ((a (subr-arity def)))
- (logior (car a)
- (if (numberp (cdr a))
- (lsh (cdr a) 8)
- (lsh 1 7))))))
- (max (lsh args-desc -8))
- (min (logand args-desc 127))
- (rest (logand args-desc 128))
- (arglist ()))
- (dotimes (i min)
- (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
- (when (> max min)
- (push '&optional arglist)
- (dotimes (i (- max min))
- (push (intern (concat "arg" (number-to-string (+ 1 i min))))
- arglist)))
- (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
- (nreverse arglist))))
- ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
- "[Arg list not available until function definition is loaded.]")
- (t t)))
-
-;; FIXME: Move to subr.el?
-(defun help-make-usage (function arglist)
- (cons (if (symbolp function) function 'anonymous)
- (mapcar (lambda (arg)
- (if (not (symbolp arg)) arg
- (let ((name (symbol-name arg)))
- (cond
- ((string-match "\\`&" name) arg)
- ((string-match "\\`_" name)
- (intern (upcase (substring name 1))))
- (t (intern (upcase name)))))))
- arglist)))
;; Could be this, if we make symbol-file do the work below.
;; (defun help-C-file-name (subr-or-var kind)
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
(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'
(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)))
(setq load-hist (cdr load-hist)))
found))
+(defun help-fns--interactive-only (function)
+ "Insert some help blurb if FUNCTION should only be used interactively."
+ ;; Ignore lambda constructs, keyboard macros, etc.
+ (and (symbolp function)
+ (not (eq (car-safe (symbol-function function)) 'macro))
+ (let* ((interactive-only
+ (or (get function 'interactive-only)
+ (if (boundp 'byte-compile-interactive-only-functions)
+ (memq function
+ byte-compile-interactive-only-functions)))))
+ (when interactive-only
+ (insert "\nThis function is for interactive use only"
+ ;; Cf byte-compile-form.
+ (cond ((stringp interactive-only)
+ (format ";\nin Lisp code %s" interactive-only))
+ ((and (symbolp 'interactive-only)
+ (not (eq interactive-only t)))
+ (format ";\nin Lisp code use `%s' instead."
+ 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)
(beg (if (and (or (byte-code-function-p def)
(keymapp def)
(memq (car-safe def) '(macro lambda closure)))
- file-name
+ (stringp file-name)
(help-fns--autoloaded-p function file-name))
(if (commandp def)
"an interactive autoloaded "
;; aliases before functions.
(aliased
(format "an alias for `%s'" real-def))
+ ((autoloadp def)
+ (format "%s autoloaded %s"
+ (if (commandp def) "an interactive" "an")
+ (if (eq (nth 4 def) 'keymap) "keymap"
+ (if (nth 4 def) "Lisp macro" "Lisp function"))))
((or (eq (car-safe def) 'macro)
;; For advised macros, def is a lambda
;; expression or a byte-code-function-p, so we
(concat beg "Lisp function"))
((eq (car-safe def) 'closure)
(concat beg "Lisp closure"))
- ((autoloadp def)
- (format "%s autoloaded %s"
- (if (commandp def) "an interactive" "an")
- (if (eq (nth 4 def) 'keymap) "keymap"
- (if (nth 4 def) "Lisp macro" "Lisp function"))))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
;; 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
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)
;; Add defaults to `help-fns-describe-function-functions'.
(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
+(add-hook 'help-fns-describe-function-functions #'help-fns--interactive-only)
(add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode)
(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro)
(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.