← Back to branch summary

~ubuntu-branches/ubuntu/hardy/cl-kmrcl/hardy

« back to all changes in this revision

Viewing changes to datetime.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Kevin M. Rosenberg
  • Date: 2007-09-18 23:54:44 UTC
  • mfrom: (1.1.8 upstream)
  • Revision ID: james.westby@ubuntu.com-20070918235444-5wdl38udmwy6bdd1
Tags: 1.97-1
New upstream

Show diffs side-by-side

added added

removed removed

Lines of Context:
datetime.lisp
7
7
;;;; Programmer:    Kevin M. Rosenberg
8
8
;;;; Date Started:  Apr 2000
9
9
;;;;
10
 
;;;; $Id: datetime.lisp 11722 2007-06-07 13:25:10Z kevin $
 
10
;;;; $Id$
11
11
;;;;
12
12
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
13
13
;;;;
26
26
    (decode-universal-time
27
27
     (encode-universal-time s m hour day month year))
28
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)
 
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)
36
36
            (format nil "~A" yr)
37
 
            (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
 
37
            (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
38
38
 
39
39
(defun pretty-date-ut (&optional (tm (get-universal-time)))
40
40
  (multiple-value-bind (sec min hr dy mn yr) (decode-universal-time tm)
43
43
(defun date-string (ut)
44
44
  (if (typep ut 'integer)
45
45
      (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
46
 
          (decode-universal-time ut)
47
 
        (declare (ignore daylight-p zone))
48
 
        (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"
49
 
                dow
50
 
                day
51
 
                (1- mon)
52
 
                year
53
 
                hr min sec))))
 
46
          (decode-universal-time ut)
 
47
        (declare (ignore daylight-p zone))
 
48
        (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"
 
49
                dow
 
50
                day
 
51
                (1- mon)
 
52
                year
 
53
                hr min sec))))
54
54
 
55
55
(defun print-seconds (secs)
56
56
  (print-float-units secs "sec"))