Mercurial > emacs
changeset 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 | 959f4471c16e |
| children | e48eeb58ebc3 |
| files | lisp/ChangeLog lisp/mouse.el lisp/subr.el src/ChangeLog src/keymap.c |
| diffstat | 5 files changed, 78 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Apr 04 16:59:52 2008 +0000 +++ b/lisp/ChangeLog Fri Apr 04 17:31:20 2008 +0000 @@ -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>
--- a/lisp/mouse.el Fri Apr 04 16:59:52 2008 +0000 +++ b/lisp/mouse.el Fri Apr 04 17:31:20 2008 +0000 @@ -201,19 +201,7 @@ 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 @@ (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 @@ ;; 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)))
--- 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)
--- a/src/ChangeLog Fri Apr 04 16:59:52 2008 +0000 +++ b/src/ChangeLog Fri Apr 04 17:31:20 2008 +0000 @@ -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.
--- a/src/keymap.c Fri Apr 04 16:59:52 2008 +0000 +++ b/src/keymap.c Fri Apr 04 17:31:20 2008 +0000 @@ -731,6 +731,26 @@ 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 @@ 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 @@ 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));