diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 38 |
2 files changed, 34 insertions, 6 deletions
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 4b9985380c3..7beb4d4b4cc 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "21df83d6106cb0c3d037e75ad79359dc") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "0907093f7720996444ededb4edfe8072") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 6d242eda3ab..fb19115287c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -238,6 +238,37 @@ It is a list of elements of the form either: (declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) +(defun cl--make-usage-var (x) + "X can be a var or a (destructuring) lambda-list." + (cond + ((symbolp x) (make-symbol (upcase (symbol-name x)))) + ((consp x) (cl--make-usage-args x)) + (t x))) + +(defun cl--make-usage-args (arglist) + ;; `orig-args' can contain &cl-defs (an internal + ;; CL thingy I don't understand), so remove it. + (let ((x (memq '&cl-defs arglist))) + (when x (setq arglist (delq (car x) (remq (cadr x) arglist))))) + (let ((state nil)) + (mapcar (lambda (x) + (cond + ((symbolp x) + (if (eq ?\& (aref (symbol-name x) 0)) + (setq state x) + (make-symbol (upcase (symbol-name x))))) + ((not (consp x)) x) + ((memq state '(nil &rest)) (cl--make-usage-args x)) + (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). + (list* + (if (and (consp (car x)) (eq state '&key)) + (list (caar x) (cl--make-usage-var (nth 1 (car x)))) + (cl--make-usage-var (car x))) + (nth 1 x) ;INITFORM. + (cl--make-usage-args (nthcdr 2 x)) ;SVAR. + )))) + arglist))) + (defun cl-transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (orig-args args) (bind-defs nil) (bind-enquote nil) @@ -282,11 +313,8 @@ It is a list of elements of the form either: (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car hdr)) (pop hdr)) - ;; orig-args can contain &cl-defs (an internal - ;; CL thingy I don't understand), so remove it. - (let ((x (memq '&cl-defs orig-args))) - (if (null x) orig-args - (delq (car x) (remq (cadr x) orig-args))))) + (format "(fn %S)" + (cl--make-usage-args orig-args))) hdr))) (list (nconc (list 'let* bind-lets) (nreverse bind-forms) body))))))) |