From: ueno Date: Mon, 24 Sep 2001 10:06:57 +0000 (+0000) Subject: * semi-def.el (mime-should-use-popup-menu): New function. X-Git-Tag: emiko-1_14_0~11 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=76c2e68e2e39c85d9f198a74c13a59e7f687fa3f;p=elisp%2Fsemi.git * semi-def.el (mime-should-use-popup-menu): New function. (mime-menu-select): New function which wraps the call of the function `mime-popup-menu-select'. * mime-play.el (mime-play-entity): Uniquify menu items before asking user. --- diff --git a/mime-play.el b/mime-play.el index 519659b..a476a05 100644 --- a/mime-play.el +++ b/mime-play.el @@ -90,21 +90,19 @@ specified, play as it. Default MODE is \"play\"." mime-acting-situation-example-list 'method ignored-method mime-play-find-every-situations)) - method) + method menu) (setq mime-acting-situation-example-list (cdr ret) ret (car ret)) (cond ((cdr 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)) + (while ret + (or (vassoc (setq method + (format "%s" + (cdr (assq 'method (pop ret))))) + menu) + (push (vector method situation t) menu))) + (setq ret (mime-sort-situation + (mime-menu-select "Play entity with: " + (cons "Methods" menu)))) (add-to-list 'mime-acting-situation-example-list (cons ret 0))) (t (setq ret (car ret)))) diff --git a/semi-def.el b/semi-def.el index 2745c96..96cc2ed 100644 --- a/semi-def.el +++ b/semi-def.el @@ -113,7 +113,8 @@ (setq function (lookup-key ,bogus-menu (apply #'vector selection))) ;; If a callback entry has no name, easy-menu wraps its value. ;; See `easy-menu-make-symbol'. - (if (eq t (compare-strings "menu-function-" 0 nil (symbol-name function) 0 14)) + (if (eq t (compare-strings "menu-function-" 0 nil + (symbol-name function) 0 14)) (car (last (symbol-function function))) function))))) @@ -134,6 +135,21 @@ (defun mime-popup-menu-select (menu &optional event) (mime-popup-menu-bogus-filter-constructor menu))) +(static-if (featurep 'xemacs) + (defun mime-should-use-popup-menu () + (mouse-event-p last-command-event)) + (defun mime-should-use-popup-menu () + (memq 'click (event-modifiers last-command-event)))) + +(defun mime-menu-select (prompt menu &optional event) + (if (mime-should-use-popup-menu) + (mime-popup-menu-select menu event) + (let ((rest (cdr menu))) + (while rest + (setcar rest (append (car rest) nil)) + (setq rest (cdr rest))) + (nth 1 (assoc (completing-read prompt (cdr menu)) (cdr menu)))))) + ;;; @ Other Utility ;;;