From: keiichi <keiichi>
Date: Fri, 12 Nov 1999 07:20:04 +0000 (+0000)
Subject: (product-define): Add new slot `version-string'.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=fa3cf7d91ef29cecec1d15bebbe0b4a12dc4ac9c;p=elisp%2Fapel.git

(product-define): Add new slot `version-string'.
(product-provide): Likewise.
(product-version-string): New function.
(product-set-version-string): New function.
(product-string-1): Use `version-string'.
(product-for-each): New function.
(product-string): Separate `product-string' and `product-string-verbose'.
(product-string-verbose): Likewise.
(product-parse-version-string): New function.
(Toplevel): Define product information for `Meadow'.
---

diff --git a/product.el b/product.el
index bf41025..6a899f0 100644
--- a/product.el
+++ b/product.el
@@ -56,7 +56,7 @@ numbers.  Optional 4th argument CODE-NAME is a string."
   (and family
        (product-add-to-family family name))
   (set (intern name product-obarray)
-       (vector name family version code-name nil nil nil)))
+       (vector name family version code-name nil nil nil nil)))
 
 (defun product-name (product)
   "Return the name of PRODUCT, a string."
@@ -79,6 +79,9 @@ numbers.  Optional 4th argument CODE-NAME is a string."
 (defun product-features (product)
   "Return the features of PRODUCT, a list of feature."
   (aref product 6))
+(defun product-version-string (product)
+  "Return the version string of PRODUCT, a string."
+  (aref product 7))
 
 (defun product-set-name (product name)
   "Set name of PRODUCT to NAME."
@@ -102,6 +105,9 @@ numbers.  Optional 4th argument CODE-NAME is a string."
 (defun product-set-features (product features)
   "Set features of PRODUCT to FEATURES."
   (aset product 6 features))
+(defun product-set-version-string (product version-string)
+  "Set version string of PRODUCT to VERSION-STRING."
+  (aset product 7 version-string))
 
 (defun product-add-to-family (family product-name)
   "Add PRODUCT-NAME to FAMILY product."
@@ -201,7 +207,8 @@ all checkers."
 	 (product-name (product-name product))
 	 (product-family (product-family product))
 	 (product-version (product-version product))
-	 (product-code-name (product-code-name product)))
+	 (product-code-name (product-code-name product))
+	 (product-version-string (product-version-string product)))
     (`  (progn
 	  (, product-def)
 	  (put (, feature) 'product
@@ -215,7 +222,7 @@ all checkers."
 		     product
 		   (vector (, product-name) (, product-family)
 			   '(, product-version) (, product-code-name)
-			   nil nil nil))))
+			   nil nil nil (, product-version-string)))))
 	  (, feature-def)))))
 
 (defun product-string-1 (product &optional verbose)
@@ -224,29 +231,56 @@ If optional argument VERBOSE is non-nil, then return string of
 \"NAME/VERSION (CODE-NAME)\"."
   (setq product (product-find product))
   (concat (product-name product)
-	  (if (product-version product)
-	      (concat "/"
-		      (mapconcat (function number-to-string)
-				 (product-version product)
-				 "."))
-	    "")
+	  (cond
+	   ((product-version-string product)
+	    (concat "/" (product-version-string product)))
+	   ((product-version product)
+	    (concat "/"
+		    (product-set-version-string
+		     product
+		     (mapconcat (function number-to-string)
+				(product-version product)
+				"."))))
+	   (""))
 	  (if (and verbose (product-code-name product))
 	      (concat " (" (product-code-name product) ")")
 	    "")))
 
-(defun product-string (product &optional verbose)
+(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."
   (setq product (product-find product))
-  (let ((family (product-family-products product))
-	dest str)
-    (and (product-features product)
-	 (setq dest (product-string-1 product verbose)))
+  (let ((family (product-family-products product)))
+    (and (or all (product-features product))
+	 (apply function product args))
     (while family
-      (setq str (product-string (car family) verbose)
-	    family (cdr family))
-      (if str
-	  (setq dest (if dest
-			 (concat dest " " str)
-		       str))))
+      (apply 'product-for-each (car family) all function args)
+      (setq family (cdr family)))))
+
+(defun product-string (product)
+  "Return information of PRODUCT as a string of \"NAME/VERSION\"."
+  (let (dest)
+    (product-for-each product nil
+     (function
+      (lambda (product)
+	(let ((str (product-string-1 product nil)))
+	  (if str
+	      (setq dest (if dest
+			     (concat dest " " str)
+			   str)))))))
+    dest))
+
+(defun product-string-verbose (product)
+  "Return information of PRODUCT as a string of \"NAME/VERSION (CODE-NAME)\"."
+  (let (dest)
+    (product-for-each product nil
+     (function
+      (lambda (product)
+	(let ((str (product-string-1 product t)))
+	  (if str
+	      (setq dest (if dest
+			     (concat dest " " str)
+			   str)))))))
     dest))
 
 (defun product-version-compare (v1 v2)
@@ -270,7 +304,29 @@ If optional argument VERBOSE is non-nil, then return string of
 	(setq dest (cons (symbol-value sym) dest))))
      product-obarray)
     dest))
-      
+
+(defun product-parse-version-string (verstr)
+  "Parse version string \".*v1.v2... (CODE-NAME)\".
+Return list of version, code-name, and version-string."
+  (let (version version-string code-name)
+    (and (string-match "\\(\\([0-9.]+\\)[^ ]*\\)[^(]*\\((\\(.+\\))\\)?" verstr)
+	 (let ((temp (substring verstr (match-beginning 2) (match-end 2))))
+	   (setq version-string (substring verstr
+					   (match-beginning 1)
+					   (match-end 1))
+		 code-name (and (match-beginning 4)
+				(substring verstr
+					   (match-beginning 4)
+					   (match-end 4))))
+	   (while (string-match "^\\([0-9]+\\)\\.?" temp)
+	     (setq version (cons (string-to-number
+				  (substring temp
+					     (match-beginning 1)
+					     (match-end 1)))
+				 version)
+		   temp (substring temp (match-end 0))))))
+    (list (nreverse version) code-name version-string)))
+
 ;;; @ End.
 ;;;
 
@@ -280,14 +336,36 @@ If optional argument VERBOSE is non-nil, then return string of
 
 ;;; @ Define emacs versions.
 
-;(or (product-find "emacs")
-;    (progn
-;      (product-define "emacs")
-;      (product-define "Meadow" "emacs" '(1 11 1) "TSUYU")
-;      (product-provide 'Meadow "Meadow")))
-;(product-define "MULE" "Meadow" '(4 1) "AOI")
-;(product-provide 'mule "MULE")
-;(product-define "Emacs" "Meadow" '(20 4) system-configuration)
-;(product-provide 'emacs "Emacs")
+(or (product-find "emacs")
+    (progn
+      (product-define "emacs")
+      (cond
+       ((featurep 'meadow)
+	(let* ((info (product-parse-version-string (Meadow-version)))
+	       (version (nth 0 info))
+	       (code-name (nth 1 info))
+	       (version-string (nth 2 info)))
+	  (product-set-version-string
+	   (product-define "Meadow" "emacs" version code-name)
+	   version-string)
+	  (product-provide 'Meadow "Meadow"))
+	(and (featurep 'mule)
+	     (let* ((info (product-parse-version-string mule-version))
+		    (version (nth 0 info))
+		    (code-name (nth 1 info))
+		    (version-string (nth 2 info)))
+	       (product-set-version-string
+		(product-define "MULE" "Meadow" version code-name)
+		version-string)
+	       (product-provide 'mule "MULE")))
+	(let* ((info (product-parse-version-string emacs-version))
+	       (version (nth 0 info))
+	       (code-name (nth 1 info))
+	       (version-string (nth 2 info)))
+	  (product-set-version-string
+	   (product-define "Emacs" "Meadow" version code-name)
+	   version-string)
+	  (product-provide 'emacs "Emacs")))
+       )))
 
 ;;; product.el ends here