From: ueno <ueno>
Date: Wed, 13 Sep 2000 05:10:28 +0000 (+0000)
Subject: * mime-view.el (mime-view-xemacs-popup-menu): Abolish.
X-Git-Tag: emiko-1_14-pgg-0_1-last-~18
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4dff238f60501b2990725dce9a02ffe394223fd0;p=elisp%2Fsemi.git

* mime-view.el (mime-view-xemacs-popup-menu): Abolish.
(mime-view-menu-title): Abolish.
(mime-view-menu-list): Rewrite in easymenu-style.
(mime-view-popup-menu): New function.
(mime-view-define-keymap): Simplify; don't check `emacs-major-version'.

* semi-def.el (mime-menu-bogus-filter-constructor): New macro.
(mime-menu-popup): New macro.
(select-menu-alist): Rewrite with `defun-maybe-cond'.
(mime-insert-button): Use `widget-convert-button'.
(mime-url-link): New widget.
---

diff --git a/mime-view.el b/mime-view.el
index 85d0771..270ec9d 100644
--- a/mime-view.el
+++ b/mime-view.el
@@ -1004,51 +1004,22 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 ;;; @ MIME viewer mode
 ;;;
 
-(defconst mime-view-menu-title "MIME-View")
 (defconst mime-view-menu-list
-  '((up		 "Move to upper entity"    mime-preview-move-to-upper)
-    (previous	 "Move to previous entity" mime-preview-move-to-previous)
-    (next	 "Move to next entity"	   mime-preview-move-to-next)
-    (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
-    (scroll-up	 "Scroll-up"               mime-preview-scroll-up-entity)
-    (play	 "Play current entity"     mime-preview-play-current-entity)
-    (extract	 "Extract current entity"  mime-preview-extract-current-entity)
-    (print	 "Print current entity"    mime-preview-print-current-entity))
+  '("MIME-View"
+    ["Move to upper entity" mime-preview-move-to-upper]
+    ["Move to previous entity" mime-preview-move-to-previous]
+    ["Move to next entity" mime-preview-move-to-next]
+    ["Scroll-down" mime-preview-scroll-down-entity]
+    ["Scroll-up" mime-preview-scroll-up-entity]
+    ["Play current entity" mime-preview-play-current-entity]
+    ["Extract current entity" mime-preview-extract-current-entity]
+    ["Print current entity" mime-preview-print-current-entity])
   "Menu for MIME Viewer")
 
-(cond ((featurep 'xemacs)
-       (defvar mime-view-xemacs-popup-menu
-	 (cons mime-view-menu-title
-	       (mapcar (function
-			(lambda (item)
-			  (vector (nth 1 item)(nth 2 item) t)))
-		       mime-view-menu-list)))
-       (defun mime-view-xemacs-popup-menu (event)
-	 "Popup the menu in the MIME Viewer buffer"
-	 (interactive "e")
-	 (select-window (event-window event))
-	 (set-buffer (event-buffer event))
-	 (popup-menu 'mime-view-xemacs-popup-menu))
-       (defvar mouse-button-2 'button2))
-      (t
-       (defvar mime-view-popup-menu 
-         (let ((menu (make-sparse-keymap mime-view-menu-title)))
-           (nconc menu
-                  (mapcar (function
-                           (lambda (item)
-                             (list (intern (nth 1 item)) 'menu-item 
-                                   (nth 1 item)(nth 2 item))))
-                          mime-view-menu-list))))
-       (defun mime-view-popup-menu (event)
-         "Popup the menu in the MIME Viewer buffer"
-         (interactive "@e")
-         (let ((menu mime-view-popup-menu) events func)
-           (setq events (x-popup-menu t menu))
-           (and events
-                (setq func (lookup-key menu (apply #'vector events)))
-                (commandp func)
-                (funcall func))))
-       (defvar mouse-button-2 [mouse-2])))
+(defun mime-view-popup-menu (event)
+  "Popup the menu in the MIME Viewer buffer"
+  (interactive "@e")
+  (mime-menu-popup event mime-view-menu-list))
 
 ;;; 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.
@@ -1130,26 +1101,12 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (define-key mime-view-mode-map
       [backspace] (function mime-preview-scroll-down-entity))
     (if (functionp default)
-	(cond ((featurep 'xemacs)
-	       (set-keymap-default-binding mime-view-mode-map default))
-	      (t
-	       (setq mime-view-mode-map
-		     (append mime-view-mode-map (list (cons t default)))))))
-    (cond ((featurep 'xemacs)
-	   (define-key mime-view-mode-map
-	     mouse-button-3 (function mime-view-xemacs-popup-menu)))
-	  ((>= emacs-major-version 19)
-	   (define-key mime-view-mode-map
-             mouse-button-3 (function mime-view-popup-menu))
-	   (define-key mime-view-mode-map [menu-bar mime-view]
-	     (cons mime-view-menu-title
-		   (make-sparse-keymap mime-view-menu-title)))
-	   (mapcar (function
-		    (lambda (item)
-		      (define-key mime-view-mode-map
-			(vector 'menu-bar 'mime-view (car item))
-			(cons (nth 1 item)(nth 2 item)))))
-		   (reverse mime-view-menu-list))))
+	(static-if (featurep 'xemacs)
+	    (set-keymap-default-binding mime-view-mode-map default)
+	  (setq mime-view-mode-map
+		(append mime-view-mode-map (list (cons t default))))))
+    (define-key mime-view-mode-map
+      mouse-button-3 (function mime-view-popup-menu))
     (use-local-map mime-view-mode-map)
     (run-hooks 'mime-view-define-keymap-hook)))
 
diff --git a/semi-def.el b/semi-def.el
index dbae683..a9a94ba 100644
--- a/semi-def.el
+++ b/semi-def.el
@@ -50,20 +50,29 @@
 ;;; @ button
 ;;;
 
-(define-widget 'mime-button 'push-button
+(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-callback))
-	(data (widget-get widget :mime-data)))
+  (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."
-  (widget-create 'mime-button :mime-callback function :mime-data data string)
-  (insert "\n"))
+  (save-restriction
+    (narrow-to-region (point)(point))
+    ;; 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
@@ -73,51 +82,65 @@
   (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)
-    (widget-convert-button 'url-link (match-beginning 0)(match-end 0)
+    (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))))
+(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)
+  `(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))))
+
+(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))))
 
 
 ;;; @ Other Utility