Changed semantics of ymd->date

dates.lisp

@@ -57,10 +57,10 @@ or a numeric offset in fractions of an hour e.g., +5.5"
 	 (offset (zone-to-offset zone)))
     (- jdate (/ offset 24))))
 
-(defun date->ymd (date)
+(defun date->ymd (date &key (want-time nil))
-  "Returns 6 values corresponding to the given datetime-
+  "Returns 6 values if :want-time is true: year, month, day, hour, minute, second.
-year, month, day, hour, minute, second. Second may be a floating
+Second may be a floating point value but the first five are aways integers.
-point value but the first five are aways integers"
+If :want-time is NIL, returns year, month and day as integers."
   (let* ((jd (jday-number date))
 	 (e (floor (/ (- jd 1867216.25d0) 36524.25d0)))
 	 (f (+ 1 jd e (- (floor (/ e 4)))))
@@ -70,20 +70,21 @@ point value but the first five are aways integers"
 	 (j (floor (/ (- g i) 30.6001d0)))
 	 (dd (- g i (floor (* j 30.6001d0))))
 	 (mm (- j (* 12 (floor (/ j 14))) 1))
-	 (yy (+ h (floor (* 1/12 (- 14 mm))) -4716))
+	 (yy (+ h (floor (* 1/12 (- 14 mm))) -4716)))
-	 (day-frac (multiple-value-bind (day frac) (truncate date)
+    (if want-time
+	(let ((day-frac (multiple-value-bind (day frac) (truncate date)
 			  (declare (ignore day))
 			  (if (>= frac 0.5d0)
 			      ;; midnight to noon
 			      (- frac 0.5d0)
 			      (+ frac 0.5d0)))))
 	  (multiple-value-bind (h m s) (day-fraction->hms day-frac)
-      (values yy mm dd h m s))))
+	    (values yy mm dd h m s)))
+	(values yy mm dd))))
 
 (defun valid-date-p (yy mm dd)
   "Check that year, month and day form a valid calendar date"
-  (multiple-value-bind (y m d hr mn sc) (date->ymd (ymd->date yy mm dd))
+  (multiple-value-bind (y m d) (date->ymd (ymd->date yy mm dd))
-    (declare (ignore hr mn sc))
     (and (= yy y) (= mm m) (= dd d))))
 
 (defun valid-time-p (h m s)
@@ -198,7 +199,7 @@ it returns year, month, day, hour, minute and second as 6 values"
 		     (t (error "Invalid param which: ~a" which)))))
     (setf date (apply-correction-factors yy date))
     (if want-gregorian-date
-	(date->ymd date)
+	(date->ymd date :want-time t)
 	date)))
 
 (defun cos-degrees (deg)

parse-date.lisp

@@ -418,7 +418,7 @@
 	    ((setf tmp (str-to-relative-date token))
 	     (when (/= 0 num-date-comps)
 	       (return-from string->date nil))
-	     (multiple-value-bind (yy mm dd h m s) (date->ymd (+ reference-date tmp))
+	     (multiple-value-bind (yy mm dd h m s) (date->ymd (+ reference-date tmp) :want-time t)
 	       (setf (dt-yr res) yy
 		     (dt-mth res) mm
 		     (dt-day res) dd
@@ -568,7 +568,7 @@
       (when (dt-yr res)
 	(setf (dt-yr res) (make-four-digit-year (dt-yr res))))
       ;; copy all missing values from the reference date
-      (multiple-value-bind (yy mm dd h m s) (date->ymd reference-date)
+      (multiple-value-bind (yy mm dd h m s) (date->ymd reference-date :want-time t)
 	(when-null-set res dt-yr yy)
 	(when-null-set res dt-mth mm)
 	(when-null-set res dt-day dd)

print-date.lisp

@@ -40,7 +40,7 @@ The :human format is the same as :iso-8601 except that the separators between da
 time and timezone are spaces to make it more readable to the human eye."
   (let ((offset (zone-to-offset zone)))
     (incf date (/ offset 24))
-    (multiple-value-bind (yy mm dd h m s) (date->ymd date)
+    (multiple-value-bind (yy mm dd h m s) (date->ymd date :want-time t)
       (let ((year (format nil "~d" yy))
 	    (month (case format
 		     ((:asctime :rfc-822 :rfc-850) (three-letter-month mm))
@@ -61,7 +61,7 @@ e.g., \"Thursday, 6 July 2017, 09:38:43.567 +0900\".
 If :date-only is true, the time and timezone are omitted."
   (let ((offset (zone-to-offset zone)))
     (incf date (/ offset 24))
-    (multiple-value-bind (yy mm dd h m s) (date->ymd date)
+    (multiple-value-bind (yy mm dd h m s) (date->ymd date :want-time t)
       (if date-only
 	  (format nil "~a, ~d ~a ~d" (dow->string (day-of-week date))
 		  dd (month->string mm) yy)