[Emacs-diffs] /srv/bzr/emacs/trunk r111769: * lisp/tmm.el: Use lexical-binding and current-active-maps.

[Stefan Monnier]

------------------------------------------------------------
revno: 111769
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2013-02-13 08:40:00 -0500
message:
  * lisp/tmm.el: Use lexical-binding and current-active-maps.
  (tmm-menubar): Use map-keymap and pcase.
  (tmm--completion-table): New function.
  (tmm-prompt): Use it to fix the menu order.
  (tmm-get-keybind): Use current-active-maps.
modified:
  lisp/ChangeLog
  lisp/tmm.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-02-13 09:42:31 +0000
+++ b/lisp/ChangeLog    2013-02-13 13:40:00 +0000
@@ -1,3 +1,11 @@
+2013-02-13  Stefan Monnier  <address@hidden>
+
+       * tmm.el: Use lexical-binding and current-active-maps.
+       (tmm-menubar): Use map-keymap and pcase.
+       (tmm--completion-table): New function.
+       (tmm-prompt): Use it to fix the menu order.
+       (tmm-get-keybind): Use current-active-maps.
+
 2013-02-12  Christopher Schmidt  <address@hidden>
 
        Add dired-hide-details-mode.  (Bug#6799)

=== modified file 'lisp/tmm.el'
--- a/lisp/tmm.el       2013-01-01 09:11:05 +0000
+++ b/lisp/tmm.el       2013-02-13 13:40:00 +0000
@@ -1,4 +1,4 @@
-;;; tmm.el --- text mode access to menu-bar
+;;; tmm.el --- text mode access to menu-bar  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1994-1996, 2000-2013 Free Software Foundation, Inc.
 
@@ -54,36 +54,37 @@
   (interactive)
   (run-hooks 'menu-bar-update-hook)
   ;; Obey menu-bar-final-items; put those items last.
-  (let ((menu-bar (tmm-get-keybind [menu-bar]))
+  (let ((menu-bar '())
+        (menu-end '())
        menu-bar-item)
-    (let ((list menu-bar-final-items))
-      (while list
-       (let ((item (car list)))
-         ;; ITEM is the name of an item that we want to put last.
-         ;; Find it in MENU-BAR and move it to the end.
-         (let ((this-one (assq item menu-bar)))
-           (setq menu-bar (append (delq this-one menu-bar)
-                                  (list this-one)))))
-       (setq list (cdr list))))
+    (map-keymap
+     (lambda (key binding)
+       (push (cons key binding)
+             ;; If KEY is the name of an item that we want to put last,
+             ;; move it to the end.
+             (if (memq key menu-bar-final-items)
+                 menu-end
+               menu-bar)))
+     (tmm-get-keybind [menu-bar]))
+    (setq menu-bar `(keymap ,@(nreverse menu-bar) ,@(nreverse menu-end)))
     (if x-position
-       (let ((tail menu-bar) (column 0)
-             this-one name visible)
-         (while (and tail (<= column x-position))
-           (setq this-one (car tail))
-           (if (and (consp this-one)
-                    (consp (cdr this-one))
-                    (setq name  ;simple menu
-                          (cond ((stringp (nth 1  this-one))
-                                 (nth 1  this-one))
-                                ;extended menu
-                                ((stringp (nth 2 this-one))
-                                 (setq visible (plist-get
-                                                (nthcdr 4 this-one) :visible))
-                                 (unless (and visible (not (eval visible)))
-                                   (nth 2 this-one))))))
-               (setq column (+ column (length name) 1)))
-           (setq tail (cdr tail)))
-         (setq menu-bar-item (car this-one))))
+       (let ((column 0))
+          (catch 'done
+            (map-keymap
+             (lambda (key binding)
+               (when (> column x-position)
+                 (setq menu-bar-item key)
+                 (throw 'done nil))
+               (pcase binding
+                 ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
+                      `(menu-item ,name ,_cmd            ;Extended menu item.
+                        . ,(and props
+                                (guard (let ((visible
+                                              (plist-get props :visible)))
+                                         (or (null visible)
+                                             (eval visible)))))))
+                  (setq column (+ column (length name) 1)))))
+             menu-bar))))
     (tmm-prompt menu-bar nil menu-bar-item)))
 
 ;;;###autoload
