Skip to content
Snippets Groups Projects
Commit ae9f91f8 authored by pmai's avatar pmai
Browse files

Add ISO 8601 conformant style :iso8601 to FORMAT-TIME.

parent 59fe11e7
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format-time.lisp,v 1.7 2000/06/07 07:12:52 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format-time.lisp,v 1.8 2001/12/06 23:39:35 pmai Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
...@@ -69,8 +69,9 @@ ...@@ -69,8 +69,9 @@
timezone keyword is an integer specifying hours west of Greenwich. timezone keyword is an integer specifying hours west of Greenwich.
The style keyword can be :short (numeric date), :long (months and The style keyword can be :short (numeric date), :long (months and
weekdays expressed as words), :abbreviated (like :long but words weekdays expressed as words), :abbreviated (like :long but words
are abbreviated), :rfc1123 (conforming to RFC 1123), or :government are abbreviated), :rfc1123 (conforming to RFC 1123), :government
(of the form \"XX Mon XX XX:XX:XX\"). (of the form \"XX Mon XX XX:XX:XX\"), or :iso8601 (conforming to
ISO 8601), which is the recommended way of printing date and time.
The keyword date-first, if nil, will print the time first instead of The keyword date-first, if nil, will print the time first instead of
the date (the default). The print- keywords, if nil, inhibit the the date (the default). The print- keywords, if nil, inhibit the
printing of the obvious part of the time/date." printing of the obvious part of the time/date."
...@@ -96,12 +97,13 @@ ...@@ -96,12 +97,13 @@
((:abbreviated :long) "~A ~D, ~D") ;; Month DD, YYYY ((:abbreviated :long) "~A ~D, ~D") ;; Month DD, YYYY
(:rfc1123 "~2,'0D ~A ~4,'0D") ;; DD Mon YYYY (:rfc1123 "~2,'0D ~A ~4,'0D") ;; DD Mon YYYY
(:government "~2,'0D ~:@(~A~) ~2,'0D") ;; DD MON YY (:government "~2,'0D ~:@(~A~) ~2,'0D") ;; DD MON YY
(:iso8601 "~4,'0D-~2,'0D-~2,'0D") ;; YYYY-MM-DD
(t (t
(error "~A: Unrecognized :style keyword value." style)))) (error "~A: Unrecognized :style keyword value." style))))
(time-args (time-args
(if (eq style :rfc1123) (case style
(list mins hours) ((:rfc1123 :iso8601) (list mins hours))
(list mins (max (mod hours 12) (1+ (mod (1- hours) 12)))))) (t (list mins (max (mod hours 12) (1+ (mod (1- hours) 12)))))))
(date-args (case style (date-args (case style
(:short (:short
(list month day (mod year 100))) (list month day (mod year 100)))
...@@ -113,15 +115,18 @@ ...@@ -113,15 +115,18 @@
(list day (svref abbrev-month-table (1- month)) year)) (list day (svref abbrev-month-table (1- month)) year))
(:government (:government
(list day (svref abbrev-month-table (1- month)) (list day (svref abbrev-month-table (1- month))
(mod year 100))))) (mod year 100)))
(timezone-name (if (eq style :rfc1123) (:iso8601
(timezone-rfc1123-name dst tz) (list year month day))))
(timezone-name dst tz)))) (timezone-name (case style
(:rfc1123 (timezone-rfc1123-name dst tz))
(:iso8601 (timezone-iso8601-name dst tz))
(t (timezone-name dst tz)))))
(declare (simple-string time-string date-string timezone-name)) (declare (simple-string time-string date-string timezone-name))
(when print-weekday (when print-weekday
(push (case style (push (case style
((:short :long) (svref long-weekday-table dow)) ((:short :long) (svref long-weekday-table dow))
((:abbreviated :rfc1123 :government) ((:abbreviated :rfc1123 :government :iso8601)
(svref abbrev-weekday-table dow))) (svref abbrev-weekday-table dow)))
date-args) date-args)
(setq date-string (setq date-string
...@@ -130,17 +135,20 @@ ...@@ -130,17 +135,20 @@
(push secs time-args) (push secs time-args)
(setq time-string (setq time-string
(concatenate 'simple-string time-string ":~2,'0D"))) (concatenate 'simple-string time-string ":~2,'0D")))
(when (and print-meridian (not (eq style :rfc1123))) (when (and print-meridian (not (member style '(:rfc1123 :iso8601))))
(push (signum (floor hours 12)) time-args) (push (signum (floor hours 12)) time-args)
(setq time-string (setq time-string
(concatenate 'simple-string time-string " ~[am~;pm~]"))) (concatenate 'simple-string time-string " ~[am~;pm~]")))
(apply #'format destination (apply #'format destination
(if date-first (if (or date-first (eq style :iso8601))
(concatenate 'simple-string date-string " " time-string (concatenate 'simple-string date-string " " time-string
(if print-timezone " ~A")) (when print-timezone
(if (eq style :iso8601)
"~A"
" ~A")))
(concatenate 'simple-string time-string " " date-string (concatenate 'simple-string time-string " " date-string
(if print-timezone " ~A"))) (if print-timezone " ~A")))
(if date-first (if (or date-first (eq style :iso8601))
(nconc date-args (nreverse time-args) (nconc date-args (nreverse time-args)
(if print-timezone (if print-timezone
(list timezone-name))) (list timezone-name)))
...@@ -155,7 +163,7 @@ ...@@ -155,7 +163,7 @@
(svref (if dst daylight-table timezone-table) tz) (svref (if dst daylight-table timezone-table) tz)
(multiple-value-bind (multiple-value-bind
(rest seconds) (rest seconds)
(truncate (* tz 60 60) 60) (truncate (* (if dst (1- tz) tz) 60 60) 60)
(multiple-value-bind (multiple-value-bind
(hours minutes) (hours minutes)
(truncate rest 60) (truncate rest 60)
...@@ -178,12 +186,26 @@ ...@@ -178,12 +186,26 @@
(svref (if dst daylight-table timezone-table) tz) (svref (if dst daylight-table timezone-table) tz)
(multiple-value-bind (multiple-value-bind
(hours minutes) (hours minutes)
(truncate tz) (truncate (if dst (1+ tz) tz))
(format nil "~C~2,'0D~2,'0D" (format nil "~C~2,'0D~2,'0D"
(if (minusp tz) #\- #\+) (if (minusp tz) #\- #\+)
(abs hours) (abs hours)
(abs (truncate (* minutes 60)))))))) (abs (truncate (* minutes 60))))))))
;;; ISO 8601 style timezone: Z, +1000, -1000.
;;; Timezone is the negative of the CL timezone.
;;;
(defun timezone-iso8601-name (dst tz)
(let ((tz (- tz)))
(if (and (not dst) (= tz 0))
"Z"
(multiple-value-bind (hours minutes)
(truncate (if dst (1+ tz) tz))
(format nil "~C~2,'0D:~2,'0D"
(if (minusp tz) #\- #\+)
(abs hours)
(abs (truncate (* minutes 60))))))))
;;; Format-Decoded-Time - External. ;;; Format-Decoded-Time - External.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment