X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fapel.git;a=blobdiff_plain;f=product.el;h=b49d69884dddb5f386a599f19c1ccbd357f435e0;hp=d420efd4afdef4d89f89389f23b2026c846d6515;hb=24a3e5bce8c3c1228130d84b297002c73b185f70;hpb=06ff6d53e10772fc6d985e9a4bd14ceda595baee

diff --git a/product.el b/product.el
index d420efd..b49d698 100644
--- a/product.el
+++ b/product.el
@@ -1,7 +1,6 @@
 ;;; product.el --- Functions for product version information.
 
-;; Copyright (C) 1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Keiichi Suzuki
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
 
 ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
 ;;	Keiichi Suzuki <keiichi@nanap.org>
@@ -21,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -97,7 +96,7 @@ numbers.  Optional 4th argument CODE-NAME is a string."
   "Set code-name of PRODUCT to CODE-NAME."
   (aset product 3 code-name))
 (defun product-set-checkers (product checkers)
-  "Set ckecker functions of PRODUCT to CHECKERS."
+  "Set checker functions of PRODUCT to CHECKERS."
   (aset product 4 checkers))
 (defun product-set-family-products (product products)
   "Set family products of PRODUCT to PRODUCTS."
@@ -110,7 +109,9 @@ numbers.  Optional 4th argument CODE-NAME is a string."
   (aset product 7 version-string))
 
 (defun product-add-to-family (family product-name)
-  "Add PRODUCT-NAME to FAMILY product."
+  "Add a product to a family.
+FAMILY is a product structure which returned by `product-define'.
+PRODUCT-NAME is a string of the product's name ."
   (let ((family-product (product-find-by-name family)))
     (if family-product
 	(let ((dest (product-family-products family-product)))
@@ -120,7 +121,9 @@ numbers.  Optional 4th argument CODE-NAME is a string."
       (error "Family product `%s' is not defined" family))))
 
 (defun product-remove-from-family (family product-name)
-  "Remove PRODUCT-NAME from FAMILY product."
+  "Remove a product from a family.
+FAMILY is a product string which returned by `product-define'.
+PRODUCT-NAME is a string of the product's name."
   (let ((family-product (product-find-by-name family)))
     (if family-product
 	(product-set-family-products
@@ -129,7 +132,11 @@ numbers.  Optional 4th argument CODE-NAME is a string."
       (error "Family product `%s' is not defined" family))))
 
 (defun product-add-checkers (product &rest checkers)
-  "Add CHECKERS to checker functions list of PRODUCT.
+  "Add checker function(s) to a product.
+PRODUCT is a product structure which returned by `product-define'.
+The rest arguments CHECKERS should be functions.  These functions
+are registered to the product's checkers list, and will be called by
+ `product-run-checkers'.
 If a checker is `ignore' will be ignored all checkers after this."
   (setq product (product-find product))
   (or product-ignore-checkers
@@ -143,7 +150,10 @@ If a checker is `ignore' will be ignored all checkers after this."
 	(product-set-checkers product dest))))
 
 (defun product-remove-checkers (product &rest checkers)
-  "Remove CHECKERS from checker functions list of PRODUCT."
+  "Remove checker function(s) from a product.
+PRODUCT is a product structure which returned by `product-define'.
+The rest arguments CHECKERS should be functions.  These functions removed
+from the product's checkers list."
   (setq product (product-find product))
   (let ((dest (product-checkers product)))
     (while checkers
@@ -152,22 +162,27 @@ If a checker is `ignore' will be ignored all checkers after this."
     (product-set-checkers product dest)))
 
 (defun product-add-feature (product feature)
-  "Add FEATURE to features list of PRODUCT."
+  "Add a feature to the features list of a product.
+PRODUCT is a product structure which returned by `product-define'.
+FEATURE is a feature in the PRODUCT's."
   (setq product (product-find product))
   (let ((dest (product-features product)))
     (or (memq feature dest)
 	(product-set-features product (cons feature dest)))))
 
 (defun product-remove-feature (product feature)
-  "Remove FEATURE from features list of PRODUCT."
+  "Remove a feature from the features list of a product.
+PRODUCT is a product structure which returned by `product-define'.
+FEATURE is a feature which registered in the products list of PRODUCT."
   (setq product (product-find product))
   (product-set-features product
 			(delq feature (product-features product))))
 
 (defun product-run-checkers (product version &optional force)
-  "Run checker functions of PRODUCT.
+  "Run checker functions of product.
+PRODUCT is a product structure which returned by `product-define'.
 VERSION is target version.
-If optional 2nd argument FORCE is non-nil then do not ignore
+If optional 3rd argument FORCE is non-nil then do not ignore
 all checkers."
   (let ((checkers (product-checkers product)))
     (if (or force
@@ -179,15 +194,21 @@ all checkers."
 	    (setq checkers (cdr checkers)))))))
 
 (defun product-find-by-name (name)
-  "Return PRODUCT information of NAME."
+  "Find product by name and return a product structure.
+NAME is a string of the product's name."
   (symbol-value (intern-soft name product-obarray)))
 
 (defun product-find-by-feature (feature)
-  "Get product information of FEATURE."
+  "Get a product structure of a feature's product.
+FEATURE is a symbol of the feature."
   (get feature 'product))
 
 (defun product-find (product)
-  "Get product information."
+  "Find product information.
+If PRODUCT is a product structure, then return PRODUCT itself.
+If PRODUCT is a string, then find product by name and return a
+product structure.  If PRODUCT is symbol of feature, then return
+the feature's product."
   (cond
    ((and (symbolp product)
 	 (featurep product))
@@ -201,7 +222,9 @@ all checkers."
 
 (put 'product-provide 'lisp-indent-function 1)
 (defmacro product-provide (feature-def product-def)
-  "Declare FEATURE as a part of PRODUCT."
+  "Declare a feature as a part of product.
+FEATURE-DEF is a definition of the feature.
+PRODUCT-DEF is a definition of the product."
   (let* ((feature feature-def)
 	 (product (product-find (eval product-def)))
 	 (product-name (product-name product))
@@ -209,46 +232,54 @@ all checkers."
 	 (product-version (product-version product))
 	 (product-code-name (product-code-name product))
 	 (product-version-string (product-version-string product)))
-    (`  (progn
-	  (, product-def)
-	  (put (, feature) 'product
-	       (let ((product (product-find-by-name (, product-name))))
-		 (product-run-checkers product '(, product-version))
-		 (and (, product-family)
-		      (product-add-to-family (, product-family)
-					     (, product-name)))
-		 (product-add-feature product (, feature))
-		 (if (equal '(, product-version) (product-version product))
-		     product
-		   (vector (, product-name) (, product-family)
-			   '(, product-version) (, product-code-name)
-			   nil nil nil (, product-version-string)))))
-	  (, feature-def)))))
+    (` (progn
+	 (, product-def)
+	 (put (, feature) 'product
+	      (let ((product (product-find-by-name (, product-name))))
+		(product-run-checkers product '(, product-version))
+		(and (, product-family)
+		     (product-add-to-family (, product-family)
+					    (, product-name)))
+		(product-add-feature product (, feature))
+		(if (equal '(, product-version) (product-version product))
+		    product
+		  (vector (, product-name) (, product-family)
+			  '(, product-version) (, product-code-name)
+			  nil nil nil (, product-version-string)))))
+	 (, feature-def)))))
+
+(defun product-version-as-string (product)
+  "Return version number of product as a string.
+PRODUCT is a product structure which returned by `product-define'.
+If optional argument UPDATE is non-nil, then regenerate
+`product-version-string' from `product-version'."
+  (setq product (product-find product))
+  (or (product-version-string product)
+      (and (product-version product)
+	   (product-set-version-string product
+				       (mapconcat (function int-to-string)
+						  (product-version product)
+						  ".")))))
 
 (defun product-string-1 (product &optional verbose)
-  "Return information of PRODUCT as a string of \"NAME/VERSION\".
+  "Return information of product as a string of \"NAME/VERSION\".
+PRODUCT is a product structure which returned by `product-define'.
 If optional argument VERBOSE is non-nil, then return string of
 \"NAME/VERSION (CODE-NAME)\"."
   (setq product (product-find product))
   (concat (product-name product)
-	  (cond
-	   ((product-version-string product)
-	    (concat "/" (product-version-string product)))
-	   ((product-version product)
-	    (concat "/"
-		    (product-set-version-string
-		     product
-		     (mapconcat (function int-to-string)
-				(product-version product)
-				"."))))
-	   (""))
-	  (if (and verbose (product-code-name product))
-	      (concat " (" (product-code-name product) ")")
-	    "")))
+	  (let ((version-string (product-version-as-string product)))
+	    (and version-string
+		 (concat "/" version-string)))
+	  (and verbose (product-code-name product)
+	       (concat " (" (product-code-name product) ")"))))
 
 (defun product-for-each (product all function &rest args)
-  "Apply FUNCTION to PRODUCT and PRODUCT's family with ARGS.
-If ALL is nil, apply function to only products which provide feature."
+  "Apply a function to a product and the product's family with args.
+PRODUCT is a product structure which returned by `product-define'.
+If ALL is nil, apply function to only products which provided feature.
+FUNCTION is a function.  The function called with following arguments.
+The 1st argument is a product structure.  The rest arguments are ARGS."
   (setq product (product-find product))
   (let ((family (product-family-products product)))
     (and (or all (product-features product))
@@ -258,7 +289,8 @@ If ALL is nil, apply function to only products which provide feature."
       (setq family (cdr family)))))
 
 (defun product-string (product)
-  "Return information of PRODUCT as a string of \"NAME/VERSION\"."
+  "Return information of product as a string of \"NAME/VERSION\".
+PRODUCT is a product structure which returned by `product-define'."
   (let (dest)
     (product-for-each product nil
      (function
@@ -271,7 +303,8 @@ If ALL is nil, apply function to only products which provide feature."
     dest))
 
 (defun product-string-verbose (product)
-  "Return information of PRODUCT as a string of \"NAME/VERSION (CODE-NAME)\"."
+  "Return information of product as a string of \"NAME/VERSION (CODE-NAME)\".
+PRODUCT is a product structure which returned by `product-define'."
   (let (dest)
     (product-for-each product nil
      (function
@@ -284,13 +317,20 @@ If ALL is nil, apply function to only products which provide feature."
     dest))
 
 (defun product-version-compare (v1 v2)
-  "Compare version of product."
+  "Compare two versions.
+Return an integer greater than, equal to, or less than 0,
+according as the version V1 is greater than, equal to, or less
+than the version V2.
+Both V1 and V2 are a list of integer(s) respectively."
   (while (and v1 v2 (= (car v1) (car v2)))
     (setq v1 (cdr v1)
 	  v2 (cdr v2)))
   (if v1 (if v2 (- (car v1) (car v2)) 1) (if v2 -1 0)))
 
 (defun product-version>= (product require-version)
+  "Compare product version with required version.
+PRODUCT is a product structure which returned by `product-define'.
+REQUIRE-VERSION is a list of integer."
   (>= (product-version-compare (product-version (product-find product))
 			       require-version)
       0))
@@ -307,7 +347,8 @@ If ALL is nil, apply function to only products which provide feature."
 
 (defun product-parse-version-string (verstr)
   "Parse version string \".*v1.v2... (CODE-NAME)\".
-Return list of version, code-name, and version-string."
+Return list of version, code-name, and version-string.
+VERSTR is a string."
   (let (version version-string code-name)
     (and (string-match "\\(\\([0-9.]+\\)[^ ]*\\)[^(]*\\((\\(.+\\))\\)?" verstr)
 	 (let ((temp (substring verstr (match-beginning 2) (match-end 2))))
@@ -327,14 +368,30 @@ Return list of version, code-name, and version-string."
 		   temp (substring temp (match-end 0))))))
     (list (nreverse version) code-name version-string)))
 
+
 ;;; @ End.
 ;;;
 
 (provide 'product)			; beware of circular dependency.
 (require 'apel-ver)			; these two files depend on each other.
 (product-provide 'product 'apel-ver)
+
 
 ;;; @ Define emacs versions.
+;;;
+
+(require 'pym)
+
+(defconst-maybe emacs-major-version
+  (progn (string-match "^[0-9]+" emacs-version)
+	 (string-to-int (substring emacs-version
+				   (match-beginning 0)(match-end 0))))
+  "Major version number of this version of Emacs.")
+(defconst-maybe emacs-minor-version
+  (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
+	 (string-to-int (substring emacs-version
+				   (match-beginning 1)(match-end 1))))
+  "Minor version number of this version of Emacs.")
 
 ;;(or (product-find "emacs")
 ;;    (progn