X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=semi-def.el;h=fd7dac1de76942e419c308ac15afdf32cb5c31ef;hb=bc4209fd45589510b68273e0d1a8b08b2fb808a5;hp=98d0e8666f11443783dc678f8dcac95e84e777dd;hpb=4addbba27406fe7988fa431ef708baa69c00127c;p=elisp%2Fsemi.git

diff --git a/semi-def.el b/semi-def.el
index 98d0e86..fd7dac1 100644
--- a/semi-def.el
+++ b/semi-def.el
@@ -1,11 +1,11 @@
-;;; semi-def.el --- definition module for REMI
+;;; semi-def.el --- definition module for WEMI
 
 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: definition, MIME, multimedia, mail, news
 
-;; This file is part of SEMI (Sample of Emacs MIME Implementation).
+;; This file is part of WEMI (Widget based Emacs MIME Interfaces).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -28,9 +28,8 @@
 
 (eval-when-compile (require 'cl))
 
-(require 'custom)
 
-(defconst mime-user-interface-version '("SEMI" "Toyama" 1 8 0)
+(defconst mime-user-interface-version '("WEMI" "Katahama" 1 8 2)
   "Implementation name, version name and numbers of MIME-kernel package.")
 
 (autoload 'mule-caesar-region "mule-caesar"
@@ -59,24 +58,32 @@
   :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."
-  (let ((overlay (make-overlay from to)))
-    (and mime-button-face
-	 (overlay-put overlay 'face mime-button-face))
-    (and mime-button-mouse-face
-	 (overlay-put overlay 'mouse-face mime-button-mouse-face))
-    (add-text-properties from to (list 'mime-button-callback function))
-    (and data
-	 (add-text-properties from to (list 'mime-button-data 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)
+    (mapcar #'(lambda (line)
+		(widget-create
+		 'push-button
+		 :action `(lambda (widget &optional event)
+			    (,function)
+			    )
+		 :mouse-down-action `(lambda (widget event)
+				       (let (buf point)
+					 (save-window-excursion
+					   (mouse-set-point event)
+					   (setq buf (current-buffer)
+						 point (point)))
+					 (save-excursion
+					   (set-buffer buf)
+					   (goto-char point)
+					   (,function)
+					   )))
+		 line)
+		(insert "\n")
+		)
+	    (split-string string "\n"))
+    ;;(mime-add-button (point-min)(point-max) function data)
     ))
 
 (defvar mime-button-mother-dispatcher nil)
@@ -99,8 +106,33 @@
 	  (apply func data)
 	(if (fboundp mime-button-mother-dispatcher)
 	    (funcall mime-button-mother-dispatcher event)
-	  )
-	))))
+	  )))))
+
+
+;;; @ for URL
+;;;
+
+(defcustom mime-browse-url-regexp
+  (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."
+  :group 'mime
+  :type 'regexp)
+
+(defcustom mime-browse-url-function (function browse-url)
+  "*Function to browse URL."
+  :group 'mime
+  :type 'function)
+
+(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)))
+      (widget-convert-text 'url-link beg end)
+      )))
 
 
 ;;; @ menu
@@ -179,73 +211,6 @@ FUNCTION.")
 	pgp-function-alist)
 
 
-;;; @ field
-;;;
-
-(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)
-    ))
-
-
 ;;; @ Other Utility
 ;;;