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

Added day-number and week-number functions

Browse source
This commit is contained in:
Sudhir Shenoy 2017-07-24 20:29:45 +09:00
parent ef46ca4777
commit cbf2e8db5d
1 changed files with 22 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

30
date-arith.lisp
View file

@ -79,6 +79,28 @@ weekday in the month."
(return dt) (return dt)
(setf dt next-dt))))))))) (setf dt next-dt)))))))))
(defun date+ (date days)
"Advance date by given number of days"
(+ date days))
(defun date- (date days)
"Retreat date by given number of days"
(- date days))
(defun day-number (date)
"Return the day number for the year"
(let ((year (date->ymd date)))
(1+ (truncate (date- date (ymd->date year 1 1))))))
(defun week-number (date)
"Return the week of year in which date falls.
If Jan 1 is not a Monday, the 1st Monday of January is week 2 by definition"
(let* ((year (date->ymd date))
(first-monday (nth-day-of-week (ymd->date year 1 1) :monday 1)))
(if (date< date first-monday)
1
(+ 2 (truncate (/ (date- date first-monday) 7))))))
(defun first-of-next-month (date) (defun first-of-next-month (date)
"Returns the 1st of the following month" "Returns the 1st of the following month"
(multiple-value-bind (yy mm dd) (date->ymd date) (multiple-value-bind (yy mm dd) (date->ymd date)
@ -97,14 +119,6 @@ weekday in the month."
(declare (ignore dd)) (declare (ignore dd))
(1- (ymd->date yy mm 1)))) (1- (ymd->date yy mm 1))))
(defun date+ (date days)
"Advance date by given number of days"
(+ date days))
(defun date- (date days)
"Retreat date by given number of days"
(- date days))
(defun add-years (date years &key eom-rule) (defun add-years (date years &key eom-rule)
"Add number of years to date (subtract if negative) - see add-months" "Add number of years to date (subtract if negative) - see add-months"
(add-months date (* 12 years) :eom-rule eom-rule)) (add-months date (* 12 years) :eom-rule eom-rule))