1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: datetime.lisp
6 ;;;; Purpose: Date & Time functions for KMRCL package
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; KMRCL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
22 ;;; Formatting functions
24 (defun pretty-date (year month day &optional (hour 12) (m 0) (s 0))
25 (multiple-value-bind (sec min hr dy mn yr wkday)
26 (decode-universal-time
27 (encode-universal-time s m hour day month year))
28 (values (elt '("Monday" "Tuesday" "Wednesday" "Thursday"
29 "Friday" "Saturday" "Sunday")
31 (elt '("January" "February" "March" "April" "May" "June"
32 "July" "August" "September" "October" "November"
35 (format nil "~A" dy) (format nil "~A" yr)
36 (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
39 (defun date-string (ut)
40 (if (typep ut 'integer)
41 (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
42 (decode-universal-time ut)
43 (declare (ignore daylight-p zone))
44 (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"
51 (defun print-seconds (secs)
52 (print-float-units secs "sec"))
54 (defun print-float-units (val unit)
57 (format t "~,2,9F nano~A" val unit))
59 (format t "~,2,6F micro~A" val unit))
61 (format t "~,2,3F milli~A" val unit))
63 (format t "~,2,-9F giga~A" val unit))
65 (format t "~,2,-6F mega~A" val unit))
67 (format t "~,2,-3F kilo~A" val unit))
69 (format t "~,2F ~A" val unit))))