X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=datetime.lisp;fp=datetime.lisp;h=9d204494d7835a77163a69e3ed24aef1ef7321c9;hp=0000000000000000000000000000000000000000;hb=aa610805927518a648eb0da6a8713cd0a83337df;hpb=d1e9c5969a0eecb7923dc350754ea9ab50417a1e

diff --git a/datetime.lisp b/datetime.lisp
new file mode 100644
index 0000000..9d20449
--- /dev/null
+++ b/datetime.lisp
@@ -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))))