mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-24 10:38:38 +00:00
Code Issues Releases Activity

* lisp/tmm.el: Use lexical-binding and current-active-maps.

Browse Source 
(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.
This commit is contained in:
Stefan Monnier 2013-02-13 08:40:00 -05:00
parent a2a538b15e
commit 4d0463b974
2 changed files with 47 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lisp/ChangeLog
View File

@ -1,3 +1,11 @@
2013-02-13 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <christopher@ch.ristopher.com>
Add dired-hide-details-mode. (Bug#6799)

109
lisp/tmm.el
View File

@ -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 @@ we make that menu bar item (the one at that position) the default choice."
(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 @@ specify nil for this variable."
"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 @@ Its value should be an event that has a binding in MENU."
((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 @@ Its value should be an event that has a binding in MENU."
(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 @@ If KEYSEQ is a prefix key that has local and global bindings,
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)