Commit b68581e2 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists.

Fixes: debbugs:11719
parent e33c6771
2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca> 2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists
(bug#11719).
* minibuffer.el (completion--twq-try): Try to fail more gracefully when * minibuffer.el (completion--twq-try): Try to fail more gracefully when
the requote function doesn't work properly (bug#11714). the requote function doesn't work properly (bug#11714).
......
...@@ -11,7 +11,7 @@ ...@@ -11,7 +11,7 @@
;;;;;; cl--set-frame-visible-p cl--map-overlays cl--map-intervals ;;;;;; cl--set-frame-visible-p cl--map-overlays cl--map-intervals
;;;;;; cl--map-keymap-recursively cl-notevery cl-notany cl-every ;;;;;; cl--map-keymap-recursively cl-notevery cl-notany cl-every
;;;;;; cl-some cl-mapcon cl-mapcan cl-mapl cl-maplist cl-map cl--mapcar-many ;;;;;; cl-some cl-mapcon cl-mapcan cl-mapl cl-maplist cl-map cl--mapcar-many
;;;;;; cl-equalp cl-coerce) "cl-extra" "cl-extra.el" "25963dec757a527e3be3ba7f7abc49ee") ;;;;;; cl-equalp cl-coerce) "cl-extra" "cl-extra.el" "3656b89f2196d70e50ba9d7bb9519416")
;;; Generated autoloads from cl-extra.el ;;; Generated autoloads from cl-extra.el
(autoload 'cl-coerce "cl-extra" "\ (autoload 'cl-coerce "cl-extra" "\
...@@ -265,7 +265,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ...@@ -265,7 +265,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;;;; cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case ;;;;;; cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
;;;;;; cl-load-time-value cl-eval-when cl-destructuring-bind cl-function ;;;;;; cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el" ;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
;;;;;; "66d8d151a97f91a79ebe3d1a9d699483") ;;;;;; "41a15289eda7e6ae03ac9edd86bbb1a6")
;;; Generated autoloads from cl-macs.el ;;; Generated autoloads from cl-macs.el
(autoload 'cl-gensym "cl-macs" "\ (autoload 'cl-gensym "cl-macs" "\
......
...@@ -350,28 +350,36 @@ its argument list allows full Common Lisp conventions." ...@@ -350,28 +350,36 @@ its argument list allows full Common Lisp conventions."
(t x))) (t x)))
(defun cl--make-usage-args (arglist) (defun cl--make-usage-args (arglist)
;; `orig-args' can contain &cl-defs (an internal (if (cdr-safe (last arglist)) ;Not a proper list.
;; CL thingy I don't understand), so remove it. (let* ((last (last arglist))
(let ((x (memq '&cl-defs arglist))) (tail (cdr last)))
(when x (setq arglist (delq (car x) (remq (cadr x) arglist))))) (unwind-protect
(let ((state nil)) (progn
(mapcar (lambda (x) (setcdr last nil)
(cond (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail)))
((symbolp x) (setcdr last tail)))
(if (eq ?\& (aref (symbol-name x) 0)) ;; `orig-args' can contain &cl-defs (an internal
(setq state x) ;; CL thingy I don't understand), so remove it.
(make-symbol (upcase (symbol-name x))))) (let ((x (memq '&cl-defs arglist)))
((not (consp x)) x) (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
((memq state '(nil &rest)) (cl--make-usage-args x)) (let ((state nil))
(t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). (mapcar (lambda (x)
(cl-list* (cond
(if (and (consp (car x)) (eq state '&key)) ((symbolp x)
(list (caar x) (cl--make-usage-var (nth 1 (car x)))) (if (eq ?\& (aref (symbol-name x) 0))
(cl--make-usage-var (car x))) (setq state x)
(nth 1 x) ;INITFORM. (make-symbol (upcase (symbol-name x)))))
(cl--make-usage-args (nthcdr 2 x)) ;SVAR. ((not (consp x)) x)
)))) ((memq state '(nil &rest)) (cl--make-usage-args x))
arglist))) (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
(cl-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--do-arglist (args expr &optional num) ; uses bind-* (defun cl--do-arglist (args expr &optional num) ; uses bind-*
(if (nlistp args) (if (nlistp args)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment