r9728: updates

diff --git a/debian/changelog b/debian/changelog
index 3429a8d759ff4593eaa030cc24583d4cbc60b970..da896b8ea57f8751a9f1eb8e71f8660738966e34 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-kmrcl (1.76-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 28 Jun 2004 11:24:57 -0600
+
 cl-kmrcl (1.75-1) unstable; urgency=low
 
   * New upstream

diff --git a/io.lisp b/io.lisp
index db94854156e6dbd0bae9052a5e14746bb9857f7b..61298add617fceb73802eaba82e48457f7dd411b 100644 (file)
--- a/io.lisp
+++ b/io.lisp
@@ -219,4 +219,111 @@
            (list root)
            (error "root not directory ~A" root)))))
 
-  
+
+(defmacro with-utime-decoding ((utime &optional zone) &body body)
+  "UTIME is a universal-time, ZONE is a number of hours offset from UTC, or NIL to use local time.  Execute BODY in an environment where SECOND MINUTE HOUR DAY-OF-MONTH MONTH YEAR DAY-OF-WEEK DAYLIGHT-P ZONE are bound to the decoded components of the universal time"
+  `(multiple-value-bind
+       (second minute hour day-of-month month year day-of-week daylight-p zone)
+       (decode-universal-time ,utime ,@(if zone (list zone)))
+     (declare (ignorable second minute hour day-of-month month year day-of-week daylight-p zone))
+     ,@body))
+
+(defvar +datetime-number-strings+ 
+  (make-array 61 :adjustable nil :element-type 'string :fill-pointer nil
+             :initial-contents 
+             '("00" "01" "02" "03" "04" "05" "06" "07" "08" "09" "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")))
+
+(defun is-dst (utime)
+  (with-utime-decoding (utime)
+    daylight-p))
+
+
+(defmacro with-utime-decoding-utc-offset ((utime utc-offset) &body body)
+  (with-gensyms (zone)
+    `(let* ((,zone (cond
+                   ((eq :utc ,utc-offset) 
+                    0)
+                   ((null utc-offset)
+                    nil)
+                   (t
+                    (if (is-dst ,utime)
+                        (1- (- ,utc-offset))
+                      (- ,utc-offset))))))
+       (if ,zone
+          (with-utime-decoding (,utime ,zone)
+            ,@body)
+        (with-utime-decoding (,utime)
+          ,@body)))))
+
+
+(defun write-utime-hms (utime &key utc-offset stream)
+  (if stream
+      (write-utime-hms-stream utime stream utc-offset)
+    (with-output-to-string (s)
+      (write-utime-hms-stream utime s utc-offset))))
+
+(defun write-utime-hms-stream (utime stream &optional utc-offset)
+  (with-utime-decoding-utc-offset (utime utc-offset)
+    (write-string (aref +datetime-number-strings+ hour) stream)
+    (write-char #\: stream)
+    (write-string (aref +datetime-number-strings+ minute) stream)
+    (write-char #\: stream)
+    (write-string (aref +datetime-number-strings+ second) stream)))
+
+(defun write-utime-hm (utime &key utc-offset stream)
+  (if stream
+      (write-utime-hm-stream utime stream utc-offset)
+    (with-output-to-string (s)
+      (write-utime-hm-stream utime s utc-offset))))
+
+(defun write-utime-hm-stream (utime stream &optional utc-offset)
+  (with-utime-decoding-utc-offset (utime utc-offset)
+    (write-string (aref +datetime-number-strings+ hour) stream)
+    (write-char #\: stream)
+    (write-string (aref +datetime-number-strings+ minute) stream)))
+
+
+(defun write-utime-ymdhms (utime &key stream utc-offset)
+  (if stream
+      (write-utime-ymdhms-stream utime stream utc-offset)
+    (with-output-to-string (s)
+      (write-utime-ymdhms-stream utime s utc-offset))))
+
+(defun write-utime-ymdhms-stream (utime stream &optional utc-offset)
+  (with-utime-decoding-utc-offset (utime utc-offset)
+    (write-string (prefixed-fixnum-string year nil 4) stream)
+    (write-char #\/ stream)
+    (write-string (aref +datetime-number-strings+ month) stream)
+    (write-char #\/ stream)
+    (write-string (aref +datetime-number-strings+ day-of-month) stream)
+    (write-char #\space stream)
+    (write-string (aref +datetime-number-strings+ hour) stream)
+    (write-char #\: stream)
+    (write-string (aref +datetime-number-strings+ minute) stream)
+    (write-char #\: stream)
+    (write-string (aref +datetime-number-strings+ second) stream)))
+
+(defun write-utime-ymdhm (utime &key stream utc-offset)
+  (if stream
+      (write-utime-ymdhm-stream utime stream utc-offset)
+    (with-output-to-string (s)
+      (write-utime-ymdhm-stream utime s utc-offset))))
+
+(defun write-utime-ymdhm-stream (utime stream &optional utc-offset)
+  (with-utime-decoding-utc-offset (utime utc-offset)
+    (write-string (prefixed-fixnum-string year nil 4) stream)
+    (write-char #\/ stream)
+    (write-string (aref +datetime-number-strings+ month) stream)
+    (write-char #\/ stream)
+    (write-string (aref +datetime-number-strings+ day-of-month) stream)
+    (write-char #\space stream)
+    (write-string (aref +datetime-number-strings+ hour) stream)
+    (write-char #\: stream)
+    (write-string (aref +datetime-number-strings+ minute) stream)))
+
+

diff --git a/package.lisp b/package.lisp
index 8bb206b53063f45dd61042d8a97028a9160fe75f..64db28fb66e2c7f168395a6649ec7edb44f37d19 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -85,7 +85,30 @@
    #:stream-subst
    #:null-output-stream
    #:directory-tree
-
+   #:write-utime-hms
+   #:write-utime-hm
+   #:write-utime-ymdhms
+   #:write-utime-ymdhm
+   #:write-utime-hms-stream
+   #:write-utime-hm-stream
+   #:write-utime-ymdhms-stream
+   #:write-utime-ymdhm-stream
+   #:with-utime-decoding
+   #:with-utime-decoding-utc-offset
+   #:is-dst
+   #:year
+   #:month
+   #:day-of-month
+   #:hour
+   #:minute
+   #:second
+   #:daylight-p
+   #:zone
+   #:day-of-month
+   #:day-of-week
+   #:+datetime-number-strings+   
+   #:utc-offset
+   
    ;; impl.lisp
    #:probe-directory
    #:cwd

diff --git a/strings.lisp b/strings.lisp
index 8201a98b2d209fda6cde8a98d4e0d08248fe400b..9dbe1babdccd7950172033dc0d5c6d9614ff4921 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -413,9 +413,9 @@ for characters in a string"
   (declare (type (integer 0 15) n))
   (schar +hex-chars+ n))
 
-(defconstant +char-code-lower-a+ (char-code #\a))
-(defconstant +char-code-upper-a+ (char-code #\A))
-(defconstant +char-code-0+ (char-code #\0))
+(defconst +char-code-lower-a+ (char-code #\a))
+(defconst +char-code-upper-a+ (char-code #\A))
+(defconst +char-code-0+ (char-code #\0))
 (declaim (type fixnum +char-code-0+ +char-code-upper-a+
               +char-code-0))