/usr/share/common-lisp/source/metatilities-base/dev/l0-time.lisp is in cl-metatilities-base 20120909-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | (in-package #:metatilities)
(defconstant +minutes-per-hour+ 60
"The number of minutes in one hour.")
(defconstant +seconds-per-minute+ 60
"The number of seconds in one minute.")
(defconstant +usual-days-per-year+ 365
"The number of days in an ordinary year.")
(defconstant +seconds-per-hour+ (* +seconds-per-minute+ +minutes-per-hour+)
"The number of seconds in one hour.")
(defconstant +hours-per-day+ 24
"The number of hours in one day.")
(defconstant +seconds-per-day+
(* +hours-per-day+ +seconds-per-hour+)
"The number of seconds in one day.")
(defparameter +days-per-month+
'(31 28 31 30 31 30 31 31 30 31 30 31))
(eval-always
(defmacro generate-time-part-function (part-name position)
(let ((function-name (form-symbol (symbol-name 'time) "-" part-name)))
`(eval-always
(export ',function-name)
(defun ,function-name
(&optional (universal-time (get-universal-time))
(time-zone nil))
,(format nil "Returns the ~(~A~) part of the given time." part-name)
(nth-value ,position (apply #'decode-universal-time universal-time time-zone))))))
(generate-time-part-function second 0)
(generate-time-part-function minute 1)
(generate-time-part-function hour 2)
(generate-time-part-function date 3)
(generate-time-part-function month 4)
(generate-time-part-function year 5)
(generate-time-part-function day-of-week 6)
(generate-time-part-function daylight-savings-time-p 7))
(defun days-in-month (month &optional leap-year?)
"Returns the number of days in the specified month. The month should be
between 1 and 12."
(+ (nth (1- month) +days-per-month+) (if (and (= month 2) leap-year?) 1 0)))
(defun leap-year-p (year)
"Returns t if the specified year is a leap year. I.e. if the year
is divisible by four but not by 100 or if it is divisible by 400."
(or (and (= (mod year 4) 0) ; logand is faster but less perspicuous
(not (= (mod year 100) 0)))
(= (mod year 400) 0)))
(defun day-of-year (date &optional time-zone)
"Returns the day of the year [1 to 366] of the specified date [which must be \(CL\) universal time format.]"
(let ((leap-year? (leap-year-p (time-year date time-zone))))
(+ (loop for month from 1 to (1- (time-month date time-zone)) sum
(days-in-month month leap-year?))
(time-date date time-zone))))
(defun format-date (format date &optional stream (time-zone nil tz-supplied?))
"Formats universal dates using the same format specifiers as NSDateFormatter. The format is:
%% - A '%' character
%a - Abbreviated weekday name
%A - Full weekday name
%b - Abbreviated month name
%B - Full month name
%c - Shorthand for \"%X %x\", the locale format for date and time
%d - Day of the month as a decimal number [01-31]
%e - Same as %d but does not print the leading 0 for days 1 through 9
[unlike strftime[], does not print a leading space]
%F - Milliseconds as a decimal number [000-999]
%H - Hour based on a 24-hour clock as a decimal number [00-23]
%I - Hour based on a 12-hour clock as a decimal number [01-12]
%j - Day of the year as a decimal number [001-366]
%m - Month as a decimal number [01-12]
%M - Minute as a decimal number [00-59]
%p - AM/PM designation for the locale
%S - Second as a decimal number [00-59]
%w - Weekday as a decimal number [0-6], where Sunday is 0
%x - Date using the date representation for the locale, including
the time zone [produces different results from strftime[]]
%X - Time using the time representation for the locale [produces
different results from strftime[]]
%y - Year without century [00-99]
%Y - Year with century [such as 1990]
%Z - Time zone name [such as Pacific Daylight Time;
produces different results from strftime[]]
%z - Time zone offset in hours and minutes from GMT [HHMM]
None of %c, %F, %x, %X, %Z are implemented."
(let ((format-length (length format)))
(multiple-value-bind (sec min hr day mon yr dow dst tz)
(if tz-supplied?
(decode-universal-time date time-zone)
(decode-universal-time date))
(declare (ignore dst))
(format
stream "~{~A~}"
(loop for index = 0 then (1+ index)
while (< index format-length) collect
(let ((char (aref format index)))
(cond
((char= #\% char)
(setf char (aref format (incf index)))
(cond
;; %% - A '%' character
((char= char #\%) #\%)
;; %a - Abbreviated weekday name
((char= char #\a) (day->string dow :short))
;; %A - Full weekday name
((char= char #\A) (day->string dow :long))
;; %b - Abbreviated month name
((char= char #\b) (month->string mon :short))
;; %B - Full month name
((char= char #\B) (month->string mon :long))
;; %c - Shorthand for "%X, %x", the locale format for date and time
((char= char #\c) (nyi))
;; %d - Day of the month as a decimal number [01-31]
((char= char #\d) (format nil "~2,'0D" day))
;; %e - Same as %d but does not print the leading 0 for days 1 through 9
;; Unlike strftime, does not print a leading space
((char= char #\e) (format nil "~D" day))
;; %F - Milliseconds as a decimal number [000-999]
((char= char #\F) (nyi))
;; %H - Hour based on a 24-hour clock as a decimal number [00-23]
((char= char #\H) (format nil "~2,'0D" hr))
;; %I - Hour based on a 12-hour clock as a decimal number [01-12]
((char= char #\I) (format nil "~2,'0D" (1+ (mod (1- hr) 12))))
;; %j - Day of the year as a decimal number [001-366]
((char= char #\j) (format nil "~3,'0D" (day-of-year date time-zone)))
;; %m - Month as a decimal number [01-12]
((char= char #\m) (format nil "~2,'0D" mon))
;; %M - Minute as a decimal number [00-59]
((char= char #\M) (format nil "~2,'0D" min))
;; %p - AM/PM designation for the locale
((char= char #\p) (format nil "~:[PM~;AM~]" (< hr 12)))
;; %S - Second as a decimal number [00-59]
((char= char #\S) (format nil "~2,'0D" sec))
;; %w - Weekday as a decimal number [0-6], where Sunday is 0
((char= char #\w) (format nil "~D" dow))
;; %x - Date using the date representation for the locale,
;; including the time zone [produces different results from strftime]
((char= char #\x) (nyi))
;; %X - Time using the time representation for the locale
;; [produces different results from strftime]
((char= char #\X) (nyi))
;; %y - Year without century [00-99]
((char= char #\y)
(let ((year-string (format nil "~,2A" yr)))
(subseq year-string (- (length year-string) 2))))
;; %Y - Year with century [such as 1990]
((char= char #\Y) (format nil "~D" yr))
;; %Z - Time zone name (such as Pacific Daylight Time;
;; produces different results from strftime.
((char= char #\Z) (nyi))
;; %z - Time zone offset in hours and minutes from GMT [HHMM]
((char= char #\z)
(multiple-value-bind (tzint tzfrac)
(truncate tz)
(format nil "~:[+~;-~]~2,'0D~2,'0D"
(> tzint 0) (abs tzint) (* (abs tzfrac) 60))))
(t
(error "Ouch - unknown formatter '%~c" char))))
(t char))))))))
(defconstant +longer-format-index+ 0)
(defconstant +shorter-format-index+ 1)
(defparameter +month-output-list+
'(("January" "February" "March" "April" "May" "June" "July" "August" "September"
"October" "November" "December")
("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
(defparameter +dow-output-list
'(("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))
(defun day->string (day-of-the-week &optional (format :long))
"Returns the name of `day-of-the-week`. The parameter should be a number between 0 and 6 where 0 represents Sunday and 6 repressents Saturday. The optional format argument can be either :long or :short. In the latter case, the return string will be of length three; in the former it will be the complete name of the appropriate day."
(check-type day-of-the-week (mod 7))
(check-type format (member :long :short))
(nth day-of-the-week
(case format
(:long (nth +longer-format-index+ +dow-output-list))
(:short (nth +shorter-format-index+ +dow-output-list)))))
(defun month->string (month &optional (format :long))
"Returns the name \(in English\) of the month. Format can be :long or :short."
(check-type month (integer 1 12))
(check-type format (member :long :short))
(nth (1- month)
(case format
(:long (nth +longer-format-index+ +month-output-list+))
(:short (nth +shorter-format-index+ +month-output-list+)))))
|