(require 'custom)
-(defconst mime-user-interface-product ["REMI" (1 14 0) "Uragawara"]
+(defconst mime-user-interface-product ["EMIKO" (1 14 0) "Zoomastigophora"]
"Product name, version number and code name of MIME-kernel package.")
(autoload 'mule-caesar-region "mule-caesar"
"Caesar rotation of current region." t)
+(autoload 'widget-convert-button "wid-edit")
;;; @ constants
;;;
;;; @ button
;;;
-(defcustom mime-button-face 'bold
- "Face used for content-button or URL-button of MIME-Preview buffer."
- :group 'mime
- :type 'face)
-
-(defcustom mime-button-mouse-face 'highlight
- "Face used for MIME-preview buffer mouse highlighting."
- :group 'mime
- :type 'face)
-
-(defsubst mime-add-button (from to function &optional data)
- "Create a button between FROM and TO with callback FUNCTION and DATA."
- (and mime-button-face
- (put-text-property from to 'face mime-button-face))
- (and mime-button-mouse-face
- (put-text-property from to 'mouse-face mime-button-mouse-face))
- (put-text-property from to 'mime-button-callback function)
- (and data
- (put-text-property from to 'mime-button-data data))
- )
+(define-widget 'mime-button 'link
+ "Widget for MIME button."
+ :action 'mime-button-action)
+(defun mime-button-action (widget &optional event)
+ (let ((function (widget-get widget :mime-button-callback))
+ (data (widget-get widget :mime-button-data)))
+ (when function
+ (funcall function data))))
+
(defsubst mime-insert-button (string function &optional data)
"Insert STRING as button with callback FUNCTION and DATA."
(save-restriction
(narrow-to-region (point)(point))
- (insert (concat "[" string "]\n"))
- (mime-add-button (point-min)(point-max) function data)
- ))
-
-(defvar mime-button-mother-dispatcher nil)
-
-(defun mime-button-dispatcher (event)
- "Select the button under point."
- (interactive "e")
- (let (buf point func data)
- (save-window-excursion
- (mouse-set-point event)
- (setq buf (current-buffer)
- point (point)
- func (get-text-property (point) 'mime-button-callback)
- data (get-text-property (point) 'mime-button-data)
- ))
- (save-excursion
- (set-buffer buf)
- (goto-char point)
- (if func
- (apply func data)
- (if (fboundp mime-button-mother-dispatcher)
- (funcall mime-button-mother-dispatcher event)
- )))))
+ ;; Maybe we should introduce button formatter such as
+ ;; `gnus-mime-button-line-format'.
+ (insert "[" string "]")
+ ;; XEmacs -- when `widget-glyph-enable' is non nil, widget values are not
+ ;; guaranteed to be underlain.
+ (widget-convert-button 'mime-button (point-min)(point-max)
+ :mime-button-callback function
+ :mime-button-data data)
+ (insert "\n")))
;;; @ for URL
(concat "\\(http\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):"
"\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?"
"[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
- "*Regexp to match URL in text body."
+ "Regexp to match URL in text body."
:group 'mime
:type 'regexp)
(defcustom mime-browse-url-function (function browse-url)
- "*Function to browse URL."
+ "Function to browse URL."
:group 'mime
:type 'function)
+(define-widget 'mime-url-link 'url-link
+ "A link to an www page.")
+
(defsubst mime-add-url-buttons ()
"Add URL-buttons for text body."
(goto-char (point-min))
(while (re-search-forward mime-browse-url-regexp nil t)
- (let ((beg (match-beginning 0))
- (end (match-end 0)))
- (mime-add-button beg end mime-browse-url-function
- (list (buffer-substring beg end))))))
+ (widget-convert-button 'mime-url-link (match-beginning 0)(match-end 0)
+ (match-string-no-properties 0))))
;;; @ menu
;;;
-(if window-system
- (if (featurep 'xemacs)
- (defun select-menu-alist (title menu-alist)
- (let (ret)
- (popup-menu
- (list* title
- "---"
- (mapcar (function
- (lambda (cell)
- (vector (car cell)
- `(progn
- (setq ret ',(cdr cell))
- (throw 'exit nil)
- )
- t)
- ))
- menu-alist)
- ))
- (recursive-edit)
- ret))
- (defun select-menu-alist (title menu-alist)
- (x-popup-menu
- (list '(1 1) (selected-window))
- (list title (cons title menu-alist))
- ))
- )
- (defun select-menu-alist (title menu-alist)
- (cdr
- (assoc (completing-read (concat title " : ") menu-alist)
- menu-alist)
- ))
- )
+(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)))
;;; @ Other Utility
(funcall func sym condition)
(if file
(let ((method (cdr (assq 'method condition))))
- (autoload method file)
- ))
- )
- (error "Function for mode `%s' is not found." mode)
- ))
- (error "Variable for target-type `%s' is not found." target-type)
- )))
+ (autoload method file))))
+ (error "Function for mode `%s' is not found." mode)))
+ (error "Variable for target-type `%s' is not found." target-type))))
;;; @ end