Mercurial > emacs
comparison lisp/subr.el @ 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 | c15f559a5ada |
| children | 6604d09cf521 |
comparison
equal
deleted
inserted
replaced
| 93663:959f4471c16e | 93664:c7dd307b0ec5 |
|---|---|
| 547 (if (integerp b) t | 547 (if (integerp b) t |
| 548 ;; string< also accepts symbols. | 548 ;; string< also accepts symbols. |
| 549 (string< a b)))))) | 549 (string< a b)))))) |
| 550 (dolist (p list) | 550 (dolist (p list) |
| 551 (funcall function (car p) (cdr p))))) | 551 (funcall function (car p) (cdr p))))) |
| 552 | |
| 553 (defun keymap-canonicalize (map) | |
| 554 "Return an equivalent keymap, without inheritance." | |
| 555 (let ((bindings ()) | |
| 556 (ranges ())) | |
| 557 (while (keymapp map) | |
| 558 (setq map (map-keymap-internal | |
| 559 (lambda (key item) | |
| 560 (if (consp key) | |
| 561 ;; Treat char-ranges specially. | |
| 562 (push (cons key item) ranges) | |
| 563 (push (cons key item) bindings))) | |
| 564 map))) | |
| 565 (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) | |
| 566 (keymap-prompt map))) | |
| 567 (dolist (binding ranges) | |
| 568 ;; Treat char-ranges specially. | |
| 569 (define-key map (car binding) (cdr binding))) | |
| 570 (dolist (binding (prog1 bindings (setq bindings ()))) | |
| 571 (let* ((key (car binding)) | |
| 572 (item (cdr binding)) | |
| 573 (oldbind (assq key bindings))) | |
| 574 ;; Newer bindings override older. | |
| 575 (if oldbind (setq bindings (delq oldbind bindings))) | |
| 576 (when item ;nil bindings just hide older ones. | |
| 577 (push binding bindings)))) | |
| 578 (nconc map bindings))) | |
| 552 | 579 |
| 553 (put 'keyboard-translate-table 'char-table-extra-slots 0) | 580 (put 'keyboard-translate-table 'char-table-extra-slots 0) |
| 554 | 581 |
| 555 (defun keyboard-translate (from to) | 582 (defun keyboard-translate (from to) |
| 556 "Translate character FROM to TO at a low level. | 583 "Translate character FROM to TO at a low level. |