[claw-cvs] r22 - trunk/main/claw-core/src

[achiumenti at common-lisp.net]

Author: achiumenti
Date: Tue Mar 25 10:42:54 2008
New Revision: 22

Modified:
   trunk/main/claw-core/src/i18n.lisp
Log:
continuning on l13n

Modified: trunk/main/claw-core/src/i18n.lisp
==============================================================================
--- trunk/main/claw-core/src/i18n.lisp	(original)
+++ trunk/main/claw-core/src/i18n.lisp	Tue Mar 25 10:42:54 2008
@@ -37,8 +37,8 @@
 * 'SEC seconds
 * 'MIN minutes
 * 'HR hours
-* 'DAYS days
-* 'MONTH month
+* 'DAY days
+* 'MONTH monthes
 * 'YEARS years.
 And other FIELD value will produce an error condition."))
 
@@ -82,8 +82,8 @@
   (multiple-value-bind (d-month d-year)
       (floor (abs value) 12)
     (when (< value 0)
-      (setf d-month (* d-month -1)
-	    d-year (* d-year -1))	     
+      (setf d-month (- d-month)
+	    d-year (- d-year))	     
       (multiple-value-bind (ns ss mm hh day month year)
 	  (decode-local-time local-time)
 	(multiple-value-bind (ns ss mm hh day month-ignore year)
@@ -101,11 +101,63 @@
     local-time-result))
 
 (defun local-time-add-hour (local-time value)
-  (multiple-value-bind (d-hour d-day)
-      (floor (abs value) 24)
+  (multiple-value-bind (ns ss mm hh day month year)
+	  (decode-local-time local-time)
+    (multiple-value-bind (d-hour d-day)
+	(floor (abs value) 24)
+      (when (< value 0)
+	(setf d-hour (- d-hour)
+	      d-day (- d-day)))
+      (let ((local-time-result (local-time-add-day local-time d-day)))
+	(multiple-value-bind (ns2 ss2 mm2 hh2 day2 month2 year2)
+	    (decode-local-time local-time-result)
+	  (encode-local-time ns2 ss2 mm2 (+ hh d-hour) day2 month2 year2))))))
+
+(defun local-time-add-min (local-time value)
+  (multiple-value-bind (ns ss mm hh day month year)
+	  (decode-local-time local-time)
+    (multiple-value-bind (d-min d-hour)
+	(floor (abs value) 60)
+      (when (< value 0)
+	(setf d-min (- d-min)
+	      d-hour (- d-hour)))
+      (let ((local-time-result (local-time-add-hour local-time d-hour)))
+	(multiple-value-bind (ns2 ss2 mm2 hh2 day2 month2 year2)
+	    (decode-local-time local-time-result)
+	  (encode-local-time ns2 ss2 (+ mm d-min) hh2 day2 month2 year2))))))
 
-#|
+(defun local-time-add-sec (local-time value)
+  (multiple-value-bind (ns ss mm hh day month year)
+	  (decode-local-time local-time)
+    (multiple-value-bind (d-sec d-min)
+	(floor (abs value) 60)
+      (when (< value 0)
+	(setf d-sec (- d-sec)
+	      d-min (- d-min)))
+      (let ((local-time-result (local-time-add-min local-time d-min)))
+	(multiple-value-bind (ns2 ss2 mm2 hh2 day2 month2 year2)
+	    (decode-local-time local-time-result)
+	  (encode-local-time ns2 (+ ss d-sec) mm2 hh2 day2 month2 year2))))))
+
+(defun local-time-add-nsec (local-time value)
+  (multiple-value-bind (ns ss mm hh day month year)
+	  (decode-local-time local-time)
+    (multiple-value-bind (d-nsec d-sec)
+	(floor (abs value) 10000000)
+      (when (< value 0)
+	(setf d-nsec (- d-nsec)
+	      d-sec (- d-sec)))
+      (let ((local-time-result (local-time-add-sec local-time d-sec)))
+	(multiple-value-bind (ns2 ss2 mm2 hh2 day2 month2 year2)
+	    (decode-local-time local-time-result)
+	  (encode-local-time (+ ns d-nsec) ss2 mm2 hh2 day2 month2 year2))))))
+	  	
 (defmethod local-time-add ((local-time local-time) field value)
   (ccase field 
-    ('NSEC 
-|#
\ No newline at end of file
+    (NSEC (local-time-add-nsec local-time value))
+    (SEC (local-time-add-sec local-time value))
+    (MIN (local-time-add-min local-time value))
+    (HR (local-time-add-hour local-time value))
+    (DAY (local-time-add-day local-time value))
+    (MONTH (local-time-add-month local-time value))
+    (YEAR (local-time-add-year local-time value))))