From f8a5d0fbe526708b9d98e265ef0f34b75fe01465 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Tue, 16 May 2023 19:00:49 -0700 Subject: [PATCH] Rewrite code for deciding 'Good morning', 'Good evening' 'You're working late' Y2K (#1208) --- sources/HIST | 178 +++++++++++++++++++++++----------------------- sources/HIST.LCOM | Bin 44348 -> 44410 bytes 2 files changed, 88 insertions(+), 90 deletions(-) diff --git a/sources/HIST b/sources/HIST index e0ce6fb4..3e3c147a 100644 --- a/sources/HIST +++ b/sources/HIST @@ -1,16 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "10-Jul-91 12:07:43" |{PELE:MV:ENVOS}SOURCES>HIST.;3| 152184 - |changes| |to:| (VARS HISTCOMS) +(FILECREATED "19-Apr-2023 18:58:13" |{DSK}larry>il>medley>sources>HIST.;6| 152088 - |previous| |date:| "16-May-90 18:10:04" |{PELE:MV:ENVOS}SOURCES>HIST.;2|) + :EDIT-BY "lmm" + :CHANGES-TO (FNS GREET0) + + :PREVIOUS-DATE "19-Mar-2023 10:09:08" |{DSK}larry>il>medley>sources>HIST.;1|) -; Copyright (c) 1978, 1984, 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved. -; The following program was created in 1978 but has not been published -; within the meaning of the copyright law, is furnished under license, -; and may not be used, copied and/or disclosed except in accordance -; with the terms of said license. (PRETTYCOMPRINT HISTCOMS) @@ -2527,7 +2524,7 @@ this sysout is initialized for user " T) ) (ADDTOVAR SYSTEMINITVARS (LISPXHISTORY NIL 0 100 100) - (GREETHIST)) + (GREETHIST)) (DECLARE\: DONTEVAL@LOAD DOCOPY (RPAQQ \#REDOCNT 3) @@ -2656,8 +2653,8 @@ this sysout is initialized for user " T) (ADDTOVAR HISTORYSAVEFORMS ) -(ADDTOVAR LISPXCOMS  |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix| |forget| - |name| |redo| |repeat| |retry| |undo| |use|) +(ADDTOVAR LISPXCOMS  |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix| |forget| + |name| |redo| |repeat| |retry| |undo| |use|) (ADDTOVAR SYSTATS (LISPXSTATS LISPX INPUTS) @@ -2703,27 +2700,27 @@ this sysout is initialized for user " T) (ADDTOVAR NOCLEARSTKLST ) (APPENDTOVAR AFTERSYSOUTFORMS (COND ((LISTP SYSOUTGAG) - (EVAL SYSOUTGAG)) - (SYSOUTGAG) - ((OR (NULL USERNAME) - (EQ USERNAME (USERNAME NIL T))) - (TERPRI T) - (PRIN1 HERALDSTRING T) - (TERPRI T) - (TERPRI T) - (GREET0) - (TERPRI T)) - (T (LISPXPRIN1 '"****ATTENTION USER " T) - (LISPXPRIN1 (USERNAME) - T) - (LISPXPRIN1 '": + (EVAL SYSOUTGAG)) + (SYSOUTGAG) + ((OR (NULL USERNAME) + (EQ USERNAME (USERNAME NIL T))) + (TERPRI T) + (PRIN1 HERALDSTRING T) + (TERPRI T) + (TERPRI T) + (GREET0) + (TERPRI T)) + (T (LISPXPRIN1 '"****ATTENTION USER " T) + (LISPXPRIN1 (USERNAME) + T) + (LISPXPRIN1 '": this sysout is initialized for user " T) - (LISPXPRIN1 USERNAME T) - (LISPXPRIN1 '". + (LISPXPRIN1 USERNAME T) + (LISPXPRIN1 '". " T) - (LISPXPRIN1 '"To reinitialize, type GREET() + (LISPXPRIN1 '"To reinitialize, type GREET() " T))) - (SETINITIALS)) + (SETINITIALS)) (MAPC SYSTATS (FUNCTION (LAMBDA (X) (AND (LISTP X) @@ -2756,46 +2753,48 @@ this sysout is initialized for user " T) (return t))) (printout t "error during GREET..." t)))) -(greet0 - (lambda nil (* |lmm| "28-DEC-82 08:49") - (cond - (greetdates - (lispxprin1 - (prog ((date (date)) - hour tem digit) - (return (or (and (fixp (setq digit (nthchar date -1))) - (or (and (evenp (lrsh digit 1)) - (stringp (setq tem - (cdr (sassoc (u-case (substring date 1 6)) - greetdates))))) - (and (evenp digit) - (fixp (setq hour (subatom date 11 12))) - (cond - ((and firstname (ilessp hour 6)) +(GREET0 + (LAMBDA NIL (* \; "Edited 19-Apr-2023 18:55 by lmm") + (* \; "Edited 19-Mar-2023 09:58 by lmm") + (* |lmm| "28-DEC-82 08:49") + (COND + (GREETDATES (LISPXPRIN1 (CL:MULTIPLE-VALUE-BIND + (SECONDS MINUTES HOUR DAY MONTH YEAR) + (CL:GET-DECODED-TIME) + (OR (AND (EVENP (LRSH SECONDS 1)) + (CDR (SASSOC (CL:FORMAT NIL "~2D-~A" DAY + (CL:NTH MONTH + '("JAN" "FEB" "MAR" "APR" "MAY" + "JUN" "JUL" "AUG" "SEP" + "OCT" "NOV" "DEC"))) + GREETDATES))) + (AND (EVENP SECONDS) + (COND + ((AND FIRSTNAME (ILESSP HOUR 6)) '"You're working late tonight") - ((ilessp hour 12) + ((ILESSP HOUR 12) '"Good morning") - ((ilessp hour 18) + ((ILESSP HOUR 18) '"Good afternoon") - (t '"Good evening"))) - (and (evenp digit 3) - "Hello"))) - '"Hi"))) - t) - (cond - (firstname (lispxprin1 '", " t) - (lispxprin1 firstname t))) - (lispxprin1 "." t) - (lispxterpri t))))) + (T '"Good evening"))) + (AND (EVENP SECONDS 3) + "Hello") + '"Hi")) + T) + (COND + (FIRSTNAME (LISPXPRIN1 '", " T) + (LISPXPRIN1 FIRSTNAME T))) + (LISPXPRIN1 "." T) + (LISPXTERPRI T))))) ) (ADDTOVAR PREGREETFORMS (DREMOVE GREETFORM RESETFORMS) - (SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0))) - (SETQ CONSOLETIME0 (CLOCK 0)) - (SETQ CPUTIME0 (CLOCK 2))) + (SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0))) + (SETQ CONSOLETIME0 (CLOCK 0)) + (SETQ CPUTIME0 (CLOCK 2))) (ADDTOVAR POSTGREETFORMS (SETINITIALS) - (AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS))) + (AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS))) (DECLARE\: DONTEVAL@LOAD DOCOPY (RPAQQ GREETHIST NIL) @@ -2803,21 +2802,21 @@ this sysout is initialized for user " T) (RPAQQ SYSTEMTYPE NIL) (RPAQQ GREETFORM (LISPXEVAL '(GREET) - '_)) + '_)) (RPAQQ CUTEFLG NIL) (RPAQQ GREETDATES ((" 1-JAN" . "Happy new year") - ("12-FEB" . "Happy Lincoln's birthday") - ("14-FEB" . "Happy Valentine's day") - ("22-FEB" . "Happy Washington's birthday") - ("15-MAR" . "Beware the Ides of March") - ("17-MAR" . "Happy St. Patrick's day") - ("18-MAY" . "It's Victoria Day") - (" 1-JUL" . "It's Canada Day") - ("31-OCT" . "Trick or Treat") - (" 5-NOV" . " it's Guy Fawkes day") - ("25-DEC" . "Merry Christmas"))) + ("12-FEB" . "Happy Lincoln's birthday") + ("14-FEB" . "Happy Valentine's day") + ("22-FEB" . "Happy Washington's birthday") + ("15-MAR" . "Beware the Ides of March") + ("17-MAR" . "Happy St. Patrick's day") + ("18-MAY" . "It's Victoria Day") + (" 1-JUL" . "It's Canada Day") + ("31-OCT" . "Trick or Treat") + (" 5-NOV" . " it's Guy Fawkes day") + ("25-DEC" . "Merry Christmas"))) (RPAQQ USERNAME NIL) @@ -2837,11 +2836,11 @@ this sysout is initialized for user " T) (ADDTOVAR BEFOREMAKESYSFORMS (SETQ RESETFORMS (CONS GREETFORM RESETFORMS)) - (SETQ MAKESYSDATE (DATE))) + (SETQ MAKESYSDATE (DATE))) (ADDTOVAR AFTERMAKESYSFORMS (LISPXEVAL '(GREET) - '_)) + '_)) ) (DEFINEQ @@ -3038,21 +3037,20 @@ this sysout is initialized for user " T) (ADDTOVAR LAMA ) ) -(PUTPROPS HIST COPYRIGHT ("Venue & Xerox Corporation" T 1978 1984 1985 1986 1987 1988 1990 1991)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (14585 21330 (PRINTHISTORY 14595 . 16385) (ENTRY# 16387 . 16722) (PRINTHISTORY1 16724 . -19893) (PRINTHISTORY2 19895 . 21328)) (21331 129761 (EVALQT 21341 . 22141) (ENTEREVALQT 22143 . 22698) - (USEREXEC 22700 . 23335) (LISPXREAD 23337 . 25140) (LISPXREADBUF 25142 . 27368) (LISPXREADP 27370 . -27919) (LISPXUNREAD 27921 . 28214) (LISPX 28216 . 63911) (LISPX/ 63913 . 65367) (LISPX/1 65369 . 70655 -) (LISPXEVAL 70657 . 71281) (LISPXSTOREVALUE 71283 . 71537) (HISTORYSAVE 71539 . 78823) (LISPXFIND -78825 . 86260) (LISPXGETINPUT 86262 . 86475) (REMEMBER 86477 . 86671) (GETEXPRESSIONFROMEVENTSPEC -86673 . 88783) (LISPXFIND0 88785 . 93059) (LISPXFIND1 93061 . 93489) (HISTORYFIND 93491 . 99065) ( -HISTORYFIND1 99067 . 102512) (HISTORYMATCH 102514 . 102589) (VALUEOF 102591 . 103616) (VALUOF 103618 - . 104508) (VALUOF-EVENT 104510 . 104915) (LISPXUSE 104917 . 111336) (LISPXUSE0 111338 . 114064) ( -LISPXUSE1 114066 . 115691) (LISPXSUBST 115693 . 116113) (LISPXUSEC 116115 . 124356) (LISPXFIX 124358 - . 125208) (CHANGESLICE 125210 . 127057) (LISPXSTATE 127059 . 128153) (LISPXTYPEAHEAD 128155 . 129759) -) (137892 140620 (GREET 137902 . 139043) (GREET0 139045 . 140618)) (142290 149466 (LISPXPRINT 142300 - . 142864) (LISPXPRIN1 142866 . 143750) (LISPXPRIN2 143752 . 144694) (LISPXPRINTDEF 144696 . 145250) ( -LISPXPRINTDEF0 145252 . 145615) (LISPXSPACES 145617 . 146303) (LISPXTERPRI 146305 . 146930) (LISPXTAB -146932 . 147490) (USERLISPXPRINT 147492 . 148892) (LISPXPUT 148894 . 149464))))) + (FILEMAP (NIL (14244 20989 (PRINTHISTORY 14254 . 16044) (ENTRY# 16046 . 16381) (PRINTHISTORY1 16383 . +19552) (PRINTHISTORY2 19554 . 20987)) (20990 129420 (EVALQT 21000 . 21800) (ENTEREVALQT 21802 . 22357) + (USEREXEC 22359 . 22994) (LISPXREAD 22996 . 24799) (LISPXREADBUF 24801 . 27027) (LISPXREADP 27029 . +27578) (LISPXUNREAD 27580 . 27873) (LISPX 27875 . 63570) (LISPX/ 63572 . 65026) (LISPX/1 65028 . 70314 +) (LISPXEVAL 70316 . 70940) (LISPXSTOREVALUE 70942 . 71196) (HISTORYSAVE 71198 . 78482) (LISPXFIND +78484 . 85919) (LISPXGETINPUT 85921 . 86134) (REMEMBER 86136 . 86330) (GETEXPRESSIONFROMEVENTSPEC +86332 . 88442) (LISPXFIND0 88444 . 92718) (LISPXFIND1 92720 . 93148) (HISTORYFIND 93150 . 98724) ( +HISTORYFIND1 98726 . 102171) (HISTORYMATCH 102173 . 102248) (VALUEOF 102250 . 103275) (VALUOF 103277 + . 104167) (VALUOF-EVENT 104169 . 104574) (LISPXUSE 104576 . 110995) (LISPXUSE0 110997 . 113723) ( +LISPXUSE1 113725 . 115350) (LISPXSUBST 115352 . 115772) (LISPXUSEC 115774 . 124015) (LISPXFIX 124017 + . 124867) (CHANGESLICE 124869 . 126716) (LISPXSTATE 126718 . 127812) (LISPXTYPEAHEAD 127814 . 129418) +) (137472 140690 (GREET 137482 . 138623) (GREET0 138625 . 140688)) (142292 149468 (LISPXPRINT 142302 + . 142866) (LISPXPRIN1 142868 . 143752) (LISPXPRIN2 143754 . 144696) (LISPXPRINTDEF 144698 . 145252) ( +LISPXPRINTDEF0 145254 . 145617) (LISPXSPACES 145619 . 146305) (LISPXTERPRI 146307 . 146932) (LISPXTAB +146934 . 147492) (USERLISPXPRINT 147494 . 148894) (LISPXPUT 148896 . 149466))))) STOP diff --git a/sources/HIST.LCOM b/sources/HIST.LCOM index c991eedbb8ac719c57f5ed6aaa63c963433cdd9d..00745f739196f80a639cdad4ee10ba0011abe7d2 100644 GIT binary patch delta 3273 zcmb_eeN0=|6$j_DZ)^z(gg^qld!)rqYh;^Gy9vv~e#VApKl9!*9}OhX*d!1ehmSNR zF*r$~$w~_ecR*VR&~0gfB~?2oOR_~ts!HoWo7Pp`xxu$=|fl$z25oqo1?yG1IR0RFLfWNPzCv>=b zpTDQV;gpraCrZOQ!m!4&2UZPci@{(qn!(Cb-4TDnaF~Sm9cb;`@9(jMNtML&ih+dN zJHv#n_Xj}9PkKYdemD^DcaxqzaMDYXtriv*vJ46PT6_IISd%=34ofVCQdal%SR>yM z?EexRF_xGN<>kb}+nkENvXQWXU=TK9u{t<+6))=*k!bC1IUbRYSUeJ6=M=rN-UbOL zjhJv(Ya-zW3vRZYCCq=n31e8t2u|74V0XH0oWWo)5{s>zq3OZg=s!~HR;4mgZjB`s z{=#c-uSjKRJ6}P^)7AlTK5Yqz=;Zo{2KcOv0l-Mj6ZGcBo|TN&L#Q!t6TOkWJ^FNp zhz5R{`7!)~iaGjm)+J=7vNxng7`Ia(DSug$l9JK_zm!WWPQI1$yR|4jgpl64+L3z0 zq0uy_UUzABr~bS~lX}hV`{>}`I_~{cd-FgDm8zZUAA@olLJNXA)LizseX4TNO_iMr ztQM9gRQ)$|1Nt;!XV@@$EbI9;NRlou13lV#CL%8H3qu-HY(#VMrJj03mg z0JEg2$yFBt&kB?d(p9{oxA9id#@qCY)5SxP8qKA|?v!N3&AE7}^0MR+eBK9hW#(96 zVJ*p|IB5W8z*{+C3t8ynV!}QSZEGwoA*`dF6~MO{B!3_f0=C#l*s4&-NBmFwJKH<= z162fyD%IN7>+kLig*t&WffRz4qua!Wi2e;5+XAUjS|7dx%mAbdR3M%)u zwQYgF`d#0~V)kuTQs=|*iQpkCS=XYW=Cbfqk)qxS%z zBcsjATFokK$r4&9km&PukD;ZX)gJ@1riMj~^UqD-Hu`S!^Eeah;#G8PFZ$o!(ul{v zp#KQY-RfXz-u{PysMvo31HRP($&0Q&Xn3$PjSd9HfJ_gLAjz%S9KG84Fp9NuM)cEA z0g4%2A+*|+9b1RF-=<--R1oZRpyw^nF!UY)obO!(ln)Pr_8$&+fp)a|h=hyIJ%d5t zf2Ix4*S81oojzppk2V9IIEwt=RoQ+F<%`Gm0j7sr06V7h>3G-z(tBZ?E9>_GPWPi+ zIHRYA0W(PFW?1^dKqW}O8Njt|vjz0Y2+q7a`v|=j;Xv9o_dRMk{wPST$6Eo@UqwsW z6KH8v#m`SPGYl_DqGaU+fxdk*gWmihR@{}7sFe3CF8J+_o&>z}EN*?rAo5E;_5(gN zgpPwl$b2yL6kyqND9=2%88Gejdcbw3$^ffQA^*lH+{F6RC|{g6(S_5+Al*5Q?5^*l z#Sa&10dgXzBF}+4Qqfv{rlu`KdFFfM@%*(Di3A_PVq98Lphgm7B&e>fSNj z^6qsfMISPa+ubLf1(9i*HY4zOtk%kb8W>UvgnJ-a89 zu?jo~*ISJc&!0{Q5v9(-QA~5^utAQ`VNG0|!`1)yZfu3baWYyrhI--?%#p!k`PEL>^CasI} zSP6VQg;QkOHM^Dm>GhrYjMfT{8+2+}z$(y#JIqGnrg==pj(O-oosM?RZ=_e}3t%I6 z=i73CNtBoRLQX2cmW55AbY!6{GofMiDr&pLs_C5t{N&$wWJD4xuv*n8hq@$Qlnyce z4oN1hqFWXPh!x%^hUGmav4&(CqWg+sjEO5fsy017puep3;F%K(A?*T&(0u_9^UD{= JDtvY_{{i|S!Ri12 delta 3169 zcmb_fYj6|S74`!t4{yW61`HT3Yrqmlu2v7r5)ZSMR+j9QR_v}HN_g0@W!FWvjBG;y z`2~bW%ll%R00z5I9tIkWOf%DI(#&+GO*_*J&19M>lV;q^Bx(Djf$6l(qz`(|N;VGd zkN)Tkd^-Ex@0@$i-E;3=fB7iwM~~7@^WBWj?G**5Ebyw}BCN@3D64HT*oz2fad1ZX z#}XY|7in&73Ww@Rq=m2~w%?_ccWwwbwYAnoqM=P~k&b9xsBM$StEdI*xtN|Xtl4Pr z)kY0=D=`@zX0yX+0l$|qPB^bVMq*7ZF~a&n_1)pnUYN?jcQm57pr8PB^|kFG5V6mA z&gwAP9F`(h|6IPD(NNYAHrP4BnH)xtm@&VAAPNp&r9<#nN=oMj(W?ZUk}Paeqzc(7 zD9KFCF~W6QOHAPl%dTu*0ZwxuyT`Z&8J{&uE>ZgUrY z3O_Jtj~f?{A@fQ0{M0Y=u=Om8=Xd<3Mo1hXCy+U;158%6cVMP zgjXdWymc#4RN3n<1)j4Lg;x~GNjRgOR2ZDRB7kW@bwWgnYy_9RS{3Ag>?K89;t^~= zM+)szpR6eD25n-{{FOnIiTG8I)5FU!Epfr-fzITtg~aWZ71huCU}DZfN@YP%aa19N z<|$(q%hZP{GKfMPcvKsHLf;ktLknNKcQuz7XW(M18dWnqvSuNZH9M0H8 zOWpIp3c8B`pD6kCP4`&R8Z3PyY4vz6gSEo@7%(wa8(3G${s4Haybs630SNwv*anRr z&zIiAX8u>;RX~jS`j+p5wOwuj{H44j$@X|edQB0vr-y*BGvfbLXQoYObOBUQZD>H*GZ$1m;X!A)RL-McW}ANR=Uw{b7lJGi$2aN54@fOY$j`N_U* zfGhVSe{?_EpK7)*RtNTItOjuQU@o2h}MBN9S^?)0?(0=!_fj;cAgSGJrOV@Rm zfEDRR-x))B^viA>X&hQjgFQT0<3q*tQO_E%QhRFwM~5-eJG~g`8wU{k4{V#w2(m26 zPF@sg?ZHgC<0`BftvZOqZyiL3UDsX&>^g+$es~D^Gv5mV-g*@$W)36Me)wg;4>Wtz zk;P!&xq*%Q`Vkx8XGc)uKZ;4*JBqgNmWg_gS-|Q#hV1w;jJRiH3*gU30)R_yBhzym z)t}ua^w-~UgOzg}=j=U>?C+0bcD@sc_fO#R&OeF#UJb`jA}^f6#lLn6`8lT>(ix(o zTkmGm6Q?oS`=^m#eMZ*G;4IdhNioCS6t%zA?Ba7c+m&~>#8IF+z$IDKSw^DG6 zr9{<(Ykw9v?de~+Y(n6I(@^Ata31o}9=#kPG=V4=l=_jEARlg(Apqe^N6zuxPTxfGqg}YHqTe zH5`-_liWeMGCCTMb+1&G4la;Ab;JGYm@p*h7gXeL9r@i(PV9jf2 z|4hSz3)nH|E+F&w3;2d!x`;jSwuY-OZTmXoU0h6WUNVB@Ht z)9az4;UPGO>6=5iJ;*Tjgl`zV|L=RT78Z_oxl{?RM#L{oNd~frUdKAR4p-Cs8*{+2 z-Po}((YlGRr*2DyqzZ&}Oxd@q8CDNnsn-*oBB)-!SM~Cu0yXJ;e85TI<*B@?(0N14 zXzb?3Tt?@FiL3QmTYwkn0u`!@Btr|h7$4q*9jMpSdAAnO>RWk`NYAZ?CBRIym-az^ z)_`Y67J_Ech%IYE;H*%!-I8dgx)FTi|Mk3pn{#4|VY6x89u@BSm7$i75LrX2L(#}9#2JaUMxwRtO_3IssBrDD!CwV-xGe)%5egA( R2snWEV7r}zwT6kAe*-+au#5lz