diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 112 |
1 files changed, 104 insertions, 8 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 6513950e4ef..b1295a0f0d6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1183,6 +1183,30 @@ KEY is a string or vector representing a sequence of keystrokes." (if (current-local-map) (local-set-key key nil)) nil) + +(defun local-key-binding (keys &optional accept-default) + "Return the binding for command KEYS in current local keymap only. +KEYS is a string or vector, a sequence of keystrokes. +The binding is probably a symbol with a function definition. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details +about this." + (let ((map (current-local-map))) + (when map (lookup-key map keys accept-default)))) + +(defun global-key-binding (keys &optional accept-default) + "Return the binding for command KEYS in current global keymap only. +KEYS is a string or vector, a sequence of keystrokes. +The binding is probably a symbol with a function definition. +This function's return values are the same as those of `lookup-key' +\(which see). + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details +about this." + (lookup-key (current-global-map) keys accept-default)) + ;;;; substitute-key-definition and its subroutines. @@ -1335,7 +1359,9 @@ The normal global definition of the character C-x indirects to this keymap.") map) "Default global keymap mapping Emacs keyboard input into commands. The value is a keymap that is usually (but not necessarily) Emacs's -global map.") +global map. + +See also `current-global-map'.") (use-global-map global-map) @@ -1879,9 +1905,33 @@ all symbols are bound before any of the VALUEFORMs are evalled." ;; As a special-form, we could implement it more efficiently (and cleanly, ;; making the vars actually unbound during evaluation of the binders). (declare (debug let) (indent 1)) - `(let ,(mapcar #'car binders) - ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) - ,@body)) + ;; Use plain `let*' for the non-recursive definitions. + ;; This only handles the case where the first few definitions are not + ;; recursive. Nothing as fancy as an SCC analysis. + (let ((seqbinds nil)) + ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep' + ;; may fail to see references that will be introduced later by + ;; macroexpansion. We could call `macroexpand-all' to avoid that, + ;; but in order to avoid that, we instead check to see if the binders + ;; appear in the macroexp environment, since that's how references can be + ;; introduced later on. + (unless (macroexp--fgrep binders macroexpand-all-environment) + (while (and binders + (null (macroexp--fgrep binders (nth 1 (car binders))))) + (push (pop binders) seqbinds))) + (let ((nbody (if (null binders) + (macroexp-progn body) + `(let ,(mapcar #'car binders) + ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) + ,@body)))) + (cond + ;; All bindings are recursive. + ((null seqbinds) nbody) + ;; Special case for trivial uses. + ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds))) + (nth 1 (car seqbinds))) + ;; General case. + (t `(let* ,(nreverse seqbinds) ,nbody)))))) (defmacro dlet (binders &rest body) "Like `let*' but using dynamic scoping." @@ -2524,23 +2574,52 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'." ;;;; Input and display facilities. -(defconst read-key-empty-map (make-sparse-keymap)) +;; The following maps are used by `read-key' to remove all key +;; bindings while calling `read-key-sequence'. This way the keys +;; returned are independent of the key binding state. + +(defconst read-key-empty-map (make-sparse-keymap) + "Used internally by `read-key'.") + +(defconst read-key-full-map + (let ((map (make-sparse-keymap))) + (define-key map [t] 'dummy) + + ;; ESC needs to be unbound so that escape sequences in + ;; `input-decode-map' are still processed by `read-key-sequence'. + (define-key map [?\e] nil) + map) + "Used internally by `read-key'.") (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. -(defun read-key (&optional prompt) +(defun read-key (&optional prompt disable-fallbacks) "Read a key from the keyboard. Contrary to `read-event' this will not return a raw event but instead will obey the input decoding and translations usually done by `read-key-sequence'. So escape sequences and keyboard encoding are taken into account. When there's an ambiguity because the key looks like the prefix of -some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." +some sort of escape sequence, the ambiguity is resolved via `read-key-delay'. + +If the optional argument PROMPT is non-nil, display that as a +prompt. + +If the optional argument DISABLE-FALLBACKS is non-nil, all +unbound fallbacks usually done by `read-key-sequence' are +disabled such as discarding mouse down events. This is generally +what you want as `read-key' temporarily removes all bindings +while calling `read-key-sequence'. If nil or unspecified, the +only unbound fallback disabled is downcasing of the last event." ;; This overriding-terminal-local-map binding also happens to ;; disable quail's input methods, so although read-key-sequence ;; always inherits the input method, in practice read-key does not ;; inherit the input method (at least not if it's based on quail). (let ((overriding-terminal-local-map nil) - (overriding-local-map read-key-empty-map) + (overriding-local-map + ;; FIXME: Audit existing uses of `read-key' to see if they + ;; should always specify disable-fallbacks to be more in line + ;; with `read-event'. + (if disable-fallbacks read-key-full-map read-key-empty-map)) (echo-keystrokes 0) (old-global-map (current-global-map)) (timer (run-with-idle-timer @@ -2594,6 +2673,23 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (message nil) (use-global-map old-global-map)))) +;; FIXME: Once there's a safe way to transition away from read-event, +;; callers to this function should be updated to that way and this +;; function should be deleted. +(defun read--potential-mouse-event () + "Read an event that might be a mouse event. + +This function exists for backward compatibility in code packaged +with Emacs. Do not call it directly in your own packages." + ;; `xterm-mouse-mode' events must go through `read-key' as they + ;; are decoded via `input-decode-map'. + (if xterm-mouse-mode + (read-key nil + ;; Normally `read-key' discards all mouse button + ;; down events. However, we want them here. + t) + (read-event))) + (defvar read-passwd-map ;; BEWARE: `defconst' would purecopy it, breaking the sharing with ;; minibuffer-local-map along the way! |