[Emacs-diffs] /srv/bzr/emacs/trunk r108127: New function set-temporary-overlay-map and macros (defvar|setq)-local.

[Stefan Monnier]

------------------------------------------------------------
revno: 108127
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2012-05-04 21:47:04 -0400
message:
  New function set-temporary-overlay-map and macros (defvar|setq)-local.
  * lisp/subr.el (setq-local, defvar-local): New macros.
  (kbd): Redefine as an alias.
  (with-selected-window): Leave unrelated frames alone.
  (set-temporary-overlay-map): New function.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/subr.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-05-04 23:16:47 +0000
+++ b/etc/NEWS  2012-05-05 01:47:04 +0000
@@ -199,7 +199,12 @@
 
 * Lisp changes in Emacs 24.2
 
+** New function `set-temporary-overlay-map'.
+
+** New macros `setq-local' and `defvar-local'.
+
 ** New error type and new function `user-error'.  Doesn't trigger the debugger.
+
 ** Completion
 
 *** New function `completion-table-with-quoting' to handle completion

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-05-04 23:16:47 +0000
+++ b/lisp/ChangeLog    2012-05-05 01:47:04 +0000
@@ -1,3 +1,10 @@
+2012-05-05  Stefan Monnier  <address@hidden>
+
+       * subr.el (setq-local, defvar-local): New macros.
+       (kbd): Redefine as an alias.
+       (with-selected-window): Leave unrelated frames alone.
+       (set-temporary-overlay-map): New function.
+
 2012-05-04  Stefan Monnier  <address@hidden>
 
        * subr.el (user-error): New function.

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2012-05-04 23:16:47 +0000
+++ b/lisp/subr.el      2012-05-05 01:47:04 +0000
@@ -116,6 +116,19 @@
   ;; depend on backquote.el.
   (list 'function (cons 'lambda cdr)))
 
+(defmacro setq-local (var val)
+  "Set variable VAR to value VAL in current buffer."
+  ;; Can't use backquote here, it's too early in the bootstrap.
+  (list 'set (list 'make-local-variable (list 'quote var)) val))
+
+(defmacro defvar-local (var val &optional docstring)
+  "Define VAR as a buffer-local variable with default value VAL.
+Like `defvar' but additionally marks the variable as being automatically
+buffer-local wherever it is set."
+  ;; Can't use backquote here, it's too early in the bootstrap.
+  (list 'progn (list 'defvar var val docstring)
+        (list 'make-variable-buffer-local (list 'quote var))))
+
 (defun apply-partially (fun &rest args)
   "Return a function that is a partial application of FUN to ARGS.
 ARGS is a list of the first N arguments to pass to FUN.
@@ -506,11 +519,8 @@
 
 ;;;; Keymap support.
 
-(defmacro kbd (keys)
-  "Convert KEYS to the internal Emacs key representation.
-KEYS should be a string constant in the format used for
-saving keyboard macros (see `edmacro-mode')."
-  (read-kbd-macro keys))
+(defalias 'kbd 'read-kbd-macro)
+(put 'kbd 'pure t)
 
 (defun undefined ()
   "Beep to tell the user this binding is undefined."
@@ -2986,21 +2996,26 @@
 the buffer list ordering."
   (declare (indent 1) (debug t))
   ;; Most of this code is a copy of save-selected-window.
-  `(let ((save-selected-window-window (selected-window))
-        ;; It is necessary to save all of these, because calling
-        ;; select-window changes frame-selected-window for whatever
-        ;; frame that window is in.
-        (save-selected-window-alist
-         (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
-                 (frame-list))))
+  `(let* ((save-selected-window-destination ,window)
+          (save-selected-window-window (selected-window))
+          ;; Selecting a window on another frame changes not only the
+          ;; selected-window but also the frame-selected-window of the
+          ;; destination frame.  So we need to save&restore it.
+          (save-selected-window-other-frame
+           (unless (eq (selected-frame)
+                       (window-frame save-selected-window-destination))
+             (frame-selected-window
+              (window-frame save-selected-window-destination)))))
      (save-current-buffer
        (unwind-protect
-          (progn (select-window ,window 'norecord)
+           (progn (select-window save-selected-window-destination 'norecord)
                  ,@body)
-        (dolist (elt save-selected-window-alist)
-          (and (frame-live-p (car elt))
-               (window-live-p (cadr elt))
-               (set-frame-selected-window (car elt) (cadr elt) 'norecord)))
+         ;; First reset frame-selected-window.
+         (if (window-live-p save-selected-window-other-frame)
+             ;; We don't use set-frame-selected-window because it does not
+             ;; pass the `norecord' argument to Fselect_window.
+             (select-window save-selected-window-other-frame 'norecord))
+         ;; Then reset the actual selected-window.
         (when (window-live-p save-selected-window-window)
           (select-window save-selected-window-window 'norecord))))))
 
@@ -3808,6 +3823,29 @@
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 
+(defun set-temporary-overlay-map (map &optional keep-pred)
+  (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
+         (overlaysym (make-symbol "t"))
+         (alist (list (cons overlaysym map)))
+         (clearfun
+          ;; FIXME: Use lexical-binding.
+          `(lambda ()
+             (unless ,(cond ((null keep-pred) nil)
+                            ((eq t keep-pred)
+                             `(eq this-command
+                                  (lookup-key ',map
+                                              (this-command-keys-vector))))
+                            (t `(funcall ',keep-pred)))
+               (remove-hook 'pre-command-hook ',clearfunsym)
+               (setq emulation-mode-map-alists
+                     (delq ',alist emulation-mode-map-alists))))))
+    (set overlaysym overlaysym)
+    (fset clearfunsym clearfun)
+    (add-hook 'pre-command-hook clearfunsym)
+    ;; FIXME: That's the keymaps with highest precedence, except for
+    ;; the `keymap' text-property ;-(
+    (push alist emulation-mode-map-alists)))
+
 ;;;; Progress reporters.
 
 ;; Progress reporter has the following structure: