[Emacs-diffs] Changes to emacs/lisp/subr.el,v

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        08/04/04 17:31:21

Index: lisp/subr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/subr.el,v
retrieving revision 1.585
retrieving revision 1.586
diff -u -b -r1.585 -r1.586
--- lisp/subr.el        29 Mar 2008 22:50:10 -0000      1.585
+++ lisp/subr.el        4 Apr 2008 17:31:19 -0000       1.586
@@ -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)