Skip to content
Snippets Groups Projects
Commit 2ed5cbea authored by dtc's avatar dtc
Browse files

Extend format-universal-time to print RFC1123/RFC850 style dates, and

correct timezone-name to correctly handle a timezone of zero.
parent 1a7d9380
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.6 2000/01/30 13:58:27 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format-time.lisp,v 1.7 2000/06/07 07:12:52 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
...@@ -68,11 +68,12 @@ ...@@ -68,11 +68,12 @@
destination which can be accepted by the Format function. The destination which can be accepted by the Format function. The
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 are weekdays expressed as words), :abbreviated (like :long but words
abbreviated), or :government (of the form \"XX Mon XX XX:XX:XX\") are abbreviated), :rfc1123 (conforming to RFC 1123), or :government
The keyword date-first, if nil, will print the time first instead (of the form \"XX Mon XX XX:XX:XX\").
of the date (the default). The print- keywords, if nil, inhibit The keyword date-first, if nil, will print the time first instead of
the printing of the obvious part of the time/date." the date (the default). The print- keywords, if nil, inhibit the
printing of the obvious part of the time/date."
(unless (valid-destination-p destination) (unless (valid-destination-p destination)
(error "~A: Not a valid format destination." destination)) (error "~A: Not a valid format destination." destination))
(unless (integerp universal-time) (unless (integerp universal-time)
...@@ -93,11 +94,14 @@ ...@@ -93,11 +94,14 @@
(case style (case style
(:short "~D/~D/~2,'0D") ;; MM/DD/YY (:short "~D/~D/~2,'0D") ;; MM/DD/YY
((: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
(:government "~2,'0D ~:@(~A~) ~2,'0D") ;; DD MON YY (:government "~2,'0D ~:@(~A~) ~2,'0D") ;; DD MON YY
(t (t
(error "~A: Unrecognized :style keyword value." style)))) (error "~A: Unrecognized :style keyword value." style))))
(time-args (time-args
(list mins (max (mod hours 12) (1+ (mod (1- hours) 12))))) (if (eq style :rfc1123)
(list mins hours)
(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)))
...@@ -105,15 +109,20 @@ ...@@ -105,15 +109,20 @@
(list (svref abbrev-month-table (1- month)) day year)) (list (svref abbrev-month-table (1- month)) day year))
(:long (:long
(list (svref long-month-table (1- month)) day year)) (list (svref long-month-table (1- month)) day year))
(:rfc1123
(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)))))
(declare (simple-string time-string date-string)) (timezone-name (if (eq style :rfc1123)
(timezone-rfc1123-name dst tz)
(timezone-name dst tz))))
(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 (svref abbrev-weekday-table dow)) ((:abbreviated :rfc1123 :government)
(:government (svref abbrev-weekday-table dow))) (svref abbrev-weekday-table dow)))
date-args) date-args)
(setq date-string (setq date-string
(concatenate 'simple-string "~A, " date-string))) (concatenate 'simple-string "~A, " date-string)))
...@@ -121,7 +130,7 @@ ...@@ -121,7 +130,7 @@
(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 print-meridian (when (and print-meridian (not (eq style :rfc1123)))
(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~]")))
...@@ -134,14 +143,14 @@ ...@@ -134,14 +143,14 @@
(if date-first (if date-first
(nconc date-args (nreverse time-args) (nconc date-args (nreverse time-args)
(if print-timezone (if print-timezone
(list (timezone-name dst tz)))) (list timezone-name)))
(nconc (nreverse time-args) date-args (nconc (nreverse time-args) date-args
(if print-timezone (if print-timezone
(list (timezone-name dst tz))))))))) (list timezone-name))))))))
(defun timezone-name (dst tz) (defun timezone-name (dst tz)
(if (and (integerp tz) (if (and (integerp tz)
(or (and dst (= tz 0)) (or (and (not dst) (= tz 0))
(<= 5 tz 8))) (<= 5 tz 8)))
(svref (if dst daylight-table timezone-table) tz) (svref (if dst daylight-table timezone-table) tz)
(multiple-value-bind (multiple-value-bind
...@@ -158,6 +167,22 @@ ...@@ -158,6 +167,22 @@
(not (zerop seconds)) (not (zerop seconds))
(abs seconds)))))) (abs seconds))))))
;;; RFC 1123 style timezone: GMT, +1000, -1000.
;;; Timezone is the negative of the CL timezone.
;;;
(defun timezone-rfc1123-name (dst tz)
(let ((tz (- tz)))
(if (and (integerp tz)
(or (and (not dst) (= tz 0))
(<= 5 tz 8)))
(svref (if dst daylight-table timezone-table) tz)
(multiple-value-bind
(hours minutes)
(truncate 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