X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=calist.el;h=fbef6808a08863ff8d80b690c6e47d9d1592556e;hb=6e972cf6c7ba473c4a83d9caaaa25e2aa31e9c7c;hp=d11b46673c9dee2022ccc95854c8cbe9df70bab2;hpb=0d1d483074d501ed6a6b43bdfa96c981f14e9384;p=elisp%2Fapel.git

diff --git a/calist.el b/calist.el
index d11b466..fbef680 100644
--- a/calist.el
+++ b/calist.el
@@ -33,16 +33,36 @@
 (defvar calist-package-alist nil)
 (defvar calist-field-match-method-obarray nil)
 
-(defun make-calist-package (name)
-  "Create a new calist-package."
-  (let ((p (make-vector 7 0)))
-    (set-alist 'calist-package-alist name p)
-    p))
-
 (defun find-calist-package (name)
   "Return a calist-package by NAME."
   (cdr (assq name calist-package-alist)))
 
+(defun define-calist-field-match-method (field-type function)
+  "Set field-match-method for FIELD-TYPE to FUNCTION."
+  (fset (intern (symbol-name field-type) calist-field-match-method-obarray)
+	function))
+
+(defun use-calist-package (name)
+  "Make the symbols of package NAME accessible in the current package."
+  (mapatoms (lambda (sym)
+	      (if (intern-soft (symbol-name sym)
+			       calist-field-match-method-obarray)
+		  (signal 'conflict-of-calist-symbol
+			  (list (format "Conflict of symbol %s")))
+		(if (fboundp sym)
+		    (define-calist-field-match-method
+		      sym (symbol-function sym))
+		  )))
+	    (find-calist-package name)))
+
+(defun make-calist-package (name &optional use)
+  "Create a new calist-package."
+  (let ((calist-field-match-method-obarray (make-vector 7 0)))
+    (set-alist 'calist-package-alist name
+	       calist-field-match-method-obarray)
+    (use-calist-package (or use 'standard))
+    calist-field-match-method-obarray))
+
 (defun in-calist-package (name)
   "Set the current calist-package to a new or existing calist-package."
   (setq calist-field-match-method-obarray
@@ -51,11 +71,6 @@
 
 (in-calist-package 'standard)
 
-(defun define-calist-field-match-method (field-type function)
-  "Set field-match-method for FIELD-TYPE to FUNCTION."
-  (fset (intern (symbol-name field-type) calist-field-match-method-obarray)
-	function))
-
 (defun calist-default-field-match-method (calist field-type field-value)
   (let ((s-field (assoc field-type calist)))
     (cond ((null s-field)
@@ -66,12 +81,14 @@
 	  ((equal (cdr s-field) field-value)
 	   calist))))
 
-(define-calist-field-match-method t #'calist-default-field-match-method)
+(define-calist-field-match-method t (function calist-default-field-match-method))
 
 (defsubst calist-field-match-method (field-type)
   (symbol-function
-   (or (intern-soft
-	(symbol-name field-type) calist-field-match-method-obarray)
+   (or (intern-soft (if (symbolp field-type)
+			(symbol-name field-type)
+		      field-type)
+		    calist-field-match-method-obarray)
        (intern-soft "t" calist-field-match-method-obarray))))
 
 (defsubst calist-field-match (calist field-type field-value)
@@ -308,6 +325,7 @@ even if other rules are matched for ALIST."
 ;;; @ end
 ;;;
 
-(provide 'calist)
+(require 'product)
+(product-provide (provide 'calist) (require 'apel-ver))
 
 ;;; calist.el ends here