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

diff --git a/semi-def.el b/semi-def.el
index bb14d37..fd7dac1 100644
--- a/semi-def.el
+++ b/semi-def.el
@@ -29,26 +29,13 @@
 (eval-when-compile (require 'cl))
 
 
-(defconst mime-module-version '("WEMI" ".DNRfuna" 1 3 1)
+(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"
   "Caesar rotation of current region." t)
 
 
-;;; @ variables
-;;;
-
-(defvar mime/use-multi-frame
-  (and (>= emacs-major-version 19) window-system))
-
-(defvar mime/find-file-function
-  (if mime/use-multi-frame
-      (function find-file-other-frame)
-    (function find-file)
-    ))
-
-
 ;;; @ constants
 ;;;
 
@@ -111,8 +98,7 @@
 	    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)
@@ -120,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
@@ -191,8 +202,7 @@ FUNCTION.")
 
 (defmacro pgp-function (method)
   "Return function to do service METHOD."
-  `(cadr (assq ,method (symbol-value 'pgp-function-alist)))
-  )
+  `(cadr (assq ,method (symbol-value 'pgp-function-alist))))
 
 (mapcar (function
 	 (lambda (method)
@@ -201,98 +211,42 @@ 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)
-    ))
-
-
-;;; @ RCS version
-;;;
-
-(defsubst get-version-string (id)
-  "Return a version-string from RCS ID."
-  (and (string-match ",v \\([0-9][0-9.][0-9.]+\\)" id)
-       (substring id (match-beginning 1)(match-end 1))
-       ))
-
-
 ;;; @ Other Utility
 ;;;
 
-(defun call-after-loaded (module func &optional hook-name)
-  "If MODULE is provided, then FUNC is called.
-Otherwise func is set to MODULE-load-hook.
-If optional argument HOOK-NAME is specified,
-it is used as hook to set."
-  (if (featurep module)
-      (funcall func)
-    (or hook-name
-	(setq hook-name (intern (concat (symbol-name module) "-load-hook")))
-	)
-    (add-hook hook-name func)
-    ))
+(defvar mime-condition-type-alist
+  '((preview . mime-preview-condition)
+    (action . mime-acting-condition)))
+
+(defvar mime-condition-mode-alist
+  '((with-default . ctree-set-calist-with-default)
+    (t . ctree-set-calist-strictly)))
+
+(defun mime-add-condition (target-type condition &optional mode file)
+  "Add CONDITION to database specified by TARGET-TYPE.
+TARGET-TYPE must be 'preview or 'action.  
+If optional argument MODE is 'strict or nil (omitted), CONDITION is
+added strictly.
+If optional argument MODE is 'with-default, CONDITION is added with
+default rule.
+If optional argument FILE is specified, it is loaded when CONDITION is
+activate."
+  (let ((sym (cdr (assq target-type mime-condition-type-alist))))
+    (if sym
+	(let ((func (cdr (or (assq mode mime-condition-mode-alist)
+			     (assq t mime-condition-mode-alist)))))
+	  (if (fboundp func)
+	      (progn
+		(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)
+      )))
 
 
 ;;; @ end