* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 951fe1d23fa25245ea65a23a6e0ae4bc3fc67fa7..533dd7f1bc21d67c091a4771da3e3b1740b04d20 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2008-04-04  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * subr.el (keymap-canonicalize): New function.
+       * mouse.el (mouse-menu-non-singleton): Use it.
+       (mouse-major-mode-menu): Remove hack made unnecessary.
+
        * simple.el (set-fill-column): Prompt rather than error by default.
 
 2008-04-04  Andreas Schwab  <schwab@suse.de>

diff --git a/lisp/mouse.el b/lisp/mouse.el
index c26f12c100ccbdf6362d56c05c31e556dfcb1bd9..eb20a73f43ff0c2f9a101b5a72ffe2e27ae7b64e 100644 (file)
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -201,19 +201,7 @@ Default to the Edit menu if the major mode doesn't define a menu."
                   menu-bar-edit-menu))
         uniq)
     (if ancestor
-       ;; Make our menu inherit from the desired keymap which we want
-       ;; to display as the menu now.
-       ;; Sometimes keymaps contain duplicate menu code, leading to
-       ;; duplicates in the popped-up menu. Avoid this by simply
-       ;; taking the first of any identically-named menus.
-       ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00469.html
-       (set-keymap-parent newmap
-                          (progn
-                            (dolist (e ancestor)
-                              (unless (and (listp e)
-                                           (assoc (car e) uniq))
-                                (setq uniq (append uniq (list e)))))
-                            uniq)))
+       (set-keymap-parent newmap ancestor))
     (popup-menu newmap event prefix)))
 
 
@@ -225,7 +213,7 @@ Otherwise return the whole menu."
       (let (submap)
         (map-keymap
          (lambda (k v) (setq submap (if submap t (cons k v))))
-         menubar)
+         (keymap-canonicalize menubar))
         (if (eq submap t)
             menubar
           (lookup-key menubar (vector (car submap)))))))
@@ -246,21 +234,20 @@ not it is actually displayed."
         ;; display non-empty menu pane names.
         (minor-mode-menus
          (mapcar
-          (function
-           (lambda (menu)
-             (let* ((minor-mode (car menu))
-                    (menu (cdr menu))
-                    (title-or-map (cadr menu)))
-               (or (stringp title-or-map)
-                   (setq menu
-                         (cons 'keymap
-                               (cons (concat
-                                      (capitalize (subst-char-in-string
-                                                   ?- ?\s (symbol-name
-                                                           minor-mode)))
-                                      " Menu")
-                                     (cdr menu)))))
-               menu)))
+           (lambda (menu)
+             (let* ((minor-mode (car menu))
+                    (menu (cdr menu))
+                    (title-or-map (cadr menu)))
+               (or (stringp title-or-map)
+                   (setq menu
+                         (cons 'keymap
+                               (cons (concat
+                                      (capitalize (subst-char-in-string
+                                                   ?- ?\s (symbol-name
+                                                           minor-mode)))
+                                      " Menu")
+                                     (cdr menu)))))
+               menu))
           (minor-mode-key-binding [menu-bar])))
         (local-title-or-map (and local-menu (cadr local-menu)))
         (global-title-or-map (cadr global-menu)))

diff --git a/lisp/subr.el b/lisp/subr.el
index b656d2ed203e05d7b55f96d24c21513a6ff43fda..9166d22b602ae66bb3bc42345dd5210c088c0a2c 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -550,6 +550,33 @@ Don't call this function; it is for internal use only."
     (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)

diff --git a/src/ChangeLog b/src/ChangeLog
index 1fdeca7ed57255620f3c4f1c77ec0bb574e75ebd..e8cc705a23c10f5f206c4b37a551234aae679b5d 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,9 @@
 2008-04-04  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * keymap.c (Qkeymap_canonicalize): New var.
+       (Fmap_keymap_internal): New fun.
+       (describe_map): Use keymap-canonicalize.
+
        * undo.c (last_boundary_buffer, last_boundary_position): New vars.
        (Fundo_boundary): Set them.
        (syms_of_undo): Initialize them.

diff --git a/src/keymap.c b/src/keymap.c
index 9ed1e92c84b99982564a63c5beb2aa1dab0c69ab..94d2ab5fe679e63993ff3f109e8ab059bd86f35f 100644 (file)
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -731,6 +731,26 @@ map_keymap (map, fun, args, data, autoload)
   UNGCPRO;
 }
 
+Lisp_Object Qkeymap_canonicalize;
+
+/* Same as map_keymap, but does it right, properly eliminating duplicate
+   bindings due to inheritance.   */
+void
+map_keymap_canonical (map, fun, args, data)
+     map_keymap_function_t fun;
+     Lisp_Object map, args;
+     void *data;
+{
+  struct gcpro gcpro1;
+  GCPRO1 (args);
+  /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
+     so be careful to ignore errors and to inhibit redisplay.  */
+  map = safe_call1 (Qkeymap_canonicalize, map);
+  /* No need to use `map_keymap' here because canonical map has no parent.  */
+  map_keymap_internal (map, fun, args, data);
+  UNGCPRO;
+}
+
 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
        doc: /* Call FUNCTION once for each event binding in KEYMAP.
 FUNCTION is called with two arguments: the event that is bound, and
@@ -3407,14 +3427,16 @@ describe_map (map, prefix, elt_describer, partial, shadow,
   kludge = Fmake_vector (make_number (1), Qnil);
   definition = Qnil;
 
+  GCPRO3 (prefix, definition, kludge);
+
+  map = call1 (Qkeymap_canonicalize, map);
+
   for (tail = map; CONSP (tail); tail = XCDR (tail))
     length_needed++;
 
   vect = ((struct describe_map_elt *)
          alloca (sizeof (struct describe_map_elt) * length_needed));
 
-  GCPRO3 (prefix, definition, kludge);
-
   for (tail = map; CONSP (tail); tail = XCDR (tail))
     {
       QUIT;
@@ -3850,6 +3872,9 @@ syms_of_keymap ()
   apropos_predicate = Qnil;
   apropos_accumulate = Qnil;
 
+  Qkeymap_canonicalize = intern ("keymap-canonicalize");
+  staticpro (&Qkeymap_canonicalize);
+
   /* Now we are ready to set up this property, so we can
      create char tables.  */
   Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));