changeset 5513:cf2733b1ff4b

Be more reasonable in the implementation of #'make-modeline-command-wrapper. lisp/ChangeLog addition: 2011-05-27 Aidan Kehoe <kehoea@parhasard.net> * modeline.el (make-modeline-command-wrapper): Be more reasonable about the implementation of this wrapper, don't require that the value of COMMAND be available at macro-expansion time. (Basically, implement a closure.) * modeline.el (add-minor-mode): Remove a workaround and misguided comment that are no longer necessary or exact.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 27 May 2011 14:31:56 +0100
parents 4aa8ee813265
children 9d519ab9fd68
files lisp/ChangeLog lisp/modeline.el
diffstat 2 files changed, 48 insertions(+), 8 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed May 25 09:15:20 2011 -0600
+++ b/lisp/ChangeLog	Fri May 27 14:31:56 2011 +0100
@@ -1,3 +1,13 @@
+2011-05-27  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* modeline.el (make-modeline-command-wrapper):
+	Be more reasonable about the implementation of this wrapper, don't
+	require that the value of COMMAND be available at macro-expansion
+	time. (Basically, implement a closure.)
+	* modeline.el (add-minor-mode):
+	Remove a workaround and misguided comment that are no longer
+	necessary or exact.
+
 2011-05-25  Didier Verna  <didier@xemacs.org>
 
 	* cl-macs.el (macrolet):
--- a/lisp/modeline.el	Wed May 25 09:15:20 2011 -0600
+++ b/lisp/modeline.el	Fri May 27 14:31:56 2011 +0100
@@ -332,11 +332,43 @@
   (set-face-font 'modeline-mousable [bold] nil '(default grayscale win)))
 
 (defmacro make-modeline-command-wrapper (command)
-  `#'(lambda (event)
-       (interactive "e")
-       (save-selected-window
-	 (select-window (event-window event))
-	 (call-interactively ',(eval command)))))
+  "Return a function object wrapping COMMAND, for use with the modeline.
+
+The function (itself a command, with \"e\" as its interactive spec) calls
+COMMAND with the appropriate window selected, and is suitable as a binding
+in the keymaps associated with the modeline."
+  (cond
+   ((and-fboundp 'cl-const-expr-p (cl-const-expr-p command))
+    `#'(lambda (event)
+         (interactive "e")
+         (save-selected-window
+           (select-window (event-window event))
+           (call-interactively ,command))))
+   ((eval-when-compile (cl-compiling-file))
+    (let ((compiled
+           (eval-when-compile
+             (byte-compile-sexp
+              #'(lambda (event)
+                  (interactive "e")
+                  (save-selected-window
+                    (select-window (event-window event))
+                    (call-interactively 'placeholder)))))))
+      `(make-byte-code ',(compiled-function-arglist compiled)
+        ,(compiled-function-instructions compiled)
+        (vector ,@(subst command ''placeholder
+                         (mapcar 'quote-maybe 
+                                 (compiled-function-constants compiled))
+                         :test 'equal))
+        ,(compiled-function-stack-depth compiled)
+        ,(compiled-function-doc-string compiled)
+        ,(quote-maybe (second (compiled-function-interactive compiled))))))
+   (t
+    `(lexical-let ((command ,command))
+      #'(lambda (event)
+          (interactive "e")
+          (save-selected-window
+            (select-window (event-window event))
+            (call-interactively command)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;                            Minor modes                              ;;;
@@ -427,9 +459,7 @@
 					   (symbol-name toggle)
 					   "-map"))))
       (define-key toggle-keymap 'button2
-	;; defeat the DUMB-ASS byte-compiler, which tries to
-	;; expand the macro at compile time and fucks up.
-	(eval '(make-modeline-command-wrapper toggle-fun)))
+        (make-modeline-command-wrapper toggle-fun))
       (put toggle 'modeline-toggle-function toggle-fun))
     (when name
       (let ((hacked-name