aland/cl-dates
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Changed semantics of ymd->date

Browse source
This commit is contained in:
Sudhir Shenoy 2017-07-13 07:07:44 +09:00
parent 29bb69d1b5
commit 4c57a3c0d1
3 changed files with 21 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

21
dates.lisp
View file

@ -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)
"Returns 6 values corresponding to the given datetime-
year, month, day, hour, minute, second. Second may be a floating
point value but the first five are aways integers"
(defun date->ymd (date &key (want-time nil))
"Returns 6 values if :want-time is true: year, month, day, hour, minute, second.
Second may be a floating 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))
(day-frac (multiple-value-bind (day frac) (truncate date)
(yy (+ h (floor (* 1/12 (- 14 mm))) -4716)))
(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))
(declare (ignore hr mn sc))
(multiple-value-bind (y m d) (date->ymd (ymd->date yy mm dd))
(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)

4
parse-date.lisp
View file

@ -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)

4
print-date.lisp
View file

@ -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)