[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r104860: Add multiple inheritance to
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r104860: Add multiple inheritance to keymaps. |
|
Date: |
Sat, 02 Jul 2011 00:27:41 -0400 |
|
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 104860
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2011-07-02 00:27:41 -0400
message:
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.
modified:
etc/NEWS
lisp/ChangeLog
lisp/minibuffer.el
lisp/subr.el
src/ChangeLog
src/keyboard.c
src/keymap.c
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2011-07-01 09:54:39 +0000
+++ b/etc/NEWS 2011-07-02 04:27:41 +0000
@@ -111,6 +111,10 @@
*** `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 @@
---
** 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
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-07-01 18:21:09 +0000
+++ b/lisp/ChangeLog 2011-07-02 04:27:41 +0000
@@ -1,3 +1,19 @@
+2011-07-02 Stefan Monnier <address@hidden>
+
+ * 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 <address@hidden>
* type-break.el (type-break-time-sum): Use dolist.
=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el 2011-06-23 03:35:05 +0000
+++ b/lisp/minibuffer.el 2011-07-02 04:27:41 +0000
@@ -1634,30 +1634,43 @@
;;; 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))
-
-(let ((map minibuffer-local-must-match-map))
- (define-key map "\r" 'minibuffer-complete-and-exit)
- (define-key map "\n" 'minibuffer-complete-and-exit))
-
-(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-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.")
+
+(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 @@
(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)
=== modified file 'lisp/subr.el'
--- a/lisp/subr.el 2011-06-21 08:55:22 +0000
+++ b/lisp/subr.el 2011-07-02 04:27:41 +0000
@@ -490,6 +490,7 @@
"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 @@
(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)
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog 2011-07-01 17:53:59 +0000
+++ b/src/ChangeLog 2011-07-02 04:27:41 +0000
@@ -1,3 +1,24 @@
+2011-07-02 Stefan Monnier <address@hidden>
+
+ 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 <address@hidden>
* Makefile.in (SETTINGS_LIBS): Fix typo.
=== modified file 'src/keyboard.c'
--- a/src/keyboard.c 2011-06-20 06:07:16 +0000
+++ b/src/keyboard.c 2011-07-02 04:27:41 +0000
@@ -7470,7 +7470,7 @@
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 @@
/* 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);
=== modified file 'src/keymap.c'
--- a/src/keymap.c 2011-06-24 21:25:22 +0000
+++ b/src/keymap.c 2011-07-02 04:27:41 +0000
@@ -16,6 +16,27 @@
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 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 @@
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 @@
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 @@
{
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 @@
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 @@
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 @@
/* 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 @@
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 NOINHERIT, stop finding prefix definitions
- after we pass a second occurrence of the `keymap' symbol. */
- if (noinherit && EQ (binding, Qkeymap))
- RETURN_UNGCPRO (Qnil);
+ if (EQ (binding, Qkeymap))
+ {
+ 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 @@
(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 @@
{
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 @@
{
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 @@
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 = 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 @@
}
/* 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 @@
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 @@
}
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 @@
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 @@
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 @@
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 @@
{
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 @@
}
}
- 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 @@
{
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 @@
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 @@
*/)
(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 @@
}
}
- /* 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. */
-
- 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;
+ value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
+ key, accept_default);
+
if (NILP (value) || INTEGERP (value))
return Qnil;
@@ -3829,31 +3686,6 @@
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 @@
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);
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r104860: Add multiple inheritance to keymaps.,
Stefan Monnier <=