;;; Code:
-(require 'poe)
-
(eval-when-compile (require 'cl))
(require 'custom)
-(defconst mime-user-interface-product ["EMIKO" (1 14 0) "Zoomastigophora"]
+(defconst mime-user-interface-product ["EMIKO" (1 14 1) "Choanoflagellata"]
"Product name, version number and code name of MIME-kernel package.")
(autoload 'mule-caesar-region "mule-caesar"
;;;
(defcustom mime-browse-url-regexp
- (concat "\\(http\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):"
+ (concat "\\(https?\\|ftps?\\|file\\|gopher\\|news\\|nntps?\\|telnets?\\|wais\\|mailto\\):"
"\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?"
- "[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
+ "[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,;]*[-a-zA-Z0-9_=#$@~`%&*+|\\/;]")
"Regexp to match URL in text body."
:group 'mime
:type 'regexp)
;;;
(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))))
- (if (and x y)
- (funcall y))))
+ ;; #### Kludge for FSF Emacs-style menu.
+ (let ((bogus-menu (make-symbol "bogus-menu")))
+ `(let (,bogus-menu selection function)
+ (easy-menu-define ,bogus-menu nil nil ,menu)
+ (setq selection (x-popup-menu t ,bogus-menu))
+ (when selection
+ (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))
+ (car (last (symbol-function function)))
+ function)))))
;;; 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))))
+ (let ((function (mime-popup-menu-bogus-filter-constructor menu)))
+ (when (symbolp function)
+ (funcall function)))))
(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))))
+ (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 (event-basic-type last-command-event) '(mouse-1 mouse-2 mouse-3))))
+
+(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