From 00f7c5edc6a0703d84f4a37f273c31364e6ce0fc Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 4 Apr 2008 17:31:20 +0000 Subject: [PATCH] * 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. --- lisp/ChangeLog | 4 ++++ lisp/mouse.el | 45 ++++++++++++++++----------------------------- lisp/subr.el | 27 +++++++++++++++++++++++++++ src/ChangeLog | 4 ++++ src/keymap.c | 29 +++++++++++++++++++++++++++-- 5 files changed, 78 insertions(+), 31 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 951fe1d23fa..533dd7f1bc2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2008-04-04 Stefan Monnier + * 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 diff --git a/lisp/mouse.el b/lisp/mouse.el index c26f12c100c..eb20a73f43f 100644 --- 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 b656d2ed203..9166d22b602 100644 --- 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 1fdeca7ed57..e8cc705a23c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,9 @@ 2008-04-04 Stefan Monnier + * 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 9ed1e92c84b..94d2ab5fe67 100644 --- 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)); -- 2.39.5