From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 23 Apr 2010 16:26:11 +0000 (-0400)
Subject: Provide byte-compiler warnings when set-default a read-only var.
X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~413
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9ae0c31028f246f77a16f4989d5c63bfbbee4832;p=emacs.git

Provide byte-compiler warnings when set-default a read-only var.
* emacs-lisp/bytecomp.el (byte-compile-set-default): New function.
(byte-compile-setq-default): Optimize for the
single-var case and don't call byte-compile-form in this case to avoid
inf-loop with byte-compile-set-default.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5b1396a9198..834f8486ea6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2010-04-23  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/bytecomp.el (byte-compile-set-default): New function.
+	(byte-compile-setq-default): Optimize for the
+	single-var case and don't call byte-compile-form in this case to avoid
+	inf-loop with byte-compile-set-default.
+
 	* progmodes/compile.el (compilation-start): Abbreviate default directory.
 
 2010-04-23  Michael Albinus  <michael.albinus@gmx.de>
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b593596a526..0c3a7b69798 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3333,21 +3333,31 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
     (setq for-effect nil)))
 
 (defun byte-compile-setq-default (form)
-  (let ((bytecomp-args (cdr form))
-	setters)
-    (while bytecomp-args
-      (let ((var (car bytecomp-args)))
-	(and (or (not (symbolp var))
-		 (byte-compile-const-symbol-p var t))
-	     (byte-compile-warning-enabled-p 'constants)
-	     (byte-compile-warn
-	      "variable assignment to %s `%s'"
-	      (if (symbolp var) "constant" "nonvariable")
-	      (prin1-to-string var)))
-	(push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
-	      setters))
-      (setq bytecomp-args (cdr (cdr bytecomp-args))))
-    (byte-compile-form (cons 'progn (nreverse setters)))))
+  (setq form (cdr form))
+  (if (> (length form) 2)
+      (let ((setters ()))
+        (while (consp form)
+          (push `(setq-default ,(pop form) ,(pop form)) setters))
+        (byte-compile-form (cons 'progn (nreverse setters))))
+    (let ((var (car form)))
+      (and (or (not (symbolp var))
+               (byte-compile-const-symbol-p var t))
+           (byte-compile-warning-enabled-p 'constants)
+           (byte-compile-warn
+            "variable assignment to %s `%s'"
+            (if (symbolp var) "constant" "nonvariable")
+            (prin1-to-string var)))
+      (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+
+(byte-defop-compiler-1 set-default)
+(defun byte-compile-set-default (form)
+  (let ((varexp (car-safe (cdr-safe form))))
+    (if (eq (car-safe varexp) 'quote)
+        ;; If the varexp is constant, compile it as a setq-default
+        ;; so we get more warnings.
+        (byte-compile-setq-default `(setq-default ,(car-safe (cdr varexp))
+                                                  ,@(cddr form)))
+      (byte-compile-normal-call form))))
 
 (defun byte-compile-quote (form)
   (byte-compile-constant (car (cdr form))))
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 18a75437f97..c1fcd530d60 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -232,6 +232,7 @@ holds a keymap."
 	 submap key)
     ;; We'll pick up the last valid entry in the list of keys if
     ;; there's more than one.
+    ;; FIXME: Aren't they *all* "valid"??  --Stef
     (dolist (k keys)
       ;; We're looking for a binding of the command in a submap of
       ;; the menu bar map, so the key sequence must be two or more
@@ -242,24 +243,24 @@ holds a keymap."
                 ;; Last element in the bound key sequence:
                 (kk (aref k (1- (length k)))))
             (if (and (keymapp m)
-                     (symbolp kk))
+                     (symbolp kk))      ;FIXME: Why?  --Stef
                 (setq submap m
                       key kk)))))
-    (when (and (symbolp submap) (boundp submap))
-      (setq submap (eval submap)))
-    (let ((defn (assq key (cdr submap))))
-      (if (eq (cadr defn) 'menu-item)
-          (define-key-after in-map (vector key)
-            (append (cdr defn) (list :image image-exp) props))
-        (setq defn (cdr defn))
+    (when submap
+      (let ((defn nil))
+        ;; Here, we're essentially doing a "lookup-key without get_keyelt".
+        (map-keymap (lambda (k b) (if (eq k key) (setq defn b)))
+                    submap)
         (define-key-after in-map (vector key)
-          (let ((rest (cdr defn)))
-            ;; If the rest of the definition starts
-            ;; with a list of menu cache info, get rid of that.
-            (if (and (consp rest) (consp (car rest)))
-                (setq rest (cdr rest)))
-            (append `(menu-item ,(car defn) ,rest)
-                    (list :image image-exp) props)))))))
+          (if (eq (car defn) 'menu-item)
+              (append (cdr defn) (list :image image-exp) props)
+            (let ((rest (cdr defn)))
+              ;; If the rest of the definition starts
+              ;; with a list of menu cache info, get rid of that.
+              (if (and (consp rest) (consp (car rest)))
+                  (setq rest (cdr rest)))
+              (append `(menu-item ,(car defn) ,rest)
+                      (list :image image-exp) props))))))))
 
 ;;; Set up some global items.  Additions/deletions up for grabs.