Mercurial > hg > xemacs-beta

diff lisp/cl-macs.el @ 4793:8b50bee3c88c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove attempted support for 1996-era emacs without self-quoting keywords. lisp/ChangeLog addition: 2009-12-19 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-do-arglist): * cl-compat.el (keyword-of): Remove support in our generated code for emacs versions where keywords are not self-quoting. src/ChangeLog addition: 2009-12-19 Aidan Kehoe <kehoea@parhasard.net> * symbols.c (reject_constant_symbols): Indicate that accepting attempted modification of keywords is a temporary thing.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 19 Dec 2009 18:10:20 +0000
parents e29fcfd8df5f
children 8484c6c76837
line wrap: on
line diff
--- a/lisp/cl-macs.el	Fri Dec 18 17:49:43 2009 +0000
+++ b/lisp/cl-macs.el	Sat Dec 19 18:10:20 2009 +0000
@@ -440,12 +440,19 @@
 	(while (and args (not (memq (car args) lambda-list-keywords)))
 	  (let ((arg (pop args)))
 	    (or (consp arg) (setq arg (list arg)))
-	    (let* ((karg (if (consp (car arg)) (caar arg)
-			   (intern (format ":%s" (car arg)))))
+	    (let* ((karg (if (consp (car arg))
+			     ;; It's possible to use non-keywords here, as
+			     ;; in the KEYWORD-ARGUMENT-NAME-PACKAGE Common
+			     ;; Lisp issue:
+			     (caar arg)
+			   ;; Use read instead of intern in case we ever
+			   ;; actually get packages and keywords are no
+			   ;; longer in obarray:
+			   (read (concat ":" (symbol-name (car arg))))))
 		   (varg (if (consp (car arg)) (cadar arg) (car arg)))
 		   (def (if (cdr arg) (cadr arg)
 			  (or (car bind-defs) (cadr (assq varg bind-defs)))))
-		   (look (list 'memq (list 'quote karg) restarg)))
+		   (look (list 'memq (quote-maybe karg) restarg)))
 	      (and def bind-enquote (setq def (list 'quote def)))
 	      (if (cddr arg)
 		  (let* ((temp (or (nth 2 arg) (gensym)))
@@ -467,12 +474,7 @@
 					  'quote
 					  (list nil (cl-const-expr-val def)))
 				       (list 'list nil def))))))))
-	      (push karg keys)
-	      ;; XEmacs addition
-	      (if (= (aref (symbol-name karg) 0) ?:)
-		  (progn (set karg karg)
-			 (push (list 'setq karg (list 'quote karg))
-			       bind-inits)))))))
+	      (push karg keys)))))
       (setq keys (nreverse keys))
       (or (and (eq (car args) '&allow-other-keys) (pop args))
 	  (null keys) (= safety 0)
@@ -487,7 +489,7 @@
 				(list 'setq var (list 'cdr (list 'cdr var))))
 			  (list (list 'car
 				      (list 'cdr
-					    (list 'memq (cons 'quote allow)
+					    (list 'memq (car allow)
 						  restarg)))
 				(list 'setq var nil))
 			  (list t