X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Ftime.lisp;h=0b70f2c6f28b9610f7b7ac9875b38dfa72da3f4a;hp=cd32be4388732410d60265fcec033390f701f276;hb=9bbed78051e80e6ab76ae47834136035602bbbf1;hpb=fe9654a9f2c7db4f13f4db58bcd357fc22c634b4 diff --git a/base/time.lisp b/base/time.lisp index cd32be4..0b70f2c 100644 --- a/base/time.lisp +++ b/base/time.lisp @@ -15,7 +15,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base-sys) +(in-package #:clsql-base) ;; ------------------------------------------------------------ ;; Months @@ -109,13 +109,17 @@ (%make-wall-time :mjd (time-mjd time) :second (time-second time))) -(defun get-time () +(defun utime->time (utime) "Return a pair: (GREGORIAN DAY . TIME-OF-DAY)" (multiple-value-bind (second minute hour day mon year) - (decode-universal-time (get-universal-time)) + (decode-universal-time utime) (make-time :year year :month mon :day day :hour hour :minute minute :second second))) +(defun get-time () + "Return a pair: (GREGORIAN DAY . TIME-OF-DAY)" + (utime->time (get-universal-time))) + (defun make-duration (&key (year 0) (month 0) (day 0) (hour 0) (minute 0) (second 0)) (multiple-value-bind (minute-add second-60) @@ -680,31 +684,32 @@ TIME2." (internal-separator " ")) "produces on stream the timestring corresponding to the wall-time with the given options" - (multiple-value-bind (second minute hour day month year dow) - (decode-time time) - (case format - (:pretty - (format stream "~A ~A, ~A ~D, ~D" - (pretty-time hour minute) - (day-name dow) - (month-name month) - day - year)) - (:short-pretty - (format stream "~A, ~D/~D/~D" - (pretty-time hour minute) - month day year)) - (:iso - (let ((string (iso-timestring time))) - (if stream - (write-string string stream) + (let ((*print-circle* nil)) + (multiple-value-bind (second minute hour day month year dow) + (decode-time time) + (case format + (:pretty + (format stream "~A ~A, ~A ~D, ~D" + (pretty-time hour minute) + (day-name dow) + (month-name month) + day + year)) + (:short-pretty + (format stream "~A, ~D/~D/~D" + (pretty-time hour minute) + month day year)) + (:iso + (let ((string (iso-timestring time))) + (if stream + (write-string string stream) string))) - (t - (format stream "~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D" - year date-separator month date-separator day - internal-separator hour time-separator minute time-separator - second))))) - + (t + (format stream "~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D" + year date-separator month date-separator day + internal-separator hour time-separator minute time-separator + second)))))) + (defun pretty-time (hour minute) (cond ((eq hour 0) @@ -780,6 +785,9 @@ with the given options" (t (values hours "AM")))) +(defgeneric to-string (val &rest keys) + ) + (defmethod to-string ((time wall-time) &rest keys) (destructuring-bind (&key (style :daytime) &allow-other-keys) keys