[Emacs-diffs] /srv/bzr/emacs/trunk r100010: Provide byte-compiler warnings when set-default a read-only var.

[Stefan Monnier]

------------------------------------------------------------
revno: 100010
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2010-04-23 12:26:11 -0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/bytecomp.el
  lisp/tool-bar.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-04-23 15:59:32 +0000
+++ b/lisp/ChangeLog    2010-04-23 16:26:11 +0000
@@ -1,5 +1,10 @@
 2010-04-23  Stefan Monnier  <address@hidden>
 
+       * 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  <address@hidden>

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el       2010-01-13 08:35:10 +0000
+++ b/lisp/emacs-lisp/bytecomp.el       2010-04-23 16:26:11 +0000
@@ -3333,21 +3333,31 @@
     (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))))

=== modified file 'lisp/tool-bar.el'
--- a/lisp/tool-bar.el  2010-04-20 18:52:07 +0000
+++ b/lisp/tool-bar.el  2010-04-23 16:26:11 +0000
@@ -232,6 +232,7 @@
         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 @@
                 ;; 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.