r4665: *** empty log message ***
[kmrcl.git] / datetime.lisp
diff --git a/datetime.lisp b/datetime.lisp
new file mode 100644 (file)
index 0000000..9d20449
--- /dev/null
@@ -0,0 +1,49 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          datetime.lisp
+;;;; Purpose:       Date & Time functions for KMRCL package
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: datetime.lisp,v 1.1 2003/04/28 21:12:27 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package #:kmrcl)
+
+
+;;; Formatting functions
+
+(defun pretty-date (year month day &optional (hour 12) (m 0) (s 0))
+  (multiple-value-bind (sec min hr dy mn yr wkday)
+    (decode-universal-time
+     (encode-universal-time s m hour day month year))
+    (values (elt '("Monday" "Tuesday" "Wednesday" "Thursday"
+                  "Friday" "Saturday" "Sunday")
+                wkday)
+           (elt '("January" "February" "March" "April" "May" "June"
+                  "July" "August" "September" "October" "November"
+                  "December")
+                (1- mn))
+           (format nil "~A" dy) (format nil "~A" yr)
+           (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
+
+
+(defun date-string (ut)
+  (if (typep ut 'integer)
+      (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
+         (decode-universal-time ut)
+       (declare (ignore daylight-p zone))
+       (format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d" 
+               dow
+               day
+               (1- mon)
+               year
+               hr min sec))))