@@ -138,6 +139,12 @@
   "Face used for inactive menu items."
   :group 'tmm)
 
+(defun tmm--completion-table (items)
+  (lambda (string pred action)
+    (if (eq action 'metadata)
+       '(metadata (display-sort-function . identity))
+      (complete-with-action action items string pred))))
+
 ;;;###autoload
 (defun tmm-prompt (menu &optional in-popup default-item)
   "Text-mode emulation of calling the bindings in keymap.
@@ -174,6 +181,7 @@
          ((vectorp elt)
           (dotimes (i (length elt))
             (tmm-get-keymap (cons i (aref elt i)) not-menu))))))
+    (setq tmm-km-list (nreverse tmm-km-list))
     ;; Choose an element of tmm-km-list; put it in choice.
     (if (and not-menu (= 1 (length tmm-km-list)))
        ;; If this is the top-level of an x-popup-menu menu,
@@ -226,7 +234,7 @@
                        (completing-read
                         (concat gl-str
                                 " (up/down to change, PgUp to menu): ")
-                        tmm-km-list nil t nil
+                        (tmm--completion-table tmm-km-list) nil t nil
                         (cons 'history
                               (- (* 2 history-len) index-of-default))))))))
       (setq choice (cdr (assoc out tmm-km-list)))
@@ -497,46 +505,7 @@
 we merge them into a single keymap which shows the proper order of the menu.
 However, for the menu bar itself, the value does not take account
 of `menu-bar-final-items'."
-  (let (allbind bind minorbind localbind globalbind)
-    (setq bind (key-binding keyseq))
-    ;; If KEYSEQ is a prefix key, then BIND is either nil
-    ;; or a symbol defined as a keymap (which satisfies keymapp).
-    (if (keymapp bind)
-       (setq bind nil))
-    ;; If we have a non-keymap definition, return that.
-    (or bind
-       (progn
-         ;; Otherwise, it is a prefix, so make a list of the subcommands.
-         ;; Make a list of all the bindings in all the keymaps.
-          ;; FIXME: we'd really like to just use `key-binding' now that it
-          ;; returns a keymap that contains really all the bindings under that
-          ;; prefix, but `keyseq' is always [menu-bar], so the desired order of
-          ;; the bindings is difficult to recover.
-         (setq minorbind (mapcar 'cdr (minor-mode-key-binding keyseq)))
-         (setq localbind (local-key-binding keyseq))
-         (setq globalbind (copy-sequence (cdr (global-key-binding keyseq))))
-
-         ;; If items have been redefined/undefined locally, remove them from
-         ;; the global list.
-         (dolist (minor minorbind)
-           (dolist (item (cdr minor))
-             (setq globalbind (assq-delete-all (car-safe item) globalbind))))
-         (dolist (item (cdr localbind))
-           (setq globalbind (assq-delete-all (car-safe item) globalbind)))
-
-         (setq globalbind (cons 'keymap globalbind))
-         (setq allbind (cons globalbind (cons localbind minorbind)))
-
-         ;; Merge all the elements of ALLBIND into one keymap.
-         (dolist (in allbind)
-            (if (and (symbolp in) (keymapp in))
-                (setq in (symbol-function in)))
-            (and in (keymapp in)
-                 (setq bind (if (keymapp bind)
-                                (nconc bind (copy-sequence (cdr in)))
-                              (copy-sequence in)))))
-         ;; Return that keymap.
-         bind))))
+  (lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq))
 
 (provide 'tmm)