X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=semi-def.el;h=bc294ea2271eb9fb233b3dcb108cdacf909101e1;hb=bf765ed3ff2c3d2546f0687131812b307f9bd041;hp=c852586f4a4321a172ca4c69c4bd8173d44bcff9;hpb=db5a10d25b470aad0abf15d87dc0c73702c2b60a;p=elisp%2Fsemi.git

diff --git a/semi-def.el b/semi-def.el
index c852586..bc294ea 100644
--- a/semi-def.el
+++ b/semi-def.el
@@ -26,26 +26,16 @@
 
 (require 'emu)
 
-(defconst mime-module-version '("WEMI" "Shinagawa" 1 2 2)
+(eval-when-compile (require 'cl))
+
+
+(defconst mime-module-version '("WEMI" "K-Dòzu-A" 1 4 6)
   "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
 ;;;
 
@@ -72,23 +62,27 @@
   "Insert STRING as button with callback FUNCTION and DATA."
   (save-restriction
     (narrow-to-region (point)(point))
-    (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)
-					     )))
-		   string)
-    (insert "\n")
+    (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)
     ))
 
@@ -104,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)
@@ -117,6 +110,43 @@
 	))))
 
 
+;;; @ 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)
+     ))
+  )
+
+
 ;;; @ PGP
 ;;;
 
@@ -147,8 +177,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)
@@ -157,24 +186,6 @@ FUNCTION.")
 	pgp-function-alist)
 
 
-;;; @ method selector kernel
-;;;
-
-(require 'atype)
-
-;;; @@ field unifier
-;;;
-
-(defun field-unifier-for-mode (a b)
-  (let ((va (cdr a)))
-    (if (if (consp va)
-	    (member (cdr b) va)
-	  (equal va (cdr b))
-	  )
-	(list nil b nil)
-      )))
-
-
 ;;; @ field
 ;;;
 
@@ -242,16 +253,6 @@ FUNCTION.")
     ))
 
 
-;;; @ 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
 ;;;
 
@@ -269,6 +270,41 @@ it is used as hook to set."
     ))
 
 
+(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
 ;;;