Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "30-AUG-81 23:02:17" <LISPUSERS>DATETIME.;9 82800
changes to: ADDMULTIWORDTOKEN ADVANCEDATE ADVANCEDATEUNTIL CHECKTODAY COMBINEDATETIMES
CREATEHOURDT CREATEOCCURENCEPRED DATETIMEERROR DATETIMETOSTRING DEQUALP DLESSP EVALMDTFN EXPANDINPUT
FINISHDATETIME GETDATETIME GETDAYOFWEEK GETMONTHNUM GETNUMOFDAYSINMONTH ISFIRSTOFMONTH ISJANUARY
ISSATURDAY ISSUNDAY ISXEROXHOLIDAY LISTDATES MULTIWORDTOKEN ONLYTIMESPECIFIED PARSEDATETIME
PARSEDATETIME1 PARSEDATETIME2 PARSEOFFSETDATETIME PARSEQUALIFIEDDATETIME PARSESIMPLEDATE
PARSESIMPLETIME REPEATADVANCE RESETDATETIMES RESTRICTMULTIPLEDATETIME SETNOWDATETIME SETUPDAY
SPELLPROPERLY TRANSLATETIMEZONE UNITNEXTFROMDATEFN UNITOCCURENCEPRED
previous date: " 8-Jan-80 10:26:42" <LISPUSERS>DATETIME.;8)
(PRETTYCOMPRINT DATETIMECOMS)
(RPAQQ DATETIMECOMS ((FNS * DATETIMEFNS)
(VARS * DATETIMEVARS)
(P (SETQ DTRDTBL (COPYREADTABLE T))
(SETBRK (QUOTE (%| % @ ~ - ; : / %. , > < 48 49 50 51 52 53 54 55 56 57))
1 DTRDTBL)
(SETQ DATETIMEDEBUGFLG NIL)
(LOAD? (QUOTE <LISPUSERS>DATETIMERECORDS)
LDFLG))
(PROP DATETIME * DATETIMEPROPS)
(PROP UNITMULTIPLEDATETIME YEAR MONTH WEEK DAY HOUR MINUTE)
(PROP MONTHNUM JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER
DECEMBER)
(PROP WEEKDAYNUM SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY)
(ARRAY * DATETIMEARRAY)
(RECORDS * DATETIMERECORDS)
(BLOCKS * DATETIMEBLOCKS)))
(RPAQQ DATETIMEFNS (ADDMULTIWORDTOKEN ADVANCEDATE ADVANCEDATEUNTIL CHECKTODAY COMBINEDATETIMES
CREATEHOURDT CREATEOCCURENCEPRED DATETIMEERROR DATETIMETOSTRING
DEQUALP DLESSP EVALMDTFN EXPANDINPUT FINISHDATETIME GETDATETIME
GETDAYOFWEEK GETMONTHNUM GETNUMOFDAYSINMONTH ISFIRSTOFMONTH
ISJANUARY ISSATURDAY ISSUNDAY ISXEROXHOLIDAY LISTDATES
MULTIWORDTOKEN NOTIMP ONLYTIMESPECIFIED PARSEDATETIME
PARSEDATETIME1 PARSEDATETIME2 PARSEOFFSETDATETIME
PARSEQUALIFIEDDATETIME PARSESIMPLEDATE PARSESIMPLETIME
PARSESPECIALDURATION REPEATADVANCE RESETDATETIMES RESTATE
RESTRICTMULTIPLEDATETIME SETNOWDATETIME SETUPDAY SPELLPROPERLY
TRANSLATETIMEZONE UNITNEXTFROMDATEFN UNITOCCURENCEPRED))
(DEFINEQ
(ADDMULTIWORDTOKEN
[LAMBDA (WORDLST TOKEN) (* edited: " 5-JAN-78 10:15")
(* THIS FACILITATES ADDING MULTI WORD TOKENS TO MULTIPLEWORDTOKENS (FOR COMBINING MULITIPLE WORDS IN THE I PUT
STREAM INTO A SINGLE TOKEN WHEN APPROPRIATE.) WORDLST IS THE LIST OF WORDS THAT ARE TO SEEN AS ONE TOKEN IN THE
INPUT STREAM AND TOKEN IS THE TOKEN THIS STREAM SHOULD BE REDUCED TO.)
(PROG (CANDIDATETREE)
(SETQ CANDIDATETREE MULTIPLEWORDTOKENS)
(while WORDLST do [COND
((NOT (MEMBER (CAR WORDLST)
DATETIMESPLST))
(SETQ DATETIMESPLST (CONS (CAR WORDLST)
DATETIMESPLST]
[COND
((NULL (FASSOC (CAR WORDLST)
CANDIDATETREE))
(SETQ CANDIDATETREE (NCONC1 CANDIDATETREE (LIST (CAR WORDLST]
(SETQ CANDIDATETREE (FASSOC (CAR WORDLST)
CANDIDATETREE))
(SETQ WORDLST (CDR WORDLST)))
(SETQ CANDIDATETREE (NCONC1 CANDIDATETREE (CONS NIL TOKEN])
(ADVANCEDATE
[LAMBDA (DATETIME DAYS INPAST) (* edited: "15-Jul-79 15:57")
(* RETURNS A DATETIME DAYS INTO THE FUTURE (OR PAST) FROM DATETIME. DAYS MAY BE AN INTEGER, IN WHICH CASE THE
DATETIME IS ADVANCED THAT MANY DAYS. IT MAY BE ONE OF THE KEYWORDS DAYS, MONTHS, WEEKS, YEARS, IN WHICH CASE IT WILL
ADVANCE THE DATETIME BY THAT AMOUNT. IT MAY BE A LIST OF TWO ELEMENTS THE FIRST OF WHICH IS AN INTEGER AND THE
SECOND OF WHICH IS A KEYWORD, SUCH AS (3 MONTHS) IN WHICH CASE THE DATE IS INCREASED BY THAT AMOUNT.
FINALLY, IT MAY BE A LIST OF ANY COMBINATION OF THE ABOVE, IN WHICH CASE, IT WILL APPLY EACH AMOUNT IN TURN.)
(SETQ DATETIME (GETDATETIME DATETIME))
[COND
((NOT (OR (type? DATETIME DATETIME)
(type? MULTIPLEDATETIMES DATETIME)
(type? DURATION DATETIME)
(type? QUALIFIEDDATETIME DATETIME)))
(SETQ DATETIME (COPY (GETDATETIME (QUOTE TODAY]
(COND
((NULL DAYS)
(SETQ DAYS 1)))
(COND
((type? DATETIME DATETIME)
(COND
[(NUMBERP DAYS)
(PROG (NEWYEAR NEWMONTH NEWDAYOFMONTH NEWDAYOFWEEK NUMOFDAYSINNEWMONTH)
[SETQ NEWYEAR (OR (fetch (DATETIME YEAR) of DATETIME)
(fetch (DATETIME YEAR) of (GETPROP (QUOTE TODAY)
(QUOTE DATETIME]
(SETQ NEWMONTH (OR (fetch (DATETIME MONTH) of DATETIME)
1))
(SETQ NEWDAYOFMONTH (OR (fetch (DATETIME DAYOFMONTH) of DATETIME)
1))
(SETQ NEWDAYOFWEEK (fetch (DATETIME DAYOFWEEK) of DATETIME))
[COND
(NEWDAYOFWEEK (SETQ NEWDAYOFWEEK (IREMAINDER (IPLUS NEWDAYOFWEEK DAYS)
7))
(COND
((ILESSP NEWDAYOFWEEK 1)
(SETQ NEWDAYOFWEEK (IPLUS NEWDAYOFWEEK 7]
(SETQ NEWDAYOFMONTH (IPLUS NEWDAYOFMONTH DAYS))
[while (LESSP (SETQ NUMOFDAYSINNEWMONTH (GETNUMOFDAYSINMONTH NEWMONTH NEWYEAR))
NEWDAYOFMONTH)
do (SETQ NEWDAYOFMONTH (IDIFFERENCE NEWDAYOFMONTH NUMOFDAYSINNEWMONTH))
(SETQ NEWMONTH (ADD1 NEWMONTH))
(COND
((ILESSP 12 NEWMONTH)
(SETQ NEWMONTH (IDIFFERENCE NEWMONTH 12))
(SETQ NEWYEAR (ADD1 NEWYEAR]
[while (ILESSP NEWDAYOFMONTH 1) do [COND
((IEQP NEWMONTH 1)
(SETQ NEWMONTH 12)
(SETQ NEWYEAR (SUB1 NEWYEAR)))
(T (SETQ NEWMONTH (SUB1 NEWMONTH]
(SETQ NEWDAYOFMONTH (IPLUS NEWDAYOFMONTH
(GETNUMOFDAYSINMONTH
NEWMONTH NEWYEAR]
(RETURN (create DATETIME
YEAR _ NEWYEAR
MONTH _ NEWMONTH
DAYOFMONTH _ NEWDAYOFMONTH
DAYOFWEEK _ NEWDAYOFWEEK
PRINTSTRING _ NIL using DATETIME]
[(ATOM DAYS)
(SELECTQ DAYS
[(DAY DAYS)
(ADVANCEDATE DATETIME (COND
(INPAST -1)
(T 1]
[(WEEK WEEKS)
(ADVANCEDATE DATETIME (COND
(INPAST -7)
(T 7]
[(MONTH MONTHS)
(ADVANCEDATE DATETIME (COND
[INPAST (PROG (LASTMONTH LASTYEAR)
(SETQ LASTMONTH (SUB1 (fetch (DATETIME MONTH)
of DATETIME)))
(SETQ LASTYEAR (fetch (DATETIME YEAR)
of DATETIME))
[COND
((ZEROP LASTMONTH)
(SETQ LASTMONTH 12)
(SETQ LASTYEAR (SUB1 LASTYEAR]
(RETURN (IMINUS (GETNUMOFDAYSINMONTH LASTMONTH
LASTYEAR]
(T (GETNUMOFDAYSINMONTH (fetch (DATETIME MONTH) of DATETIME)
(fetch (DATETIME YEAR) of DATETIME]
[(YEAR YEARS)
(ADVANCEDATE DATETIME (COND
(INPAST (COND
((IEQP (IREMAINDER (SUB1 (fetch (DATETIME YEAR)
of DATETIME))
4)
0)
-366)
(T -365)))
(T (COND
((IEQP (IREMAINDER (fetch (DATETIME YEAR) of DATETIME)
4)
0)
366)
(T 365]
((HOUR HOURS HR)
(PROG (DT HOURS AMORPM)
(SETQ DT (FINISHDATETIME DATETIME))
(SETQ AMORPM (fetch AMORPM of DT))
[SETQ HOURS (COND
(INPAST (SUB1 (fetch (DATETIME HOUR) of DT)))
(T (ADD1 (fetch (DATETIME HOUR) of DT]
[COND
[(MINUSP HOURS)
(replace (DATETIME HOUR) of DT with 11)
(COND
((EQ AMORPM (QUOTE PM))
(replace (DATETIME AMORPM) of DT with (QUOTE AM)))
(T (replace (DATETIME AMORPM) of DT with (QUOTE PM))
(SETQ DT (ADVANCEDATE DT -1]
((ILESSP HOURS 13)
(replace (DATETIME HOUR) of DT with HOURS))
((EQ AMORPM (QUOTE AM))
(replace (DATETIME HOUR) of DT with 1)
(replace (DATETIME AMORPM) of DT with (QUOTE PM)))
(T (replace (DATETIME HOUR) of DT with 1)
(replace (DATETIME AMORPM) of DT with (QUOTE AM))
(SETQ DT (ADVANCEDATE DT 1]
(RETURN DT)))
[(MINUTE MINUTES)
(PROG (MINUTES)
[SETQ MINUTES (COND
(INPAST (SUB1 (OR (fetch (DATETIME MINUTE) of DATETIME)
0)))
(T (ADD1 (OR (fetch (DATETIME MINUTE) of DATETIME)
0]
(COND
[(IGEQ MINUTES 60)
(RETURN (ADVANCEDATE (create DATETIME
MINUTE _ 0 using DATETIME)
(QUOTE HOUR]
((MINUSP MINUTES)
(RETURN (ADVANCEDATE (create DATETIME
MINUTE _ 59 using DATETIME)
(QUOTE HOUR)
T)))
(T (RETURN (create DATETIME
MINUTE _ MINUTES using DATETIME]
(DATETIMEERROR 1 (QUOTE (* ILLEGAL ADVANCE UNIT IN ADVANCEDATE.]
((NUMBERP (CAR DAYS))
[for I from 1 to (ABS (CAR DAYS)) do (SETQ DATETIME (ADVANCEDATE DATETIME (CADR DAYS)
(COND
((ILESSP 0
(CAR DAYS))
INPAST)
(T (NOT INPAST]
DATETIME)
(T (for SPEC in DAYS do (SETQ DATETIME (ADVANCEDATE DATETIME SPEC INPAST)))
DATETIME)))
((type? MULTIPLEDATETIMES DATETIME)
(NOTIMP))
((type? DURATION DATETIME)
(create DURATION
STARTDATETIME _(ADVANCEDATE (fetch (DURATION STARTDATETIME) of DATETIME)
DAYS INPAST)
ENDDATETIME _(ADVANCEDATE (fetch (DURATION ENDDATETIME) of DATETIME)
DAYS INPAST)))
((type? QUALIFIEDDATETIME DATETIME)
(create QUALIFIEDDATETIME
DATETIME _(ADVANCEDATE (fetch (QUALIFIEDDATETIME DATETIME) of DATETIME)
DAYS INPAST)
using DATETIME))
(T (DATETIMEERROR 2 (QUOTE (* ILLEGAL DATETIME TYPE IN ADVANCEDATE.])
(ADVANCEDATEUNTIL
[LAMBDA (DATETIME ADVANCEUNITS STOPPRED)
(* WTL: "17-MAR-78 11:22")
(* REPEATEDLY APPLIES ADVANCEDATE ON DATUM AND ADVANCEUNITS UNTIL STOPPRED IS SATISFIED. NOTE THAT DATUM AND
OLDDATUM CAN BE USED BY STOPPRED IN DETERMINING WHEN TO STOP.)
(PROG ((DATUM DATETIME)
OLDDATUM)
(SETQ DATUM (GETDATETIME DATUM))
[COND
((type? DATETIME DATUM)
[COND
((NULL (fetch (DATETIME DAYOFWEEK) of DATUM))
(* THIS IS A TEMPORARY PATCH TO KEEP FROM LOOPING FOREVER IF WE TRY TO FIND THE NEXT FRIDAY AFTER A GIVEN DATE WHERE
THE DAY OF WEEK OF THAT DATE WAS NOT SPECIFIED.)
(SETQ DATUM (FINISHDATETIME DATUM T]
(while (NOT (EVAL STOPPRED)) do (SETQ OLDDATUM DATUM)
(SETQ DATUM (ADVANCEDATE DATUM ADVANCEUNITS))
(COND
((EQ DATUM OLDDATUM)
(ERROR
"WARNING, DATUM NOT CHANGED IN ADVANCEDATEUNTIL"]
(RETURN DATUM])
(CHECKTODAY
[LAMBDA NIL (* WTL: "12-DEC-78 09:23")
(* CHECKS TO MAKE SURE THAT THE DATETIME TODAY REALLY IS TODAY, AND CORRECTS ALL
NECESSARY DATETIMES IF IT IS NOT.)
(DECLARE (SPECVARS TODAYDAYOFMONTH TODAYMONTH TODAYYEAR))
(PROG (TODAYMONTH TODAY TODAYDAYOFMONTH TODAYYEAR TEMPSTRING)
(SETQ TEMPSTRING (SUBSTRING (DATE)
1 9))
(COND
((STREQUAL TODAYSTRING TEMPSTRING)
(RETURN)))
(SETQ TODAY (GETDATETIME (QUOTE TODAY)))
[SETQ TODAYDAYOFMONTH (COND
((STREQUAL " " (SUBSTRING TEMPSTRING 1 1))
(MKATOM (SUBSTRING TEMPSTRING 2 2)))
(T (MKATOM (SUBSTRING TEMPSTRING 1 2]
[SETQ TODAYMONTH (GETMONTHNUM (MKATOM (SUBSTRING TEMPSTRING 4 6]
(SETQ TODAYYEAR (MKATOM (SUBSTRING TEMPSTRING 8 9)))
[SETQ TODAY (ADVANCEDATEUNTIL TODAY (QUOTE DAY)
(QUOTE (EQ TODAYDAYOFMONTH (fetch (DATETIME DAYOFMONTH)
of DATUM]
[SETQ TODAY (ADVANCEDATEUNTIL TODAY (QUOTE MONTH)
(QUOTE (EQ TODAYMONTH (fetch (DATETIME MONTH) of DATUM]
[SETQ TODAY (ADVANCEDATEUNTIL TODAY (QUOTE YEAR)
(QUOTE (EQ TODAYYEAR (fetch (DATETIME YEAR) of DATUM]
(PUTPROP (QUOTE TODAY)
(QUOTE DATETIME)
TODAY)
(PUTPROP (QUOTE TOMORROW)
(QUOTE DATETIME)
(ADVANCEDATE TODAY 1))
(PUTPROP (QUOTE YESTERDAY)
(QUOTE DATETIME)
(ADVANCEDATE TODAY -1))
(SETQ TODAYSTRING TEMPSTRING])
(COMBINEDATETIMES
[LAMBDA (DATETIME1 DATETIME2) (* WTL: "11-DEC-78 11:02")
(* ATTEMPTS TO COMBINE DATETIME1 AND DATETIME2 TO FORM A SINGLE DATETIME)
(PROG (RESULTDATETIME TEMP)
(COND
((NULL DATETIME2)
(RETURN DATETIME1)))
(COND
[(AND (type? DATETIME DATETIME1)
(type? DATETIME DATETIME2))
(RETURN (create DATETIME
YEAR _(OR (fetch (DATETIME YEAR) of DATETIME1)
(fetch (DATETIME YEAR) of DATETIME2))
MONTH _(OR (fetch (DATETIME MONTH) of DATETIME1)
(fetch (DATETIME MONTH) of DATETIME2))
DAYOFMONTH _(OR (fetch (DATETIME DAYOFMONTH) of DATETIME1)
(fetch (DATETIME DAYOFMONTH) of DATETIME2))
DAYOFWEEK _(OR (fetch (DATETIME DAYOFWEEK) of DATETIME1)
(fetch (DATETIME DAYOFWEEK) of DATETIME2))
HOUR _(OR (fetch (DATETIME HOUR) of DATETIME1)
(fetch (DATETIME HOUR) of DATETIME2))
AMORPM _(OR (fetch (DATETIME AMORPM) of DATETIME1)
(fetch (DATETIME AMORPM) of DATETIME2))
MINUTE _(OR (fetch (DATETIME MINUTE) of DATETIME1)
(fetch (DATETIME MINUTE) of DATETIME2]
((type? DATETIME DATETIME2)
(SETQ TEMP DATETIME1)
(SETQ DATETIME1 DATETIME2)
(SETQ DATETIME2 TEMP)))
[COND
((type? DATETIME DATETIME1)
(COND
[(type? DURATION DATETIME2)
(* THIS IS FOR PHRASES LIKE "TODAY, BETWEEN 2:30 AND 3:30")
(RETURN (create DURATION
STARTDATETIME _(COMBINEDATETIMES DATETIME1 (fetch (DURATION
STARTDATETIME)
of DATETIME2))
ENDDATETIME _(COMBINEDATETIMES DATETIME1 (fetch (DURATION
ENDDATETIME)
of DATETIME2]
((type? MULTIPLEDATETIMES DATETIME2)
(RETURN (EVALMDTFN DATETIME2 (QUOTE NEXTFROMDATEFN)
DATETIME1)))
(T (NOTIMP]
(COND
((type? QUALIFIEDDATETIME DATETIME2)
(SETQ TEMP DATETIME2)
(SETQ DATETIME2 DATETIME1)
(SETQ DATETIME1 TEMP)))
[COND
((type? QUALIFIEDDATETIME DATETIME1)
(COND
((type? MULTIPLEDATETIMES DATETIME2)
(SETQ RESULTDATETIME (EVALMDTFN DATETIME2 (QUOTE NEXTFROMDATEFN)
(fetch (QUALIFIEDDATETIME DATETIME) of DATETIME1)))
[COND
((ONLYTIMESPECIFIED DATETIME1)
(* THIS IS FOR PHRASES LIKE "WEDNESDAY, BEFORE 3:00")
(SETQ RESULTDATETIME (create QUALIFIEDDATETIME
QUALIFIER _(fetch (QUALIFIEDDATETIME QUALIFIER)
of DATETIME1)
DATETIME _ RESULTDATETIME)))
((EQ (fetch (QUALIFIEDDATETIME QUALIFIER) of DATETIME1)
(QUOTE BEFORE))
(SETQ RESULTDATETIME (EVALMDTFN DATETIME2 (QUOTE DECREMENTFN)
RESULTDATETIME]
(RETURN RESULTDATETIME))
(T (NOTIMP]
(COND
((type? DURATION DATETIME2)
(SETQ TEMP DATETIME2)
(SETQ DATETIME2 DATETIME1)
(SETQ DATETIME1 TEMP)))
(COND
[(AND (type? DURATION DATETIME1)
(type? MULTIPLEDATETIMES DATETIME2)
(ONLYTIMESPECIFIED DATETIME1))
(* THIS IS FOR PHRASES LIKE "WEDNESDAY, BETWEEN 2:30 AND 3:00")
(RETURN (create DURATION
STARTDATETIME _(EVALMDTFN DATETIME2 (QUOTE NEXTFROMDATEFN)
(fetch (DURATION STARTDATETIME) of DATETIME1))
ENDDATETIME _(EVALMDTFN DATETIME2 (QUOTE NEXTFROMDATEFN)
(fetch (DURATION ENDDATETIME) of DATETIME1]
[(AND (type? DURATION DATETIME1)
(type? MULTIPLEDATETIMES DATETIME2))
(* THIS IS FOR PHRASES LIKE "WEDNESDAY, WEEK OF SEPTEMBER 24TH")
(RETURN (COND
((EVALMDTFN DATETIME2 (QUOTE OCCURENCEPRED)
(fetch (DURATION STARTDATETIME) of DATETIME1))
(fetch (DURATION STARTDATETIME) of DATETIME1))
(T (EVALMDTFN DATETIME2 (QUOTE NEXTFROMDATEFN)
(fetch (DURATION STARTDATETIME) of DATETIME1]
(T (NOTIMP])
(CREATEHOURDT
[LAMBDA (NUM) (* edited: " 5-JAN-78 10:24")
(* ATTEMPTS TO CREATE A DATETIME WHICH JUST SPECIFIES THE HOUR OF DAY WHICH
CORRESPONDS TO NUM)
(COND
((ILESSP NUM 12)
(create DATETIME
HOUR _ NUM))
((EQ NUM 24)
(create DATETIME
HOUR _ 0
AMORPM _(QUOTE AM)))
(T (create DATETIME
HOUR _(IREMAINDER NUM 12)
AMORPM _(QUOTE PM])
(CREATEOCCURENCEPRED
[LAMBDA (DT) (* WTL: " 8-DEC-78 11:37")
(QUOTE (NOTIMP])
(DATETIMEERROR
[LAMBDA (ERRORNUMBER ERRORMESSAGE)
(* WTL: " 8-DEC-78 13:58")
(replace (DATETIMEERROR ERRORNUMBER) of DATETIMEERROR with ERRORNUMBER)
(replace (DATETIMEERROR MESSAGE) of DATETIMEERROR with ERRORMESSAGE)
(COND
(DATETIMEERRORFLG (ERROR))
(T (ERROR!])
(DATETIMETOSTRING
[LAMBDA (DATETIME) (* WTL: "14-JUL-78 10:56")
(* CHANGES A DATETIME RECORD INTO A READABLE STRING.)
(SETQ DATETIME (GETDATETIME DATETIME))
(PROG (DATE TIME)
(COND
((NULL DATETIME)
(RETURN "")))
(COND
((type? DATETIMEERROR DATETIME)
(RETURN "")))
[COND
((type? DURATION DATETIME)
(RETURN (CONCAT "between " (DATETIMETOSTRING (fetch (DURATION STARTDATETIME)
of DATETIME))
" and "
(DATETIMETOSTRING (fetch (DURATION ENDDATETIME) of DATETIME]
[COND
((type? MULTIPLEDATETIMES DATETIME)
(RETURN (fetch (MULTIPLEDATETIMES PRINTSTRING) of DATETIME]
[COND
((type? QUALIFIEDDATETIME DATETIME)
(RETURN (CONCAT (SELECTQ (fetch (QUALIFIEDDATETIME QUALIFIER) of DATETIME)
(ABOUT "~")
(BEFORE "<")
(AFTER ">")
(SHOULDNT))
" "
(DATETIMETOSTRING (fetch (QUALIFIEDDATETIME DATETIME) of DATETIME]
[COND
((fetch (DATETIME MONTH) of DATETIME)
(SETQ DATE (L-CASE (ELT MONTHNAME (fetch (DATETIME MONTH) of DATETIME))
T))
[COND
((fetch (DATETIME DAYOFMONTH) of DATETIME)
(SETQ DATE (CONCAT DATE " " (fetch (DATETIME DAYOFMONTH) of DATETIME]
(COND
((fetch (DATETIME YEAR) of DATETIME)
(SETQ DATE (CONCAT DATE ", " (IPLUS (fetch (DATETIME YEAR) of DATETIME)
1900]
[COND
[(AND (fetch (DATETIME HOUR) of DATETIME)
(fetch (DATETIME MINUTE) of DATETIME))
(SETQ TIME (CONCAT (COND
((ZEROP (fetch (DATETIME HOUR) of DATETIME))
12)
(T (fetch (DATETIME HOUR) of DATETIME)))
":"
(COND
((ILESSP (fetch (DATETIME MINUTE) of DATETIME)
10)
(CONCAT "0" (fetch (DATETIME MINUTE) of DATETIME)))
(T (fetch (DATETIME MINUTE) of DATETIME)))
(COND
((fetch (DATETIME AMORPM) of DATETIME)
(L-CASE (fetch (DATETIME AMORPM) of DATETIME)))
(T ""]
((fetch (DATETIME HOUR) of DATETIME)
(SETQ TIME (CONCAT (COND
((ZEROP (fetch (DATETIME HOUR) of DATETIME))
12)
(T (fetch (DATETIME HOUR) of DATETIME)))
":00"
(COND
((fetch (DATETIME AMORPM) of DATETIME)
(L-CASE (fetch (DATETIME AMORPM) of DATETIME)))
(T ""]
(COND
((AND DATE TIME)
(RETURN (CONCAT DATE " AT " TIME)))
(DATE (RETURN DATE))
(T (RETURN TIME])
(DEQUALP
[LAMBDA (DATETIME1 DATETIME2 RESOLUTION TIMEONLY)
(* WTL: "20-MAR-78 00:04")
(* TESTS TO SEE IF DATETIME1 AND DATETIME2 ARE EQUAL TO THE RESOLUTION OF RESOLUTION. RESOLUTION MAY HAVE ONE OF THE
VALUES YEAR, MONTH, DAYOFMONTH, HOUR, MINUTE.)
(SETQ DATETIME1 (GETDATETIME DATETIME1))
(SETQ DATETIME2 (GETDATETIME DATETIME2))
(COND
[(AND (type? DATETIME DATETIME1)
(type? DATETIME DATETIME2))
(PROG NIL
(COND
(TIMEONLY (GO TIMEONLY)))
(COND
((EQUAL DATETIME1 DATETIME2)
(RETURN T)))
(COND
((NOT (AND (fetch (DATETIME YEAR) of DATETIME1)
(fetch (DATETIME YEAR) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((NOT (EQUAL (fetch (DATETIME YEAR) of DATETIME1)
(fetch (DATETIME YEAR) of DATETIME2)))
(RETURN NIL))
((EQ RESOLUTION (QUOTE YEAR))
(RETURN T)))
(COND
((NOT (AND (fetch (DATETIME MONTH) of DATETIME1)
(fetch (DATETIME MONTH) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((NEQ (fetch (DATETIME MONTH) of DATETIME1)
(fetch (DATETIME MONTH) of DATETIME2))
(RETURN NIL))
((EQ RESOLUTION (QUOTE MONTH))
(RETURN T)))
(COND
((NOT (AND (fetch (DATETIME DAYOFMONTH) of DATETIME1)
(fetch (DATETIME DAYOFMONTH) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((NEQ (fetch (DATETIME DAYOFMONTH) of DATETIME1)
(fetch (DATETIME DAYOFMONTH) of DATETIME2))
(RETURN NIL))
((EQ RESOLUTION (QUOTE DAY))
(RETURN T)))
TIMEONLY
(COND
((NOT (AND (fetch (DATETIME AMORPM) of DATETIME1)
(fetch (DATETIME AMORPM) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((NEQ (fetch (DATETIME AMORPM) of DATETIME1)
(fetch (DATETIME AMORPM) of DATETIME2))
(RETURN NIL))
((EQ RESOLUTION (QUOTE AMORPM))
(RETURN T)))
(COND
((NOT (AND (fetch (DATETIME HOUR) of DATETIME1)
(fetch (DATETIME HOUR) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((NEQ (fetch (DATETIME HOUR) of DATETIME1)
(fetch (DATETIME HOUR) of DATETIME2))
(RETURN NIL))
((EQ RESOLUTION (QUOTE HOUR))
(RETURN T)))
(COND
((NOT (AND (fetch (DATETIME MINUTE) of DATETIME1)
(fetch (DATETIME MINUTE) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((NEQ (fetch (DATETIME MINUTE) of DATETIME1)
(fetch (DATETIME MINUTE) of DATETIME2))
(RETURN NIL))
(T (RETURN T]
(T NIL])
(DLESSP
[LAMBDA (DATETIME1 DATETIME2 RESOLUTION TIMEONLY)
(* WTL: "20-MAR-78 00:01")
(* TESTS TO SEE IF DATETIME1 AN EARLIER TIME THAN DATETIME2 TO THE RESOLUTION OF RESOLUTION.
RESOLUTION MAY HAVE ONE OF THE VALUES YEAR, MONTH, DAYOFMONTH, HOUR, MINUTE.)
(SETQ DATETIME1 (GETDATETIME DATETIME1))
(SETQ DATETIME2 (GETDATETIME DATETIME2))
(COND
[(AND (type? DATETIME DATETIME1)
(type? DATETIME DATETIME2))
(PROG NIL
(COND
(TIMEONLY (GO TIMEONLY)))
(COND
((EQUAL DATETIME1 DATETIME2)
(RETURN NIL)))
(COND
((NOT (AND (fetch (DATETIME YEAR) of DATETIME1)
(fetch (DATETIME YEAR) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((ILESSP (fetch (DATETIME YEAR) of DATETIME1)
(fetch (DATETIME YEAR) of DATETIME2))
(RETURN T))
((ILESSP (fetch (DATETIME YEAR) of DATETIME2)
(fetch (DATETIME YEAR) of DATETIME1))
(RETURN NIL))
((EQ RESOLUTION (QUOTE YEAR))
(RETURN NIL)))
(COND
((NOT (AND (fetch (DATETIME MONTH) of DATETIME1)
(fetch (DATETIME MONTH) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((LESSP (fetch (DATETIME MONTH) of DATETIME1)
(fetch (DATETIME MONTH) of DATETIME2))
(RETURN T))
((ILESSP (fetch (DATETIME MONTH) of DATETIME2)
(fetch (DATETIME MONTH) of DATETIME1))
(RETURN NIL))
((EQ RESOLUTION (QUOTE MONTH))
(RETURN NIL)))
(COND
((NOT (AND (fetch (DATETIME DAYOFMONTH) of DATETIME1)
(fetch (DATETIME DAYOFMONTH) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((ILESSP (fetch (DATETIME DAYOFMONTH) of DATETIME1)
(fetch (DATETIME DAYOFMONTH) of DATETIME2))
(RETURN T))
((ILESSP (fetch (DATETIME DAYOFMONTH) of DATETIME2)
(fetch (DATETIME DAYOFMONTH) of DATETIME1))
(RETURN NIL))
((EQ RESOLUTION (QUOTE DAY))
(RETURN NIL)))
TIMEONLY
(COND
((NOT (AND (fetch (DATETIME AMORPM) of DATETIME1)
(fetch (DATETIME AMORPM) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((AND (EQ (QUOTE AM)
(fetch (DATETIME AMORPM) of DATETIME1))
(EQ (QUOTE PM)
(fetch (DATETIME AMORPM) of DATETIME2)))
(RETURN T))
((AND (EQ (QUOTE PM)
(fetch (DATETIME AMORPM) of DATETIME1))
(EQ (fetch (DATETIME AMORPM) of DATETIME2)))
(RETURN NIL))
((EQ RESOLUTION (QUOTE AMORPM))
(RETURN NIL)))
(COND
((NOT (AND (fetch (DATETIME HOUR) of DATETIME1)
(fetch (DATETIME HOUR) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((ILESSP (fetch (DATETIME HOUR) of DATETIME1)
(fetch (DATETIME HOUR) of DATETIME2))
(RETURN T))
((ILESSP (fetch (DATETIME HOUR) of DATETIME2)
(fetch (DATETIME HOUR) of DATETIME1))
(RETURN NIL))
((EQ RESOLUTION (QUOTE HOUR))
(RETURN NIL)))
(COND
((NOT (AND (fetch (DATETIME MINUTE) of DATETIME1)
(fetch (DATETIME MINUTE) of DATETIME2)))
(RETURN (QUOTE INCOMPARABLE)))
((ILESSP (fetch (DATETIME MINUTE) of DATETIME1)
(fetch (DATETIME MINUTE) of DATETIME2))
(RETURN T))
(T (RETURN NIL]
(T NIL])
(EVALMDTFN
[LAMBDA (MDT FN DATUM) (* WTL: " 8-DEC-78 11:27")
(* APPLIES THE MULTIPLEDATETIME FUNCTIONAL OF MDT AS SPECIFIED BY FN BINDING
DATUM TO ITS THIRD ARGUMENT FOR THE EVALUATION.)
(SETQ MDT (GETDATETIME MDT))
(COND
((NOT (type? MULTIPLEDATETIMES MDT))
(ERROR "NOT A MULTIPLEDATETIME")))
(SETQ DATUM (FINISHDATETIME (GETDATETIME DATUM)
T))
(COND
((NULL DATUM)
(SETQ DATUM MDT)))
(SELECTQ FN
((OCCURENCEPRED OCCPRED PRED OP)
(EVAL (fetch (MULTIPLEDATETIMES OCCURENCEPRED) of MDT)))
((ADVANCEFN INCREMENTFN ADVANCE INCREMENT ADV INC)
(EVAL (fetch (MULTIPLEDATETIMES ADVANCEFN) of MDT)))
((DECREMENTFN BACKUPFN DECREMENT BACKUP DEC)
(EVAL (fetch (MULTIPLEDATETIMES DECREMENTFN) of MDT)))
((NEXTFROMDATEFN NEXTDATE NEXTFN NEXT)
(EVAL (fetch (MULTIPLEDATETIMES NEXTFROMDATEFN) of MDT)))
(DATETIMEERROR 3 (QUOTE (* ILLEGAL EVAL TYPE IN EVALMDTFN.])
(EXPANDINPUT
[LAMBDA (INPUT) (* WTL: "19-DEC-78 12:53")
(* TAKES A STRING OR A LIST OF TOKENS, CHANGES TO A LIST OF TOKENS, DOES SPELLING CORRECTION ON THAT LIST, REDUCES
ALL MULTIPLEWORD TOKENS, TRIES TO DO OTHER VARIOUS SMART THINGS TO THAT LIST AND RETURNS THAT LIST OF TOKENS SO THAT
THE PARSER CAN HANDLE IT.)
(PROG (TOKENLST TEMPLST SAVELST TOKEN LASTNUM TOKENSAVE)
(SETQ TOKENLST NIL)
[SETQ TEMPLST
(for TOKEN
in
(COND
[(STRINGP INPUT)
(PROG ((STR (CONCAT INPUT "||"))
TEMP BUF)
(RETURN (while (OR BUF (NEQ TEMP (QUOTE %|)))
when (NEQ (QUOTE %|)
(PROGN [SETQ TEMP (COND
(BUF (PROG1 BUF (SETQ BUF NIL)))
(T (READ STR DTRDTBL]
(while (EQ TEMP (QUOTE % ))
do (SETQ TEMP (READ STR DTRDTBL)))
[COND
((NUMBERP TEMP)
(while [AND (NOT (ZEROP (NCHARS STR)))
(NUMBERP (SETQ BUF
(READ STR DTRDTBL]
do (SETQ TEMP (PACK* TEMP BUF))
(SETQ BUF NIL]
TEMP))
collect TEMP]
((ATOM INPUT)
(LIST INPUT))
(T INPUT))
when [SETQ TEMPTOKEN (COND
((NUMBERP TOKEN)
(LIST (create NUMERAL
VALUE _ TOKEN)))
(T (SPELLPROPERLY (U-CASE TOKEN]
join (COND
((ATOM TEMPTOKEN)
(LIST TEMPTOKEN))
(T (COPY TEMPTOKEN]
(while TEMPLST do [COND
((NULL (SETQ TOKEN (MULTIWORDTOKEN MULTIPLEWORDTOKENS)))
(SETQ TOKEN (CAR TEMPLST))
(SETQ TEMPLST (CDR TEMPLST]
[COND
[(NUMBERP TOKEN)
(while (OR (NUMBERP (CAR TEMPLST))
(EQ (CAR TEMPLST)
(QUOTE +)))
do [COND
((EQ (CAR TEMPLST)
(QUOTE +))
(SETQ TEMPLST (CDR TEMPLST))
(COND
((NUMBERP (CAR TEMPLST))
(SETQ TOKENSAVE TOKEN)
(SETQ TOKEN (CAR TEMPLST))
(SETQ TEMPLST (CDR TEMPLST]
[SETQ TOKEN (PACK (CONS TOKEN (while (NUMBERP (CAR TEMPLST))
collect (PROG1 (CAR TEMPLST)
(SETQ TEMPLST
(CDR TEMPLST]
(COND
(TOKENSAVE (SETQ TOKEN (IPLUS TOKENSAVE TOKEN))
(SETQ TOKENSAVE NIL]
((type? NUMERAL TOKEN)
(SETQ TOKEN (fetch (NUMERAL VALUE) of TOKEN]
(SETQ TOKENLST (TCONC TOKENLST TOKEN)))
(SETQ TOKENLST (CAR TOKENLST))
(RETURN TOKENLST])
(FINISHDATETIME
[LAMBDA (DATETIME FILLDATEONLY)
(* WTL: "11-DEC-78 14:08")
(* ATTAMPES TO FILL IN ALL SLOTS OF DATETIME WHICH HAVE NOT ALREADY BEEN FILLED
IN. NOTE THIS IS NOT A DESTRUCTIVE FUNCTION.)
(DECLARE (SPECVARS TEMP TODAY))
(CHECKTODAY)
(SETQ DATETIME (GETDATETIME DATETIME))
(COND
((type? DATETIME DATETIME)
(PROG (DATUM NUM TODAY TEMP)
(SETQ DATUM (create DATETIME using DATETIME))
[SETQ TODAY (COPY (GETDATETIME (QUOTE TODAY]
(COND
((AND (fetch (DATETIME YEAR) of DATUM)
(NULL (fetch (DATETIME MONTH) of DATUM)))
(replace (DATETIME MONTH) of DATUM with 1)))
(COND
((AND (fetch (DATETIME MONTH) of DATUM)
(NULL (fetch (DATETIME DAYOFMONTH) of DATUM)))
(replace (DATETIME DAYOFMONTH) of DATUM with 1)))
[COND
((AND (NULL (fetch (DATETIME DAYOFMONTH) of DATUM))
(NULL (fetch (DATETIME DAYOFWEEK) of DATUM)))
(SETQ DATUM (create DATETIME
HOUR _(fetch (DATETIME HOUR) of DATUM)
MINUTE _(fetch (DATETIME MINUTE) of DATUM) using TODAY)))
[(NULL (fetch (DATETIME DAYOFMONTH) of DATUM))
(SETQ NUM (fetch (DATETIME DAYOFWEEK) of DATUM))
(SETQ DATUM (create DATETIME
HOUR _(fetch (DATETIME HOUR) of DATUM)
MINUTE _(fetch (DATETIME MINUTE) of DATUM)
AMORPM _(fetch (DATETIME AMORPM) of DATUM)
using (ADVANCEDATEUNTIL TODAY 1 (QUOTE (EQ NUM (fetch (DATETIME
DAYOFWEEK)
of DATUM]
(T
(* WE HAVE A DAYOFMONTH, BUT POSSIBLY NO DAY OF WEEK OR MONTH OR YEAR. IF THERE IS A DAY OF WEEK I'M GOING TO FLUSH
IT)
[COND
((NULL (fetch (DATETIME MONTH) of DATUM))
(replace (DATETIME MONTH) of DATUM with (fetch (DATETIME MONTH) of TODAY]
[COND
((NULL (fetch (DATETIME YEAR) of DATUM))
(replace (DATETIME YEAR) of DATUM with (fetch (DATETIME YEAR) of TODAY]
[COND
((NULL (fetch (DATETIME YEAR) of DATETIME))
(SETQ DATUM (ADVANCEDATEUNTIL DATUM (QUOTE YEAR)
(QUOTE (DLESSP TODAY DATUM (QUOTE DAY]
(SETQ TEMP DATUM)
[SETQ DATUM (ADVANCEDATEUNTIL TODAY 1 (QUOTE (EQ (fetch (DATETIME DAYOFMONTH)
of TEMP)
(fetch (DATETIME DAYOFMONTH)
of DATUM]
[SETQ DATUM (ADVANCEDATEUNTIL DATUM (QUOTE MONTH)
(QUOTE (EQ (fetch (DATETIME MONTH) of TEMP)
(fetch (DATETIME MONTH) of DATUM]
[SETQ DATUM (ADVANCEDATEUNTIL DATUM [COND
((DLESSP DATUM TEMP)
(QUOTE YEAR))
(T (QUOTE (-1 YEAR]
(QUOTE (EQ (fetch (DATETIME YEAR) of TEMP)
(fetch (DATETIME YEAR) of DATUM]
(replace (DATETIME HOUR) of DATUM with (fetch (DATETIME HOUR) of TEMP))
(replace (DATETIME MINUTE) of DATUM with (fetch (DATETIME MINUTE) of TEMP))
(replace (DATETIME AMORPM) of DATUM with (fetch (DATETIME AMORPM) of TEMP]
[COND
((NULL FILLDATEONLY)
(COND
((NULL (fetch (DATETIME HOUR) of DATUM))
(replace (DATETIME HOUR) of DATUM with 0)
(replace (DATETIME MINUTE) of DATUM with 1)))
[COND
((AND (NULL (fetch (DATETIME AMORPM) of DATUM))
(fetch (DATETIME HOUR) of DATUM))
(replace (DATETIME AMORPM) of DATUM with (COND
((ILESSP (fetch (DATETIME HOUR)
of DATUM)
9)
(QUOTE PM))
(T (QUOTE AM]
(COND
((NULL (fetch (DATETIME MINUTE) of DATUM))
(replace (DATETIME MINUTE) of DATUM with 0]
(RETURN DATUM)))
((type? DURATION DATETIME)
(create DURATION
STARTDATETIME _(FINISHDATETIME (fetch (DURATION STARTDATETIME) of DATETIME)
FILLDATEONLY)
ENDDATETIME _(FINISHDATETIME (fetch (DURATION ENDDATETIME) of DATETIME)
FILLDATEONLY)))
((type? QUALIFIEDDATETIME DATETIME)
(create QUALIFIEDDATETIME
DATETIME _(FINISHDATETIME (fetch (QUALIFIEDDATETIME DATETIME) of DATETIME)
FILLDATEONLY)
using DATETIME))
(T DATETIME])
(GETDATETIME
[LAMBDA (DATETIME) (* edited: " 8-JAN-78 10:04")
(* TRIES TO PRODUCE AN HONEST TO GOD DATETIME RECORD CORRESPOND TO DATETIME.)
(COND
((OR (type? DATETIME DATETIME)
(type? MULTIPLEDATETIMES DATETIME)
(type? QUALIFIEDDATETIME DATETIME)
(type? DURATION DATETIME))
DATETIME)
((NULL DATETIME)
NIL)
((ATOM DATETIME)
(GETPROP (OR (MISSPELLED? DATETIME NIL DATETIMESPLST)
DATETIME)
(QUOTE DATETIME)))
(T NIL])
(GETDAYOFWEEK
[LAMBDA (DAYOFWEEK) (* edited: " 5-JAN-78 10:34")
(* RETURN THE NUMBER OF THE DAY OF WEEK SPECIFIED BY DAYOFWEEK.
SUNDAY IS 1, ETC.)
(COND
((AND (NUMBERP DAYOFWEEK)
(ILESSP 0 DAYOFWEEK)
(ILESSP DAYOFWEEK 8))
DAYOFWEEK)
((AND (ATOM DAYOFWEEK)
(NOT (NUMBERP DAYOFWEEK)))
(GETPROP (MISSPELLED? DAYOFWEEK NIL DATETIMESPLST)
(QUOTE WEEKDAYNUM)))
(T NIL])
(GETMONTHNUM
[LAMBDA (MONTH) (* edited: " 8-Jan-80 10:26")
(* RETURNS THE NUMBER OF THE MONTH SPECIFIED BY MONTH.
JANUARY IS 1, ETC.)
(COND
((AND (NUMBERP MONTH)
(ILESSP 0 MONTH)
(ILESSP MONTH 13))
MONTH)
((AND (ATOM MONTH)
(NOT (NUMBERP MONTH)))
(GETPROP (MISSPELLED? (U-CASE MONTH)
NIL DATETIMESPLST)
(QUOTE MONTHNUM)))
(T NIL])
(GETNUMOFDAYSINMONTH
[LAMBDA (MONTH YEAR) (* edited: " 5-JAN-78 10:36")
(* RETURNS THE NUMBER OF DAYS IN MONTH IN THE YEARS YEAR.
IF YEAR IS NIL IT IS ASSUMED TO BE THE CURRENT YEAR.)
(SETQ MONTH (GETMONTHNUM MONTH))
[COND
((NOT (NUMBERP YEAR))
(SETQ YEAR (fetch (DATETIME YEAR) of (GETDATETIME (QUOTE TODAY]
(COND
((NULL MONTH)
NIL)
((AND (IEQP MONTH 2)
(ZEROP (IREMAINDER YEAR 4)))
29)
(T (ELT NUMOFDAYSINMONTH MONTH])
(ISFIRSTOFMONTH
[LAMBDA (DATETIME) (* WTL: " 1-DEC-78 10:30")
(AND (type? DATETIME DATETIME)
(EQ 1 (fetch (DATETIME DAYOFMONTH) of DATETIME])
(ISJANUARY
[LAMBDA (DATETIME) (* WTL: " 1-DEC-78 10:30")
(AND (type? DATETIME DATETIME)
(EQ 1 (fetch (DATETIME MONTH) of DATETIME])
(ISSATURDAY
[LAMBDA (DATETIME) (* WTL: " 1-DEC-78 10:16")
(AND (type? DATETIME DATETIME)
(EQ (fetch (DATETIME DAYOFWEEK) of DATETIME)
7])
(ISSUNDAY
[LAMBDA (DATETIME) (* WTL: " 1-DEC-78 10:15")
(AND (type? DATETIME DATETIME)
(EQ (fetch (DATETIME DAYOFWEEK) of DATETIME)
1])
(ISXEROXHOLIDAY
[LAMBDA (DATUM ACTIONKEY) (* WTL: "26-DEC-78 22:25")
(PROG (DAT XHS LAST)
(SETQ DAT (FINISHDATETIME DATUM T))
(SETQ XHS XEROXHOLIDAYS)
(while (AND XHS (DLESSP (CAR XHS)
DAT
(QUOTE DAY)))
do (SETQ LAST (CAR XHS))
(SETQ XHS (CDR XHS)))
(RETURN (SELECTQ ACTIONKEY
((NIL ?)
(DEQUALP (CAR XHS)
DAT
(QUOTE DAY)))
(DECREMENTFN LAST)
(ADVANCEFN (CADR XHS))
[NEXTFN (COND
((AND XHS (DEQUALP DAT (CAR XHS)
(QUOTE DAY)))
(CADR XHS))
(T (CAR XHS]
(SHOULDNT])
(LISTDATES
[LAMBDA (DATETIME1 DATETIME2) (* edited: " 5-JAN-78 10:38")
(* RETURNS THE LIST OF UP TO TE DATES BETWEEN DATETIME1 AND DATETIME2 INCLUSIVE. NOTE THAT DATETIME1 MAY BE A
DURATION OR A MULTIPLEDATETIME IN WHICH CASE THE SECOND ARG IS IGNORED.)
(CHECKTODAY)
(PROG (DATUM COUNT)
(SETQ DATETIME1 (GETDATETIME DATETIME1))
(SETQ DATETIME2 (GETDATETIME DATETIME2))
(SETQ COUNT 0)
[COND
((type? DURATION DATETIME1)
(SETQ DATETIME2 (fetch (DURATION ENDDATETIME) of DATETIME1))
(SETQ DATETIME1 (fetch (DURATION STARTDATETIME) of DATETIME2]
[COND
((type? MULTIPLEDATETIMES DATETIME1)
[SETQ DATUM (EVALMDTFN DATETIME1 (QUOTE NEXT)
(COND
(DATETIME2 DATETIME2)
(T (GETDATETIME (QUOTE TODAY]
(RETURN (while (AND DATUM (ILESSP COUNT 10)) collect (PROG1 DATUM (SETQ COUNT
(ADD1 COUNT))
(SETQ DATUM
(EVALMDTFN DATETIME1
(QUOTE ADVANCE)
DATUM]
(COND
((NOT (type? DATETIME DATETIME1))
(RETURN)))
[COND
((NULL DATETIME2)
(SETQ DATUM DATETIME1)
(RETURN (for I from 1 to 10 collect (PROG1 DATUM (SETQ DATUM (ADVANCEDATE DATUM]
(SETQ DATUM DATETIME1)
(RETURN (while [AND (ILESSP COUNT 10)
(NOT (DLESSP DATETIME2 DATUM (QUOTE DAY]
collect (PROG1 DATUM (SETQ COUNT (ADD1 COUNT))
(SETQ DATUM (ADVANCEDATE DATUM])
(MULTIWORDTOKEN
[LAMBDA (CANDIDATEWORDTREE) (* edited: " 5-JAN-78 10:40")
(* TRIES TO CHEW TOKENS OF TEMPLST REDUCING THEM TO A SINGLE TOKEN AS SPECIFIED
BY CANDIDATEWORDTREE FOR REDUCING MULITPLE WORD TOKENS.)
(PROG (SAVETEMPLST TEMP)
(SETQ SAVETEMPLST TEMPLST)
(COND
((NULL CANDIDATEWORDTREE)
(RETURN NIL)))
[COND
((NULL TEMPLST)
(RETURN (CDR (FASSOC NIL CANDIDATEWORDTREE]
(SETQ TEMP (CAR TEMPLST))
(SETQ TEMPLST (CDR TEMPLST))
[SETQ TOKEN (MULTIWORDTOKEN (CDR (FASSOC TEMP CANDIDATEWORDTREE]
(COND
(TOKEN (RETURN TOKEN)))
(SETQ TEMPLST SAVETEMPLST)
(RETURN (CDR (FASSOC NIL CANDIDATEWORDTREE])
(NOTIMP
[LAMBDA NIL
(PRINT (QUOTE (* NOT IMPLEMENTED)))
(HELP])
(ONLYTIMESPECIFIED
[LAMBDA (DT) (* WTL: " 8-DEC-78 11:18")
(COND
[(type? DATETIME DT)
(AND (NULL (fetch (DATETIME YEAR) of DT))
(NULL (fetch (DATETIME MONTH) of DT))
(NULL (fetch (DATETIME DAYOFMONTH) of DT))
(NULL (fetch (DATETIME DAYOFWEEK) of DT]
[(type? DURATION DT)
(AND (ONLYTIMESPECIFIED (fetch (DURATION STARTDATETIME) of DT))
(ONLYTIMESPECIFIED (fetch (DURATION ENDDATETIME) of DT]
((type? QUALIFIEDDATETIME DT)
(ONLYTIMESPECIFIED (fetch (QUALIFIEDDATETIME DATETIME) of DT])
(PARSEDATETIME
[LAMBDA (TOKENLST CONTEXT) (* WTL: " 3-DEC-78 16:07")
(* PARSES THE TOKENLST (VIEWED AS EITHER A STRING OR A LIST OF TOKENS) INTO A
DATETIME RECORD. DOES VARIOUS BOOKKEEPING AS WELL.)
(PROG (ANSWER DATETIMEERROR)
(CHECKTODAY)
(SETNOWDATETIME)
(SETQ TOKENLST (EXPANDINPUT TOKENLST))
(SETQ DATETIMEERROR (create DATETIMEERROR
ORIGINALTOKENLST _ TOKENLST))
[SETQ ANSWER (COND
(DATETIMEERRORFLG (PARSEDATETIME2))
(T (CAR (NLSETQ (PARSEDATETIME2]
(COND
(ANSWER (RETURN ANSWER))
(T (replace (DATETIMEERROR CURRENTTOKENLST) of DATETIMEERROR with TOKENLST)
(RETURN DATETIMEERROR])
(PARSEDATETIME1
[LAMBDA NIL (* WTL: " 7-DEC-78 14:54")
(* DOES ALL THE ACTUALLY PARSING.)
(AND TOKENLST
(PROG (TEMP OLDDATETIME)
[SETQ OLDDATETIME
(COND
((FMEMB (CAR TOKENLST)
(QUOTE (HOUR MINUTE DAY MONTH WEEK YEAR)))
(PARSESPECIALDURATION))
((FMEMB (CAR TOKENLST)
(QUOTE (AFTER BEFORE ABOUT BETWEEN)))
(PARSEQUALIFIEDDATETIME))
((AND (NOT (NUMBERP (CAR TOKENLST)))
(GETMONTHNUM (CAR TOKENLST)))
(PARSESIMPLEDATE))
((EQ (CAR TOKENLST)
(QUOTE IN))
(PARSESIMPLEDATE))
((EQ (CAR TOKENLST)
(QUOTE AT))
(PARSESIMPLETIME))
((SETQ TEMP (GETDATETIME (CAR TOKENLST)))
(SETQ TOKENLST (CDR TOKENLST))
TEMP)
[(NOT (NUMBERP (CAR TOKENLST)))
(DATETIMEERROR 9 (QUOTE (* DONT KNOW WHAT TO DO WITH CURRENT TOKEN.]
((FMEMB (CADR TOKENLST)
(QUOTE (: OCLOCK AM PM)))
(PARSESIMPLETIME))
((FMEMB (CADR TOKENLST)
(QUOTE (TH HOUR MINUTE DAY MONTH WEEK YEAR SUNDAY MONDAY TUESDAY WEDNESDAY
THURSDAY FRIDAY SATURDAY)))
(PARSEOFFSETDATETIME))
((NULL (CDR TOKENLST))
(PARSESIMPLETIME))
(T (PARSESIMPLEDATE]
(while [AND TOKENLST (NOT (FMEMB (CAR TOKENLST)
(QUOTE (TO AND]
do (SETQ OLDDATETIME (COMBINEDATETIMES (PARSEDATETIME2)
OLDDATETIME)))
(RETURN OLDDATETIME])
(PARSEDATETIME2
[LAMBDA NIL (* WTL: " 8-DEC-78 12:18")
(* TRIES TO CATCH VARIOUS KEYWORD TOKENS IN PARSING TO HELP DIRECT THE PARSING.)
(PROG (TEMP $TOKEN THISDATE MULTIPLEDATETIME NUM MDT)
(COND
((NULL TOKENLST)
(RETURN)))
[COND
((EQ (CAR TOKENLST)
(QUOTE ,))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((EQ (CAR TOKENLST)
(QUOTE IN))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((EQ (CAR TOKENLST)
(QUOTE THE))
(SETQ TOKENLST (CDR TOKENLST]
(SELECTQ (CAR TOKENLST)
(EVERY (SETQ TOKENLST (CDR TOKENLST))
[COND
[[SETQ TEMP (OR (GETDATETIME (CAR TOKENLST))
(GETPROP (CAR TOKENLST)
(QUOTE UNITMULTIPLEDATETIME]
(SETQ TOKENLST (CDR TOKENLST))
(while TOKENLST do (SETQ TEMP (RESTRICTMULTIPLEDATETIME TEMP (
PARSEDATETIME2]
[(NUMBERP (CAR TOKENLST))
(SETQ NUM (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST))
[COND
((EQ (CAR TOKENLST)
(QUOTE TH))
(SETQ TOKENLST (CDR TOKENLST]
[SETQ MDT (OR (GETDATETIME (CAR TOKENLST))
(GETPROP (CAR TOKENLST)
(QUOTE UNITMULTIPLEDATETIME]
[OR (type? MULTIPLEDATETIMES MDT)
(DATETIMEERROR 15 (QUOTE (* MULTIPLE DATETIME TOKEN EXPECTED HERE]
(SETQ TOKENLST (CDR TOKENLST))
(SETQ TEMP (create MULTIPLEDATETIMES
OCCURENCEPRED _(QUOTE (NOTIMP))
ADVANCEFN _(LIST (QUOTE REPEATADVANCE)
NUM
(KWOTE (fetch (MULTIPLEDATETIMES
ADVANCEFN)
of MDT)))
DECREMENTFN _(LIST (QUOTE REPEATADVANCE)
NUM
(KWOTE (fetch (MULTIPLEDATETIMES
DECREMENTFN)
of MDT)))
NEXTFROMDATEFN _(QUOTE (NOTIMP))
PRINTSTRING _ NIL))
(while TOKENLST do (SETQ TEMP (RESTRICTMULTIPLEDATETIME TEMP (
PARSEDATETIME2]
(T (SETQ MULTIPLEDATETIME T)
(SETQ TEMP (PARSEDATETIME1))
(COND
((NOT (type? MULTIPLEDATETIMES TEMP))
(DATETIMEERROR 11 (QUOTE (* UNKNOWN CYCLIC DATETIME.]
(RETURN TEMP))
[(THIS NEXT LAST)
(SETQ $TOKEN (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST))
(SETQ MULITPLEDATETIME T)
(SETQ TEMP (PARSEDATETIME1))
[COND
[(type? MULTIPLEDATETIMES TEMP)
(SETQ THISDATE (EVALMDTFN TEMP (QUOTE NEXTFROMDATEFN)
(COPY (GETPROP (QUOTE TODAY)
(QUOTE DATETIME]
(T (DATETIMEERROR 3 (QUOTE (* REQUEST TO FIND THIS, NEXT, OR LAST DATE OF A
NONCYCLIC DATETIME.]
(RETURN (SELECTQ $TOKEN
(NEXT (EVALMDTFN TEMP (QUOTE INCREMENT)
THISDATE))
(LAST (EVALMDTFN TEMP (QUOTE DECREMENT)
THISDATE))
(THIS THISDATE)
(SHOULDNT]
(PROGN (SETQ TEMP (PARSEDATETIME1))
(COND
[(type? MULTIPLEDATETIMES TEMP)
(RETURN (EVALMDTFN TEMP (QUOTE NEXTFROMDATEFN)
(SELECTQ (CAR CONTEXT)
(DATETIME CONTEXT)
(QULIFIEDDATETIME (fetch (QUALIFIEDDATETIME
DATETIME)
of CONTEXT))
(DURATION (fetch (DURATION STARTDATETIME)
of CONTEXT))
(COPY (GETPROP (QUOTE TODAY)
(QUOTE DATETIME]
(T (RETURN TEMP])
(PARSEOFFSETDATETIME
[LAMBDA NIL (* WTL: "26-DEC-78 22:19")
(PROG ((OFFSETUNIT (QUOTE DAY))
OFFSETNUM DEFAULTDATETIME THFLG RESULT INPASTFLG ENDDATETIME)
[COND
((NUMBERP (CAR TOKENLST))
(SETQ OFFSETNUM (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST))
(COND
((EQ (CAR TOKENLST)
(QUOTE TH))
(SETQ THFLG T)
(SETQ TOKENLST (CDR TOKENLST]
[COND
((FMEMB (CAR TOKENLST)
(QUOTE (MINUTE HOUR DAY MONTH YEAR WEEK)))
(SETQ OFFSETUNIT (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST)))
((type? MULTIPLEDATETIMES (GETPROP (CAR TOKENLST)
(QUOTE DATETIME)))
(SETQ OFFSETUNIT (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST]
(SETQ DEFAULTDATETIME (PARSEDATETIME2))
[COND
(DEFAULTDATETIME (SELECTQ (CAR DEFAULTDATETIME)
(DATETIME NIL)
(QUALIFIEDDATETIME (SETQ INPASTFLG (EQ (fetch (QUALIFIEDDATETIME
QUALIFIER)
of DEFAULTDATETIME)
(QUOTE BEFORE)))
(SETQ DEFAULTDATETIME (fetch (
QUALIFIEDDATETIME DATETIME) of DEFAULTDATETIME)))
(DURATION (SETQ ENDDATETIME (fetch (DURATION ENDDATETIME)
of DEFAULTDATETIME))
(SETQ DEFAULTDATETIME (fetch (DURATION STARTDATETIME)
of DEFAULTDATETIME)))
(DATETIMEERROR 12
"CANT HANDLE OFFSET DATETIMES WITH MULTIPLEDATETIME
AS DEFAULT")))
(T (RETURN (GETPROP OFFSETUNIT (QUOTE UNITMULTIPLEDATETIME]
[COND
[(GETPROP OFFSETUNIT (QUOTE WEEKDAYNUM))
[SETQ RESULT (EVALMDTFN (GETPROP OFFSETUNIT (QUOTE DATETIME))
(QUOTE NEXTFROMDATEFN)
(COPY (FINISHDATETIME DEFAULTDATETIME T]
(COND
(OFFSETNUM (SETQ RESULT (ADVANCEDATE RESULT (LIST (COND
(INPASTFLG OFFSETNUM)
(T (SUB1 OFFSETNUM)))
(QUOTE WEEK))
INPASTFLG]
[(type? MULTIPLEDATETIMES (GETPROP OFFSETUNIT (QUOTE DATETIME)))
[SETQ RESULT (EVALMDTFN (GETPROP OFFSETUNIT (QUOTE DATETIME))
(QUOTE NEXTFROMDATEFN)
(COPY (FINISHDATETIME DEFAULTDATETIME T]
(COND
(OFFSETNUM (for I from 1 to (SUB1 OFFSETNUM) do (SETQ RESULT
(EVALMDTFN (GETPROP OFFSETUNIT
(QUOTE DATETIME)
)
(QUOTE ADVANCEFN)
RESULT]
(T (SETQ RESULT (COND
(THFLG (EVALMDTFN (GETPROP OFFSETUNIT (QUOTE UNITMULTIPLEDATETIME))
(QUOTE NEXTFROMDATEFN)
DEFAULTDATETIME))
(T DEFAULTDATETIME)))
(COND
(OFFSETNUM (SETQ RESULT (ADVANCEDATE RESULT (LIST (COND
((OR (NULL THFLG)
INPASTFLG)
OFFSETNUM)
(T (SUB1 OFFSETNUM)))
OFFSETUNIT)
INPASTFLG]
(COND
((AND ENDDATETIME (DLESSP ENDDATETIME RESULT))
(DATETIMEERROR 13 "OFFSET DATETIME PARSED WITH RESULT OUTSIDE OF DURATION RANGE.")))
(RETURN RESULT])
(PARSEQUALIFIEDDATETIME
[LAMBDA NIL (* WTL: " 7-DEC-78 14:51")
(* PARSES A QUALIFIED DATETIME FROM TOKENLST ASSUMING A QUALIFIED DATETIME IS
KNOWN TO BE THERE.)
(PROG ((TOKEN (CAR TOKENLST))
ANS)
(SETQ TOKENLST (CDR TOKENLST))
(SELECTQ TOKEN
[AFTER (SETQ ANS (PARSEDATETIME2))
(COND
[(AND (EQ (CAR TOKENLST)
(QUOTE AND))
(EQ (CADR TOKENLST)
(QUOTE BEFORE)))
(SETQ TOKENLST (CDDR TOKENLST))
(RETURN (create DURATION
STARTDATETIME _ ANS
ENDDATETIME _(PARSEDATETIME2]
[(EQ (CAR TOKENLST)
(QUOTE TO))
(SETQ TOKENLST (CDR TOKENLST))
(RETURN (create DURATION
STARTDATETIME _ ANS
ENDDATETIME _(PARSEDATETIME2]
[(AND (type? QUALIFIEDDATETIME ANS)
(NEQ (fetch (QUALIFIEDDATETIME QUALIFIER) of ANS)
(QUOTE ABOUT)))
(DATETIMEERROR 7 (QUOTE (* ILLEGAL COMBINATION OF QUALIFIERS TO DATE.]
(T (RETURN (create QUALIFIEDDATETIME
QUALIFIER _(QUOTE AFTER)
DATETIME _ ANS]
[BEFORE (SETQ ANS (PARSEDATETIME2))
(COND
((AND (EQ (CAR TOKENLST)
(QUOTE AND))
(EQ (CADR TOKENLST)
(QUOTE BEFORE)))
(SETQ TOKENLST (CDDR TOKENLST))
(RETURN (create DURATION
STARTDATETIME _(PARSEDATETIME2)
ENDDATETIME _ ANS)))
[(AND (type? QUALIFIEDDATETIME ANS)
(NEQ (fetch (QUALIFIEDDATETIME QUALIFIER) of ANS)
(QUOTE ABOUT)))
(DATETIMEERROR 7 (QUOTE (* ILLEGAL COMBINATION OF QUALIFIERS TO DATE.]
(T (RETURN (create QUALIFIEDDATETIME
QUALIFIER _(QUOTE BEFORE)
DATETIME _ ANS]
(ABOUT (SETQ ANS (PARSEDATETIME2))
(COND
((AND (type? QUALIFIEDDATETIME ANS)
(EQ (QUOTE ABOUT)
(fetch (QUALIFIEDDATETIME QUALIFIER) of ANS)))
(RETURN ANS)))
[COND
((type? QUALIFIEDDATETIME ANS)
(DATETIMEERROR 7 (QUOTE (* ILLEGAL COMBINATION OF QUALIFIERS TO DATE.]
(RETURN (create QUALIFIEDDATETIME
QUALIFIER _(QUOTE ABOUT)
DATETIME _ ANS)))
[BETWEEN (SETQ ANS (PARSEDATETIME2))
[COND
((NEQ (CAR TOKENLST)
(QUOTE AND))
(DATETIMEERROR 8 (QUOTE (* "AND" EXPECTED HERE FOR DURATION.]
(SETQ TOKENLST (CDR TOKENLST))
(RETURN (create DURATION
STARTDATETIME _ ANS
ENDDATETIME _(PARSEDATETIME2]
(SHOULDNT])
(PARSESIMPLEDATE
[LAMBDA NIL (* WTL: "14-DEC-78 13:19")
(* PARSES A SIMPLE DATE OFF OF TOKENLST, ASSUMING THAT WE KNOW THAT THERE IS A
SIMPLE DATE THERE.)
(PROG (SIMPLEDATE NUM1 NUM2 MONTH)
[COND
((EQ (CAR TOKENLST)
(QUOTE IN))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((NUMBERP (CAR TOKENLST))
(SETQ NUM1 (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST)))
((SETQ MONTH (GETMONTHNUM (CAR TOKENLST)))
(SETQ TOKENLST (CDR TOKENLST)))
(T (DATETIMEERROR 5 (QUOTE (* MONTH OR DAY OF MONTH EXPECTED, BUT TOKEN CANNOT BE COERCED
TO EITHER ONE.]
[COND
((FMEMB (CAR TOKENLST)
(QUOTE (- ,)))
(SETQ TOKENLST (CDR TOKENLST]
[COND
[(NUMBERP (CAR TOKENLST))
(SETQ NUM2 (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST))
(COND
((AND MONTH (EQ (CAR TOKENLST)
(QUOTE TH)))
(SETQ TOKENLST (CDR TOKENLST]
(MONTH (RETURN (create DATETIME
MONTH _ MONTH)))
((SETQ MONTH (GETMONTHNUM (CAR TOKENLST)))
(SETQ TOKENLST (CDR TOKENLST)))
(T (DATETIMEERROR 5 (QUOTE (* MONTH OR DAY OF MONTH EXPECTED, BUT TOKEN CANNOT BE COERCED
TO EITHER ONE.]
[SETQ SIMPLEDATE (create DATETIME
MONTH _(OR MONTH NUM1)
DAYOFMONTH _(COND
[MONTH (OR NUM1 (COND
((AND NUM2 (ILESSP NUM2 33))
NUM2)
(T NIL]
(T NUM2))
YEAR _(COND
((AND MONTH NUM2 (IGREATERP NUM2 33))
(IREMAINDER NUM2 100]
[COND
((OR (EQ (CAR TOKENLST)
(QUOTE -))
(EQ (CAR TOKENLST)
(QUOTE ,)))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((NUMBERP (CAR TOKENLST))
(replace (DATETIME YEAR) of SIMPLEDATE with (IREMAINDER (CAR TOKENLST)
100))
(SETQ TOKENLST (CDR TOKENLST]
(RETURN SIMPLEDATE])
(PARSESIMPLETIME
[LAMBDA NIL (* WTL: "26-DEC-78 22:32")
(* ASSUMES THAT WE ALREADY KNOW THAT TOKENLST CONTAINS A SIMPLE TIME AND WILL
RETURN THE DATETIME RECORD FOR THAT TIME.)
(PROG (SIMPLETIME)
[COND
((EQ (CAR TOKENLST)
(QUOTE AT))
(SETQ TOKENLST (CDR TOKENLST]
[COND
[(NOT (NUMBERP (CAR TOKENLST)))
(DATETIMEERROR 11 (QUOTE (* NUMBER EXPECTED IN PARSING SIMPLETIME]
(T (SETQ SIMPLETIME (CREATEHOURDT (CAR TOKENLST)))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((EQ (CAR TOKENLST)
(QUOTE :))
(SETQ TOKENLST (CDR TOKENLST))
(COND
[(NOT (NUMBERP (CAR TOKENLST)))
(DATETIMEERROR 4 (QUOTE (* NUMBER EXPECTED AFTER COLON.]
(T (replace (DATETIME MINUTE) of SIMPLETIME with (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((EQ (CAR TOKENLST)
(QUOTE OCLOCK))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((OR (EQ (CAR TOKENLST)
(QUOTE AM))
(EQ (CAR TOKENLST)
(QUOTE PM)))
(replace (DATETIME AMORPM) of SIMPLETIME with (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST]
[COND
((FMEMB (CAR TOKENLST)
(QUOTE (EST PST MT CST HT)))
(replace (DATETIME TIMEZONE) of SIMPLETIME with (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST]
(RETURN SIMPLETIME])
(PARSESPECIALDURATION
[LAMBDA NIL (* WTL: "11-DEC-78 11:34")
(PROG (DURATIONTYPE SPECIFICDATETIME STARTDATETIME)
(SETQ DURATIONTYPE (CAR TOKENLST))
(SETQ TOKENLST (CDR TOKENLST))
(OR (EQ (CAR TOKENLST)
(QUOTE IN))
(RETURN (GETPROP DURATIONTYPE (QUOTE UNITMULTIPLEDATETIME)))
(* THIS IS FOR THINGS LIKE "NEXT MONTH")
)
(SETQ SPECIFICDATETIME (PARSEDATETIME1))
(RETURN (SELECTQ DURATIONTYPE
(HOUR (NOTIMP))
(MINUTE (NOTIMP))
(DAY (NOTIMP))
[MONTH (create DURATION
STARTDATETIME _[SETQ STARTDATETIME
(ADVANCEDATEUNTIL SPECIFICDATETIME (QUOTE (-1 DAY))
(QUOTE (ISFIRSTOFMONTH DATUM]
ENDDATETIME _(ADVANCEDATE (ADVANCEDATE STARTDATETIME -1)
(QUOTE MONTH]
[WEEK (create DURATION
STARTDATETIME _(ADVANCEDATEUNTIL SPECIFICDATETIME
(QUOTE (-1 DAY))
(QUOTE (ISSUNDAY DATUM)))
ENDDATETIME _(ADVANCEDATEUNTIL SPECIFICDATETIME
(QUOTE DAY)
(QUOTE (ISSATURDAY DATUM]
(YEAR (create DURATION
STARTDATETIME _[SETQ STARTDATETIME
(ADVANCEDATEUNTIL (ADVANCEDATEUNTIL SPECIFICDATETIME
(QUOTE (-1 MONTH))
(QUOTE (ISJANUARY
DATUM)))
(QUOTE (-1 DAY))
(QUOTE (ISFIRSTOFMONTH DATUM]
ENDDATETIME _(ADVANCEDATE (ADVANCEDATE STARTDATETIME
(QUOTE YEAR))
-1)))
(SHOULDNT])
(REPEATADVANCE
[LAMBDA (NUM EXPR) (* WTL: " 8-DEC-78 12:29")
(RPT NUM (QUOTE (SETQ DATUM (EVAL EXPR])
(RESETDATETIMES
[LAMBDA NIL (* edited: " 9-JAN-78 11:07")
(for DT in DATETIMEPROPS do (PUTPROP DT (QUOTE DATETIME)
(COND
[(type? DATETIME (GETPROP DT (QUOTE DATETIME)))
(create DATETIME using (GETPROP DT (QUOTE DATETIME]
[(type? MULTIPLEDATETIMES (GETPROP DT (QUOTE DATETIME)))
(create MULTIPLEDATETIMES using (GETPROP DT
(QUOTE DATETIME]
(T (SHOULDNT])
(RESTATE
[LAMBDA (INPUT) (* edited: " 5-JAN-78 10:45")
(* PARSES INPUT AND THEN CHANGES IT BACK TO A STRING. USEFUL FOR QUICKLY CHECKING WHETHER OR NOT THE
PARSING UNDERSTANDS SOME INPUT.)
(DATETIMETOSTRING (PARSEDATETIME INPUT])
(RESTRICTMULTIPLEDATETIME
[LAMBDA (MDT DT) (* WTL: " 8-DEC-78 11:37")
(create MULTIPLEDATETIMES
OCCURENCEPRED _(LIST (QUOTE AND)
(fetch (MULTIPLEDATETIMES OCCURENCEPRED) of MDT)
(CREATEOCCURENCEPRED DT))
NEXTFROMDATEFN _(LIST (QUOTE COMBINEDATETIMES)
(fetch (MULTIPLEDATETIMES NEXTFROMDATEFN) of MDT)
(KWOTE DT))
PRINTSTRING _ NIL using MDT])
(SETNOWDATETIME
[LAMBDA NIL (* edited: " 5-JAN-78 10:51")
(* FULLY SPECIFIES THE DATETIME FOR NOW (THIS INSTANCE.))
(* ASSUMES THE DATETIME FOR TODAY IS ALREADY CORRECT)
(PROG (NOWSTRING NOWHOUR NOWAMORPM)
(SETQ NOWSTRING (DATE))
(SETQ NOWHOUR (MKATOM (SUBSTRING NOWSTRING 11 12)))
[SETQ NOWAMORPM (COND
((ILESSP NOWHOUR 12)
(QUOTE AM))
((ILESSP NOWHOUR 24)
(QUOTE PM))
(T (QUOTE AM]
(SETQ NOWHOUR (IREMAINDER NOWHOUR 12))
(PUTPROP (QUOTE NOW)
(QUOTE DATETIME)
(create DATETIME
HOUR _ NOWHOUR
MINUTE _(MKATOM (SUBSTRING NOWSTRING 14 15))
AMORPM _ NOWAMORPM using (GETDATETIME (QUOTE TODAY])
(SETUPDAY
[LAMBDA NIL (* edited: "15-DEC-77 23:11")
(PUTPROP (QUOTE CHRISTMAS)
(QUOTE DATETIME)
(COPY (create MULTIPLEDATETIMES
OCCURENCEPRED _[QUOTE (AND (EQ 12 (FETCH (DATETIME MONTH) OF DATUM))
(EQ 25 (fetch (DATETIME DAYOFMONTH)
of DATUM]
ADVANCEFN _(QUOTE (ADVANCEDATE DATUM YEAR))
DECREMENTFN _(QUOTE (ADVANCEDATE DATUM (-1 YEAR)))
NEXTFROMDATEFN _[QUOTE (ADVANCEDATEUNTIL (ADVANCEDATEUNTIL
DATUM
(QUOTE (EQ 25
DATUM:DATETIME.DAYOFMONTH)))
(QUOTE (EQ 12
DATUM:DATETIME.MONTH]
PRINTSTRING _(CONCAT "EVERY " (QUOTE CHRISTMAS])
(SPELLPROPERLY
[LAMBDA (XWORD) (* WTL: "14-DEC-78 12:40" posted: "17-JAN-78 10:23")
(* SAME AS MISSPELLED? EXCEPT FIRES MISSPELLEDFN IF XWORD IS CORRECTED.)
(PROG (NEWWORD)
(SETQ NEWWORD (FIXSPELL XWORD NIL DATETIMESPLST (QUOTE NO-MESSAGE)))
(COND
((OR (NULL NEWWORD)
(EQ NEWWORD XWORD))
(RETURN XWORD)))
(COND
((GETD (QUOTE MISSPELLEDFN))
(MISSPELLEDFN XWORD NEWWORD)))
(RETURN NEWWORD])
(TRANSLATETIMEZONE
[LAMBDA (DATUM NEWTIMEZONE) (* WTL: "26-DEC-78 23:28")
(PROG ((OLDTIMEZONE (fetch (DATETIME TIMEZONE) of DATUM))
ADVANCEHOURS RESULT)
[SETQ ADVANCEHOURS (IDIFFERENCE (SELECTQ OLDTIMEZONE
(EST 0)
(CST 1)
(MT 2)
(PST 3)
(NIL 3)
(HT 5)
(SHOULDNT))
(SELECTQ NEWTIMEZONE
(EST 0)
(CST 1)
(MT 2)
(PST 3)
(NIL 3)
(HT 5)
(SHOULDNT]
[SETQ RESULT (ADVANCEDATE DATUM (LIST ADVANCEHOURS (QUOTE HOURS]
(replace (DATETIME TIMEZONE) of RESULT with NEWTIMEZONE)
(RETURN RESULT])
(UNITNEXTFROMDATEFN
[LAMBDA (DATUM UNIT) (* WTL: "17-JUL-78 12:18")
(PROG [ENDDATETIME (STARTDATETIME (FINISHDATETIME (COPY DATUM]
[COND
((EQ UNIT (QUOTE MINUTE))
(RETURN (create DURATION
STARTDATETIME _ STARTDATETIME
ENDDATETIME _(COPY STARTDATETIME]
(replace (DATETIME MINUTE) of STARTDATETIME with 1)
[COND
((EQ UNIT (QUOTE HOUR))
(RETURN (create DURATION
STARTDATETIME _ STARTDATETIME
ENDDATETIME _(ADVANCEDATE STARTDATETIME (QUOTE (59 MINUTE]
(replace (DATETIME MINUTE) of STARTDATETIME with NIL)
(replace (DATETIME HOUR) of STARTDATETIME with NIL)
(replace (DATETIME AMORPM) of STARTDATETIME with NIL)
(COND
((EQ UNIT (QUOTE DAY))
(RETURN STARTDATETIME)))
[COND
((EQ UNIT (QUOTE WEEK))
[SETQ ENDDATETIME (ADVANCEDATEUNTIL STARTDATETIME (QUOTE DAY)
(QUOTE (EQ (fetch (DATETIME DAYOFWEEK)
of DATUM)
7]
(RETURN (create DURATION
STARTDATETIME _(ADVANCEDATE ENDDATETIME (QUOTE (-6 DAY)))
ENDDATETIME _ ENDDATETIME]
(replace (DATETIME DAYOFMONTH) of STARTDATETIME with 1)
[COND
((EQ UNIT (QUOTE MONTH))
(RETURN (create DURATION
STARTDATETIME _ STARTDATETIME
ENDDATETIME _(ADVANCEDATE STARTDATETIME (QUOTE ((1 MONTH)
(-1 DAY]
(replace (DATETIME MONTH) of STARTDATETIME with 1)
[COND
((EQ UNIT (QUOTE YEAR))
(RETURN (create DURATION
STARTDATETIME _ STARTDATETIME
ENDDATETIME _(ADVANCEDATE STARTDATETIME (QUOTE ((1 YEAR)
(-1 DAY]
(SHOULDNT])
(UNITOCCURENCEPRED
[LAMBDA (DATUM UNIT) (* WTL: "17-JUL-78 10:58")
(AND (type? DURATION DATUM)
(PROG (STARTDATETIME ENDDATETIME)
[SETQ STARTDATETIME (FINISHDATETIME (COPY (fetch (DURATION STARTDATETIME)
of DATUM]
[SETQ ENDDATETIME (FINISHDATETIME (COPY (fetch (DURATION ENDDATETIME) of DATUM]
(RETURN (DEQUALP [ADVANCEDATE STARTDATETIME (LIST (LIST 1 UNIT)
(LIST -1 (SELECTQ
UNIT
(YEAR (QUOTE DAY))
(MONT (QUOTE DAY))
(DAYOFMONTH (QUOTE HOUT))
(DAYOFWEEK (QUOTE HOUR))
(HOUR (QUOTE MINUTE))
(MINUTE (QUOTE MINUTE))
(SHOULDNT]
ENDDATETIME
(SELECTQ UNIT
(YEAR (QUOTE DAY))
(MONTH (QUOTE DAY))
(DAYOFMONTH (QUOTE HOUR))
(DAYOFWEEK (QUOTE HOUR))
(HOUR (QUOTE MINUTE))
(MINUTE (QUOTE MINUTE))
(SHOULDNT])
)
(RPAQQ DATETIMEVARS (CURRENTERRORNUMBER DATETIMESPLST MULTIPLEWORDTOKENS TESTLST TODAYSTRING
XEROXHOLIDAYS (DATETIMEERRORFLG NIL)))
(RPAQQ CURRENTERRORNUMBER 16)
(RPAQQ DATETIMESPLST (TH TIME STANDARD EASTERN PACIFIC MOUNTAIN CENTRAL HAWAIIAN EST PST MT CST HT
HOLIDAYS XEROX EVERY JANUARY LAST TOMORROW NOON MIDNIGHT THURSDAY NIGHT
MORNING EVENING AFTERNOON CHRISTMAS OCLOCK AM PM ABOUT BEFORE AFTER AT NEXT
THIS BETWEEN AND IN NOW DAY PAYDAY , - : ; EVE WEEK MONTH YEAR HOUR MINUTE
NEW YEAR YEAR'S TUESDAY SUNDAY TODAY YESTERDAY SATURDAY FEBRUARY MARCH APRIL
MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER MONDAY WEDNESDAY
FRIDAY (JAN . JANUARY)
(FEB . FEBRUARY)
(MAR . MARCH)
(APR . APRIL)
(JUN . JUNE)
(JUL . JULY)
(AUG . AUGUST)
(SEPT . SEPTEMBER)
(SEP . SEPTEMBER)
(OCT . OCTOBER)
(NOV . NOVEMBER)
(DEC . DECEMBER)
(SUN . SUNDAY)
(MON . MONDAY)
(TUES . TUESDAY)
(WED . WEDNESDAY)
(THURS . THURSDAY)
(FRI . FRIDAY)
(SAT . SATURDAY)
(ZERO . 0)
(O . 0)
(ONE . 1)
(TWO . 2)
(THREE . 3)
(FOUR . 4)
(FIVE . 5)
(SIX . 6)
(SEVEN . 7)
(EIGHT . 8)
(NINE . 9)
(TEN . 10)
(ELEVEN . 11)
(TWELVE . 12)
(THIRTEEN . 13)
(FOURTEEN . 14)
(FIFTEEN . 15)
(SIXTEEN . 16)
(SEVENTEEN . 17)
(EIGHTEEN . 18)
(NINETEEN . 19)
(TWENTY 20 +)
(THIRTY 30 +)
(FORTY 40 +)
(FIFTY 50 +)
(SIXTY 60 +)
(SEVENTY 70 +)
(EIGHTY 80 +)
(NINETY 90 +)
(FIRST 1 TH)
(SECOND 2 TH)
(THIRD 3 TH)
(FOURTH 4 TH)
(FIFTH 5 TH)
(SIXTH 6 TH)
(SEVENTH 7 TH)
(EIHTH 8 TH)
(NINTH 9 TH)
(TENTH 10 TH)
(ELEVENTH 11 TH)
(TWELFTH 12 TH)
(THIRTEENTH 13 TH)
(FOURTEENTH 14 TH)
(FIFTEENTH 15 TH)
(SIXTEENTH 16 TH)
(SEVENTEENTH 17 TH)
(EIGHTEENTH 18 TH)
(NINETEENTH 19 TH)
(TWENTIETH 20 TH)
(THIRTIETH 30 TH)
(FORTIETH 40 TH)
(FIFTIETH 50 TH)
(SIXTIETH 60 TH)
(SEVENTIETH 70 TH)
(EIGHTIETH 80 TH)
(NINETIETH 90 TH)
(ST . TH)
(ND . TH)
(RD . TH)
(A . 1)
(AN . 1)
(@ . AT)
(~ . ABOUT)
(< . BEFORE)
(> . AFTER)
(HOURS . HOUR)
(HR . HOUR)
(HRS . HOUR)
(MINUTES . MINUTE)
(MIN . MINUTE)
(DAYS . DAY)
(MONTHS . MONTH)
(WEEKS . WEEK)
(WKS . WEEK)
(YEARS . YEAR)
(YRS . YEAR)
(YR . YEAR)
(AROUND . ABOUT)
(FROM . AFTER)
(O'CLOCK . OCLOCK)
(OF . IN)
(ON . IN)
(/ . -)
(%. . :)
(BUT . AND)
(EACH . EVERY)
(HOLIDAY . HOLIDAYS)))
(RPAQQ MULTIPLEWORDTOKENS [(CHRISTMAS (NIL . CHRISTMAS)
(DAY (NIL . CHRISTMAS))
(EVE (NIL . CHRISTMASEVE)))
[NEW (YEARS (NIL . NEWYEARS)
(DAY (NIL . NEWYEARS)))
(YEAR'S (NIL . NEWYEARS)
(DAY (NIL . NEWYEARS]
(XEROX (HOLIDAYS (NIL . XEROXHOLIDAYS))
(HOLIDAY'S (NIL . XEROXHOLIDAYS)))
[EASTERN (STANDARD (TIME (NIL . EST]
[PACIFIC (STANDARD (TIME (NIL . PST]
(MOUNTAIN (TIME (NIL . MT)))
[CENTRAL (STANDARD (TIME (NIL . CST]
(HAWAIIAN (TIME (NIL . HT])
(RPAQQ TESTLST ("TODAY" "TOMORROW" "YESTERDAY" "NOW" "CHRISTMAS" "FRIDAY" "LAST FRIDAY" "NEXT FRIDAY"
"AROUND 9:00PM"
"BEFORE 1" "JUNE 23" "WEDNESDAY, WEEK OF AUGUST 5" "SUNDAY, WEEK OF AUGUST 5"
"THE FIRST WEDNESDAY OF NEXT MONTH"
"THE THIRD TUESDAY AFTER THE FIRST MONDAY IN NOVEMBER"
"THE FOURTH OF JULY, NEXT YEAR"
"WEDNESDAY, FROM 2:30 TO 3:30" "EVERY WEDNESDAY, FROM 2:30 TO 3:30"
"EVERY WEDNESDAY, BEFORE 2:00"
"EVERY THREE MINUTES" "DEC 3 78" "DEC 3, 78" "3 DEC 78" "3 DEC, 78"
"DEC 3, 78 14:28"
"3 DEC 78, 14:28" "3 DEC 78 14:28" "DEC 3 78 14:28" "DEC 3, 1978 AT 14:28"
"THE FIRST XEROX HOLIDAY IN NOVEMBER"
"THE THIRD XEROX HOLIDAY AFTER JULY 1" "10:00 EASTERN STANDARD TIME"))
(RPAQQ TODAYSTRING " 8-Jan-80")
(RPAQQ XEROXHOLIDAYS ((DATETIME 78 12 25 NIL NIL NIL NIL NIL)
(DATETIME 78 12 26 NIL NIL NIL NIL NIL)
(DATETIME 79 1 1 NIL NIL NIL NIL NIL)
(DATETIME 79 4 13 NIL NIL NIL NIL NIL)
(DATETIME 79 5 28 NIL NIL NIL NIL NIL)
(DATETIME 79 7 4 NIL NIL NIL NIL NIL)
(DATETIME 79 8 31 NIL NIL NIL NIL NIL)
(DATETIME 79 9 3 NIL NIL NIL NIL NIL)
(DATETIME 79 11 22 NIL NIL NIL NIL NIL)
(DATETIME 79 11 23 NIL NIL NIL NIL NIL)
(DATETIME 79 12 24 NIL NIL NIL NIL NIL)
(DATETIME 79 12 25 NIL NIL NIL NIL NIL)
(DATETIME 79 12 31 NIL NIL NIL NIL NIL)))
(RPAQ DATETIMEERRORFLG NIL)
(SETQ DTRDTBL (COPYREADTABLE T))
(SETBRK (QUOTE (%| % @ ~ - ; : / %. , > < 48 49 50 51 52 53 54 55 56 57))
1 DTRDTBL)
(SETQ DATETIMEDEBUGFLG NIL)
(LOAD? (QUOTE <LISPUSERS>DATETIMERECORDS)
LDFLG)
(RPAQQ DATETIMEPROPS (TODAY TOMORROW YESTERDAY SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY
SATURDAY NEWYEARS CHRISTMAS PAYDAY NOON MIDNIGHT XEROXHOLIDAYS))
(PUTPROPS TODAY DATETIME (DATETIME 80 1 8 3 NIL NIL NIL NIL NIL))
(PUTPROPS TOMORROW DATETIME (DATETIME 80 1 9 4 NIL NIL NIL NIL NIL))
(PUTPROPS YESTERDAY DATETIME (DATETIME 80 1 7 2 NIL NIL NIL NIL NIL))
(PUTPROPS SUNDAY DATETIME (MULTIPLEDATETIMES (EQ 1 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
[ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 1 (fetch (DATETIME
DAYOFWEEK)
of DATUM]
"every Sunday"))
(PUTPROPS MONDAY DATETIME (MULTIPLEDATETIMES (EQ 2 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
[ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 2 (fetch (DATETIME
DAYOFWEEK)
of DATUM]
"every Monday"))
(PUTPROPS TUESDAY DATETIME (MULTIPLEDATETIMES (EQ 3 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
[ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 3 (fetch (DATETIME
DAYOFWEEK)
of DATUM]
"every Tuesday"))
(PUTPROPS WEDNESDAY DATETIME (MULTIPLEDATETIMES (EQ 4 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
[ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 4 (fetch (DATETIME
DAYOFWEEK)
of DATUM]
"every Wednesday"))
(PUTPROPS THURSDAY DATETIME (MULTIPLEDATETIMES (EQ 5 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
[ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 5 (fetch (DATETIME
DAYOFWEEK)
of DATUM]
"every Thursday"))
(PUTPROPS FRIDAY DATETIME (MULTIPLEDATETIMES (EQ 6 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
[ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 6 (fetch (DATETIME
DAYOFWEEK)
of DATUM]
"every Friday"))
(PUTPROPS SATURDAY DATETIME (MULTIPLEDATETIMES (EQ 7 (fetch (DATETIME DAYOFWEEK)
of DATUM))
(ADVANCEDATE DATUM 7)
(ADVANCEDATE DATUM -7)
(ADVANCEDATEUNTIL (ADVANCEDATE DATUM)
1
(QUOTE (EQ 7
DATUM:DATETIME.DAYOFWEEK)))
"every Saturday"))
(PUTPROPS NEWYEARS DATETIME (MULTIPLEDATETIMES (AND (EQ 1 (FETCH (DATETIME MONTH)
OF DATUM))
(EQ 1 (fetch (DATETIME DAYOFMONTH)
of DATUM)))
(ADVANCEDATE DATUM YEAR)
(ADVANCEDATE DATUM (-1 YEAR))
(ADVANCEDATEUNTIL (ADVANCEDATEUNTIL
(ADVANCEDATE DATUM)
(QUOTE DAY)
(QUOTE (EQ 1
DATUM:DATETIME.DAYOFMONTH)))
(QUOTE MONTH)
(QUOTE (EQ 1 DATUM:DATETIME.MONTH)))
"every Newyears"))
(PUTPROPS CHRISTMAS DATETIME (MULTIPLEDATETIMES (AND (EQ 12 (FETCH (DATETIME MONTH)
OF DATUM))
(EQ 25 (fetch (DATETIME DAYOFMONTH)
of DATUM)))
(ADVANCEDATE DATUM YEAR)
(ADVANCEDATE DATUM (-1 YEAR))
[ADVANCEDATEUNTIL
[ADVANCEDATEUNTIL
(ADVANCEDATE DATUM)
(QUOTE DAY)
(QUOTE (EQ 25 (fetch (DATETIME DAYOFMONTH)
of DATUM]
(QUOTE MONTH)
(QUOTE (EQ 12 (fetch (DATETIME MONTH)
of DATUM]
"every Christmas"))
(PUTPROPS PAYDAY DATETIME (MULTIPLEDATETIMES NIL NIL NIL NIL "every payday"))
(PUTPROPS NOON DATETIME (DATETIME NIL NIL NIL NIL 0 NIL PM))
(PUTPROPS MIDNIGHT DATETIME (DATETIME NIL NIL NIL NIL 0 NIL AM))
(PUTPROPS XEROXHOLIDAYS DATETIME (MULTIPLEDATETIMES (ISXEROXHOLIDAY DATUM (QUOTE ?))
(ISXEROXHOLIDAY DATUM (QUOTE ADVANCEFN))
(ISXEROXHOLIDAY DATUM (QUOTE DECREMENTFN))
(ISXEROXHOLIDAY DATUM (QUOTE NEXTFN))
"EVERY XEROX HOLIDAY"))
(PUTPROPS YEAR UNITMULTIPLEDATETIME (MULTIPLEDATETIMES (UNITOCCURENCEPRED DATUM (QUOTE YEAR))
(ADVANCEDATE DATUM (QUOTE YEAR))
(ADVANCE DATUM (QUOTE (-1 YEAR)))
(UNITNEXTFROMDATEFN DATUM (QUOTE YEAR))
"EVERY YEAR"))
(PUTPROPS MONTH UNITMULTIPLEDATETIME (MULTIPLEDATETIMES (UNITOCCURENCEPRED DATUM (QUOTE MONTH))
(ADVANCEDATE DATUM (QUOTE MONTH))
(ADVANCE DATUM (QUOTE (-1 MONTH)))
(UNITNEXTFROMDATEFN DATUM (QUOTE MONTH))
"EVERY MONTH"))
(PUTPROPS WEEK UNITMULTIPLEDATETIME (MULTIPLEDATETIMES (UNITOCCURENCEPRED DATUM (QUOTE WEEK))
(ADVANCEDATE DATUM (QUOTE WEEK))
(ADVANCE DATUM (QUOTE (-1 WEEK)))
(UNITNEXTFROMDATEFN DATUM (QUOTE WEEK))
"EVERY WEEK"))
(PUTPROPS DAY UNITMULTIPLEDATETIME (MULTIPLEDATETIMES (UNITOCCURENCEPRED DATUM (QUOTE DAY))
(ADVANCEDATE DATUM (QUOTE DAY))
(ADVANCE DATUM (QUOTE (-1 DAY)))
(UNITNEXTFROMDATEFN DATUM (QUOTE DAY))
"EVERY DAY"))
(PUTPROPS HOUR UNITMULTIPLEDATETIME (MULTIPLEDATETIMES (UNITOCCURENCEPRED DATUM (QUOTE HOUR))
(ADVANCEDATE DATUM (QUOTE HOUR))
(ADVANCE DATUM (QUOTE (-1 HOUR)))
(UNITNEXTFROMDATEFN DATUM (QUOTE HOUR))
"EVERY HOUR"))
(PUTPROPS MINUTE UNITMULTIPLEDATETIME (MULTIPLEDATETIMES (UNITOCCURENCEPRED DATUM (QUOTE MINUTE))
(ADVANCEDATE DATUM (QUOTE MINUTE))
(ADVANCE DATUM (QUOTE (-1 MINUTE)))
(UNITNEXTFROMDATEFN DATUM (QUOTE MINUTE))
"EVERY MINUTE"))
(PUTPROPS JANUARY MONTHNUM 1)
(PUTPROPS FEBRUARY MONTHNUM 2)
(PUTPROPS MARCH MONTHNUM 3)
(PUTPROPS APRIL MONTHNUM 4)
(PUTPROPS MAY MONTHNUM 5)
(PUTPROPS JUNE MONTHNUM 6)
(PUTPROPS JULY MONTHNUM 7)
(PUTPROPS AUGUST MONTHNUM 8)
(PUTPROPS SEPTEMBER MONTHNUM 9)
(PUTPROPS OCTOBER MONTHNUM 10)
(PUTPROPS NOVEMBER MONTHNUM 11)
(PUTPROPS DECEMBER MONTHNUM 12)
(PUTPROPS SUNDAY WEEKDAYNUM 1)
(PUTPROPS MONDAY WEEKDAYNUM 2)
(PUTPROPS TUESDAY WEEKDAYNUM 3)
(PUTPROPS WEDNESDAY WEEKDAYNUM 4)
(PUTPROPS THURSDAY WEEKDAYNUM 5)
(PUTPROPS FRIDAY WEEKDAYNUM 6)
(PUTPROPS SATURDAY WEEKDAYNUM 7)
(RPAQQ DATETIMEARRAY (MONTHNAME NUMOFDAYSINMONTH WEEKDAYNAME))
(SETQ MONTHNAME (READARRAY 12 0))
(JANUARY
FEBRUARY
MARCH
APRIL
MAY
JUNE
JULY
AUGUST
SEPTEMBER
OCTOBER
NOVEMBER
DECEMBER
NIL
)(SETQ NUMOFDAYSINMONTH (READARRAY 12 0))
(31
28
31
30
31
30
31
31
30
31
30
31
T
31
31
31
31
31
31
31
31
31
31
31
31
)(SETQ WEEKDAYNAME (READARRAY 7 0))
(SUNDAY
MONDAY
TUESDAY
WEDNESDAY
THURSDAY
FRIDAY
SATURDAY
NIL
)
(RPAQQ DATETIMERECORDS (DATETIME DATETIMEERROR DURATION MULTIPLEDATETIMES NUMERAL QUALIFIEDDATETIME))
[DECLARE: EVAL@COMPILE
(TYPERECORD DATETIME (YEAR MONTH DAYOFMONTH DAYOFWEEK HOUR MINUTE AMORPM PRINTSTRING TIMEZONE))
(TYPERECORD DATETIMEERROR (ERRORNUMBER MESSAGE ORIGINALTOKENLST CURRENTTOKENLST)
CURRENTTOKENLST _ TOKENLST)
(TYPERECORD DURATION (STARTDATETIME ENDDATETIME PRINTSTRING))
(TYPERECORD MULTIPLEDATETIMES (OCCURENCEPRED ADVANCEFN DECREMENTFN NEXTFROMDATEFN PRINTSTRING))
(TYPERECORD NUMERAL (VALUE))
(TYPERECORD QUALIFIEDDATETIME (QUALIFIER DATETIME PRINTSTRING))
]
(RPAQQ DATETIMEBLOCKS ((DATETIME ADDMULTIWORDTOKEN ADVANCEDATE ADVANCEDATEUNTIL CHECKTODAY
COMBINEDATETIMES CREATEHOURDT CREATEOCCURENCEPRED DATETIMEERROR
DATETIMETOSTRING DEQUALP DLESSP EVALMDTFN EXPANDINPUT FINISHDATETIME
GETDATETIME GETDAYOFWEEK GETMONTHNUM GETNUMOFDAYSINMONTH
ISFIRSTOFMONTH ISJANUARY ISSATURDAY ISSUNDAY ISXEROXHOLIDAY
LISTDATES MULTIWORDTOKEN NOTIMP ONLYTIMESPECIFIED PARSEDATETIME
PARSEDATETIME1 PARSEDATETIME2 PARSEOFFSETDATETIME
PARSEQUALIFIEDDATETIME PARSESIMPLEDATE PARSESIMPLETIME
PARSESPECIALDURATION REPEATADVANCE RESETDATETIMES RESTATE
RESTRICTMULTIPLEDATETIME SETNOWDATETIME SETUPDAY SPELLPROPERLY
TRANSLATETIMEZONE UNITNEXTFROMDATEFN UNITOCCURENCEPRED
(ENTRIES ADDMULTIWORDTOKEN ADVANCEDATE ADVANCEDATEUNTIL CHECKTODAY
COMBINEDATETIMES CREATEHOURDT CREATEOCCURENCEPRED
DATETIMETOSTRING DEQUALP DLESSP EVALMDTFN FINISHDATETIME
GETDATETIME GETDAYOFWEEK GETMONTHNUM GETNUMOFDAYSINMONTH
ISFIRSTOFMONTH ISJANUARY ISSATURDAY ISSUNDAY ISXEROXHOLIDAY
LISTDATES MULTIWORDTOKEN ONLYTIMESPECIFIED PARSEDATETIME
REPEATADVANCE RESETDATETIMES RESTATE
RESTRICTMULTIPLEDATETIME SETNOWDATETIME SETUPDAY
SPELLPROPERLY TRANSLATETIMEZONE UNITNEXTFROMDATEFN
UNITOCCURENCEPRED)
(SPECVARS DATUM)
(GLOBALVARS CURRENTERRORNUMBER DATETIMESPLST MULTIPLEWORDTOKENS
TODAYSTRING DATETIMEERRORFLG XEROXHOLIDAYS)
(LOCALFREEVARS TOKENLST DATETIMEERROR TOKEN)
(NOLINKFNS . T))))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: DATETIME ADDMULTIWORDTOKEN ADVANCEDATE ADVANCEDATEUNTIL CHECKTODAY COMBINEDATETIMES
CREATEHOURDT CREATEOCCURENCEPRED DATETIMEERROR DATETIMETOSTRING DEQUALP DLESSP EVALMDTFN
EXPANDINPUT FINISHDATETIME GETDATETIME GETDAYOFWEEK GETMONTHNUM GETNUMOFDAYSINMONTH
ISFIRSTOFMONTH ISJANUARY ISSATURDAY ISSUNDAY ISXEROXHOLIDAY LISTDATES MULTIWORDTOKEN NOTIMP
ONLYTIMESPECIFIED PARSEDATETIME PARSEDATETIME1 PARSEDATETIME2 PARSEOFFSETDATETIME
PARSEQUALIFIEDDATETIME PARSESIMPLEDATE PARSESIMPLETIME PARSESPECIALDURATION REPEATADVANCE
RESETDATETIMES RESTATE RESTRICTMULTIPLEDATETIME SETNOWDATETIME SETUPDAY SPELLPROPERLY
TRANSLATETIMEZONE UNITNEXTFROMDATEFN UNITOCCURENCEPRED
(ENTRIES ADDMULTIWORDTOKEN ADVANCEDATE ADVANCEDATEUNTIL CHECKTODAY COMBINEDATETIMES
CREATEHOURDT CREATEOCCURENCEPRED DATETIMETOSTRING DEQUALP DLESSP EVALMDTFN
FINISHDATETIME GETDATETIME GETDAYOFWEEK GETMONTHNUM GETNUMOFDAYSINMONTH
ISFIRSTOFMONTH ISJANUARY ISSATURDAY ISSUNDAY ISXEROXHOLIDAY LISTDATES MULTIWORDTOKEN
ONLYTIMESPECIFIED PARSEDATETIME REPEATADVANCE RESETDATETIMES RESTATE
RESTRICTMULTIPLEDATETIME SETNOWDATETIME SETUPDAY SPELLPROPERLY TRANSLATETIMEZONE
UNITNEXTFROMDATEFN UNITOCCURENCEPRED)
(SPECVARS DATUM)
(GLOBALVARS CURRENTERRORNUMBER DATETIMESPLST MULTIPLEWORDTOKENS TODAYSTRING DATETIMEERRORFLG
XEROXHOLIDAYS)
(LOCALFREEVARS TOKENLST DATETIMEERROR TOKEN)
(NOLINKFNS . T))
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (2299 66768 (ADDMULTIWORDTOKEN 2311 . 3321) (ADVANCEDATE 3325 . 10251) (ADVANCEDATEUNTIL
10255 . 11324) (CHECKTODAY 11328 . 12954) (COMBINEDATETIMES 12958 . 17326) (CREATEHOURDT 17330 .
17804) (CREATEOCCURENCEPRED 17808 . 17925) (DATETIMEERROR 17929 . 18300) (DATETIMETOSTRING 18304 .
21134) (DEQUALP 21138 . 23876) (DLESSP 23880 . 27336) (EVALMDTFN 27340 . 28433) (EXPANDINPUT 28437 .
31043) (FINISHDATETIME 31047 . 35725) (GETDATETIME 35729 . 36290) (GETDAYOFWEEK 36294 . 36785) (
GETMONTHNUM 36789 . 37261) (GETNUMOFDAYSINMONTH 37265 . 37831) (ISFIRSTOFMONTH 37835 . 38021) (
ISJANUARY 38025 . 38201) (ISSATURDAY 38205 . 38394) (ISSUNDAY 38398 . 38585) (ISXEROXHOLIDAY 38589 .
39272) (LISTDATES 39276 . 40938) (MULTIWORDTOKEN 40942 . 41750) (NOTIMP 41754 . 41834) (
ONLYTIMESPECIFIED 41838 . 42492) (PARSEDATETIME 42496 . 43312) (PARSEDATETIME1 43316 . 44863) (
PARSEDATETIME2 44867 . 48497) (PARSEOFFSETDATETIME 48501 . 51649) (PARSEQUALIFIEDDATETIME 51653 .
54372) (PARSESIMPLEDATE 54376 . 56427) (PARSESIMPLETIME 56431 . 57943) (PARSESPECIALDURATION 57947 .
59652) (REPEATADVANCE 59656 . 59787) (RESETDATETIMES 59791 . 60290) (RESTATE 60294 . 60599) (
RESTRICTMULTIPLEDATETIME 60603 . 61049) (SETNOWDATETIME 61053 . 61890) (SETUPDAY 61894 . 62638) (
SPELLPROPERLY 62642 . 63179) (TRANSLATETIMEZONE 63183 . 63905) (UNITNEXTFROMDATEFN 63909 . 65799) (
UNITOCCURENCEPRED 65803 . 66765)))))
STOP