From 56759cf12aeea9a51020ad19784d6ca6c55ab36e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 13 Mar 2014 20:32:41 -0400 Subject: [PATCH] Move some help functions from help-fns.el to help.el, which is preloaded. They are now needed by eg the function `documentation' in some circumstances. * lisp/help-fns.el (help-split-fundoc, help-add-fundoc-usage) (help-function-arglist, help-make-usage): Move from here... * lisp/help.el (help-split-fundoc, help-add-fundoc-usage) (help-function-arglist, help-make-usage): ... to here. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Do not load help-fns. Fixes: debbugs:17001 --- lisp/ChangeLog | 8 +++ lisp/emacs-lisp/bytecomp.el | 1 - lisp/help-fns.el | 103 ---------------------------------- lisp/help.el | 107 ++++++++++++++++++++++++++++++++++++ 4 files changed, 115 insertions(+), 104 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e4dff0abd91..260a77fdca9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2014-03-14 Glenn Morris + + * help-fns.el (help-split-fundoc, help-add-fundoc-usage) + (help-function-arglist, help-make-usage): Move from here... + * help.el (help-split-fundoc, help-add-fundoc-usage) + (help-function-arglist, help-make-usage): ... to here. (Bug#17001) + * emacs-lisp/bytecomp.el (byte-compile-lambda): Do not load help-fns. + 2014-03-14 Juanma Barranquero * net/socks.el (socks, socks-override-functions) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e2e468717a6..e5f8a8cc22a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2706,7 +2706,6 @@ for symbols generated by the byte compiler itself." (cdr compiled) ;; optionally, the doc string. (cond (lexical-binding - (require 'help-fns) (list (help-add-fundoc-usage doc arglist))) ((or doc int) (list doc))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index c772962f64b..a186254123d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -69,109 +69,6 @@ The functions will receive the function name as argument.") ;; 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) 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) -- 2.39.2