From: Thomas A. Russ
Subject: Re: format-time-string?
Date: 
Message-ID: <ymien4kvhye.fsf@sevak.isi.edu>
Here's something to get you started.  It takes a universal time and
produces a formatted version.  It has some options, but not an awful
lot.  If you want to have a string returned instead of printed out, then
pass NIL to the stream argument with style :string.



(defvar *format-time-smallest-unit* :second
  "One of :second, :minute, :hour, :day, :month, :year")
(defvar *format-time-style* :string
  "One of :string, :s-expression, nil.  Nil means no formatting.")
(defvar *format-time-include-date-p* t "Whether the date is included.")
(defvar *format-time-long-date-p* nil "t => February 22, 1958; nil => 2/22/58")


(defun format-time (universalTime &optional (stream t)
		    &key (smallest-unit *format-time-smallest-unit*) 
		         (include-date-p *format-time-include-date-p*)
			 (long-date-p *format-time-long-date-p*)
			 (style *format-time-style*))
  ;; Formats "universalTime" on the stream "stream";
  ;; ":smallest-unit" is one of :second, :minute, :hour, :day, :month, :year
  ;;    and controls the smallest unit used in the formated time;
  ;; ":include-date-p" if non-nil means the date is included in the time
  ;;    representation.
  ;; ":long-date-p" if non-nil means to use the long form of the date;
  ;; ":style" is :string for string format, :s-expression for keyword list format, nil
  ;;    for no formatting.
  (unless (and (numberp universalTime)
	       (plusp universalTime)	; Safety valve.
	       (member style '(:string :s-expression)))
    (format stream "~S" universalTime)
    (return-from format-time universalTime))
  (labels ((month-name (month)
	    (aref '#("January" "February" "March" "April" "May" "June" "July"
		     "August" "September" "October" "November" "December")
		  (1- month)))
	   (year-not-close-enough-p (year)
	    ;; "year" is not close enough to the current year to abbreviate!
	    (> (abs (- year 1997)) 45))
	 (format-string-time (second minute hour date month year)
	   (if long-date-p
	       (ecase smallest-unit
		 (:second (format stream "~:[~3*~;~A ~D, ~D ~]~2,'0D:~2,'0D:~2,'0D"
				  include-date-p (month-name month) date year
				  hour minute second))
		 (:minute (format stream "~:[~3*~;~A ~D, ~D ~]~2,'0D:~2,'0D"
				  include-date-p (month-name month) date year hour minute))
		 (:hour (format stream "~:[~3*~;~A ~D, ~D ~]~2,'0D"
				include-date-p (month-name month) date year hour))
		 (:day (format stream "~:[~3*~;~A ~D, ~D~]"
			       include-date-p (month-name month) date year))
		 (:month (format stream "~:[~2*~;~A ~D~]"
				 include-date-p (month-name month) year))
		 (:year (format stream "~:[~*~;~D~]" include-date-p year)))
	       (ecase smallest-unit
		 (:second (format stream
				  "~:[~3*~;~2,'0D/~2,'0D/~2,'0D ~]~2,'0D:~2,'0D:~2,'0D"
				  include-date-p month date year hour minute second))
		 (:minute (format stream
				  "~:[~3*~;~2,'0D/~2,'0D/~2,'0D ~]~2,'0D:~2,'0D"
				  include-date-p month date year hour minute))
		 (:hour (format stream "~:[~3*~;~2,'0D/~2,'0D/~2,'0D ~]~2,'0D"
				include-date-p month date year hour))
		 (:day (format stream "~:[~3*~;~2,'0D/~2,'0D/~2,'0D~]"
			       include-date-p month date year))
		 (:month (format stream "~:[~2*~;~2,'0D/~2,'0D~]"
				 include-date-p month year))
		 (:year (format stream "~:[~*~;~D~]" include-date-p year)))))
	 (format-s-expression-date (second minute hour date month year)
	   (format stream "~S"
		   (ecase smallest-unit
		     (:second (if include-date-p
				  `(:year ,year :month ,month :day ,date
				    :hour ,hour :minute ,minute :second ,second)
				  `(:hour ,hour :minute ,minute :second ,second)))
		     (:minute (if include-date-p
				  `(:year ,year :month ,month :day ,date
				    :hour ,hour :minute ,minute)
				  `(:hour ,hour :minute ,minute)))
		     (:hour (if include-date-p
				  `(:year ,year :month ,month :day ,date :hour ,hour)
				  `(:hour ,hour)))
		     (:day (if include-date-p
			       `(:year ,year :month ,month :day ,date)
			       nil))
		     (:month (if include-date-p
				 `(:year ,year :month ,month)
				 nil))
		     (:year (if include-date-p
				`(:year ,year)
				 nil))))))
	   
    (multiple-value-bind (second minute hour date month year)
	(decode-universal-time universalTime)
      (unless (or long-date-p
		  (eq smallest-unit :year)
		  (year-not-close-enough-p year))
	(setq year (mod year 100)))
      (case style
	(:string (format-string-time second minute hour date month year))
	(:s-expression (format-s-expression-date second minute hour date month year))
	(t (format stream "~S" universalTime))) )))


-- 
Thomas A. Russ,  USC/Information Sciences Institute          ยทยทยท@isi.edu