From b68581e26c51dd78674a5a83928f680cdbd22213 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Jun 2012 00:24:06 -0400 Subject: [PATCH] * lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists. Fixes: debbugs:11719 --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/cl-loaddefs.el | 4 ++-- lisp/emacs-lisp/cl-macs.el | 52 ++++++++++++++++++++++++------------------ 3 files changed, 35 insertions(+), 24 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4f7f8a2d300..4f017f0f503 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-06-23 Stefan Monnier + * 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 the requote function doesn't work properly (bug#11714). diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 79f4d775e1a..f7eaa3b9f9c 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -11,7 +11,7 @@ ;;;;;; cl--set-frame-visible-p cl--map-overlays cl--map-intervals ;;;;;; 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-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 (autoload 'cl-coerce "cl-extra" "\ @@ -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-load-time-value cl-eval-when cl-destructuring-bind cl-function ;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el" -;;;;;; "66d8d151a97f91a79ebe3d1a9d699483") +;;;;;; "41a15289eda7e6ae03ac9edd86bbb1a6") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index d4bd73827d2..eaa988bfb58 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -350,28 +350,36 @@ its argument list allows full Common Lisp conventions." (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). - (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))) + (if (cdr-safe (last arglist)) ;Not a proper list. + (let* ((last (last arglist)) + (tail (cdr last))) + (unwind-protect + (progn + (setcdr last nil) + (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail))) + (setcdr last tail))) + ;; `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). + (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-* (if (nlistp args) -- 2.11.4.GIT