From 19fe876c999fe0d44e6d07c5cbaf36d4a2dc5db7 Mon Sep 17 00:00:00 2001 From: ueno Date: Wed, 13 Sep 2000 06:51:20 +0000 Subject: [PATCH] * mime-play.el (mime-play-entity): Pass easymenu-style menu to `mime-popup-menu-select'. * semi-def.el (mime-popup-menu-popup): Rename from `mime-menu-popup'. (mime-popup-menu-select): Rename from `select-menu-alist'. (mime-popup-menu-select) [XEmacs]: Use `get-popup-menu-response'. (mime-popup-menu-bogus-filter-constructor): Abolish argument `name'. --- mime-play.el | 19 ++++++++++--------- mime-view.el | 9 +++++---- semi-def.el | 57 ++++++++++++++++++++++++--------------------------------- 3 files changed, 39 insertions(+), 46 deletions(-) diff --git a/mime-play.el b/mime-play.el index 9d023b3..0f8288e 100644 --- a/mime-play.el +++ b/mime-play.el @@ -91,15 +91,16 @@ specified, play as it. Default MODE is \"play\"." (setq mime-acting-situation-example-list (cdr ret) ret (car ret)) (cond ((cdr ret) - (setq ret (select-menu-alist - "Methods" - (mapcar (function - (lambda (situation) - (cons - (format "%s" - (cdr (assq 'method situation))) - situation))) - ret))) + (setq ret (mime-popup-menu-select + (cons + "Methods" + (mapcar + (lambda (situation) + (vector + (format "%s" + (cdr (assq 'method situation))) + situation t)) + ret)))) (setq ret (mime-sort-situation ret)) (add-to-list 'mime-acting-situation-example-list (cons ret 0))) (t diff --git a/mime-view.el b/mime-view.el index 270ec9d..a077ae1 100644 --- a/mime-view.el +++ b/mime-view.el @@ -1004,7 +1004,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." ;;; @ MIME viewer mode ;;; -(defconst mime-view-menu-list +(defconst mime-view-popup-menu-list '("MIME-View" ["Move to upper entity" mime-preview-move-to-upper] ["Move to previous entity" mime-preview-move-to-previous] @@ -1019,10 +1019,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (defun mime-view-popup-menu (event) "Popup the menu in the MIME Viewer buffer" (interactive "@e") - (mime-menu-popup event mime-view-menu-list)) + (mime-popup-menu-popup mime-view-popup-menu-list event)) -;;; The current local map is taken precendence over `widget-keymap', because GNU Emacs' -;;; widget implementation doesn't set `local-map' property. So we need to specify derivation. +;;; The current local map is taken precendence over `widget-keymap', +;;; because GNU Emacs' widget implementation doesn't set `local-map' property. +;;; So we need to specify derivation. (defvar widget-keymap) (defun mime-view-maybe-inherit-widget-keymap () (when (boundp 'widget-keymap) diff --git a/semi-def.el b/semi-def.el index a9a94ba..ba0e34f 100644 --- a/semi-def.el +++ b/semi-def.el @@ -105,42 +105,33 @@ ;;; @ menu ;;; -(defun-maybe-cond select-menu-alist (title menu-alist) - ((fboundp 'popup-menu) - ;; While XEmacs can have both X and tty frames at the same time with - ;; gnuclient, we shouldn't emulate in text-mode here. - (let (ret) - (popup-menu - ;; list* is CL function, but CL is a part of XEmacs. - (list* title - "---" - (mapcar - (lambda (cell) - (vector (car cell) - `(progn - (setq ret ',(cdr cell)) - (throw 'exit nil)) - t))) - menu-alist)) - (recursive-edit) - ret)) - (window-system - (x-popup-menu t (list title (cons title menu-alist))))) - -(defmacro mime-menu-bogus-filter-constructor (name menu) +(defmacro mime-popup-menu-bogus-filter-constructor (menu) `(let (x y) (setq x (x-popup-menu t ,menu) - y (and x (lookup-key ,menu (apply #'vector x)))) + y (and x (lookup-key ,menu (apply #'vector x)))) (if (and x y) - (funcall y)))) - -(defmacro mime-menu-popup (event menu) - (if (fboundp 'popup-menu) - `(popup-menu ,menu) - ;; #### Kludge for GNU Emacs 20.7 or earlier. - `(let (bogus-menu) - (easy-menu-define bogus-menu nil nil ,menu) - (mime-menu-bogus-filter-constructor "Popup" bogus-menu)))) + (funcall y)))) + +;;; While XEmacs can have both X and tty frames at the same time with +;;; gnuclient, we shouldn't emulate in text-mode here. + +(static-if (featurep 'xemacs) + (defalias 'mime-popup-menu-popup 'popup-menu) + (defun mime-popup-menu-popup (menu &optional event) + (let (bogus-menu) + ;; #### Kludge for FSF Emacs-style menu. + (easy-menu-define bogus-menu nil nil menu) + (mime-popup-menu-bogus-filter-constructor bogus-menu)))) + +(static-if (featurep 'xemacs) + (defun mime-popup-menu-select (menu &optional event) + (let ((selection (get-popup-menu-response menu event))) + (event-object selection))) + (defun mime-popup-menu-select (menu &optional event) + (let (bogus-menu) + ;; #### Kludge for FSF Emacs-style menu. + (easy-menu-define bogus-menu nil nil menu) + (x-popup-menu t bogus-menu)))) ;;; @ Other Utility -- 1.7.10.4