-(defun tm:set-fields (sym field-list &optional regexp-sym)
- (or regexp-sym
- (setq regexp-sym
- (let ((name (symbol-name sym)))
- (intern
- (concat (if (string-match "\\(.*\\)-list" name)
- (substring name 0 (match-end 1))
- name)
- "-regexp")
- )))
- )
- (set sym field-list)
- (set regexp-sym
- (concat "^" (apply (function regexp-or) field-list) ":"))
- )
-
-(defun tm:add-fields (sym field-list &optional regexp-sym)
- (or regexp-sym
- (setq regexp-sym
- (let ((name (symbol-name sym)))
- (intern
- (concat (if (string-match "\\(.*\\)-list" name)
- (substring name 0 (match-end 1))
- name)
- "-regexp")
- )))
- )
- (let ((fields (eval sym)))
- (mapcar (function
- (lambda (field)
- (or (member field fields)
- (setq fields (cons field fields))
- )
- ))
- (reverse field-list)
- )
- (set regexp-sym
- (concat "^" (apply (function regexp-or) fields) ":"))
- (set sym fields)
- ))
-
-(defun tm:delete-fields (sym field-list &optional regexp-sym)
- (or regexp-sym
- (setq regexp-sym
- (let ((name (symbol-name sym)))
- (intern
- (concat (if (string-match "\\(.*\\)-list" name)
- (substring name 0 (match-end 1))
- name)
- "-regexp")
- )))
- )
- (let ((fields (eval sym)))
- (mapcar (function
- (lambda (field)
- (setq fields (delete field fields))
- ))
- field-list)
- (set regexp-sym
- (concat "^" (apply (function regexp-or) fields) ":"))
- (set sym fields)
- ))
+(defmacro mime-popup-menu-bogus-filter-constructor (menu)
+ ;; #### 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 ((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)
+ (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))))))