Commit c23d55f4 authored by Vitalie Spinu's avatar Vitalie Spinu Committed by Stefan Monnier
Browse files

* lisp/subr.el (internal-push-keymap, internal-pop-keymap): New functions.

(set-temporary-overlay-map): Use them; and take advantage of
lexical-binding.

Fixes: debbugs:14095
parent 8baeb37a
2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (internal-push-keymap, internal-pop-keymap): New functions.
(set-temporary-overlay-map): Use them (bug#14095); and take advantage of
lexical-binding.
2013-06-13 Vitalie Spinu <spinuvit@gmail.com>
* subr.el (set-temporary-overlay-map): Add on-exit argument.
2013-06-13 Glenn Morris <rgm@gnu.org> 2013-06-13 Glenn Morris <rgm@gnu.org>
   
* startup.el (tty-handle-args): * startup.el (tty-handle-args):
...@@ -4234,7 +4234,25 @@ use `called-interactively-p'." ...@@ -4234,7 +4234,25 @@ use `called-interactively-p'."
(declare (obsolete called-interactively-p "23.2")) (declare (obsolete called-interactively-p "23.2"))
(called-interactively-p 'interactive)) (called-interactively-p 'interactive))
(defun set-temporary-overlay-map (map &optional keep-pred) (defun internal-push-keymap (keymap symbol)
(let ((map (symbol-value symbol)))
(unless (memq keymap map)
(unless (memq 'add-keymap-witness (symbol-value symbol))
(setq map (make-composed-keymap nil (symbol-value symbol)))
(push 'add-keymap-witness (cdr map))
(set symbol map))
(push keymap (cdr map)))))
(defun internal-pop-keymap (keymap symbol)
(let ((map (symbol-value symbol)))
(when (memq keymap map)
(setf (cdr map) (delq keymap (cdr map))))
(let ((tail (cddr map)))
(and (or (null tail) (keymapp tail))
(eq 'add-keymap-witness (nth 1 map))
(set symbol tail)))))
(defun set-temporary-overlay-map (map &optional keep-pred on-exit)
"Set MAP as a temporary keymap taking precedence over most other keymaps. "Set MAP as a temporary keymap taking precedence over most other keymaps.
Note that this does NOT take precedence over the \"overriding\" maps Note that this does NOT take precedence over the \"overriding\" maps
`overriding-terminal-local-map' and `overriding-local-map' (or the `overriding-terminal-local-map' and `overriding-local-map' (or the
...@@ -4244,29 +4262,29 @@ found in MAP, the normal key lookup sequence then continues. ...@@ -4244,29 +4262,29 @@ found in MAP, the normal key lookup sequence then continues.
Normally, MAP is used only once. If the optional argument Normally, MAP is used only once. If the optional argument
KEEP-PRED is t, MAP stays active if a key from MAP is used. KEEP-PRED is t, MAP stays active if a key from MAP is used.
KEEP-PRED can also be a function of no arguments: if it returns KEEP-PRED can also be a function of no arguments: if it returns
non-nil then MAP stays active." non-nil then MAP stays active.
(let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
(overlaysym (make-symbol "t")) Optional ON-EXIT argument is a function that is called after the
(alist (list (cons overlaysym map))) deactivation of MAP."
(clearfun (letrec ((clearfun
;; FIXME: Use lexical-binding. (lambda ()
`(lambda () ;; FIXME: Handle the case of multiple temporary-overlay-maps
(unless ,(cond ((null keep-pred) nil) ;; E.g. if isearch and C-u both use temporary-overlay-maps, Then
;; the lifetime of the C-u should be nested within the isearch
;; overlay, so the pre-command-hook of isearch should be
;; suspended during the C-u one so we don't exit isearch just
;; because we hit 1 after C-u and that 1 exits isearch whereas it
;; doesn't exit C-u.
(unless (cond ((null keep-pred) nil)
((eq t keep-pred) ((eq t keep-pred)
`(eq this-command (eq this-command
(lookup-key ',map (lookup-key map (this-command-keys-vector))))
(this-command-keys-vector)))) (t (funcall keep-pred)))
(t `(funcall ',keep-pred))) (remove-hook 'pre-command-hook clearfun)
(set ',overlaysym nil) ;Just in case. (internal-pop-keymap map 'overriding-terminal-local-map)
(remove-hook 'pre-command-hook ',clearfunsym) (when on-exit (funcall on-exit))))))
(setq emulation-mode-map-alists (add-hook 'pre-command-hook clearfun)
(delq ',alist emulation-mode-map-alists)))))) (internal-push-keymap map 'overriding-terminal-local-map)))
(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 reporters.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment