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)