diff options
Diffstat (limited to 'lisp/help.el')
| -rw-r--r-- | lisp/help.el | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/lisp/help.el b/lisp/help.el index 1e3d41eb88a..46094e9f6b0 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1222,6 +1222,113 @@ value in BODY." (if (stringp msg) (with-output-to-temp-buffer " *Char Help*" (princ msg))))) + + +;; The following functions used to be in help-fns.el, which is not preloaded. +;; But for various reasons, they are more widely needed, so they were +;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001 + +(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)))))) + +(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)))))) + +(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))) + +(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))) + (provide 'help) |