Commit 3349e122 authored by Stefan Monnier's avatar Stefan Monnier

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.
parent 3de63bf8
......@@ -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
......
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.")
(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)
......
......@@ -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)
......
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);
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment