datetime.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          datetime.lisp
   6 ;;;; Purpose:       Date & Time functions for KMRCL package
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: datetime.lisp,v 1.2 2003/04/28 23:51:59 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  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 ;;;; *************************************************************************
  18
  19 (in-package #:kmrcl)
  20
  21
  22 ;;; Formatting functions
  23
  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")
  30                  wkday)
  31             (elt '("January" "February" "March" "April" "May" "June"
  32                    "July" "August" "September" "October" "November"
  33                    "December")
  34                  (1- mn))
  35             (format nil "~A" dy) (format nil "~A" yr)
  36             (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
  37
  38
  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"
  45                 dow
  46                 day
  47                 (1- mon)
  48                 year
  49                 hr min sec))))
  50
  51 (defun print-seconds (secs)
  52   (print-float-units secs "sec"))
  53
  54 (defun print-float-units (val unit)
  55   (cond
  56     ((< val 1d-6)
  57      (format t "~,2,9F nano~A" val unit))
  58     ((< val 1d-3)
  59      (format t "~,2,6F micro~A" val unit))
  60     ((< val 1)
  61      (format t "~,2,3F milli~A" val unit))
  62     ((> val 1d9)
  63      (format t "~,2,-9F giga~A" val unit))
  64     ((> val 1d6)
  65      (format t "~,2,-6F mega~A" val unit))
  66     ((> val 1d3)
  67      (format t "~,2,-3F kilo~A" val unit))
  68     (t
  69      (format t "~,2F ~A" val unit))))
  70