Mercurial > emacs
diff lisp/subr.el @ 93664:c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
* mouse.el (mouse-menu-non-singleton): Use it.
(mouse-major-mode-menu): Remove hack made unnecessary.
* keymap.c (Qkeymap_canonicalize): New var.
(Fmap_keymap_internal): New fun.
(describe_map): Use keymap-canonicalize.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 04 Apr 2008 17:31:20 +0000 |
parents | c15f559a5ada |
children | 6604d09cf521 |
line wrap: on
line diff
--- a/lisp/subr.el Fri Apr 04 16:59:52 2008 +0000 +++ b/lisp/subr.el Fri Apr 04 17:31:20 2008 +0000 @@ -550,6 +550,33 @@ (dolist (p list) (funcall function (car p) (cdr p))))) +(defun keymap-canonicalize (map) + "Return an equivalent keymap, without inheritance." + (let ((bindings ()) + (ranges ())) + (while (keymapp map) + (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))) + (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) + (keymap-prompt map))) + (dolist (binding ranges) + ;; Treat char-ranges specially. + (define-key map (car binding) (cdr binding))) + (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)))) + (nconc map bindings))) + (put 'keyboard-translate-table 'char-table-extra-slots 0) (defun keyboard-translate (from to)