;;; -*- mode:lisp;package:user;base:10.;fonts:(cptfontb) -*- 
;;; $Header: /ct/ctlisp/time.l,v 1.4 83/09/20 23:09:32 penny Exp $
;;; $Log:	/ct/ctlisp/time.l,v $
;;;Revision 1.4  83/09/20  23:09:32  penny
;;;convert to new filename convention
;;;
;;;Revision 1.3  83/09/08  15:39:26  john
;;;Rewrote to require ct_io file, and use ct_io functions.
;;;
;;;Revision 1.2  83/07/06  09:54:47  penny
;;;repositioned mode line
;;;
;;;Revision 1.1  83/06/22  13:39:54  penny
;;;Initial revision
;;;
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                              TIME                                ;;;
;;; Package of LM/Franz Compatible Functiions/Macros Related to Time ;;;
;;;                                                                  ;;;
;;; Mark L. Miller                                  February 6, 1983 ;;;
;;;                                                                  ;;;
;;;  Edited by:                                                      ;;;
;;;  Mark L. Miller, John L. Shelton                March 25, 1983   ;;;
;;;                                                                  ;;;
;;; This file is part of a proprietary software project.  Source     ;;;
;;; code and documentation describing implementation details are     ;;;
;;; available on a confidential, non-disclosure basis only.  These   ;;;
;;; materials, including this file in particular, are trade secrets  ;;;
;;; of Computer * Thought Corporation.                               ;;;
;;;                                                                  ;;;
;;; (c) Copyright 1982 and 1983,  Computer * Thought Corporation.    ;;;
;;;     All Rights Reserved.                                         ;;;
;;;                                                                  ;;;
;;; Reference materials:                                             ;;;
;;;   Foderaro and Sklower, The FRANZ LISP Manual, September 1981.   ;;;
;;;   Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981.   ;;;
;;;   Charniak et al., 198?.  Artificial Intelligence Programming.   ;;;
;;;   Miller, 1982.  The C*T Ada Tutor: Guide to the Implementation. ;;;
;;; The following code assumes familiarity with these materials.     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ensure presence of needed files. 

(comment Assumes that ct_load and some suitable database are present)

(eval-when (compile load eval) (ct_load 'aip))	  ;AIP macros pkg. 

(eval-when (compile load eval) (ct_load 'compat)) ;Franz/LM compat pkg. 

(eval-when (compile load eval) (ct_load 'ctio))  ; correct io stuff.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiler Declarations and Global Variables -- 

#+franz (declare (macros t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; User-Callable Functions/Macros -- 


(defun nice_current_time (&optional (stream (terminal-output)))
  " Print the time in a short format I like -- 9:08pm Tue 11 Jan 83 "
  (let ((base 10.) (ibase 10.) (*nopoint t))
   #+lispm 
    (multiple-value-bind (secs mins hrs dat mon yr day savp)
			 (time:get-time)
      (let ((ampm (cond ((greaterp hrs 12.)
			 (setq hrs (difference hrs 12.)) "pm")
			(T "am"))))
	secs savp				;Ignored
	(ct_format stream
		"~D:~2,'0D~A ~A ~D ~A ~D"
		hrs
		mins
		ampm
		(time:day-of-the-week-string day ':short)
		dat
		(time:month-string mon ':short)
		yr)))
    ;;; Franz version needs to be made a little prettier, but...++
    #+franz (ct_princ (status ctime) stream)))

(defun ct_millisecond_time macro (form)
       (selfinsertmacro form
	   #+lispm '(quotient (time:microsecond-time) 1000.)

	   #+franz '(times 17. (car (ptime)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal Use Only Functions/Macros -- 

#+lispm
(defun fix_time ()
   ; Fix the lossage that the time on the LM is usually wrong. 
  (cond
    ((y-or-n-p (format nil
		    "~&Time is ~A, OK? " (time:print-current-date nil))))
    ((y-or-n-p "Two hours slow, huh? ")		;Dumb Chaosnet Timezone bug!
     (multiple-value-bind (secs mins hrs day mon yr) (time:get-time)
       (time:set-local-time
	 (format nil "~D//~D//~D ~D:~2,'0D:~2,'0D"
		 mon day yr (plus 2. hrs) mins secs))))
    (T (time:set-local-time)))
  (nice_current_time nil))

;;; eof
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;