procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* subr.el (keymap-canonicalize): New function.

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2008-04-04 17:31:20 +00:00
parent 4591d6cbef
commit 00f7c5edc6
5 changed files with 78 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lisp/ChangeLog
View file

@ -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>

45
lisp/mouse.el
View file

@ -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)))

27
lisp/subr.el
View file

@ -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)

4
src/ChangeLog
View file

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

29
src/keymap.c
View file

@ -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));