From 3349e122e2ed4e1e96851bdf84ce8ae4732b6420 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 2 Jul 2011 00:27:41 -0400 Subject: [PATCH] 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. --- etc/NEWS | 5 + lisp/ChangeLog | 16 ++ lisp/minibuffer.el | 68 ++++-- lisp/subr.el | 72 +++++- src/ChangeLog | 21 ++ src/keyboard.c | 4 +- src/keymap.c | 533 ++++++++++++++++----------------------------- 7 files changed, 337 insertions(+), 382 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5cf4cd1b7cf..01b767b62f7 100644 --- a/etc/NEWS +++ b/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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a05c85f56ce..25c3f48ded7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2011-07-02 Stefan Monnier + + * 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 * type-break.el (type-break-time-sum): Use dolist. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 32ddfe99707..1700b90eb1e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -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.") + +(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-must-match-map)) - (define-key map "\r" 'minibuffer-complete-and-exit) - (define-key map "\n" 'minibuffer-complete-and-exit)) +(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'.") -(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-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) diff --git a/lisp/subr.el b/lisp/subr.el index 4d2f3b1808c..48158466c6b 100644 --- a/lisp/subr.el +++ b/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) diff --git a/src/ChangeLog b/src/ChangeLog index 5ee7a3d7e6c..bb5c579d7fa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,24 @@ +2011-07-02 Stefan Monnier + + 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 * Makefile.in (SETTINGS_LIBS): Fix typo. diff --git a/src/keyboard.c b/src/keyboard.c index bffe2b035dc..3441f1dfd12 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -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); diff --git a/src/keymap.c b/src/keymap.c index ac7f651e283..062fb5d0d5f 100644 --- a/src/keymap.c +++ b/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 . */ +/* Old BUGS: + - [M-C-a] != [?\M-\C-a] + - [M-f2] != [?\e f2]. + - (define-key map [menu-bar foo] ) does not always place + 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 #include @@ -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); -- 2.39.2