Add multiple inheritance to keymaps.
* src/keymap.c (Fmake_composed_keymap): New function. (Fset_keymap_parent): Simplify. (fix_submap_inheritance): Remove. (access_keymap_1): New function extracted from access_keymap to handle embedded parents and handle lists of maps. (access_keymap): Use it. (Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap) (Fcopy_keymap): Handle embedded parents. (Fcommand_remapping, define_as_prefix): Simplify. (Fkey_binding): Simplify. (syms_of_keymap): Move minibuffer-local-completion-map, minibuffer-local-filename-completion-map, minibuffer-local-must-match-map, and minibuffer-local-filename-must-match-map to Elisp. (syms_of_keymap): Defsubr make-composed-keymap. * src/keyboard.c (menu_bar_items): Use map_keymap_canonical. (parse_menu_item): Trivial simplification. * lisp/subr.el (remq): Don't allocate if it's not needed. (keymap--menu-item-binding, keymap--menu-item-with-binding) (keymap--merge-bindings): New functions. (keymap-canonicalize): Use them to refine the canonicalization. * lisp/minibuffer.el (minibuffer-local-completion-map) (minibuffer-local-must-match-map): Move initialization from C. (minibuffer-local-filename-completion-map): Move initialization from C; don't inherit from anything here. (minibuffer-local-filename-must-match-map): Make obsolete. (completing-read-default): Use make-composed-keymap to combine minibuffer-local-filename-completion-map with either minibuffer-local-must-match-map or minibuffer-local-filename-completion-map.
This commit is contained in:
Stefan Monnier
parent
3de63bf809
commit
3349e122e2
7 changed files with 337 additions and 382 deletions
5
etc/NEWS
5
etc/NEWS
|
|
@ -111,6 +111,10 @@ and pops down the *Completions* buffer accordingly.
|
|||
*** `completing-read' can be customized using the new variable
|
||||
`completing-read-function'.
|
||||
|
||||
*** minibuffer-local-filename-must-match-map is not used any more.
|
||||
Instead, the bindings in minibuffer-local-filename-completion-map are combined
|
||||
with minibuffer-local-must-match-map.
|
||||
|
||||
** auto-mode-case-fold is now enabled by default.
|
||||
|
||||
** smtpmail changes
|
||||
|
|
@ -1094,6 +1098,7 @@ as well as those in the -*- line.
|
|||
---
|
||||
** rx.el has a new `group-n' construct for explicitly numbered groups.
|
||||
|
||||
** keymaps can inherit from multiple parents.
|
||||
|
||||
* Changes in Emacs 24.1 on non-free operating systems
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,19 @@
|
|||
2011-07-02 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* subr.el (remq): Don't allocate if it's not needed.
|
||||
(keymap--menu-item-binding, keymap--menu-item-with-binding)
|
||||
(keymap--merge-bindings): New functions.
|
||||
(keymap-canonicalize): Use them to refine the canonicalization.
|
||||
* minibuffer.el (minibuffer-local-completion-map)
|
||||
(minibuffer-local-must-match-map): Move initialization from C.
|
||||
(minibuffer-local-filename-completion-map): Move initialization from C;
|
||||
don't inherit from anything here.
|
||||
(minibuffer-local-filename-must-match-map): Make obsolete.
|
||||
(completing-read-default): Use make-composed-keymap to combine
|
||||
minibuffer-local-filename-completion-map with either
|
||||
minibuffer-local-must-match-map or
|
||||
minibuffer-local-filename-completion-map.
|
||||
|
||||
2011-07-01 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* type-break.el (type-break-time-sum): Use dolist.
|
||||
|
|
|
|||
|
|
@ -1634,30 +1634,43 @@ The completion method is determined by `completion-at-point-functions'."
|
|||
|
||||
;;; Key bindings.
|
||||
|
||||
(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
|
||||
'minibuffer-local-filename-must-match-map "23.1")
|
||||
|
||||
(let ((map minibuffer-local-map))
|
||||
(define-key map "\C-g" 'abort-recursive-edit)
|
||||
(define-key map "\r" 'exit-minibuffer)
|
||||
(define-key map "\n" 'exit-minibuffer))
|
||||
|
||||
(let ((map minibuffer-local-completion-map))
|
||||
(define-key map "\t" 'minibuffer-complete)
|
||||
;; M-TAB is already abused for many other purposes, so we should find
|
||||
;; another binding for it.
|
||||
;; (define-key map "\e\t" 'minibuffer-force-complete)
|
||||
(define-key map " " 'minibuffer-complete-word)
|
||||
(define-key map "?" 'minibuffer-completion-help))
|
||||
(defvar minibuffer-local-completion-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map minibuffer-local-map)
|
||||
(define-key map "\t" 'minibuffer-complete)
|
||||
;; M-TAB is already abused for many other purposes, so we should find
|
||||
;; another binding for it.
|
||||
;; (define-key map "\e\t" 'minibuffer-force-complete)
|
||||
(define-key map " " 'minibuffer-complete-word)
|
||||
(define-key map "?" 'minibuffer-completion-help)
|
||||
map)
|
||||
"Local keymap for minibuffer input with completion.")
|
||||
|
||||
(let ((map minibuffer-local-must-match-map))
|
||||
(define-key map "\r" 'minibuffer-complete-and-exit)
|
||||
(define-key map "\n" 'minibuffer-complete-and-exit))
|
||||
(defvar minibuffer-local-must-match-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map minibuffer-local-completion-map)
|
||||
(define-key map "\r" 'minibuffer-complete-and-exit)
|
||||
(define-key map "\n" 'minibuffer-complete-and-exit)
|
||||
map)
|
||||
"Local keymap for minibuffer input with completion, for exact match.")
|
||||
|
||||
(let ((map minibuffer-local-filename-completion-map))
|
||||
(define-key map " " nil))
|
||||
(let ((map minibuffer-local-filename-must-match-map))
|
||||
(define-key map " " nil))
|
||||
(defvar minibuffer-local-filename-completion-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map " " nil)
|
||||
map)
|
||||
"Local keymap for minibuffer input with completion for filenames.
|
||||
Gets combined either with `minibuffer-local-completion-map' or
|
||||
with `minibuffer-local-must-match-map'.")
|
||||
|
||||
(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
|
||||
(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
|
||||
(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
|
||||
'minibuffer-local-filename-must-match-map "23.1")
|
||||
|
||||
(let ((map minibuffer-local-ns-map))
|
||||
(define-key map " " 'exit-minibuffer)
|
||||
|
|
@ -2732,13 +2745,22 @@ See `completing-read' for the meaning of the arguments."
|
|||
(minibuffer-completion-predicate predicate)
|
||||
(minibuffer-completion-confirm (unless (eq require-match t)
|
||||
require-match))
|
||||
(keymap (if require-match
|
||||
(if (memq minibuffer-completing-file-name '(nil lambda))
|
||||
(base-keymap (if require-match
|
||||
minibuffer-local-must-match-map
|
||||
minibuffer-local-filename-must-match-map)
|
||||
(if (memq minibuffer-completing-file-name '(nil lambda))
|
||||
minibuffer-local-completion-map
|
||||
minibuffer-local-filename-completion-map)))
|
||||
minibuffer-local-completion-map))
|
||||
(keymap (if (memq minibuffer-completing-file-name '(nil lambda))
|
||||
base-keymap
|
||||
;; Layer minibuffer-local-filename-completion-map
|
||||
;; on top of the base map.
|
||||
;; Use make-composed-keymap so that set-keymap-parent
|
||||
;; doesn't modify minibuffer-local-filename-completion-map.
|
||||
(let ((map (make-composed-keymap
|
||||
minibuffer-local-filename-completion-map)))
|
||||
;; Set base-keymap as the parent, so that nil bindings
|
||||
;; in minibuffer-local-filename-completion-map can
|
||||
;; override bindings in base-keymap.
|
||||
(set-keymap-parent map base-keymap)
|
||||
map)))
|
||||
(result (read-from-minibuffer prompt initial-input keymap
|
||||
nil hist def inherit-input-method)))
|
||||
(when (and (equal result "") def)
|
||||
|
|
|
|||
72
lisp/subr.el
72
lisp/subr.el
|
|
@ -490,6 +490,7 @@ SEQ must be a list, vector, or string. The comparison is done with `equal'."
|
|||
"Return LIST with all occurrences of ELT removed.
|
||||
The comparison is done with `eq'. Contrary to `delq', this does not use
|
||||
side-effects, and the argument LIST is not modified."
|
||||
(while (eq elt (car list)) (setq list (cdr list)))
|
||||
(if (memq elt list)
|
||||
(delq elt (copy-sequence list))
|
||||
list))
|
||||
|
|
@ -591,31 +592,88 @@ Don't call this function; it is for internal use only."
|
|||
(dolist (p list)
|
||||
(funcall function (car p) (cdr p)))))
|
||||
|
||||
(defun keymap--menu-item-binding (val)
|
||||
"Return the binding part of a menu-item."
|
||||
(cond
|
||||
((not (consp val)) val) ;Not a menu-item.
|
||||
((eq 'menu-item (car val))
|
||||
(let* ((binding (nth 2 val))
|
||||
(plist (nthcdr 3 val))
|
||||
(filter (plist-get plist :filter)))
|
||||
(if filter (funcall filter binding)
|
||||
binding)))
|
||||
((and (consp (cdr val)) (stringp (cadr val)))
|
||||
(cddr val))
|
||||
((stringp (car val))
|
||||
(cdr val))
|
||||
(t val))) ;Not a menu-item either.
|
||||
|
||||
(defun keymap--menu-item-with-binding (item binding)
|
||||
"Build a menu-item like ITEM but with its binding changed to BINDING."
|
||||
(cond
|
||||
((eq 'menu-item (car item))
|
||||
(setq item (copy-sequence item))
|
||||
(let ((tail (nthcdr 2 item)))
|
||||
(setcar tail binding)
|
||||
;; Remove any potential filter.
|
||||
(if (plist-get (cdr tail) :filter)
|
||||
(setcdr tail (plist-put (cdr tail) :filter nil))))
|
||||
item)
|
||||
((and (consp (cdr item)) (stringp (cadr item)))
|
||||
(cons (car item) (cons (cadr item) binding)))
|
||||
(t (cons (car item) binding))))
|
||||
|
||||
(defun keymap--merge-bindings (val1 val2)
|
||||
"Merge bindings VAL1 and VAL2."
|
||||
(let ((map1 (keymap--menu-item-binding val1))
|
||||
(map2 (keymap--menu-item-binding val2)))
|
||||
(if (not (and (keymapp map1) (keymapp map2)))
|
||||
;; There's nothing to merge: val1 takes precedence.
|
||||
val1
|
||||
(let ((map (list 'keymap map1 map2))
|
||||
(item (if (keymapp val1) (if (keymapp val2) nil val2) val1)))
|
||||
(keymap--menu-item-with-binding item map)))))
|
||||
|
||||
(defun keymap-canonicalize (map)
|
||||
"Return an equivalent keymap, without inheritance."
|
||||
"Return a simpler equivalent keymap.
|
||||
This resolves inheritance and redefinitions. The returned keymap
|
||||
should behave identically to a copy of KEYMAP w.r.t `lookup-key'
|
||||
and use in active keymaps and menus.
|
||||
Subkeymaps may be modified but are not canonicalized."
|
||||
;; FIXME: Problem with the difference between a nil binding
|
||||
;; that hides a binding in an inherited map and a nil binding that's ignored
|
||||
;; to let some further binding visible. Currently a nil binding hides all.
|
||||
;; FIXME: we may want to carefully (re)order elements in case they're
|
||||
;; menu-entries.
|
||||
(let ((bindings ())
|
||||
(ranges ())
|
||||
(prompt (keymap-prompt map)))
|
||||
(while (keymapp map)
|
||||
(setq map (map-keymap-internal
|
||||
(setq map (map-keymap ;; -internal
|
||||
(lambda (key item)
|
||||
(if (consp key)
|
||||
;; Treat char-ranges specially.
|
||||
(push (cons key item) ranges)
|
||||
(push (cons key item) bindings)))
|
||||
map)))
|
||||
;; Create the new map.
|
||||
(setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
|
||||
(dolist (binding ranges)
|
||||
;; Treat char-ranges specially.
|
||||
;; Treat char-ranges specially. FIXME: need to merge as well.
|
||||
(define-key map (vector (car binding)) (cdr binding)))
|
||||
;; Process the bindings starting from the end.
|
||||
(dolist (binding (prog1 bindings (setq bindings ())))
|
||||
(let* ((key (car binding))
|
||||
(item (cdr binding))
|
||||
(oldbind (assq key bindings)))
|
||||
;; Newer bindings override older.
|
||||
(if oldbind (setq bindings (delq oldbind bindings)))
|
||||
(when item ;nil bindings just hide older ones.
|
||||
(push binding bindings))))
|
||||
(push (if (not oldbind)
|
||||
;; The normal case: no duplicate bindings.
|
||||
binding
|
||||
;; This is the second binding for this key.
|
||||
(setq bindings (delq oldbind bindings))
|
||||
(cons key (keymap--merge-bindings (cdr binding)
|
||||
(cdr oldbind))))
|
||||
bindings)))
|
||||
(nconc map bindings)))
|
||||
|
||||
(put 'keyboard-translate-table 'char-table-extra-slots 0)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,24 @@
|
|||
2011-07-02 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Add multiple inheritance to keymaps.
|
||||
* keymap.c (Fmake_composed_keymap): New function.
|
||||
(Fset_keymap_parent): Simplify.
|
||||
(fix_submap_inheritance): Remove.
|
||||
(access_keymap_1): New function extracted from access_keymap to handle
|
||||
embedded parents and handle lists of maps.
|
||||
(access_keymap): Use it.
|
||||
(Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap)
|
||||
(Fcopy_keymap): Handle embedded parents.
|
||||
(Fcommand_remapping, define_as_prefix): Simplify.
|
||||
(Fkey_binding): Simplify.
|
||||
(syms_of_keymap): Move minibuffer-local-completion-map,
|
||||
minibuffer-local-filename-completion-map,
|
||||
minibuffer-local-must-match-map, and
|
||||
minibuffer-local-filename-must-match-map to Elisp.
|
||||
(syms_of_keymap): Defsubr make-composed-keymap.
|
||||
* keyboard.c (menu_bar_items): Use map_keymap_canonical.
|
||||
(parse_menu_item): Trivial simplification.
|
||||
|
||||
2011-07-01 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* Makefile.in (SETTINGS_LIBS): Fix typo.
|
||||
|
|
|
|||
|
|
@ -7470,7 +7470,7 @@ menu_bar_items (Lisp_Object old)
|
|||
if (CONSP (def))
|
||||
{
|
||||
menu_bar_one_keymap_changed_items = Qnil;
|
||||
map_keymap (def, menu_bar_item, Qnil, NULL, 1);
|
||||
map_keymap_canonical (def, menu_bar_item, Qnil, NULL);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -7811,7 +7811,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
|
|||
/* If we got no definition, this item is just unselectable text which
|
||||
is OK in a submenu but not in the menubar. */
|
||||
if (NILP (def))
|
||||
return (inmenubar ? 0 : 1);
|
||||
return (!inmenubar);
|
||||
|
||||
/* See if this is a separate pane or a submenu. */
|
||||
def = AREF (item_properties, ITEM_PROPERTY_DEF);
|
||||
|
|
|
|||
533
src/keymap.c
533
src/keymap.c
|
|
@ -16,6 +16,27 @@ GNU General Public License for more details.
|
|||
You should have received a copy of the GNU General Public License
|
||||
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
|
||||
/* Old BUGS:
|
||||
- [M-C-a] != [?\M-\C-a]
|
||||
- [M-f2] != [?\e f2].
|
||||
- (define-key map [menu-bar foo] <bla>) does not always place <bla>
|
||||
at the head of the menu (if `foo' was already bound earlier and
|
||||
then unbound, for example).
|
||||
TODO:
|
||||
- allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak)
|
||||
- Think about the various defaulting that's currently hard-coded in
|
||||
keyboard.c (uppercase->lowercase, char->charset, button-events, ...)
|
||||
and make it more generic. Maybe we should allow mappings of the
|
||||
form (PREDICATE . BINDING) as generalization of the default binding,
|
||||
tho probably a cleaner way to attack this is to allow functional
|
||||
keymaps (i.e. keymaps that are implemented as functions that implement
|
||||
a few different methods like `lookup', `map', ...).
|
||||
- Make [a] equivalent to [?a].
|
||||
BEWARE:
|
||||
- map-keymap should work meaningfully even if entries are added/removed
|
||||
to the keymap while iterating through it:
|
||||
start - removed <= visited <= start + added
|
||||
*/
|
||||
|
||||
#include <config.h>
|
||||
#include <stdio.h>
|
||||
|
|
@ -73,7 +94,6 @@ static Lisp_Object where_is_cache_keymaps;
|
|||
|
||||
static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object);
|
||||
static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
|
||||
static void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object);
|
||||
|
||||
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
|
||||
static void describe_command (Lisp_Object, Lisp_Object);
|
||||
|
|
@ -130,6 +150,17 @@ in case you use it as a menu with `x-popup-menu'. */)
|
|||
return Fcons (Qkeymap, Qnil);
|
||||
}
|
||||
|
||||
DEFUN ("make-composed-keymap", Fmake_composed_keymap, Smake_composed_keymap,
|
||||
0, MANY, 0,
|
||||
doc: /* Construct and return a new keymap composed of KEYMAPS.
|
||||
When looking up a key in the returned map, the key is looked in each
|
||||
keymap in turn until a binding is found.
|
||||
usage: (make-composed-keymap &rest KEYMAPS) */)
|
||||
(ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
return Fcons (Qkeymap, Flist (nargs, args));
|
||||
}
|
||||
|
||||
/* This function is used for installing the standard key bindings
|
||||
at initialization time.
|
||||
|
||||
|
|
@ -174,6 +205,12 @@ when reading a key-sequence to be looked-up in this keymap. */)
|
|||
Lisp_Object tem = XCAR (map);
|
||||
if (STRINGP (tem))
|
||||
return tem;
|
||||
else if (KEYMAPP (tem))
|
||||
{
|
||||
tem = Fkeymap_prompt (tem);
|
||||
if (!NILP (tem))
|
||||
return tem;
|
||||
}
|
||||
map = XCDR (map);
|
||||
}
|
||||
return Qnil;
|
||||
|
|
@ -300,23 +337,16 @@ Return PARENT. PARENT should be nil or another keymap. */)
|
|||
{
|
||||
Lisp_Object list, prev;
|
||||
struct gcpro gcpro1, gcpro2;
|
||||
int i;
|
||||
|
||||
/* Force a keymap flush for the next call to where-is.
|
||||
Since this can be called from within where-is, we don't set where_is_cache
|
||||
directly but only where_is_cache_keymaps, since where_is_cache shouldn't
|
||||
be changed during where-is, while where_is_cache_keymaps is only used at
|
||||
the very beginning of where-is and can thus be changed here without any
|
||||
adverse effect.
|
||||
This is a very minor correctness (rather than safety) issue. */
|
||||
where_is_cache_keymaps = Qt;
|
||||
/* Flush any reverse-map cache. */
|
||||
where_is_cache = Qnil; where_is_cache_keymaps = Qt;
|
||||
|
||||
GCPRO2 (keymap, parent);
|
||||
keymap = get_keymap (keymap, 1, 1);
|
||||
|
||||
if (!NILP (parent))
|
||||
{
|
||||
parent = get_keymap (parent, 1, 1);
|
||||
parent = get_keymap (parent, 1, 0);
|
||||
|
||||
/* Check for cycles. */
|
||||
if (keymap_memberp (keymap, parent))
|
||||
|
|
@ -332,121 +362,35 @@ Return PARENT. PARENT should be nil or another keymap. */)
|
|||
If we came to the end, add the parent in PREV. */
|
||||
if (!CONSP (list) || KEYMAPP (list))
|
||||
{
|
||||
/* If we already have the right parent, return now
|
||||
so that we avoid the loops below. */
|
||||
if (EQ (XCDR (prev), parent))
|
||||
RETURN_UNGCPRO (parent);
|
||||
|
||||
CHECK_IMPURE (prev);
|
||||
XSETCDR (prev, parent);
|
||||
break;
|
||||
RETURN_UNGCPRO (parent);
|
||||
}
|
||||
prev = list;
|
||||
}
|
||||
|
||||
/* Scan through for submaps, and set their parents too. */
|
||||
|
||||
for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
|
||||
{
|
||||
/* Stop the scan when we come to the parent. */
|
||||
if (EQ (XCAR (list), Qkeymap))
|
||||
break;
|
||||
|
||||
/* If this element holds a prefix map, deal with it. */
|
||||
if (CONSP (XCAR (list))
|
||||
&& CONSP (XCDR (XCAR (list))))
|
||||
fix_submap_inheritance (keymap, XCAR (XCAR (list)),
|
||||
XCDR (XCAR (list)));
|
||||
|
||||
if (VECTORP (XCAR (list)))
|
||||
for (i = 0; i < ASIZE (XCAR (list)); i++)
|
||||
if (CONSP (XVECTOR (XCAR (list))->contents[i]))
|
||||
fix_submap_inheritance (keymap, make_number (i),
|
||||
XVECTOR (XCAR (list))->contents[i]);
|
||||
|
||||
if (CHAR_TABLE_P (XCAR (list)))
|
||||
{
|
||||
map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
|
||||
}
|
||||
}
|
||||
|
||||
RETURN_UNGCPRO (parent);
|
||||
}
|
||||
|
||||
/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
|
||||
if EVENT is also a prefix in MAP's parent,
|
||||
make sure that SUBMAP inherits that definition as its own parent. */
|
||||
|
||||
static void
|
||||
fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap)
|
||||
{
|
||||
Lisp_Object map_parent, parent_entry;
|
||||
|
||||
/* SUBMAP is a cons that we found as a key binding.
|
||||
Discard the other things found in a menu key binding. */
|
||||
|
||||
submap = get_keymap (get_keyelt (submap, 0), 0, 0);
|
||||
|
||||
/* If it isn't a keymap now, there's no work to do. */
|
||||
if (!CONSP (submap))
|
||||
return;
|
||||
|
||||
map_parent = keymap_parent (map, 0);
|
||||
if (!NILP (map_parent))
|
||||
parent_entry =
|
||||
get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
|
||||
else
|
||||
parent_entry = Qnil;
|
||||
|
||||
/* If MAP's parent has something other than a keymap,
|
||||
our own submap shadows it completely. */
|
||||
if (!CONSP (parent_entry))
|
||||
return;
|
||||
|
||||
if (! EQ (parent_entry, submap))
|
||||
{
|
||||
Lisp_Object submap_parent;
|
||||
submap_parent = submap;
|
||||
while (1)
|
||||
{
|
||||
Lisp_Object tem;
|
||||
|
||||
tem = keymap_parent (submap_parent, 0);
|
||||
|
||||
if (KEYMAPP (tem))
|
||||
{
|
||||
if (keymap_memberp (tem, parent_entry))
|
||||
/* Fset_keymap_parent could create a cycle. */
|
||||
return;
|
||||
submap_parent = tem;
|
||||
}
|
||||
else
|
||||
break;
|
||||
}
|
||||
Fset_keymap_parent (submap_parent, parent_entry);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Look up IDX in MAP. IDX may be any sort of event.
|
||||
Note that this does only one level of lookup; IDX must be a single
|
||||
event, not a sequence.
|
||||
|
||||
MAP must be a keymap or a list of keymaps.
|
||||
|
||||
If T_OK is non-zero, bindings for Qt are treated as default
|
||||
bindings; any key left unmentioned by other tables and bindings is
|
||||
given the binding of Qt.
|
||||
|
||||
If T_OK is zero, bindings for Qt are not treated specially.
|
||||
|
||||
If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
|
||||
If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
|
||||
|
||||
Returns Qunbound if no binding was found (and returns Qnil if a nil
|
||||
binding was found). */
|
||||
|
||||
Lisp_Object
|
||||
access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
|
||||
access_keymap_1 (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
|
||||
{
|
||||
Lisp_Object val;
|
||||
|
||||
/* Qunbound in VAL means we have found no binding yet. */
|
||||
val = Qunbound;
|
||||
|
||||
/* If idx is a list (some sort of mouse click, perhaps?),
|
||||
the index we want to use is the car of the list, which
|
||||
ought to be a symbol. */
|
||||
|
|
@ -461,21 +405,21 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
|
|||
with more than 24 bits of integer. */
|
||||
XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
|
||||
|
||||
/* Handle the special meta -> esc mapping. */
|
||||
/* Handle the special meta -> esc mapping. */
|
||||
if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier)
|
||||
{
|
||||
/* See if there is a meta-map. If there's none, there is
|
||||
no binding for IDX, unless a default binding exists in MAP. */
|
||||
struct gcpro gcpro1;
|
||||
Lisp_Object event_meta_map;
|
||||
Lisp_Object event_meta_binding, event_meta_map;
|
||||
GCPRO1 (map);
|
||||
/* A strange value in which Meta is set would cause
|
||||
infinite recursion. Protect against that. */
|
||||
if (XINT (meta_prefix_char) & CHAR_META)
|
||||
meta_prefix_char = make_number (27);
|
||||
event_meta_map = get_keymap (access_keymap (map, meta_prefix_char,
|
||||
t_ok, noinherit, autoload),
|
||||
0, autoload);
|
||||
event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
|
||||
noinherit, autoload);
|
||||
event_meta_map = get_keymap (event_meta_binding, 0, autoload);
|
||||
UNGCPRO;
|
||||
if (CONSP (event_meta_map))
|
||||
{
|
||||
|
|
@ -486,8 +430,8 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
|
|||
/* Set IDX to t, so that we only find a default binding. */
|
||||
idx = Qt;
|
||||
else
|
||||
/* We know there is no binding. */
|
||||
return Qnil;
|
||||
/* An explicit nil binding, or no binding at all. */
|
||||
return NILP (event_meta_binding) ? Qnil : Qunbound;
|
||||
}
|
||||
|
||||
/* t_binding is where we put a default binding that applies,
|
||||
|
|
@ -495,25 +439,52 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
|
|||
for this key sequence. */
|
||||
{
|
||||
Lisp_Object tail;
|
||||
Lisp_Object t_binding = Qnil;
|
||||
Lisp_Object t_binding = Qunbound;
|
||||
Lisp_Object retval = Qunbound;
|
||||
Lisp_Object retval_tail = Qnil;
|
||||
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
||||
|
||||
GCPRO4 (map, tail, idx, t_binding);
|
||||
GCPRO4 (tail, idx, t_binding, retval);
|
||||
|
||||
for (tail = XCDR (map);
|
||||
for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
|
||||
(CONSP (tail)
|
||||
|| (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
|
||||
tail = XCDR (tail))
|
||||
{
|
||||
Lisp_Object binding;
|
||||
/* Qunbound in VAL means we have found no binding. */
|
||||
Lisp_Object val = Qunbound;
|
||||
Lisp_Object binding = XCAR (tail);
|
||||
Lisp_Object submap = get_keymap (binding, 0, autoload);
|
||||
|
||||
binding = XCAR (tail);
|
||||
if (SYMBOLP (binding))
|
||||
if (EQ (binding, Qkeymap))
|
||||
{
|
||||
/* If NOINHERIT, stop finding prefix definitions
|
||||
after we pass a second occurrence of the `keymap' symbol. */
|
||||
if (noinherit && EQ (binding, Qkeymap))
|
||||
RETURN_UNGCPRO (Qnil);
|
||||
if (noinherit || NILP (retval))
|
||||
/* If NOINHERIT, stop here, the rest is inherited. */
|
||||
break;
|
||||
else if (!EQ (retval, Qunbound))
|
||||
{
|
||||
Lisp_Object parent_entry;
|
||||
eassert (KEYMAPP (retval));
|
||||
parent_entry
|
||||
= get_keymap (access_keymap_1 (tail, idx,
|
||||
t_ok, 0, autoload),
|
||||
0, autoload);
|
||||
if (KEYMAPP (parent_entry))
|
||||
{
|
||||
if (CONSP (retval_tail))
|
||||
XSETCDR (retval_tail, parent_entry);
|
||||
else
|
||||
{
|
||||
retval_tail = Fcons (retval, parent_entry);
|
||||
retval = Fcons (Qkeymap, retval_tail);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
else if (CONSP (submap))
|
||||
{
|
||||
val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
|
||||
}
|
||||
else if (CONSP (binding))
|
||||
{
|
||||
|
|
@ -556,23 +527,47 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
|
|||
(i.e. it shadows any parent binding but not bindings in
|
||||
keymaps of lower precedence). */
|
||||
val = Qnil;
|
||||
|
||||
val = get_keyelt (val, autoload);
|
||||
if (KEYMAPP (val))
|
||||
fix_submap_inheritance (map, idx, val);
|
||||
RETURN_UNGCPRO (val);
|
||||
|
||||
if (!KEYMAPP (val))
|
||||
{
|
||||
if (NILP (retval) || EQ (retval, Qunbound))
|
||||
retval = val;
|
||||
if (!NILP (val))
|
||||
break; /* Shadows everything that follows. */
|
||||
}
|
||||
else if (NILP (retval) || EQ (retval, Qunbound))
|
||||
retval = val;
|
||||
else if (CONSP (retval_tail))
|
||||
{
|
||||
XSETCDR (retval_tail, Fcons (val, Qnil));
|
||||
retval_tail = XCDR (retval_tail);
|
||||
}
|
||||
else
|
||||
{
|
||||
retval_tail = Fcons (val, Qnil);
|
||||
retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
|
||||
}
|
||||
}
|
||||
QUIT;
|
||||
}
|
||||
UNGCPRO;
|
||||
return get_keyelt (t_binding, autoload);
|
||||
return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
|
||||
}
|
||||
}
|
||||
|
||||
Lisp_Object
|
||||
access_keymap (Lisp_Object map, Lisp_Object idx,
|
||||
int t_ok, int noinherit, int autoload)
|
||||
{
|
||||
Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
|
||||
return EQ (val, Qunbound) ? Qnil : val;
|
||||
}
|
||||
|
||||
static void
|
||||
map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
|
||||
{
|
||||
/* We should maybe try to detect bindings shadowed by previous
|
||||
ones and things like that. */
|
||||
if (EQ (val, Qt))
|
||||
val = Qnil;
|
||||
(*fun) (key, val, args, data);
|
||||
|
|
@ -583,8 +578,8 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
|
|||
{
|
||||
if (!NILP (val))
|
||||
{
|
||||
map_keymap_function_t fun =
|
||||
(map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
|
||||
map_keymap_function_t fun
|
||||
= (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
|
||||
args = XCDR (args);
|
||||
/* If the key is a range, make a copy since map_char_table modifies
|
||||
it in place. */
|
||||
|
|
@ -612,7 +607,9 @@ map_keymap_internal (Lisp_Object map,
|
|||
{
|
||||
Lisp_Object binding = XCAR (tail);
|
||||
|
||||
if (CONSP (binding))
|
||||
if (KEYMAPP (binding)) /* An embedded parent. */
|
||||
break;
|
||||
else if (CONSP (binding))
|
||||
map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
|
||||
else if (VECTORP (binding))
|
||||
{
|
||||
|
|
@ -644,7 +641,7 @@ map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
|
|||
call2 (fun, key, val);
|
||||
}
|
||||
|
||||
/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
|
||||
/* Same as map_keymap_internal, but traverses parent keymaps as well.
|
||||
A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
|
||||
void
|
||||
map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload)
|
||||
|
|
@ -654,8 +651,15 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *
|
|||
map = get_keymap (map, 1, autoload);
|
||||
while (CONSP (map))
|
||||
{
|
||||
map = map_keymap_internal (map, fun, args, data);
|
||||
map = get_keymap (map, 0, autoload);
|
||||
if (KEYMAPP (XCAR (map)))
|
||||
{
|
||||
map_keymap (XCAR (map), fun, args, data, autoload);
|
||||
map = XCDR (map);
|
||||
}
|
||||
else
|
||||
map = map_keymap_internal (map, fun, args, data);
|
||||
if (!CONSP (map))
|
||||
map = get_keymap (map, 0, autoload);
|
||||
}
|
||||
UNGCPRO;
|
||||
}
|
||||
|
|
@ -791,16 +795,10 @@ get_keyelt (Lisp_Object object, int autoload)
|
|||
}
|
||||
|
||||
/* If the contents are (KEYMAP . ELEMENT), go indirect. */
|
||||
else if (KEYMAPP (XCAR (object)))
|
||||
error ("Wow, indirect keymap entry!!");
|
||||
else
|
||||
{
|
||||
struct gcpro gcpro1;
|
||||
Lisp_Object map;
|
||||
GCPRO1 (object);
|
||||
map = get_keymap (Fcar_safe (object), 0, autoload);
|
||||
UNGCPRO;
|
||||
return (!CONSP (map) ? object /* Invalid keymap */
|
||||
: access_keymap (map, Fcdr (object), 0, 0, autoload));
|
||||
}
|
||||
return object;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -811,6 +809,9 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
|
|||
where_is_cache = Qnil;
|
||||
where_is_cache_keymaps = Qt;
|
||||
|
||||
if (EQ (idx, Qkeymap))
|
||||
error ("`keymap' is reserved for embedded parent maps");
|
||||
|
||||
/* If we are preparing to dump, and DEF is a menu element
|
||||
with a menu item indicator, copy it to ensure it is not pure. */
|
||||
if (CONSP (def) && PURE_P (def)
|
||||
|
|
@ -903,7 +904,16 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
|
|||
}
|
||||
else if (CONSP (elt))
|
||||
{
|
||||
if (EQ (idx, XCAR (elt)))
|
||||
if (EQ (Qkeymap, XCAR (elt)))
|
||||
{ /* A sub keymap. This might be due to a lookup that found
|
||||
two matching bindings (maybe because of a sub keymap).
|
||||
It almost never happens (since the second binding normally
|
||||
only happens in the inherited part of the keymap), but
|
||||
if it does, we want to update the sub-keymap since the
|
||||
main one might be temporary (built by access_keymap). */
|
||||
tail = insertion_point = elt;
|
||||
}
|
||||
else if (EQ (idx, XCAR (elt)))
|
||||
{
|
||||
CHECK_IMPURE (elt);
|
||||
XSETCDR (elt, def);
|
||||
|
|
@ -1068,7 +1078,13 @@ is not copied. */)
|
|||
ASET (elt, i, copy_keymap_item (AREF (elt, i)));
|
||||
}
|
||||
else if (CONSP (elt))
|
||||
elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
|
||||
{
|
||||
if (EQ (XCAR (elt), Qkeymap))
|
||||
/* This is a sub keymap. */
|
||||
elt = Fcopy_keymap (elt);
|
||||
else
|
||||
elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
|
||||
}
|
||||
XSETCDR (tail, Fcons (elt, Qnil));
|
||||
tail = XCDR (tail);
|
||||
keymap = XCDR (keymap);
|
||||
|
|
@ -1234,23 +1250,15 @@ remapping in all currently active keymaps. */)
|
|||
ASET (command_remapping_vector, 1, command);
|
||||
|
||||
if (NILP (keymaps))
|
||||
return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
|
||||
command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
|
||||
else
|
||||
{
|
||||
Lisp_Object maps, binding;
|
||||
|
||||
for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
|
||||
{
|
||||
binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
|
||||
if (!NILP (binding) && !INTEGERP (binding))
|
||||
return binding;
|
||||
}
|
||||
return Qnil;
|
||||
}
|
||||
command = Flookup_key (Fcons (Qkeymap, keymaps),
|
||||
command_remapping_vector, Qnil);
|
||||
return INTEGERP (command) ? Qnil : command;
|
||||
}
|
||||
|
||||
/* Value is number if KEY is too long; nil if valid but has no definition. */
|
||||
/* GC is possible in this function if it autoloads a keymap. */
|
||||
/* GC is possible in this function. */
|
||||
|
||||
DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
|
||||
doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
|
||||
|
|
@ -1325,10 +1333,6 @@ define_as_prefix (Lisp_Object keymap, Lisp_Object c)
|
|||
Lisp_Object cmd;
|
||||
|
||||
cmd = Fmake_sparse_keymap (Qnil);
|
||||
/* If this key is defined as a prefix in an inherited keymap,
|
||||
make it a prefix in this map, and make its definition
|
||||
inherit the other prefix definition. */
|
||||
cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
|
||||
store_in_keymap (keymap, c, cmd);
|
||||
|
||||
return cmd;
|
||||
|
|
@ -1530,7 +1534,7 @@ like in the respective argument of `key-binding'. */)
|
|||
{
|
||||
int count = SPECPDL_INDEX ();
|
||||
|
||||
Lisp_Object keymaps;
|
||||
Lisp_Object keymaps = Fcons (current_global_map, Qnil);
|
||||
|
||||
/* If a mouse click position is given, our variables are based on
|
||||
the buffer clicked on, not the current buffer. So we may have to
|
||||
|
|
@ -1560,12 +1564,11 @@ like in the respective argument of `key-binding'. */)
|
|||
}
|
||||
}
|
||||
|
||||
keymaps = Fcons (current_global_map, Qnil);
|
||||
|
||||
if (!NILP (olp))
|
||||
{
|
||||
if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
|
||||
keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps);
|
||||
keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map),
|
||||
keymaps);
|
||||
/* The doc said that overriding-terminal-local-map should
|
||||
override overriding-local-map. The code used them both,
|
||||
but it seems clearer to use just one. rms, jan 2005. */
|
||||
|
|
@ -1576,23 +1579,19 @@ like in the respective argument of `key-binding'. */)
|
|||
{
|
||||
Lisp_Object *maps;
|
||||
int nmaps, i;
|
||||
|
||||
Lisp_Object keymap, local_map;
|
||||
EMACS_INT pt;
|
||||
|
||||
pt = INTEGERP (position) ? XINT (position)
|
||||
EMACS_INT pt
|
||||
= INTEGERP (position) ? XINT (position)
|
||||
: MARKERP (position) ? marker_position (position)
|
||||
: PT;
|
||||
|
||||
/* Get the buffer local maps, possibly overriden by text or
|
||||
overlay properties */
|
||||
|
||||
local_map = get_local_map (pt, current_buffer, Qlocal_map);
|
||||
keymap = get_local_map (pt, current_buffer, Qkeymap);
|
||||
/* This usually returns the buffer's local map,
|
||||
but that can be overridden by a `local-map' property. */
|
||||
Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
|
||||
/* This returns nil unless there is a `keymap' property. */
|
||||
Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap);
|
||||
|
||||
if (CONSP (position))
|
||||
{
|
||||
Lisp_Object string;
|
||||
Lisp_Object string = POSN_STRING (position);
|
||||
|
||||
/* For a mouse click, get the local text-property keymap
|
||||
of the place clicked on, rather than point. */
|
||||
|
|
@ -1619,8 +1618,7 @@ like in the respective argument of `key-binding'. */)
|
|||
consider `local-map' and `keymap' properties of
|
||||
that string. */
|
||||
|
||||
if (string = POSN_STRING (position),
|
||||
(CONSP (string) && STRINGP (XCAR (string))))
|
||||
if (CONSP (string) && STRINGP (XCAR (string)))
|
||||
{
|
||||
Lisp_Object pos, map;
|
||||
|
||||
|
|
@ -1691,12 +1689,7 @@ specified buffer position instead of point are used.
|
|||
*/)
|
||||
(Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
|
||||
{
|
||||
Lisp_Object *maps, value;
|
||||
int nmaps, i;
|
||||
struct gcpro gcpro1, gcpro2;
|
||||
int count = SPECPDL_INDEX ();
|
||||
|
||||
GCPRO2 (key, position);
|
||||
Lisp_Object value;
|
||||
|
||||
if (NILP (position) && VECTORP (key))
|
||||
{
|
||||
|
|
@ -1715,145 +1708,9 @@ specified buffer position instead of point are used.
|
|||
}
|
||||
}
|
||||
|
||||
/* Key sequences beginning with mouse clicks
|
||||
are read using the keymaps of the buffer clicked on, not
|
||||
the current buffer. So we may have to switch the buffer
|
||||
here. */
|
||||
value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
|
||||
key, accept_default);
|
||||
|
||||
if (CONSP (position))
|
||||
{
|
||||
Lisp_Object window;
|
||||
|
||||
window = POSN_WINDOW (position);
|
||||
|
||||
if (WINDOWP (window)
|
||||
&& BUFFERP (XWINDOW (window)->buffer)
|
||||
&& XBUFFER (XWINDOW (window)->buffer) != current_buffer)
|
||||
{
|
||||
/* Arrange to go back to the original buffer once we're done
|
||||
processing the key sequence. We don't use
|
||||
save_excursion_{save,restore} here, in analogy to
|
||||
`read-key-sequence' to avoid saving point. Maybe this
|
||||
would not be a problem here, but it is easier to keep
|
||||
things the same.
|
||||
*/
|
||||
|
||||
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
|
||||
|
||||
set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
|
||||
}
|
||||
}
|
||||
|
||||
if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
|
||||
{
|
||||
value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map),
|
||||
key, accept_default);
|
||||
if (! NILP (value) && !INTEGERP (value))
|
||||
goto done;
|
||||
}
|
||||
else if (! NILP (Voverriding_local_map))
|
||||
{
|
||||
value = Flookup_key (Voverriding_local_map, key, accept_default);
|
||||
if (! NILP (value) && !INTEGERP (value))
|
||||
goto done;
|
||||
}
|
||||
else
|
||||
{
|
||||
Lisp_Object keymap, local_map;
|
||||
EMACS_INT pt;
|
||||
|
||||
pt = INTEGERP (position) ? XINT (position)
|
||||
: MARKERP (position) ? marker_position (position)
|
||||
: PT;
|
||||
|
||||
local_map = get_local_map (pt, current_buffer, Qlocal_map);
|
||||
keymap = get_local_map (pt, current_buffer, Qkeymap);
|
||||
|
||||
if (CONSP (position))
|
||||
{
|
||||
Lisp_Object string;
|
||||
|
||||
/* For a mouse click, get the local text-property keymap
|
||||
of the place clicked on, rather than point. */
|
||||
|
||||
if (POSN_INBUFFER_P (position))
|
||||
{
|
||||
Lisp_Object pos;
|
||||
|
||||
pos = POSN_BUFFER_POSN (position);
|
||||
if (INTEGERP (pos)
|
||||
&& XINT (pos) >= BEG && XINT (pos) <= Z)
|
||||
{
|
||||
local_map = get_local_map (XINT (pos),
|
||||
current_buffer, Qlocal_map);
|
||||
|
||||
keymap = get_local_map (XINT (pos),
|
||||
current_buffer, Qkeymap);
|
||||
}
|
||||
}
|
||||
|
||||
/* If on a mode line string with a local keymap,
|
||||
or for a click on a string, i.e. overlay string or a
|
||||
string displayed via the `display' property,
|
||||
consider `local-map' and `keymap' properties of
|
||||
that string. */
|
||||
|
||||
if (string = POSN_STRING (position),
|
||||
(CONSP (string) && STRINGP (XCAR (string))))
|
||||
{
|
||||
Lisp_Object pos, map;
|
||||
|
||||
pos = XCDR (string);
|
||||
string = XCAR (string);
|
||||
if (INTEGERP (pos)
|
||||
&& XINT (pos) >= 0
|
||||
&& XINT (pos) < SCHARS (string))
|
||||
{
|
||||
map = Fget_text_property (pos, Qlocal_map, string);
|
||||
if (!NILP (map))
|
||||
local_map = map;
|
||||
|
||||
map = Fget_text_property (pos, Qkeymap, string);
|
||||
if (!NILP (map))
|
||||
keymap = map;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if (! NILP (keymap))
|
||||
{
|
||||
value = Flookup_key (keymap, key, accept_default);
|
||||
if (! NILP (value) && !INTEGERP (value))
|
||||
goto done;
|
||||
}
|
||||
|
||||
nmaps = current_minor_maps (0, &maps);
|
||||
/* Note that all these maps are GCPRO'd
|
||||
in the places where we found them. */
|
||||
|
||||
for (i = 0; i < nmaps; i++)
|
||||
if (! NILP (maps[i]))
|
||||
{
|
||||
value = Flookup_key (maps[i], key, accept_default);
|
||||
if (! NILP (value) && !INTEGERP (value))
|
||||
goto done;
|
||||
}
|
||||
|
||||
if (! NILP (local_map))
|
||||
{
|
||||
value = Flookup_key (local_map, key, accept_default);
|
||||
if (! NILP (value) && !INTEGERP (value))
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
|
||||
value = Flookup_key (current_global_map, key, accept_default);
|
||||
|
||||
done:
|
||||
unbind_to (count, Qnil);
|
||||
|
||||
UNGCPRO;
|
||||
if (NILP (value) || INTEGERP (value))
|
||||
return Qnil;
|
||||
|
||||
|
|
@ -3829,31 +3686,6 @@ don't alter it yourself. */);
|
|||
Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
|
||||
Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
|
||||
|
||||
DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map,
|
||||
doc: /* Local keymap for minibuffer input with completion. */);
|
||||
Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
|
||||
Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
|
||||
|
||||
DEFVAR_LISP ("minibuffer-local-filename-completion-map",
|
||||
Vminibuffer_local_filename_completion_map,
|
||||
doc: /* Local keymap for minibuffer input with completion for filenames. */);
|
||||
Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
|
||||
Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
|
||||
Vminibuffer_local_completion_map);
|
||||
|
||||
|
||||
DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map,
|
||||
doc: /* Local keymap for minibuffer input with completion, for exact match. */);
|
||||
Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
|
||||
Fset_keymap_parent (Vminibuffer_local_must_match_map,
|
||||
Vminibuffer_local_completion_map);
|
||||
|
||||
DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
|
||||
Vminibuffer_local_filename_must_match_map,
|
||||
doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
|
||||
Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
|
||||
Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
|
||||
Vminibuffer_local_must_match_map);
|
||||
|
||||
DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
|
||||
doc: /* Alist of keymaps to use for minor modes.
|
||||
|
|
@ -3922,6 +3754,7 @@ preferred. */);
|
|||
defsubr (&Sset_keymap_parent);
|
||||
defsubr (&Smake_keymap);
|
||||
defsubr (&Smake_sparse_keymap);
|
||||
defsubr (&Smake_composed_keymap);
|
||||
defsubr (&Smap_keymap_internal);
|
||||
defsubr (&Smap_keymap);
|
||||
defsubr (&Scopy_keymap);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue