[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r108692: * lisp/emacs-lisp/cl-macs.el
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r108692: * lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists. |
Date: |
Sat, 23 Jun 2012 00:24:06 -0400 |
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 108692
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11719
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2012-06-23 00:24:06 -0400
message:
* lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists.
modified:
lisp/ChangeLog
lisp/emacs-lisp/cl-loaddefs.el
lisp/emacs-lisp/cl-macs.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-06-23 03:48:18 +0000
+++ b/lisp/ChangeLog 2012-06-23 04:24:06 +0000
@@ -1,5 +1,8 @@
2012-06-23 Stefan Monnier <address@hidden>
+ * 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).
=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el 2012-06-22 21:24:54 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el 2012-06-23 04:24:06 +0000
@@ -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 @@
;;;;;; 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" "\
=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el 2012-06-22 21:24:54 +0000
+++ b/lisp/emacs-lisp/cl-macs.el 2012-06-23 04:24:06 +0000
@@ -350,28 +350,36 @@
(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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r108692: * lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists.,
Stefan Monnier <=