(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED "19-Apr-2023 18:58:13" |{DSK}larry>il>medley>sources>HIST.;6| 152088 :EDIT-BY "lmm" :CHANGES-TO (FNS GREET0) :PREVIOUS-DATE "19-Mar-2023 10:09:08" |{DSK}larry>il>medley>sources>HIST.;1|) (PRETTYCOMPRINT HISTCOMS) (RPAQQ HISTCOMS ((FNS PRINTHISTORY ENTRY# PRINTHISTORY1 PRINTHISTORY2) (FNS EVALQT ENTEREVALQT USEREXEC LISPXREAD LISPXREADBUF LISPXREADP LISPXUNREAD LISPX LISPX/ LISPX/1 LISPXEVAL LISPXSTOREVALUE HISTORYSAVE LISPXFIND LISPXGETINPUT REMEMBER GETEXPRESSIONFROMEVENTSPEC LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1 HISTORYMATCH VALUEOF VALUOF VALUOF-EVENT LISPXUSE LISPXUSE0 LISPXUSE1 LISPXSUBST LISPXUSEC LISPXFIX CHANGESLICE LISPXSTATE LISPXTYPEAHEAD) (ALISTS (SYSTEMINITVARS LISPXHISTORY GREETHIST)) (DECLARE\: DONTEVAL@LOAD DOCOPY (VARS (\#REDOCNT 3) (ARCHIVEFLG T) (ARCHIVEFN) (ARCHIVELST '(NIL 0 50 100)) (DISPLAYTERMFLG) (EDITHISTORY '(NIL 0 30 100)) (HERALDSTRING) (LASTEXEC) (LASTHISTORY) (LISPXBUFS) (LISPXHIST) (LISPXHISTORY '(NIL 0 30 100)) (LISPXPRINTFLG T) (LISPXUSERFN) (MAKESYSDATE) (PROMPT#FLG T) (REDOCNT) (SYSOUT.EXT 'SYSOUT) (SYSOUTFILE 'WORK) (SYSOUTGAG) (TOPLISPXBUFS))) (LISPXMACROS SHH RETRIEVE BEFORE AFTER OK REMEMBER\: REMEMBER TYPE-AHEAD ??T) (ADDVARS (LISPXFINDSPLST FROM TO THRU SUCHTHAT ALL AND) (BEFORESYSOUTFORMS (SETQ SYSOUTDATE (DATE)) (PROGN (COND ((NULL FILE) (SETQ FILE SYSOUTFILE)) (T (SETQ SYSOUTFILE (PACKFILENAME 'VERSION NIL 'BODY FILE)))) (COND ((AND (NULL (FILENAMEFIELD FILE 'EXTENSION)) (NULL (FILENAMEFIELD FILE 'VERSION))) (SETQ FILE (PACKFILENAME 'BODY FILE 'EXTENSION SYSOUT.EXT)))))) (RESETFORMS (SETQ READBUF NIL) (SETQ READBUFSOURCE NIL) (SETQ TOPLISPXBUFS (OR (CLBUFS T) TOPLISPXBUFS)) (COND ((EQ CLEARSTKLST T) (COND ((EQ NOCLEARSTKLST NIL) (CLEARSTK)) (T (* |clear| |all| |stack| |pointers| EXCEPT |those| |on| NOCLEARSTKLST.) (MAPC (CLEARSTK T) (FUNCTION (LAMBDA (X) (AND (NOT (FMEMB X NOCLEARSTKLST)) (RELSTK X)))))))) (T (MAPC CLEARSTKLST (FUNCTION RELSTK)) (SETQ CLEARSTKLST NIL)))) (HISTORYSAVEFORMS) (LISPXCOMS  |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix| |forget| |name| |redo| |repeat| |retry| |undo| |use|) (SYSTATS (LISPXSTATS LISPX INPUTS) (UNDOSAVES UNDO SAVES) (UNDOSTATS CHANGES UNDONE) NIL (EDITCALLS CALLS TO EDITOR) (EDITSTATS EDIT COMMANDS) (EDITEVALSTATS COMMANDS INVOLVING EVALUATING A LISP EXPRESSION) (EDITESTATS USES OF AN E COMMAND TYPED IN DIRECTLY) (EDITISTATS USES OF AN I COMMAND TYPED IN DIRECTLY) (EDITUNDOSAVES EDIT UNDO SAVES) (EDITUNDOSTATS EDIT CHANGES UNDONE) NIL (P.A.STATS P.A. COMMANDS) NIL (CLISPIFYSTATS CALLS TO CLISPIFY) NIL (FIXCALLS CALLS TO DWIM) (FIXTIME) (ERRORCALLS WERE DUE TO ERRORS) (DWIMIFYFIXES WERE FROM DWIMIFYING) NIL "OF THOSE DUE TO ERRORS:" (TYPEINFIXES WERE DUE TO ERRORS IN TYPE-IN) (PROGFIXES WERE DUE TO ERRORS IN USER PROGRAMS) (SUCCFIXES1 OF THESE CALLS WERE SUCCESSFUL) NIL "OF THE CALLS DUE TO DWIMIFYING:" (SUCCFIXES2 WERE SUCCESSFUL) NIL (SPELLSTATS OF ALL DWIM CORRECTIONS WERE SPELLING CORRECTIONS) (CLISPSTATS WERE CLISP TRANSFORMATIONS) (INFIXSTATS OF THESE WERE INFIX TRANSFORMATIONS) (IFSTATS WERE IF/THEN/ELSE STATEMENTS) (I.S.STATS WERE ITERATIVE STATEMENTS) (MATCHSTATS WERE PATTERN MATCHES) (RECORDSTATS WERE RECORD OPERATIONS) NIL (SPELLSTATS1 OTHER SPELLING CORRECTIONS\, E.G. EDIT COMMANDS) NIL (RUNONSTATS OF ALL SPELLING CORRECTIONS WERE RUN-ON CORRECTIONS) NIL (VETOSTATS CORRECTIONS WERE VETOED) NIL) (NOCLEARSTKLST)) (APPENDVARS (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 '": this sysout is initialized for user " T) (LISPXPRIN1 USERNAME T) (LISPXPRIN1 '". " T) (LISPXPRIN1 '"To reinitialize, type GREET() " T))) (SETINITIALS))) (P (MAPC SYSTATS (FUNCTION (LAMBDA (X) (AND (LISTP X) (EQ (GETTOPVAL (CAR X)) 'NOBIND) (SETTOPVAL (CAR X) NIL))))) (PUTD 'E)) (COMS (FNS GREET GREET0) (ADDVARS (PREGREETFORMS (DREMOVE GREETFORM RESETFORMS) (SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0))) (SETQ CONSOLETIME0 (CLOCK 0)) (SETQ CPUTIME0 (CLOCK 2))) (POSTGREETFORMS (SETINITIALS) (AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS)))) (DECLARE\: DONTEVAL@LOAD DOCOPY (VARS (GREETHIST) (SYSTEMTYPE) (GREETFORM '(LISPXEVAL '(GREET) '_)) (CUTEFLG) (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"))) (USERNAME) (HOSTNAME) (CONSOLETIME 0) (CONSOLETIME0 0) (CPUTIME 0) (CPUTIME0 0) (EDITIME 0) (FIRSTNAME)) (ADDVARS (BEFOREMAKESYSFORMS (SETQ RESETFORMS (CONS GREETFORM RESETFORMS)) (SETQ MAKESYSDATE (DATE)))) (ADDVARS (AFTERMAKESYSFORMS (LISPXEVAL '(GREET) '_))))) (FNS LISPXPRINT LISPXPRIN1 LISPXPRIN2 LISPXPRINTDEF LISPXPRINTDEF0 LISPXSPACES LISPXTERPRI LISPXTAB USERLISPXPRINT LISPXPUT) (GLOBALVARS \#REDOCNT ARCHIVEFLG ARCHIVEFN ARCHIVELST BOUNDPDUMMY BREAKRESETVALSLST CAR/CDRNIL CHCONLST1 CLEARSTKLST CLISPARRAY CLISPCHARS CLISPFLG CLISPTRANFLG CONSOLETIME CONSOLETIME0 CPUTIME CPUTIME0 CTRLUFLG CUTEFLG DISPLAYTERMFLG DWIMFLG EDITHISTORY EDITIME EDITQUIETFLG EDITSTATS EVALQTFORMS FILERDTBL FIRSTNAME GREETDATES GREETHIST HISTORYCOMS HISTORYSAVEFN HISTORYSAVEFORMS HISTSTR0 HISTSTR2 HISTSTR3 IT LASTHISTORY LISP-RELEASE-VERSION LISPXBUFS LISPXCOMS LISPXFINDSPLST LISPXFNS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS LISPXPRINTFLG LISPXREADFN LISPXSTATS LISPXUSERFN MACSCRATCHSTRING NEWUSERFLG P.A.STATS POSTGREETFORMS PREGREETFORMS PRETTYHEADER RANDSTATE READBUFSOURCE REDOCNT REREADFLG RESETFORMS SYSFILES TOPLISPXBUFS USERHANDLE USERNAME) (VARS (LISP-RELEASE-VERSION 2.0)) (BLOCKS (LISPXFINDBLOCK LISPXFIND LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1 (ENTRIES LISPXFIND HISTORYFIND) (LOCALFREEVARS _FLG L LST Z =FLG HISTORYFLG PREDFLG LINE HISTORY TYPE BACKUP QUIETFLG) (NOLINKFNS HISTORYMATCH LISPXGETINPUT)) (NIL ENTRY# EVALQT GETEXPRESSIONFROMEVENTSPEC GREET GREET0 HISTORYMATCH HISTORYSAVE LISPX LISPX/ LISPX/1 LISPXEVAL LISPXFIND1 LISPXGETINPUT LISPXPRIN1 LISPXPRIN2 LISPXPRINT LISPXPRINTDEF LISPXPRINTDEF0 LISPXPUT LISPXREAD LISPXREADBUF LISPXREADP LISPXSPACES LISPXSTOREVALUE LISPXSUBST LISPXTAB LISPXTERPRI LISPXTYPEAHEAD LISPXUNREAD LISPXUSE LISPXUSE0 LISPXUSE1 LISPXUSEC PRINTHISTORY PRINTHISTORY1 PRINTHISTORY2 USEREXEC USERLISPXPRINT VALUEOF VALUOF (LOCALVARS . T) (SPECVARS LISPXLINE LISPXID LISPXVALUE LISPXLISTFLG HISTORY ID EVENT BREAKRESETVALS VARS GENLST INITLST NAME MESSAGE) (LINKFNS . T) (NOLINKFNS LISPXTYPEAHEAD UNDOLISPX ARCHIVEFN LISPXFIX LISPXUSE LISPXUSE0 LISPXSUBST LISPXFIND HISTORYMATCH PRINTHISTORY DISPLAYTERMP LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT PRINTHISTORY1 PRINTHISTORY2 LISPXFIND HISTORYMATCH LISPXGETINPUT LISPXSUBST ARCHIVEFN LISPXFIX LISPXUSE LISPXUSE0 LISPXSUBST HISTORYMATCH PRINTHISTORY DISPLAYTERMP LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT LISPXTYEAHEAD UNDOLISPX GREETFILENAME))) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VALUEOF) (NLAML) (LAMA))))) (DEFINEQ (printhistory (lambda (history line skipfn novalues file) (* |wt:| 7-may-76 4 58) (and (eq history edithistory) (setq novalues t)) (* novalues |is| t |for| |printing| edithistory\, |indicates| |not| |to|  |print| |the| |value.| |if| |it| |is| |non-atomic,| |it| |is| \a |form| |which|  |is| |evaluated| |in| printhistory1 |in| |lieu| |of| |printing| |the| |value.|  |This| |form| |can| |also| |be| |obtained| |from| |the| |property| |list| |of|  |the| |entry| |under| |property| |print.|) (prog ((l (car history)) lst helpclock) (setq lst (cond ((null line) (car history)) (t (lispxfind history line 'entries)))) (terpri file) (terpri file) (mapc lst (function (lambda (event) (cond ((and skipfn (apply* skipfn event)) (* i\f skipfn |applied| |to| |this| |entry| |is| t\, |it| |is| |skipped.|) ) (t (prin2 (entry# history event) file t) (prin1 '\. file) (printhistory1 event (cond ((eq novalues t) t) (novalues (apply* novalues event))) file)))))) (terpri file) (terpri file) (return)))) (entry# (lambda (hist x) (cond ((not (igreaterp (setq x (iplus (cadr hist) (iminus (flength (car hist))) (flength (fmemb x (car hist))))) 0)) (iplus x (or (cadddr hist) 100))) (t x)))) (printhistory1 (lambda (event novalues file) (* |lmm| " 1-May-86 13:56") (* i\f novalues |is| t\, |means|  |suppress| |printing| |of| |value.|) (prog ((input (car event)) y tem) (cond ((listp (setq tem (listget1 event '*firstprint*))) (* |used| |by| |the| |editor.|) (tab 5 nil file) (apply (car tem) (cons file (cdr tem))))) (cond ((setq y (cdr (fmemb '*group* event))) (* memb |used| |instead| |of| listget |because| |value| |may| |be| nil\, |e.g.|  |if| |command| |aborted| |because| use |argument| |wasnt| |found.|) (tab 5 nil file) (maprint (listget1 event '*history*) file nil nil nil (function (lambda (x fl) (prin2 x fl t)))) (terpri file) (cond ((car y) (mapc (car y) (function (lambda (event) (printhistory1 event novalues file)))) (cond ((setq tem (listget1 event '*redocnt*)) (tab 5 nil file) (prin1 "... " file) (prin1 (add1 tem) file) (prin1 " times " file))) (return) (* |if| |group| |is| |empty,| |still| |might| |want| |to| |drop| |through|  |and| |print| |input,| |if| |any,| |e.g.|  name |command| |works| |this| |way.|) )))) (cond ((or (null input) (eq (car input) histstr2)) (go lp1))) (tab 5 nil file) (and (setq tem (cadr event)) (prin1 tem file)) lp (cond ((setq y (fmemb histstr0 (listp input))) (setq input (ldiff input y)))) (and input (printhistory2 input file novalues)) (* |shouldnt| |be| |any| |situations| |with| |two| "" \s |in| \a |row,|  |but| |just| |in| |case|) (cond (y (setq input (cdr y)) (spaces 5 file) (go lp))) lp1 (mapc (listget1 event '*lispxprint*) (function (lambda (x) (lispxreprint x file)))) (cond ((listp (setq tem (listget1 event '*print*))) (* |used| |by| |break.|) (tab 5 nil file) (apply (car tem) (cons file (cdr tem)))) (novalues) (t (|for| x |in| (listget (cdddr event) 'lispxvalues) |do| (tab 5 nil file) (showprint x file t))))))) (printhistory2 (lambda (input file novalues) (* |wt:| "14-AUG-78 02:59") (prog (tem) (cond ((nlistp input) (prin1 input file)) ((cddr input) (maprint input file nil nil nil (function (lambda (x fl) (* maprint |does| |an| |apply*| |with| |this| |argument| |on| |the| |thing|  |to| |be| |printed| |and| |the| |fl.|) (showprin2 x fl t))))) ((cdr input) (* apply |input|) (showprin2 (car input) file t) (cond ((null (setq tem (cadr input))) (prin1 (cond (\#rpars ']) (t '|()|)) file)) (t (cond ((or (atom tem) (eq novalues t)) (* i\f novalues |is| t\, |ppobaby| |is| |printing| |editor| |history| |list,|  |so| |print| |the| |space.|) (spaces 1 file))) (showprin2 tem file t)))) (t (* eval |input|) (showprin2 (car input) file t))) (terpri file)))) ) (DEFINEQ (evalqt (lambda (lispxid) (* |lmm| " 9-Jun-85 21:04") (prog nil (cond ((null lispxid) (setqq lispxid _) (enterevalqt))) (freshline t) lp (promptchar lispxid t lispxhistory) (cond ((null (ersetq (lispx (lispxread t t) lispxid))) (setq toplispxbufs (or (clbufs t) toplispxbufs)) (terpri t))) (* |this| |errorset| |is| |so| |that| evalqtforms |dont| |get| |unnecessarily|  |evaluated| |following| |each| |error| |on| |typein.|  |they| |are| |only| |for| |control-d.|) (go lp)))) (enterevalqt (lambda nil (* |lmm| " 7-Nov-86 03:47") (* |;;| "this is not on resetforms, because it is important that it be done first, i.e. before the form specified on resetforms.") (* |;;| " with unwinders it is mainly unnecessary") (* |;;| "with multiple execs, it is probably wrong") (resetrestore nil 'reset) (mapc resetforms (function (lambda (x) (ersetq (eval x))))))) (userexec (lambda (lispxid lispxxmacros lispxxuserfn) (* |Pavel| " 7-Jul-86 11:26") (* |wt:| 28-jul-77 22 1) (resetvars (readbuf readbufsource rereadflg) (cl:when (null lispxid) (setq lispxid '_)) lp (cl:when (> (position t) 0) (cl:terpri t)) (promptchar lispxid t lispxhistory) (ersetq (lispx (lispxread t t) lispxid lispxxmacros lispxxuserfn)) (go lp)))) (lispxread (lambda (file rdtbl) (* ajb "16-Jul-85 15:54") (* * a |generalized| read. i\f readbuf |is| nil\, |performs| |and| apply*  lispxreadfn file. |which| |it| |returns| |as| |its| |value.|  i\f readbuf |is| |not| nil\, "reads" |and| |returns| |the| |next| |expression|  |on| readbuf) (prog (x) lp (cond ((null (and readbuf (setq readbuf (lispxreadbuf readbuf t)))) (setq rereadflg nil) (setq x (cond ((or (eq lispxreadfn 'read) (imagestreamtypep t 'text)) (* s\o |the| |call| |will| |be| |linked,| |so| |the| |user| |can| |break| |on|  |read.|) (read file rdtbl)) (t (apply* lispxreadfn file rdtbl)))) (cond ((and (listp x) ctrluflg) (* |User| |typed| |control-u| |during| |read.|  |The| |assemble| |is| |an| openr.) (setq ctrluflg nil) (cond ((null (nlsetq (edite x))) (* |Exited| |with| stop\, |just| |save| |input| |but| |do| |not| |evaluate|  |or| |execute.|) (setq rereadflg 'abort))))) (return x))) (* rereadflg |is| |later| |used| |to| |compare| |with| |the| |first| |entry|  |on| |the| |history| |list| |to| |see| |if| |the| |reread| |expression| came  |from| |that| |entry.|) (setq x (car readbuf)) (setq readbuf (cdr (setq rereadflg readbuf))) (return x)))) (lispxreadbuf (lambda (rdbuf stripseprsflg) (* |lmm| " 4-NOV-82 23:59") (* |takes| |care| |of| |'cleaning'| |up| |read| |buffer| |by| |stripping| |off|  |extra| "" |and| |processing| |repeated| |reads.|  |used| |by| |promptchar,| |editor,| |lispxread,| |etc.|) (prog (tem) lp (cond ((nlistp rdbuf) (return nil)) ((eq (car rdbuf) histstr0) (* histstr0 |is| \a |delimiter| |for|  |eadline|) (setq rdbuf (cdr rdbuf)) (go lp)) ((eq (car rdbuf) histstr3) (* histstr3 |is| \a |marker| |for| |flagging| |the| |event| |that| |the|  |readbuf| |came| |from|) (setq rdbuf (cddr rdbuf)) (go lp)) ((eq (car rdbuf) histstr2)) (t (return rdbuf))) (setq redocnt (add1 redocnt)) (setq rdbuf (cdr rdbuf)) (setq rdbuf (cond ((setq tem (cond ((numberp (car rdbuf)) (and (igreaterp (car rdbuf) 0) (sub1 (car rdbuf)))) ((eval (car rdbuf)) (car rdbuf)))) (nconc (|for| xx |in| (cadr rdbuf) |until| (eq xx histstr2) |collect| (cond ((nlistp xx) xx) (t (copy xx)))) (cons histstr0 (cons histstr2 (cons tem (cdr rdbuf)))))) ((lispxreadbuf (cddr rdbuf))) (t (prin1 redocnt t) (prin1 " repetitions. " t) nil))) (go lp)))) (lispxreadp (lambda (flg) (* |lmm| " 5-NOV-82 00:00") (* flg |corresponds| |to| |the| flg |argument| |to| readp\, |i.e.|  |if| flg=nil\, |returns| ni\l |if| |just| \a |c.r.|  |waiting.| |if| flg=t\, |returns| t |if| |anything| |waiting|) (cond ((and readbuf (setq readbuf (lispxreadbuf readbuf))) t) ((readp t t) (or flg (neq (peekc t) (constant (character (charcode eol))))))))) (lispxunread (lambda (lst event) (* |lmm| " 5-NOV-82 00:02") (setq readbuf (append lst (cond (event (cons histstr3 (cons event readbuf))) (t (cons histstr0 readbuf))))))) (lispx (lambda (lispxx lispxid lispxxmacros lispxxuserfn lispxflg)(* |lmm| "11-Jul-86 18:01") (* lispx (|for| lisp |eXec|) |is| |designed| |to| |save| |the| |user| |the|  |task| |of| |writing| |an| |exec| |by| |allowing| |him| |to| |easily| |tailor|  lispx |to| |his| |applications.| i\n |this| |way,| |the| |user| |also| |gets|  |the| |benefit| |of| |the| |history| |features| |built| |into| lispx.  lispx |determines| |the| |type| |of| |input,| |performs| |any| |extra| |reads|  |that| |are| |necessary,| |saves| |the| |input|  (\s) |and| |the| |value| |on| |the| |history,| |and| |prints| |and| |returns|  |the| |value.| (lispx |must| |do| |the| |printing| |since| |for| |history|  |commands,| |see| |below,| |nothing| |can| |be| |printed| |until| |the| |next|  |call| |to| lispx.) -  -  |There| |are| |currently| |six| |different| |classes| |of| |inputs:|  (1) eval\, |i.e.| |forms;| (2) apply\, |i.e.|  |functions| |and| |arguments;| (3) |forms| |without| |parentheses,| |i.e.|  |lines,| |usually| |specifying| clisp |transformation,| |e.g.|  for x in |...| i\n |this| |case| |the| |entire| |line| |is| |treated| |as| \a  |form| |and| |EVALed;| (4) |commands,| |similar| |to| |edit| |macros,|  |definitions| |are| |looked| |up| |on| lispxmacros\;  (5) |user| |input,| |as| |determined| |by| |applying| lispxuserfn.  i\f |this| |yields| t\, |the| |value| |of| |the| |event| |is| |the| |value|  |of| lispxvalue\, |which| |must| |be| |set| |by| lispxuserfn\;  |and| (6) |history| |commands.| -  |For| |types| 1 |thru| 5\, lispx |saves| |the| |inputs| |on| |the| |history|  |list| |before| |executing.| |Thus| |even| |if| |the| |operation| |is|  |aborted,| |the| |user| |can| |redo| |it,| |fix| |it,| |etc.|  -  |For| |commands| 1\, 2\, |and| 3\, |the| |function| |name| |is| |looked| |up|  |on| lispxfns. |if| |the| |user| |simply| |wants| \a |different| |function|  |called| |for| |tty| |inputs| |then| |in| |his| |program,| |such| |as| |is|  |the| |case| |with| setq |or| set\, |this| |can| |easily| |be| |done| |by|  |putting| (|fn1| . |fn2|) |on| |the| |list| lispxfns.  -  |For| |commands| |of| |type| 6\, lispx |simply| |unreads| |the| |appropriate|  |information| |and| |exits.| |This| |means| |that| |if| \a |user| |function|  |calls| lispx |when| |it| |cannot| |interpret| |the| |input,| |history|  |operations| |will| |work| |provided| |only| |that| |the| |user| |function|  |obtains| |its| |input| |via| lispxread\, |and| |that| |any| |inputs|  |interpreted| |by| |the| |user| |function| |also| |save| |the| |input| |on|  |the| |history| |list.| |This| |is| |the| |way| break1 |uses| lispx.) (* i\f lispxflg |is| t\, |any| |history| |commands| |are| |executed| |in|  |this| |call| |to| lispx\, |instead| |of| |unreading| |and| |exiting.|  |This| |is| |used| |when| |the| |calling| |function| |knows| |that| |the|  |input| |should| (|must|) |be| |processed| |here,| |for| |example,| |in| |the|  e |command| |from| |the| |editor.| |Without| |this,| e redo |would| |cause|  |the| |input| |referred| |to| |by| |the| redo |command| |to| |be| |interpreted|  |as| |edit| |commands| |instead| |of| lispx |inputs.|  i\f lispxflg |is| |'RETRY,| clock |is| |backed| |up| |to| |force| \a break |on|  |any| |error.|) (and (null lispxxmacros) (setq lispxxmacros lispxmacros)) (and (null lispxxuserfn) lispxuserfn (fgetd 'lispxuserfn) (setqq lispxxuserfn lispxuserfn)) (* i\f lispx |is| |called| |with| |its| |fifth| |argument,| lispxxuserfn\,  |non-NIL,| |it| |is| |applied| (|with| apply*)\.  |Otherwise,| |the| |top| |level| |value| |of| lispxuserfn |is| |checked,| |and|  |if| |non-NIL,| lispxuserfn |itself| |is| |called.|  (|The| |former| |is| |for| |calls| |from| userexec\, |the| |latter|  |corresponds| |to| |the| |old| |way| |of| |doing| |it.|  |Similarly,| |if| lispx |is| |called| |with| |its| |fourth| |argument,|  lispxxmacros\, |non-NIL,| |it| |is| |used| |as| |the| |list| |of| |macros,|  |otherwise| |the| |top| |level| |value| |of| lispxmacros |is| |used.|)) (prog ((helpclock (clock 2)) lispxop lispxlistflg lispxline (lispxhist lispxhist) lispy lispz lispxvalue lispxtem dontsaveflg (helpflag (cond ((eq helpflag 'break!) (* |so| |that| |when| |you| |get| |in| |the| |break,| |doesnt| |always| |break|  |below| |that|) (gettopval 'helpflag)) (t helpflag))) lispxvalues) (declare (specvars helpflag lispxvalue lispxvalues)) (cond ((null lispxx) (* |Spurious| |right| |parentheses|  |or| |bracket.|) (return (print nil t))) ((nlistp lispxx) (setq lispxline (readline t (list lispxx) t)) (* |The| |third| |argument| |specifies| |that| |if| |there| |is| |juut| \a "]"  |or| ")" |on| |the| |line,| |it| |should| |be| |read| |as| \a nil\, |i.e.|  |the| |line| |should| |be| (nil)\. i\t |also| |specifies| |that| |if| |the|  |line| |begins| |with| \a |list| |which| |is| |not| |preceded| |by| |any|  |spaces,| |the| |list| |is| |to| |terminate| |the| |line| |regardless| |of|  |whether| |or| |not| |it| |is| |terminated| |by| \a ].  |Thus| |the| |usr| |can| |type| |fn| (|args|)) (setq lispxx (car lispxline)) (setq lispxline (cdr lispxline)) (* |done| |this| |way| |so| |control-W| |will| |work| |on| |first| |thing|  |read| |from| |inside| |of| |the| |readline.|) ) ((and (null rereadflg) (not (syntaxp (setq lispxtem (chcon1 (lastc t))) 'rightparen t)) (not (syntaxp lispxtem 'rightbracket t)) (cdr (setq lispxline (readline t (list lispxx) t)))) (* |The| |expression| |input| |was| \a |lis,| |although| |it| |was| |not|  |terrnated| |with| \a |right| |parent| |or| |bracket,| |e.g.|  (quote zap\,) |and| |furthermore| |there| |was| |something| |else| |on| |the|  |same| |line,| |so| |treat| |it| |as| |line| |input.|  |This| |enables| |user| |to| |type| (quote foo) :expr) (setq lispxx lispxline))) top (cond ((listp lispxx) (setq lispxop (car lispxx)) (setq lispxline (cdr lispxx)) (* |This| |is| |for| |convenience| |of| |history| |commands:| |regardless| |of|  |whether| |the| |command| |was| |typed| |as| \a |list| |or| \a |line,| lispxop  |is| |always| |the| |name| |of| |the| |command,| lispxline |its| |'arguments'.|  i\f |it| |turns| |out| |that| lispxop |is| |not| \a |history| |command,|  lispxline |will| |be| |set| |back| |to| nil  (|below| notcom)) (setq lispxlistflg t)) ((not (litatom lispxx)) (go notcom) (* |User| |might| |have| |typed| |in| \a |number| |followed| |by| |something|  |else|) ) (t (setq lispxop lispxx))) select (cond ((and rereadflg (eq (setq lispxtem (car (listget1 (caar lispxhistory) '*history*))) 'original))) ((setq lispy (fassoc lispxop lispxxmacros)) (and lispxlistflg (setq lispxline nil)) (* |so| |historysave| |at| do-it |will| |get| |called| |with| |the| |right|  |aaguments.|) (setq dontsaveflg (null (cadr lispy))) (go do-it)) ((setq lispy (fassoc lispxop lispxhistorymacros)) (setq dontsaveflg (null (cadr lispy))) (go redocom))) (selectq lispxop (original (go redocom)) (e (cond ((null lispxline) (go notcom))) (setq lispxx (setq lispxop (car lispxline))) (setq lispxline (cdr lispxline)) (go notcom)) ((retry redo repeat fix use |...|  |redo| |repeat| |use| |fix| |retry|) (go redocom)) ((|name| name) (cond ((null lispxline) (* t\o |allow| |user| |to| |have| name |as| |the| |name| |of| \a |variable.|) (go do-it))) (go redocom)) ((undo |undo|) (and (setq lispxhist (historysave lispxhistory lispxid nil lispxop lispxline)) (frplaca (cddr lispxhist) (undolispx lispxline)))) ((|retry:| retry\:) (and (eq rereadflg 'abort) (error!)) (setq helpflag 'break!) (setq lispxx (car lispxline)) (setq lispxline (cdr lispxline)) (go top)) ((|forget| forget) (and (eq rereadflg 'abort) (error!)) (mapc (cond (lispxline (lispxfind lispxhistory lispxline 'entries)) (t (car lispxhistory))) (function (lambda (x) (undolispx2 x t)))) (print '|forgotten| t t)) (?? (and (eq rereadflg 'abort) (error!)) (printhistory (cond ((eq (car lispxline) '@@) (setq lispxline (cdr lispxline)) archivelst) (t lispxhistory)) lispxline nil nil t)) ((|archive| archive) (and (eq rereadflg 'abort) (error!)) (* |Since| |these| |the| |commands| |do| |not| |call| historysave\, |we| |must|  |check| |for| |control-U| |followed| |by| stop |here.|) (cond (archivelst (frplaca archivelst (nconc (setq lispxtem (lispxfind lispxhistory lispxline 'copies)) (car archivelst))) (frplaca (cdr archivelst) (iplus (cadr archivelst) (flength lispxtem))) (print '|archived| t t)) (t (print '(|no| |archive| |list|) t)))) (go notcom)) (return '\) notcom (cond ((setq lispy (getprop lispxop '*history*)) (* |command| |defined| |by| \a name  |command.|) (cond ((null lispxline) (cond ((and (or (eq lispxid '_) (eq lispxid '\:)) (boundp lispxop)) (* |User| |typed| |command| |followd| |by| |just| |c.r.|  |since| |command| |is| |also| |the| |name| |of| \a |variable,| |thats|  |probably| |what| |he| |wants,| |especially| |since| |he| |can| |always| |say|  redo @ foo) (setq lispy nil)) (t (go redocom)))) ((null (car lispy)) (error lispxop '"doesn't take any arguments")) (t (go redocom))) (setq lispy nil)) ((fmemb lispxop lispxcoms) (* |Since| lispxop |is| |not| |one| |of| |the| |built| |in| |commands,| |and|  |not| |on| lispxmacros\, |presumably| |the| |user| |has| |included| |it| |on|  lispxcoms |because| |he| |is| |going| |to| |process| |it| |in| lispxuserfn.  i\n |any| |event,| |dont| |want| |to| |do| |any| |spelling| |correction.|) (and lispxlistflg (setq lispxline nil)) (go do-it))) (cond (lispxlistflg (* |Input| |is| \a |single| |list.|) (cond ((eq (car lispxx) 'lambda) (setq lispxline (list (lispxread t t)))) (t (and (litatom (car lispxx)) (cond ((or (fgetd (car lispxx)) (getlis (car lispxx) macroprops) (getlis (car lispxx) '(expr filedef clispword))) (and addspellflg (addspell (car lispxx) 2))) ((and dwimflg (setq lispxop (fixspell (car lispxx) 70 lispxcoms nil lispxx))) (setq lispxline (cdr lispxx)) (go select)))) (and lispxlistflg (setq lispxline nil)))) (go do-it)) ((null lispxline) (* |Input| |is| \a |single| |atom.|) (and (litatom lispxx) (cond ((boundp lispxx) (and addspellflg (addspell lispxx 3))) ((and dwimflg (setq lispxop (fixspell lispxx 70 lispxcoms nil t))) (cond ((listp lispxop) (* run-on |spelling| |error.|) (setq lispxline (list (cdr lispxop))) (setq lispxop (cond ((listp (car lispxop)) (* |synonym|) (cadar lispxop)) (t (car lispxop)))))) (setq lispxx lispxop) (go select)))) (go do-it)) ((not (litatom lispxx))) ((fgetd lispxx) (* |put| |on| spellings2 |even| |though| |in| apply |format| |since| |is|  |also| |good| |in| eval |format|) (and addspellflg (addspell lispxx 2))) ((and dwimflg (null (getlis lispxx '(expr filedef))) (setq lispxop (fixspell lispxx 70 lispxcoms nil t))) (cond ((listp lispxop) (setq lispxline (cons (cdr lispxop) lispxline)) (setq lispxop (car lispxop)))) (setq lispxx lispxop) (go select))) do-it (and (null dontsaveflg) (setq lispxhist (historysave lispxhistory lispxid nil lispxx lispxline))) (cond (lispy (setq lispxvalue (car (setq lispxvalues (cl:multiple-value-list (let ((lispxline (cond (lispxlistflg (cdr lispxx)) (t (nlambda.args lispxline))))) (eval (or (cadr lispy) (caddr lispy)) lispxid))))))) ((and lispxxuserfn (cl:funcall lispxxuserfn lispxx lispxline)) (cond (lispxvalues (setq lispxvalue (car lispxvalues))) (t (setq lispxvalues (list lispxvalue))))) (t (setq lispxvalue (car (setq lispxvalues (cl:multiple-value-list (cond ((null lispxline) (* a |form.|) (eval (cond ((nlistp lispxx) lispxx) (t (lispx/ lispxx))) lispxid)) ((or (cdr lispxline) (and clispflg (litatom lispxx) (car lispxline) (litatom (car lispxline)) (neq (setq lispxtem (nthchar (car lispxline) 1)) '-) (fmemb lispxtem clispchars) (neq (argtype lispxx) 3))) (* |The| |special| |checks| |are| |to| |enable| |constructs| |like| foo _t |to|  |work,| |even| |when| foo |is| |also| |the| |name| |of| \a |function,| |i.e.|  |instead| |of| |applying| foo |to| _t\, (|which| |would| |cause| |an| |unusal|  cdr arglist |error|) (foo _ t) |is| |evaluated,| |which| |will| |invoke| dwim.) (cond ((neq (argtype lispxx) 3) (prin1 " = " t) (print (cons lispxx lispxline) t))) (eval (lispx/ (cons lispxx lispxline)) lispxid)) (t (apply (lispx/ lispxx) (lispx/ (car lispxline) lispxx) lispxid))))))))) (and lispxhist (lispxstorevalue lispxhist lispxvalue lispxvalues)) (return (progn (setq it lispxvalue) (|for| x |in| lispxvalues |do| (showprint x t t)) (cl:values-list lispxvalues))) redocom (setq lispxx (cond (lispxlistflg (list lispxx)) (t (cons lispxx lispxline)))) (* |The| |entire| |history| |command.|) (and (null dontsaveflg) (setq lispxhist (historysave lispxhistory lispxid nil nil nil (list '*history* lispxx '*group* nil)))) (selectq lispxop (original (setq lispy (append lispxline))) ( (setq lispy (lispxusec lispxline lispxhistory))) ((|retry| retry) (setq lispy (cons 'retry\: (append (lispxfind lispxhistory lispxline 'input t))))) ((|name| name) (setq lispxtem (cdr (or (setq lispz (or (fmemb '\: lispxline) (fmemb 'in lispxline) (fmemb '|in| lispxline))) lispxline))) (* lispxtem |coresponds| |to| |the| |event| |specification,| lispz |to| |the|  |end| |of| |the| |arguments,| |if| |any.|) (setq lispz (cond ((null lispz) nil) ((cdr (setq lispz (ldiff (cdr lispxline) lispz))) lispz) ((listp (car lispz)) (* |user| |got| |confused| |and| |put| |in| |an| |extra| |set| |of| |parens.|) (car lispz)) (t lispz))) (setq lispy (lispxfind lispxhistory lispxtem 'input t)) (resetvars ((editquietflg t)) (mapc lispz (function (lambda (x) (cond ((not (historymatch lispy (editfpat x t))) (lispxprin1 x t) (maprint lispxtem t '" does not appear in " '\ nil nil t))))))) (/put (car lispxline) '*history* (cons lispz (cons (append lispy) (lispxfind lispxhistory lispxtem 'copies t)))) (* |The| |reason| |for| |storing| |the| |input| |separate| |frm| |the| |event|  (\s) |is| |that| |the| |user| |may| |have| |performed| name foo use -  |meaning| |the| use |input,| |rather| |than| |the| |normal| |input.|  |The| |reason| |for| |the| |append| |is| |that| |lispy| |will| |also| |be|  |the| |input| |portion| |of| |the| |name| |event| |on| |the| |history| |list,|  |and| |we| |want| |it| |not| |to| |be| |smashed| |when| |that| |entry| |is|  |slips| |off| |the| |end| |of| |the| |history| |list.|) (/remprop (car lispxline) 'state) (/setatomval 'lispxcoms (union (list (car lispxline)) lispxcoms)) (/setatomval 'historycoms (union (list (car lispxline)) historycoms)) (cond ((getd (car lispxline)) (maprint (cons (car lispxline) '(|is| |also| |the| |name| |of| \a |function.| |When| |typed| |in,| |its| |interpretation| |as| \a |history| |command| |will| |take| |precedence.|)) t "****Note: " '\ nil nil t))) (print (car lispxline) t t)) ((redo |redo| repeat |repeat|) (cond ((null (some lispxline (function (lambda (x tail) (selectq (car tail) ((while until |while| |until|) (cond ((and (cdr tail) (neq (car (setq lispxtem (nleft lispxline 1 tail)) ) 'f)) (* |backs| |up| |one|) (setq lispxline (and lispxtem (ldiff lispxline (cdr lispxtem)))) (and (null (cddr (setq lispxtem (cdr tail)))) (or (listp (car lispxtem)) (boundp (car lispxtem)) (not (fncheck (car lispxtem) t t t lispxtem))) (setq lispxtem (car lispxtem))) (cond ((or (eq (car tail) 'until) (eq (car tail) '|until|)) (setq lispxtem (list 'not lispxtem))) ) t))) ((times |times|) (cond ((and (null (cdr tail)) (setq lispxtem (nleft lispxline 1 tail)) (neq (car lispxtem) 'f)) (setq lispxline (ldiff lispxline lispxtem )) (setq lispxtem (or (numberp (car lispxtem )) t))))) nil))))) (setq lispxtem (or (eq lispxop 'repeat) (eq lispxop '|repeat|))))) (setq lispy (lispxfind lispxhistory lispxline 'input t)) (cond ((eq lispxid '*) (* |For| |editor.|) (setq lispy (copy lispy))) (t (* |Cant| |allow| |same| |input| |to|  |appear| |twice| |in| |history.|) (setq lispy (append lispy)))) (cond (lispxtem (setq lispy (list histstr2 lispxtem lispy))))) ((fix |fix|) (setq lispy (copy (lispxfind lispxhistory (cond ((setq lispxtem (fmemb '- lispxline)) (* |User| |can| |say| fix -  |and| |give| |the| |commands.| |Then| |he| |doesn't| |have| |to| |wait| |for|  |editor| |to| |print| edit\, |and| |him| |to| |type| ok |at| |the| |end.|  |Also,| |the| |commands| |stored| |on| |the| |history| |list| |in| |this|  |fashion| |can| |be| |reexecuted| |by| \a redo fix |command.|) (ldiff lispxline lispxtem)) (t lispxline)) 'input t))) (setq lispy (cond ((streamprop (getstream t) 'fixfn) (apply* (streamprop (getstream t) 'fixfn) (getstream t) lispy (cdr lispxtem))) (t (lispxfix lispy (cdr lispxtem))))) (* |usually| |defined| |as| |just| \a |call| |to| editl |but| |can| |be|  |advised| |to| |handle| |string| |situations,| |such| |as| |in| bard.  i\f |the| |stream| |has| \a fix |function| apply |it| |instead| |of| |the|  |default|) ) ((use |use|) (setq lispy (lispxuse lispxline lispxhistory lispxhist))) (|...| (cond ((null lispxline) (error '"... what??" '\ t))) (setq lispy (lispxfind lispxhistory nil 'entry t)) (setq lispxtem (cond ((listget1 lispy '...args)) ((setq lispxtem (listget1 lispy 'use-args)) (* |The| caaar |is| |because| car |is| |the| |list| |of| useargs |which| |is|  \a |list| |of| |list| |of| |variables.|) (cons (caaar lispxtem) (cdr lispxtem))) ((setq lispxtem (listget1 lispy '*history*)) (* e.\g. \a |lispxmacro| |or|  |lispxhistorymacro.|) (cons (cadr lispxtem) (lispxgetinput lispxtem (cons lispxtem (cdr lispy))))) (t (setq lispy (lispxfind lispxhistory nil 'input t)) (cons (cond ((or (null (cdr lispy)) (eq (cadr lispy) histstr0)) (* eval |input,| |substitute| |for|  |first| |argument| |which| |is| cadar) (cadar lispy)) ((nlistp (cadr lispy)) (* |e.g.| pp foo) (cadr lispy)) (t (* apply |input.| |e.g.|  load (foo) |substitute| |for| foo) (caadr lispy))) lispy)))) (* lipxtem |is| |now| \a |dotted| |pair| |of| |aagument| |and| |input.|) (nconc lispxhist (list '...args lispxtem)) (setq lispy (lispxuse0 (list lispxline) (list (list (car lispxtem))) (list (cdr lispxtem))))) (setq lispy (cond ((eq (car lispy) lispxop) (* |from| |lispxhistorymacro.|) (eval (or (cadr lispy) (caddr lispy)) lispxid)) ((null (car lispy)) (* |Command| |defined| |by| |name|  |command,| |with| |no| |arguments|) (append (cadr lispy))) (t (* |From| |name| |command.|) (lispxuse0 (list lispxline) (list (car lispy)) (list (cadr lispy))))))) (* lispy |is| |now| |the| |input.|) (and (null rereadflg) (fmemb histstr2 (listp lispy)) (setq redocnt -1)) (* |the| -1 |is| |because| |the| |first| |thing| |that| |will| |happen| |will|  |be| \a |call| |to| |lispxrepeatread| |which| |will| |increment| |redocnt| |to|  0 |the| |check| |is| |made| |here| |instead| |of| |inside| |the| |selectq| |at|  redo |because| |of| |cases| |where| |user| |does| use |on| |an| |event|  |involving| \arepeat |input|) (and lispxhist (frplaca lispxhist lispy)) (cond ((eq lispxop 'name) (* name |is| |handled| |as| \a |history| |command| |so| |that| |the| |command|  |is| |stored| |before| |it| |tries| |to| |do| |the| |lookup,| |and| |to|  |share| |in| |other| |common| |code.| |but| |it| |is| |not| |actually| |redone|  |or| |unread.|) ) (lispxflg (resetvars (readbuf) (lispxunread lispy lispxhist) lp (cond ((null (setq readbuf (lispxreadbuf readbuf))) (return))) (lispx (lispxread t t) lispxid) (go lp))) (t (lispxunread lispy lispxhist))) (return lispxhist)))) (lispx/ (lambda (x fn vars) (* |lmm| "16-FEB-83 06:42") (cond ((or (null lispxfns) (null lispxhistory)) x) (fn (* i\f fn |is| |not| nil\, |it| |is| |the| |name| |of| \a |function| |and| x  |is| |its| |argument| |list.| |Subsitution| |only| |occurs| |for| |functions|  |that| eval\, |such| |as| rpaq\, setq\, |and| \e.) (cond ((nlistp x) (* x |is| |an| (|atomic|) |argument| |list,| |e.g.|  |type| pp foo\, |don't| |substitute| |for| foo.) x) ((selectq (argtype fn) ((1 3) (* |Slightly| |different| |check| |than| |in| lispx/1 |and| dwimify1\, |etc.|  |This| |check| |wants| |to| |know| |whether| |this| |function| |calls| |eval|  |explicitly| |itself.| |The| |others| |say| |are| |the| |aaguments| |evaluated|  |either| |by| |virtue| |of| |it| |being| \a |normal| |function,| |or| |an|  |eval| |call.|) (eqmemb 'eval (getprop fn 'info))) nil) (lispx/1 x t)) (t x))) ((listp x) (* x |is| \a |form.|) (lispx/1 x)) (t (or (cdr (fassoc x lispxfns)) x))))) (lispx/1 (lambda (x tailflg) (* |lmm| " 2-Jul-85 02:20") (and x (prog ((tem1 (car x)) tem2 tem3) (cond ((nlistp x) (return x)) ((listp (car x)) (setq tem1 (lispx/1 (car x))) (go do-cdr))) (cond (tailflg (go do-cdr))) (setq tem1 (or (cdr (fassoc (car x) lispxfns)) (car x))) (selectq (car x) (quote (return x)) ((function f/l) (setq tem2 (lispx/1 (cdr x))) (go do-cdr1)) ((lambda nlambda) (setq tem3 (cadr x)) (prog ((vars (cond ((nlistp tem3) (cons tem3 vars)) (t (append tem3 vars))))) (setq tem2 (lispx/1 (cddr x) t))) (go do-cddr1)) (prog (prog ((vars (nconc (mapcar (cadr x) (function (lambda (x) (cond ((atom x) x) (t (setq tem3 t) (car x)))))) vars))) (setq tem2 (lispx/1 (cddr x) (car x)))) (cond ((null tem3) (go do-cddr1))) (return (cons 'prog (cons (mapcar (cadr x) (function (lambda (x) (cond ((atom x) x) (t (lispx/1 x t)))))) tem2)))) (setq (cond ((fmemb (cadr x) vars) (* |don't| |have| |to| |be| |undoable| |for| |bound| |vriabes,| |e.g.|  |in| mapc\, prog\, |etc.|) (setq tem1 (car x)) (go do-cddr)))) (cond ((and (or (eq (setq tem2 (argtype (car x))) 1) (eq tem2 3)) (not (or (eq (setq tem2 (getprop (car x) 'info)) 'eval) (fmemb 'eval tem2)))) (* d\o |not| |substitute| |unless| |you| |know| |that| |the| |function| |will|  |evaluate| |its| |arguments,| |as| |with| ersetq\, resetvar\, |etc.|  |The| |eason| |for| |not| |just| |returning| |is| |that| |the| |function|  |name| |may| |be| |on| |lispxfns,| |e.g.|  setqq |becomes| savesetqq.) (setq tem2 (cdr x)) (go do-cdr1)) ((and clisparray (null (fgetd (car x))) (setq tem3 (gethash x clisparray))) (return (lispx/1 tem3))) ((null (fgetd (car x))) (* |lispx/| |will| |get| |caaled| |again| |anyway| |after| |it| |is|  |translated,| |and| |if| |we| |do| |substitution| |now,| |may| |change| \a  |setq| |to| savesetq |that| |refers| |to| \a |variable| |bound| |in| \a bind\,  |etc.|) (return x)))) do-cdr (setq tem2 (lispx/1 (cdr x) t)) do-cdr1 (return (cond ((and (eq tem1 (car x)) (eq tem2 (cdr x))) x) (t (cons tem1 tem2)))) do-cddr (setq tem2 (lispx/1 (cddr x) t)) do-cddr1 (return (cond ((and (eq tem1 (car x)) (eq tem2 (cddr x))) x) (t (cons tem1 (cons (cadr x) tem2))))))))) (lispxeval (lambda (lispxform lispxid) (* |Evaluates| lispxform |same| |as| |though| |were| |typed| |in| |to| lispx.  i\f lispxid |not| |given,| _ |is| |used.|) (prog (lispxhist) (or lispxid (setq lispxid '_)) (setq lispxhist (historysave lispxhistory lispxid nil lispxform)) (frplaca (cddr lispxhist) (eval (cond ((nlistp lispxform) lispxform) (t (lispx/ lispxform))) lispxid)) (return (caddr lispxhist))))) (lispxstorevalue (lambda (event value values) (* |lmm| " 1-May-86 12:36") (cond (event (frplaca (cddr event) value) (lispxput 'lispxvalues values nil event))))) (historysave (lambda (history id input1 input2 input3 props) (* |wt:| "18-NOV-78 21:52") (* history |is| |of| |the| |form| (list index size mod) index |is| |between| 0  |and| mod (mod |is| |usually| 100 |or| \a |multiple| |of| 100) |and| |is|  |automatically| |incremented| |each| |time| |an| |entry| |is| |added.|  size |is| |the| |length| |of| list\, |and| |after| list |reaches| |that|  |length,| |old| |entries| |at| |the| |end| |are| |cannibalized| |and| |moved|  |to| |the| |front| |when| |new| |entries| |are| |added.|  |The| |form| |of| |each| |entry| |on| |the| history |list| |is|  (input id value . props) |Value| |is| |initialized| |to| \.) (* |the| |value| |of| |historysave| |is| |the| |corresponding| |event| |or|  |subevent| |in| |the| |case| |of| |gruped| |events.|  |Groups| |are| |represented| |by| |the| |value| |of| |the| |property| *group*  |which| |is| \a |list| |of| |the| |form|  (|event| |event| |...| |event|)\. |each| |subevent| |can| |have| |its| |own|  *group* |property,| |or| history |property,| |etc.|  historysave |automatically| |retrieves| |the| |appropraite| |subevetn,| |no|  |matter| |ho| |nested,| |when| |given| |an| |input| |that| |has| |been|  |reread,| |so| |the| |calling| |functio| |doesnt| |hae| |to| |distinguish|  |between| |new| |input| |and| |reexecution| |of| |input| |whose| |history|  |entry| |has| |alredy| |been| |set| |up.|) (prog ((l (car history)) (index (cadr history)) (size (caddr history)) (mod (or (cadddr history) 100)) (n 0) x y tem) (cond ((or (nlistp history) (and (nlistp (car history)) (car history))) (return nil)) ((and rereadflg (setq x (cdr (fmemb '*group* (cadr (fmemb histstr3 rereadflg)))))) (* |This| |input| |is| |the| |result| |of| \a |history| |command,| |so| |do|  |not| |make| \a |new| |entry.|) (cond ((and (fmemb histstr2 rereadflg) (not (ilessp redocnt \#redocnt))) (cond ((setq tem (cdr (fmemb '*redocnt* (setq x (caar history))))) (frplaca tem redocnt)) (t (nconc x (list '*redocnt* redocnt)))) (return x))) (frplaca x (nconc1 (car x) (setq y (cons (cond (input1 (cons input1 (cons input2 input3))) (input2 (cons input2 input3)) (t input3)) (cons id (cons '\ props)))))) (return y))) (cond ((igreaterp (setq index (add1 index)) mod) (setq index (iplus index (minus mod))))) lp (cond ((cddr l) (add1var n) (setq l (cdr l)) (go lp)) ((igreaterp size (iplus n 2)) (frplaca history (cons (setq x (list nil nil nil)) (car history))) (go smash))) (setq x (cdr l)) (cond ((and archivelst (neq history edithistory) (or (and archivefn (archivefn (caar x) (car x))) (listget1 (car x) '*archive*))) (frplaca archivelst (cons (lispxfind1 (car x)) (car archivelst))) (frplaca (cdr archivelst) (add1 (cadr archivelst))))) (frplacd l nil) (* |Moves| |last| |entry| |to|  |front.|) (frplaca history (frplacd x (car history))) (setq x (car x)) (* x |is| |now| |the| |entry| |to|  |be| |canniablized.|) smash (frplaca (cdr history) index) (cond ((listp id) (* id |is| |the| |new| |entry.|) (frplaca (car history) (setq y id)) (go out)) ((nlistp (setq y (car x))) (* y |is| |now| |the| |input|  |portion| |of| |the| |entry.|) (setq y (cons nil nil)))) (cond (input1 (* |Means| input |is| (input1 input2 . input3) |used| |primarily| |for| apply  input |when| input1 |is| |function| |and| input2 |args.|) (cond ((cdr y) (* |Cannibalize| |previous| |input.|) (frplaca y input1) (frplaca (cdr y) input2) (frplacd (cdr y) input3)) (t (setq y (cons input1 (cons input2 input3)))))) (input2 (* |Means| input |is| (input2 . input3) |used| |primarily| |for| eval input  |when| input2 |is| |form.|) (frplaca y input2) (frplacd y input3)) (t (* |Means| input |is| input3\, |used| |primarily| |for| |line| |inputs,| |such|  |as| history |commands.|) (setq y input3))) (frplaca x y) (frplaca (setq y (cdr x)) id) (cond ((eq (cadr y) '\) (* y |may| |correspond| |to| |an| |event| |that| |has| |not| |yet| |completed|  |but| |will,| |e.g.| |you| |are| |in| \a |break| |and| |have| |performed|  |more| |than| 30 |operations.| |Therefore| y\, |or| |at| |least| |that| |part|  |of| y |beginning| |with| |the| |value| |field,| |should| |not| |be| |used|  |since| |it| |will| |be| |smashed| |wen| |the| |event| |finishes.|) (frplacd y (setq y (cons '\ props)))) (t (frplaca (setq y (cdr y)) '\) (frplacd y props))) (cond (historysaveforms (prog ((event x)) (mapc historysaveforms (function (lambda (x) (ersetq (eval x)))))))) out (cond ((eq id '*) (lispxwatch editstats)) (t (lispxwatch lispxstats))) (cond ((eq rereadflg 'abort) (error!))) (return x)))) (lispxfind (lambda (history line type backup quietflg) (* |wt:| 24-jun-76 14 18) (* quietflg=t |means| |tell| |editor| |not| |to| |print| |messages| |on|  |alt-mode| |matches.| |Used| |by| lispxuse |and| lispxusec.) (cond ((null history) (error '"no history." '\ t))) (* line |specifies| |an| |entry| |or| |entries| |on| history\, |and| type |the|  |desired| |format| |of| |the| |value.| lispxfind |uses| historyfind |to| |get|  |the| |corresponding| |entries,| |and| |then| |decides| |what| |to| |do| |with|  |them.|) (resetvars ((editquietflg (or editquietflg quietflg))) (return (prog ((lst (car history)) (index (cadr history)) (mod (or (cadddr history) 100)) (line0 line) val tem) (cond (backup (* |Used| |when| |want| |to| |refer| |to| history |before| |last| |entry| |was|  |made,| |e.g.| |for| undo |so| undo undo |will| |work.|) (setq lst (cdr lst)) (setq index (sub1 index)))) (cond ((and rereadflg (null (caar lst))) (* |Special| |glitch| |to| |allow| \a |bad| |history| |command| |which|  |contains| |relative| |event| |numbers| |to| |be| |reexecuted| |without|  |changing| |the| |event| |specification| |provided| |it| |is| |done|  |immediately,| |e.g.| |user| |types| use foo for fie in -2\, lispx |types| fie  ? |user| |can| type use fum for fie\, |and| -2 |will| |refer| |to| |the|  |correct| |event.|) (setq lst (cdr lst)) (setq index (sub1 index)))) find (cond ((null line) (setq val (car lst)) (cond ((and (or (eq (caar val) 'undo) (eq (caar val) '|undo|)) (neq (caddr val) '\)) (* s\o |can| |say| undo |then| redo  |or| use.) (setq val (cadr lst)))) (go single)) ((eq (car line) '@@) (* |Archive.|) (return (lispxfind archivelst (cdr line) type)))) lp (setq val (nconc val (lispxfind0 (ldiff line0 (setq line0 (or (fmemb 'and (cdr line0)) (fmemb '|and| (cdr line0)))) ) lst index mod))) (cond ((setq line0 (cdr line0)) (go lp))) group (cond ((null (cdr val)) (setq val (car val)) (go single))) (* val |is| \a |list| |of| |events.|) (and archiveflg (mapc val (function (lambda (x) (lispxput '*archive* t nil x))))) (return (and val (selectq type (input (mapconc val (function (lambda (val) (append (setq tem (lispxgetinput (cond ((null (car val)) (listget1 val '*history*)) (t (car val))) val)) (and (neq (car (last tem)) histstr0) (list histstr0))))))) ((entry entries) val) ((copy copies) (mapcar val (function lispxfind1))) (go bad)))) (* |For| copies |and| entries\, |calling| |function| |expects| \a list |of|  |events,| |for| copy |and| entry |only| |one.|  (|however| |if| |the| |event| |specification| |produces| |more| |than| |one|  |event,| lispxfind |treats| copy |and| entry |the| |same| |as| copies |and|  entries.) entry |is| |used| |by| lispxuse |and| |the| |...|  |Command.| |Entries| |is| |used| |by| forget.  copies |is| |used| |by| name |and| archive.  -  redo |is| |the| |same| |as| input |except| |that| |the| |value| |returned|  |will| |not| |be| |copied| |again,| |so| |it| |must| |be| |copied| |here.|) single (* val |is| \a |single| |event.|) (and archiveflg (lispxput '*archive* t nil val)) (return (and val (selectq type (input (append (setq tem (lispxgetinput (cond ((null (car val)) (listget1 val '*history*)) (t (car val))) val)) (and (neq (car (last tem)) histstr0) (list histstr0)))) (entry val) (entries (list val)) (copy (lispxfind1 val)) (copies (list (lispxfind1 val))) (go bad)))) bad (error type '"- LISPXFIND ?" t)))))) (lispxgetinput (lambda (input event) (* |separate| |function| |so| |can|  |be| |advised|) input)) (remember (lambda (line) (* |wt:| "28-FEB-79 23:52") (markaschanged (getexpressionfromeventspec line) 'expressions))) (getexpressionfromeventspec (lambda (line) (* |wt:| "28-FEB-79 23:49") (prog ((inputlines (lispxfind lispxhistory line 'input t)) next ll) (setq ll (|while| (setq next (fmemb histstr0 inputlines)) |collect| (setq ll (ldiff inputlines next)) (setq inputlines (cdr next)) (cond ((eq (car ll) 'retry\:) (setq ll (cdr ll)))) (setq ll (cond ((null (cdr ll)) (car ll)) (t (selectq (argtype (car ll)) ((1 3) (cons (car ll) (cond ((cddr ll) (cdr ll)) (t (cadr ll))))) (cond ((cddr ll) (error ll "Can't remember")) ((eq (car ll) 'set) (cons 'setq (cons (caadr ll) (mapcar (cdadr ll) (function kwote))))) (t (cons (car ll) (mapcar (cadr ll) (function kwote))))))))) ll)) (return (mkprogn ll))))) (lispxfind0 (lambda (line0 lst index mod) (* |lmm| "10-MAY-81 20:57") (* |Value| |is| \a |list| |of| |entries| |on| |history| |list.|  |lispxfind| |decides| |whatto| |do| |with| |them.|) (prog (historyflg thruflg l1 l2 tem) (cond ((null (cdr line0)) (go out))) (selectq (car line0) (@ (* e.\g. redo @ foo\, |same| |as| |retrieve| foo |and| |then| redo |it,|  |except| |don't| |get| |two| |copies| |of| foo |on| history |list.|) (cond ((null (setq line0 (getprop (setq tem (cadr line0)) '*history*))) (error tem '" ?" t))) (return (cond ((eq type 'input) (* cadr |is| |the| |input,| cddr |the| |events| |themselves.|  |Note| |that| |input| |may| |correspond| |to| |the| |history| |portion,| |e.g.|  |user| |says| name foo use. |The| list list |is| |because| |value| |of|  lspxfind0 |is| |supposed| |to| |be| \a |list| |of| |events.|) (list (list (cadr line0)))) (t (cddr line0))))) ((from |from|) (* |Input| |can| |be| |of| |form| -  from |...| to |...| |or| |...| to |...| -  from |...| thru |...| |or| |...| thru |...|  -  from ...\; to ...\; thru ...\; |or| \a |list| |of| |entries.|) (setq l1 (cdr line0))) ((to thru |to| |thru|) (setq thruflg (or (eq (car line0) 'thru) (eq (car line0) '|thru|))) (setq l2 (historyfind lst index mod (cdr line0) line)) (go ldiff)) ((all |all|) (return (historyfind lst index mod line0 line))) nil) (* a\t |this| |point| |we| |know| |it| |did| |not| |begin| |with| to |or| thru.) (cond ((and (or (setq tem (fmemb 'to line0)) (setq tem (fmemb '|to| line0)) (setq thruflg (setq tem (or (fmemb 'thru line0) (fmemb '|thru| line0))))) (neq (car (nleft line0 1 tem)) 'f)) (setq l1 (historyfind lst index mod (ldiff (or l1 line0) tem) line)) (setq l2 (historyfind lst index mod (cdr tem) line))) (l1 (* |Line| |began| |with| from\, |but| |did| |not| |contain| \a to |or| thru.) (setq l1 (historyfind lst index mod l1 line))) (t (go out))) ldiff (return (cond ((null l1) (and thruflg (setq l2 (cdr l2))) (ldiff lst l2)) ((null l2) (dreverse (cond ((null (cdr l1)) (append lst)) (t (ldiff lst (cdr l1)))))) ((tailp l2 l1) (and thruflg (setq l2 (cdr l2))) (ldiff l1 l2)) (t (and (null thruflg) (setq l2 (cdr l2))) (dreverse (cond ((null (cdr l1)) (append l2)) (t (ldiff l2 (cdr l1)))))))) out (setq tem (car (historyfind lst index mod line0 line))) (return (list (cond ((and historyflg (eq type 'input)) (cons (listget1 tem '*history*) (cdr tem))) (t tem))))))) (lispxfind1 (lambda (x) (* |Produces| \a |copy| |of| \a |history| |entry| |so| |that| |if| |the|  |history| |list| |recycles,| |and| |this| |entry| |is| |cannibalized,| |the|  |value| |of| lispxfind1 |is| |not| |touched.|) (cons (append (car x)) (cons (car (setq x (cdr x))) (cons (car (setq x (cdr x))) (cdr x)))))) (historyfind (lambda (lst index mod eventaddress lispxfindflg) (* |wt:| " 9-SEP-78 23:25") (* |Searches| \a |history| |list| |and| |returns| |the| |tail| |for| |which|  |car| |is| |the| |indicated| |entry.|) (prog ((l lst) (x0 eventaddress) z tem _flg =flg val predflg allflg) lp (selectq (setq z (car eventaddress)) (\\ (setq l (and (equal (caaar lasthistory) (cdr lasthistory)) (car lasthistory)))) ((all |all|) (cond ((null lispxfindflg) (* all |only| |interpreted| |on|  |calls| |from| |lispxfind.|) (error z '" ?" t))) (setq allflg t) (setq eventaddress (cdr eventaddress)) (go lp)) (= (setq =flg t) (setq eventaddress (cdr eventaddress)) (go lp)) (_ (setq _flg t) (setq eventaddress (cdr eventaddress)) (go lp)) ((f \f) (cond ((setq tem (cdr eventaddress)) (* |Otherwise,| f |is| |not| \a |special| |symbol,| |e.g.|  |user| |types| redo f\, |meaning| |search| |for| f |itself.|) (setq eventaddress (cdr eventaddress)) (setq z (car eventaddress)))) (historyfind1)) ((suchthat |suchthat|) (* |What| |follows| suchthat |is| \a |functionto| |be| |applied| |to| |two|  |arguments,| |input| |portion,| |and| |entire| |event,| |and| |if| |true,|  |approves| |that| |event.| |can| |be| |used| |in| |conjuncton| |with| all |or|  _.) (setq predflg t) (setq eventaddress (cdr eventaddress)) (setq z (car eventaddress)) (historyfind1)) (cond ((or _flg =flg (not (numberp z))) (historyfind1) (* |Does| |searching.|) ) ((ilessp z 0) (* |Entries| |on| lst |are| |numbered| |starting| |at| index |and| |decreasing|  |by| 1 |if| z |is| |negative,| |count| |back| |corresponding| |number.|  |if| z |is| |positive,| |count| |forward,| |except| |when| z |is| |first|  |member| |on| x |in| |which| |case| z |is| |the| |absolute| |event| |address,|  |i.e.| z |refers| |to| |the| |index| |that| |would| |be| |printed| |by| |the|  ?? |command.|) (setq l (nth l (iminus z)))) ((neq l lst) (* |move| |forward.|) (setq l (nleft lst (add1 z) l))) ((not (igreaterp z index)) (setq l (cdr (nth l (idifference index z))))) ((igreaterp (setq tem (iplus index mod (iminus z))) 0) (* e.\g. |Suppose| |history| |numbers| |have| |just| |'RECYCLED',| |i.e.|  |current| |history| |is| 5\, |and| |user| |references| 97 |must| |subtract| 97  |from| 105 |to| |find| |how| |far| |back| |the| |entry| |is.|  |The| igreaterp |check| |is| |in| |case| |user| |simply| |typed| |very| |large|  |number.|) (setq l (cdr (nth l tem)))))) (cond ((null l) (cond (allflg (return val)) ((and dwimflg lispxfindflg (some line (function (lambda (eventaddress tail) (and (not (fmemb eventaddress lispxfindsplst)) (fixspell eventaddress 70 lispxfindsplst t tail) ))))) (* o\n |calls| |from| lispxfind\, |attempt| |to| |find| \a |misspelling| |in|  |the| |line,| |and| |if| |so,| |do| \a |retfrom.|) (retfrom 'lispxfind (lispxfind history line type backup quietflg)))) (error z '" ?" t)) ((null (setq eventaddress (cdr eventaddress))) (setq lasthistory (cons l (cons (car (setq tem (caar l))) (cdr tem)))) (* |For| \\ |command.| |Input| |is| |copied| |so| |that| |it| |can| |be| |used|  |as| \a |check| |to| |see| |whether| |this| |particular| |event| |has| |been|  |recycled| |since| |it| |was| |last| |referenced.|) (cond ((null allflg) (return l)) (t (setq val (nconc1 val (car l))) (setq eventaddress x0))))) (setq l (cdr l)) (setq _flg nil) (setq =flg nil) (setq predflg nil) (setq historyflg nil) (go lp)))) (historyfind1 (lambda nil (* |rmk:| "27-MAY-82 23:11") (* |SEarches| |history| |list,| |forward| |or| |backward,| |depending| |on|  _flg\, |looking| |for| z (|bound| |in| |historyfind|)\, |and| |resetting| l  |to| |the| |corresponding| |tail.|) (prog (pat1 pat2 tem pred) (and _flg (cond ((eq l lst) (setq l (last l))) (t (setq l (nleft lst 2 l))))) (cond (predflg) ((and (atom z) (eq (chcon1 z) (charcode _))) (setq pat1 (editfpat (pack (cdr (dunpack z chconlst1))) t))) (t (setq pat2 (editfpat z t)))) lp (cond ((cond ((and (or (eq (setq tem (caaar l)) 'undo) (eq tem '|undo|)) (eq (caddar l) (quote))) (* undo |events| |that| |failed| |to|  |find| |are| |ignored.|) nil) ((and (setq tem (listget1 (car l) '*history*)) pat2 (or (eq pat2 (car tem)) (eq pat2 (car (listp (car tem)))))) (setq historyflg t)) (predflg (apply* z (caar l) (car l))) (pat1 (edit4e pat1 (caaar l))) (t (historymatch (cond (=flg (cond ((fmemb '*history* (car l)) (* |The| |value| |slot| |is| |bell| -  |and| |is| |meaningless.|) (setq l (cdr l)) (go lp1)) ((and (fmemb '*print* (car l)) (or (eq (setq tem (caaar l)) 'ok) (eq tem 'eval))) (* |Although| |the| |value| |of| |this| |event| |may| |match| |the| |pattern,|  |the| |user| |never| |saw| |the| |value| |printed| |out|  (|and| printhistory) |wouldnt| |print| |it| |out.|) (setq l (cdr l)) (go lp1))) (caddar l)) ((and (null rereadflg) (null (caar l))) (listget1 (car l) '*history*)) (t (caar l))) pat2 (car l)))) (return l)) (_flg (setq l (nleft lst 1 l))) (t (setq l (cdr l)))) lp1 (cond ((null l) (return nil))) (go lp)))) (historymatch (lambda (input pat event) (editfindp input pat t))) (valueof (nlambda line (* |wt:| "29-OCT-78 22:25") (* |the| |problem| |is| |how| |to| |decide| |whether| |or| |not| |the| |last|  |event| |is| |to| |be| |considered| |in| |interpreting| |the| |history|  |specificaton.| |if| |the| |use| |typed,|  (valueof -1)\, |he| |obviously| |doesnt| |want| |this| |event| |considered.|  |on| |the| |other| |hand,| |if| |user| |types| |to| |editor|  (i \: (valueof -1)) |he| |does| |want| |mos| |recent| |event| |considered.|  valueof |simply| |uses| |the| |appearance| |of| valueof |in| |the| |event| |as|  |an| |indicator.| |however,| \a |separate| |function| valuof |is| |provided|  |so| |that| |users,| |e.g.| |kaplan,| |can| |define| |lispxmacros| |which|  |effectively| |call| valueof.) (valuof line (editfindp (caaar lispxhistory) 'valueof)))) (valuof (lambda (line backup) (* |lmm| " 1-May-86 23:20") (declare (specvars line backup historyflg)) (prog (y historyflg) (setq y (cond ((null line) (cadar lispxhistory)) (t (car (historyfind (cond (backup (setq y (sub1 (cadr lispxhistory))) (cdar lispxhistory)) (t (setq y (cadr lispxhistory)) (car lispxhistory))) y (or (cadddr lispxhistory) 100) (mklist line)))))) (return (valuof-event y))))) (valuof-event (lambda (y) (* |lmm| " 1-May-86 23:20") (cond ((null (setq line (listget1 y '*group*))) (cl:values-list (listget (cdddr y) 'lispxvalues))) ((null (cdr line)) (valuof-event (car line))) (t (|for| x |in| line |collect| (valuof-event x)))))) (lispxuse (lambda (line history lspxhst) (* |wt:| 18-aug-76 10 31) (prog (expr args vars state lst tem use-args genlst lispxhist) (* lispxhist |rebound| |to| nil |so| esubst |doesn't| |put| |any| |side|  |information| |on| |history.|) (cond ((null line) (error '"use what??" '\ t))) (setq state 'vars) lp (* |Parses| |input| |string| |using|  \a |finite| state |machine.|) (cond ((or (null lst) (null (cdr line)) (null (selectq (car line) ((for |for|) (cond ((eq state 'vars) (setq vars (nconc1 vars lst)) (setq tem (append lst tem)) (setq state 'args) (setq lst nil) t))) ((and |and|) (cond ((eq state 'expr) nil) (t (cond ((eq state 'args) (setq args (nconc1 args lst))) ((eq state 'vars) (* e.\g. |user| |types| use a and b |following| |previous| use |command.|) (setq vars (nconc1 vars lst)))) (setq state 'vars) (setq lst nil) t))) ((in |in|) (cond ((and (eq state 'vars) (null args)) (setq vars (nconc1 vars lst)) (setq tem (append lst tem)) (setq state 'expr) (setq lst nil) t) ((eq state 'args) (setq args (nconc1 args lst)) (setq state 'expr) (setq lst nil) t))) nil))) (setq lst (nconc1 lst (car line))) (cond ((member (car line) tem) (setq genlst (cons (cons (car line) (gensym)) genlst)) (* |This| |enables| use a b for b a\, use a for b and b for a\, |or| use a for  b and b c for a) )))) (cond ((setq line (cdr line)) (go lp))) (selectq state (vars (setq vars (nconc1 vars lst))) (args (setq args (nconc1 args lst))) (expr (setq expr lst)) (help)) (* args |and| vars |are| |lists| |of|  |lists.|) (and (null expr) args (setq expr (list 'f (caar args)))) (* expr |specifies| |expressions| |to| |be| |substituted| into.  e.\g. use foo for fie in fum |or| use foo for fie.  i\n |latter| |case,| |searches| |for| fie.  |The| f |is| |added| |because| |of| |numbers,| |e.g.|  use 3 for 4 |means| |find| 4\, |whereas| use foo for fie in 4 |means| |the| 4th  |expression| |back.|) (and (null args) (setq use-args (cadr (fmemb 'use-args (lispxfind history expr 'entry t t))))) (setq expr (lispxfind history expr 'input t t)) (* expr |now| |is| |the| |expression| (\s) |to| |be| |substituted| |into.|) (cond (args (* |Arguments| |specifically| |named| |by| |user,| |i.e.|  use |...| for |...|) (setq use-args (cons args expr)) (* t\o |be| |saved| |in| |case| |user| |gives| \a |use| |command| |referring|  |to| |this| |event.|) (setq expr (list expr))) (use-args (* |Arguments| |specified| |by|  |other| use |command.|) (setq args (car use-args)) (setq expr (list (cdr use-args))) (cond ((and (cdr args) (null (cdr vars))) (* |User| |types| |command| |of| |the| |form| use a for b and c for d |and|  |follows| |this| |with| use e f.) (setq vars (mapcar (car vars) (function cons)))))) ((or (cdr vars) (cdr (fmemb histstr0 expr))) (* |More| |than| |one| |operation,| |but| |no| args.  |e.g.| use foo in a and b\, |or| |else| |multiple| |arguments| |specified| |in|  |the| |referent| |operation,| |e.g.| |it| |was| |of| |the| |form| use a for b  and c for d.) (error '"for what ?" '\ t)) (t (* e.\g. load (foo) |followed| |by|  use makefile recompile.) (setq tem (cond ((cddr expr) (car expr)) (t (caar expr)))) (setq args (list (list tem))) (setq expr (list expr)))) (setq tem (lispxuse0 vars args expr genlst)) (nconc lspxhst (list 'use-args use-args)) (return tem)))) (lispxuse0 (lambda (vars args expr genlst) (* |wt:| 24-jun-76 14 19) (* |Does| |the| |actual| |substitution| |after| lispxuse |has| |computed| |the|  vars\, args\, |and| exprs. vars |is| \a |list| |of| |lists| |of| |variables,|  |the| |extra| |list| |corresponding| |to| |the| |clauses| |of| |an| and\,  |e.g.| use a b for c and d e for f |would| |have|  ((a b) (d e)) |for| vars\, |and| ((c) (f)) |for| aags.) (prog (val) lp (* |Argument| |names| |have| |either| |been| |supplied| |by| |user| |or|  |obtained| |implicitly| |from| |another| use |command.|) (setq expr (lispxuse1 (car vars) (car args) expr)) (setq vars (cdr vars)) (cond ((setq args (cdr args)) (go lp)) (vars (error '"use what??" '\ t))) (mapc genlst (function (lambda (x) (lispxsubst (car x) (cdr x) expr t)))) (setq val (mapconc expr (function (lambda (x) x)))) (* |Samples:| use a b c d for x y |means| |substitute| a for x and b for y and  |then| |do| |it| |again| |with| c for x and d for y.  |This| |is| |equivalent| |to| use a c for x and b d for y |except| |that|  |first| |case| |can| |be| |followed| |by| use e f |and| |will| |automatically|  |substitute| for x and y. -  use a b c for d and x y z for w |means| |three| |operations,| |with| a for d  and x for w |in| |the| |first,| b for d and y for w |in| |the| |second,| |etc.|  -  use a b c for d and x for y |means| |three| |operations,| |first| |with| a for  d and x for y |second| |with| b for d and x for y |etc.|  |equivalent| |to| use x for y and a b c for d.  -  use a b c for d and x y for z |causes| |error.|  -  use a b for b a |will| |work| |correctly,| |but| use a for b and b for a |will|  |result| |in| |all| |B's| |being| |changed| |to| |A's.|  |The| |general| |rule| |is| |substitution| |proceeds| |from| |left| |to|  |right| |with| |each| |'AND'| |handled| |separately.|  |Whenever| |the| |number| |of| |variables| |exceeds| |the| |number| |of|  |expressions| |available,| |the| |expressions| |multiply.|) (return val)))) (lispxuse1 (lambda (vars args exprs) (prog ((v vars) (a args) (e (copy exprs)) l vflg aflg eflg tem) (setq l e) lp (cond ((and genlst (setq tem (sassoc (car v) genlst)) (strpos ' (car a))) (error '"sorry, that's too hard." (quote) t))) (rplaca e (cond ((eq (car v) '!) (setq v (cdr v)) (lsubst (car v) (car a) (car e))) (t (lispxsubst (or (cdr tem) (car v)) (car a) (car e) t)))) (cond ((null (setq v (cdr v))) (setq vflg t))) (cond ((null (setq a (cdr a))) (setq aflg t))) (cond ((and a v) (go lp)) ((setq e (cdr e)) (go lp1))) (cond ((and (null a) (null v)) (return l))) (setq eflg t) (setq l (nconc l (setq e (copy exprs)))) lp1 (cond ((and eflg vflg aflg) (error '"huh??" (quote) t))) (cond ((null v) (setq v vars))) (cond ((null a) (setq a args))) (go lp)))) (lispxsubst (lambda (x y z charflg) (* |used| |by| |lispx,| |lispxuse| |and| |lispxuse0.|  \a |separate| |function| |so| |can| |be| |advised| |for| |applications|  |involving| |history| |lists| |contaiing| |different| |types| |of| |inputs,|  |e.g.| |strings.|) (cond ((null charflg) (subst x y z)) (t (esubst x y z t))))) (lispxusec (lambda (line history) (* |lmm| " 7-MAY-82 19:30") (* a |short| |version| |of| |the| use |command.|  $ x y |is| |equivalent| |to| use $y$ for $x$.  |user| |can| |also| |say| $ x = y |or| $ x -> y |or| $ y for x.  |User| |can| |specify| |event| |with| in.  |However,| |the| |distributivity| |of| use |command| |is| |not| |allowed.|  (|Note| |that| $ |can| |be| |ued| |even| |if| |character| |editing| |is| |not|  |being| |performed,| |e.g.| $ foo fie |is| |probably| |easier| |to| |type|  |than| use fie for foo.) i\f |the| |event| |referred| |to| |contains| |an|  error |property,| $ |first| |performs| |the| |substitution| |on| |that|  |argument,| |and| |then| |substitues| |the| |corrected| |offender| |into| |the|  |expression.| i\f |the| |user| |omits| \a |second| |argument,| |e.g.|  |types| $ foo\, |the| |substitution| |is| |performed| |for| |the| |offender.|  (i\n |this| |case| |there| |must| |be| |an| error |property.|)) (prog (lispy lispz lispxtem lispx1 lispx2 lispxin lispxhist) (* lispxhist |rebound| |to| nil |so| esubst |doesn't| |put| |any| |side|  |information| |on| |history.|) (cond ((cdr (setq lispxin (fmemb 'in line))) (* |May| |be| |of| |the| |form| $ x in --  |or| $ x y in --. |Note| |that| -- |may| |specify| \a |group.|) (setq line (ldiff line lispxin)) (setq lispy (lispxfind history (setq lispxin (cdr lispxin)) 'entry t t))) ((null (cdr line)) (* |Form| |is| |just| $ x.) (setq lispy (lispxfind history nil 'entry t t)))) (cond ((null (cdr line)) (cond ((setq lispz (cdr (fmemb '*error* lispy))) (setq lispx1 (car line)) (setq lispx2 (car lispz)) (go out)) ((numberp (car line)) (return (lispxusec (cons 'in line) history))) (t (* |Since| |no| |second| |argument| |was| |specified,| |this| |has| |to| |be|  |an| error |correction.| |Note| |that| |it| |may| |have| |been| |of| |the|  |form| $ x |or| $ x in --.) (prin1 '"Unable to figure out what you meant in:" t) (printhistory1 lispy t) (error!))))) (* |Identify| |substituTEE| |and|  |substituTOR.|) (cond ((cddr line) (selectq (cadr line) ((to = ->) (setq lispx1 (caddr line)) (setq lispx2 (car line))) (for (setq lispx1 (car line)) (setq lispx2 (caddr line))) (error (cadr line) '" ?" t))) (t (setq lispx1 (cadr line)) (setq lispx2 (car line)))) (cond ((null lispy) (* |Form| |of| |command| |is| $ x y. |Search| |for| x.) (setq lispxtem (cond ((and (nlistp lispx1) (nlistp lispx2) (not (strpos ' lispx2))) (pack (list ' lispx2 '))) (t lispx2))) (setq lispy (lispxfind history (setq lispxin (list lispxtem)) 'entry t t)))) (setq lispz (cdr (fmemb '*error* lispy))) (* t\o |see| |if| |the| |event| |contains| |an| |error| |property.|  |Note| |that| |even| |if| |the| |user| |identifies| |an| |event| |using| in\,  |if| |the| |event| |contains| |an| |offender,| |the| |character| |substitution|  |takes| |place| |only| |in| |the| |error,| |not| |in| |the| |whole|  |expression.| |See| |comment| |below| |after| editfindp.) out (setq lispy (copy (lispxfind history lispxin 'input t t))) (* |Need| |another| |call| |to| lispxfind |even| |though| |we| |already| |have|  |the| |entry| |because| lispxfind |contains| |smarts| |about| |what| |fields|  |to| |extract,| |e.g.| |did| |use| |say| $ x y in use |or| $ x y in -1\, |etc.|) (cond ((null lispz) (* |The| |user| |is| |using| $ |to| |avoid| |having| |to| |type| |alt-modes|  |around| |his| |patterns,| |otherwise| |this| |is| |essentially| \a  |simplified| use |command.| |therefore| |perform| |the| |substitution| |in|  |the| |input,| |i.e.| lispy) (go out1))) (* |There| |was| |an| |error| |in|  |the| |indicated| |event.|) (setq lispz (car lispz)) (cond ((and (eq lispx2 lispz) (numberp lispx1)) (* $ 1 2 |will| |change| |all| |1's| |to| |2's| |occurring| |inside| |of|  |other| |atoms| |or| |strings.| i\t |will| |not| |change| |the| |number| 1 |to|  |the| |number| 2.0 |Therefore,| |this| |check| |is| |for| |the| |case| |where|  |the| |'bad| |guy'| |was| \a |number,| |and| |the| |user| |was| |typing| |in|  |the| |correct| |number| |in| |the| |form| |of| $ |number.|  |this| |frequently| |happens| |for| |correction| |to| edit |commands,| |e.g.|  |user| |types| (|ri| 1 33) |meaning| (|ri| 1 3) |and| |then| |corrects| |by| $  3) (setq lispxtem lispx1) (and (null editquietflg) (prin2 lispx2 t t) (prin1 '-> t) (print lispx1 t t)) (* |Since| |in| |all| |other| |cases,| esubst |will| |cause| \a |message| |of|  |this| |form| |to| |be| |printed,| |we| |also| |do| |it| |here| |to| |be|  |consistent.|) ) ((null line) (cond ((or (litatom lispz) (stringp lispz)) (* |The| |effect| |of| |this| |is| |to| |cause| |the| |operation| |that|  |caused| |the| |error| |to| |be| |reexecuted| |this| |time| |searching| |for|  |something| |thatis| |'close'| |to| |the| |word| |producing| |the| |error,|  |e.g.| |user| |types| insert -- after condd |and| |system| |types| condd ?  |user| |then| |types| $ |causing| |the| |command| insert --  after condd$$ |to| |be| |executed.|) (setq lispxtem (pack (list lispz ')))) (t (error '" ? " (quote) t)))) ((null (nlsetq (setq lispxtem (esubst lispx1 lispx2 (cond ((listp lispz) (copy lispz)) (t lispz)) nil t)))) (* |The| |indicated| |characters| |do| |not| |appear| |in| lispz\, |the|  |offender.| |Therefore,| |perform| |the| |substitution| |in| |the| |input.|) (go out1))) (cond ((editfindp lispy lispz) (return (subst lispxtem lispz lispy))) (t (prin2 lispz t t) (prin1 '" does not appear in " t) (printhistory1 (list lispy) t) (error!))) out1 (return (esubst lispx1 lispx2 lispy t t))))) (lispxfix (lambda (input coms) (* |wt:| 14-jul-76 14 38) (prog (lispxhist) (return (car (last (editl (cond ((and (eq (cadr input) histstr0) (null (cddr input))) (* |eval| |input,mkae| |the| |current|  |expression| |be| |the| |form|  |itself.|) (list (car input) input)) (t (list input))) coms))))))) (changeslice (lambda (n history l) (* |wt:| "22-NOV-78 23:27") (* |Undoing| \a changslice |involves| |another| |call| |to| changeslice\,  |because| |you| |can't| |just| |replace| |the| |pointers| |because| |of| |the|  |ring| |buffer| |aspect| |of| |the| |history| |list.|  i\n |other| |words,| |the| |place| |where| |events| |was| |deleted| |may| |now|  |be| |the| |beginning| |of| |the| |history| |list.|  |Therefore,| l |represents| |the| |forgotten| |events| |if| |any,| |in| |the|  |case| |that| |the| |history| |list| |is| |being| |enlarged| |by| |virtue| |of|  |undoing| \a changeslice.) (cond ((ilessp n 3) (error n '"is too small")) ((null history) (and lispxhistory (changeslice n lispxhistory)) (and edithistory (changeslice n edithistory))) (t (nconc (car history) l) (* |Add| |forgotten| |events,| |if|  |any.|) (undosave (list 'changeslice (caddr history) history (cdr (setq l (nth (car history) n)))) lispxhist) (frplaca (cddr history) n) (frplaca (cdddr history) (itimes (add1 (iquotient (sub1 n) 100)) 100)) (cond (l (* |Chop| |off| |the| |extra|  |events.|) (frplacd l))))) n)) (lispxstate (lambda (name state) (* state |is| |either| |'BEFORE'| |or|  |'AFTER'|) (prog (x y) (cond ((null (setq x (getp name 'state))) (* |First| |time| state |command|  |used| |with| name.) (cond ((null (setq y (cdr (getp name '*history*)))) (* |The| cdr |is| |because| car  |corresponds| |to| |he| |'arguments'|) (error name '" ?" t)) ((eq state 'after) (return 'was))) (mapc y (function undolispx2)) (/put name 'state (cons 'before lispxhist))) ((eq state (car x)) (return 'was)) (t (undolispx2 x) (/put name 'state (cons state lispxhist)))) (return state)))) (lispxtypeahead (lambda nil (* |wt:| 1-jul-76 14 26) (prog (x l) lp (prin1 '> t) (nlsetq (selectq (setq x (lispxread t t)) ((ok go) (mapc l (function lispxunread)) (retfrom 'lispxtypeahead)) (stop (retfrom 'lispxtypeahead)) (fix (setq l (edite l))) (q (prin1 '\\\\ t) (print (cond ((nlistp (setq x (car l))) x) (t (car x))) t t) (setq l (cdr l))) (?? (mapc (reverse l) (function (lambda (x) (printhistory1 (list x '>) t t))))) (setq l (cons (cond ((or (listp x) (null (readp t))) (list x)) (t (* |The| |extra| |argument| |to| readline |is| |so| |that| \a |line|  |consisting| |of| |just| ]\, |e.g.| foo] |will| |read| |is| |as|  (nil) |instead| |of| nil.) (cons x (readline t nil t)))) l)))) (go lp)))) ) (ADDTOVAR SYSTEMINITVARS (LISPXHISTORY NIL 0 100 100) (GREETHIST)) (DECLARE\: DONTEVAL@LOAD DOCOPY (RPAQQ \#REDOCNT 3) (RPAQQ ARCHIVEFLG T) (RPAQQ ARCHIVEFN NIL) (RPAQQ ARCHIVELST (NIL 0 50 100)) (RPAQQ DISPLAYTERMFLG NIL) (RPAQQ EDITHISTORY (NIL 0 30 100)) (RPAQQ HERALDSTRING NIL) (RPAQQ LASTEXEC NIL) (RPAQQ LASTHISTORY NIL) (RPAQQ LISPXBUFS NIL) (RPAQQ LISPXHIST NIL) (RPAQQ LISPXHISTORY (NIL 0 30 100)) (RPAQQ LISPXPRINTFLG T) (RPAQQ LISPXUSERFN NIL) (RPAQQ MAKESYSDATE NIL) (RPAQQ PROMPT#FLG T) (RPAQQ REDOCNT NIL) (RPAQQ SYSOUT.EXT SYSOUT) (RPAQQ SYSOUTFILE WORK) (RPAQQ SYSOUTGAG NIL) (RPAQQ TOPLISPXBUFS NIL) ) (ADDTOVAR LISPXHISTORYMACROS (TYPE-AHEAD (LISPXTYPEAHEAD)) (??T NIL (PROG (TEM) (RESETVARS ((PRETTYTRANFLG T)) (RESETFORM (OUTPUT T) (PRINTDEF (COND ((NULL (CDAR (SETQ TEM (LISPXFIND LISPXHISTORY LISPXLINE 'ENTRY)))) (CAAR TEM)) (T (CAR TEM))) NIL T))) (TERPRI T) (RETURN NIL)))) (ADDTOVAR LISPXMACROS (SHH NIL (COND ((OR (CDR (LISTP LISPXLINE)) (AND (FMEMB (LASTC T) '(\) ])) (LITATOM (CAR LISPXLINE)))) (APPLY (CAR LISPXLINE) (COND ((AND (LISTP (CADR LISPXLINE)) (NULL (CDDR LISPXLINE))) (CADR LISPXLINE)) (T (CDR LISPXLINE))))) (T (EVAL (COND (LISPXLINE (CAR LISPXLINE)) (T 'SHH)))))) (RETRIEVE (PROG ((X (GETP (CAR LISPXLINE) '*HISTORY*)) REREADFLG) (COND ((NULL X) (ERROR (CAR LISPXLINE) '" ?" T))) (MAPC (CDDR X) (FUNCTION (LAMBDA (X) (HISTORYSAVE LISPXHISTORY X)))) (RETURN (CAR LISPXLINE)))) (BEFORE (LISPXSTATE (CAR LISPXLINE) 'BEFORE)) (AFTER (LISPXSTATE (CAR LISPXLINE) 'AFTER)) (OK (RETFROM (OR (STKPOS 'USEREXEC) 'LISPX) T T)) (REMEMBER\: (PROG1 (LET (FILEPKGFLG) (EVAL (LISPX/ (CAR LISPXLINE)) LISPXID)) (MARKASCHANGED (CAR LISPXLINE) 'EXPRESSIONS))) (REMEMBER (REMEMBER LISPXLINE))) (ADDTOVAR LISPXCOMS SHH RETRIEVE BEFORE AFTER OK REMEMBER\: REMEMBER TYPE-AHEAD ??T) (ADDTOVAR HISTORYCOMS RETRIEVE TYPE-AHEAD) (ADDTOVAR LISPXFINDSPLST FROM TO THRU SUCHTHAT ALL AND) (ADDTOVAR BEFORESYSOUTFORMS (SETQ SYSOUTDATE (DATE)) (PROGN (COND ((NULL FILE) (SETQ FILE SYSOUTFILE)) (T (SETQ SYSOUTFILE (PACKFILENAME 'VERSION NIL 'BODY FILE)))) (COND ((AND (NULL (FILENAMEFIELD FILE 'EXTENSION)) (NULL (FILENAMEFIELD FILE 'VERSION))) (SETQ FILE (PACKFILENAME 'BODY FILE 'EXTENSION SYSOUT.EXT)))))) (ADDTOVAR RESETFORMS (SETQ READBUF NIL) (SETQ READBUFSOURCE NIL) (SETQ TOPLISPXBUFS (OR (CLBUFS T) TOPLISPXBUFS)) (COND ((EQ CLEARSTKLST T) (COND ((EQ NOCLEARSTKLST NIL) (CLEARSTK)) (T (* |clear| |all| |stack| |pointers| EXCEPT |those| |on| NOCLEARSTKLST.) (MAPC (CLEARSTK T) (FUNCTION (LAMBDA (X) (AND (NOT (FMEMB X NOCLEARSTKLST)) (RELSTK X)))))))) (T (MAPC CLEARSTKLST (FUNCTION RELSTK)) (SETQ CLEARSTKLST NIL)))) (ADDTOVAR HISTORYSAVEFORMS ) (ADDTOVAR LISPXCOMS  |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix| |forget| |name| |redo| |repeat| |retry| |undo| |use|) (ADDTOVAR SYSTATS (LISPXSTATS LISPX INPUTS) (UNDOSAVES UNDO SAVES) (UNDOSTATS CHANGES UNDONE) NIL (EDITCALLS CALLS TO EDITOR) (EDITSTATS EDIT COMMANDS) (EDITEVALSTATS COMMANDS INVOLVING EVALUATING A LISP EXPRESSION) (EDITESTATS USES OF AN E COMMAND TYPED IN DIRECTLY) (EDITISTATS USES OF AN I COMMAND TYPED IN DIRECTLY) (EDITUNDOSAVES EDIT UNDO SAVES) (EDITUNDOSTATS EDIT CHANGES UNDONE) NIL (P.A.STATS P.A. COMMANDS) NIL (CLISPIFYSTATS CALLS TO CLISPIFY) NIL (FIXCALLS CALLS TO DWIM) (FIXTIME) (ERRORCALLS WERE DUE TO ERRORS) (DWIMIFYFIXES WERE FROM DWIMIFYING) NIL "OF THOSE DUE TO ERRORS:" (TYPEINFIXES WERE DUE TO ERRORS IN TYPE-IN) (PROGFIXES WERE DUE TO ERRORS IN USER PROGRAMS) (SUCCFIXES1 OF THESE CALLS WERE SUCCESSFUL) NIL "OF THE CALLS DUE TO DWIMIFYING:" (SUCCFIXES2 WERE SUCCESSFUL) NIL (SPELLSTATS OF ALL DWIM CORRECTIONS WERE SPELLING CORRECTIONS) (CLISPSTATS WERE CLISP TRANSFORMATIONS) (INFIXSTATS OF THESE WERE INFIX TRANSFORMATIONS) (IFSTATS WERE IF/THEN/ELSE STATEMENTS) (I.S.STATS WERE ITERATIVE STATEMENTS) (MATCHSTATS WERE PATTERN MATCHES) (RECORDSTATS WERE RECORD OPERATIONS) NIL (SPELLSTATS1 OTHER SPELLING CORRECTIONS\, E.G. EDIT COMMANDS) NIL (RUNONSTATS OF ALL SPELLING CORRECTIONS WERE RUN-ON CORRECTIONS) NIL (VETOSTATS CORRECTIONS WERE VETOED) NIL) (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 '": this sysout is initialized for user " T) (LISPXPRIN1 USERNAME T) (LISPXPRIN1 '". " T) (LISPXPRIN1 '"To reinitialize, type GREET() " T))) (SETINITIALS)) (MAPC SYSTATS (FUNCTION (LAMBDA (X) (AND (LISTP X) (EQ (GETTOPVAL (CAR X)) 'NOBIND) (SETTOPVAL (CAR X) NIL))))) (PUTD 'E) (DEFINEQ (greet (lambda (name flg) (* |lmm| "11-Dec-85 17:58") (or (ersetq (prog (file) (tab 0 0 t) (setq username (cond ((null name) (username nil t)) (t (cond ((getd 'setusername) (setusername name))) (mkatom name)))) (|for| x |in| pregreetforms |do| (eval x)) (and (setq file (greetfilename t)) (load file 'sysload)) (* |System| |greeting|) (and (setq file (greetfilename username)) (load file t)) (* |User| |greeting|) (|for| x |in| postgreetforms |do| (eval x)) (greet0) (return t))) (printout t "error during GREET..." t)))) (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) '"Good morning") ((ILESSP HOUR 18) '"Good afternoon") (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))) (ADDTOVAR POSTGREETFORMS (SETINITIALS) (AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS))) (DECLARE\: DONTEVAL@LOAD DOCOPY (RPAQQ GREETHIST NIL) (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"))) (RPAQQ USERNAME NIL) (RPAQQ HOSTNAME NIL) (RPAQQ CONSOLETIME 0) (RPAQQ CONSOLETIME0 0) (RPAQQ CPUTIME 0) (RPAQQ CPUTIME0 0) (RPAQQ EDITIME 0) (RPAQQ FIRSTNAME NIL) (ADDTOVAR BEFOREMAKESYSFORMS (SETQ RESETFORMS (CONS GREETFORM RESETFORMS)) (SETQ MAKESYSDATE (DATE))) (ADDTOVAR AFTERMAKESYSFORMS (LISPXEVAL '(GREET) '_)) ) (DEFINEQ (lispxprint (lambda (x y z nodoflg) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cons 'print (cond (z (list x y z)) (y (list x y)) (x (list x))))) t lispxhist)) (and (null nodoflg) (print x y z)))) (lispxprin1 (lambda (x y z nodoflg) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cond ((and (eq y t) (stringp x)) (* |The| |string| |itself| |will| |be| |stored.|  |This| |saves| 3 |cells.|) x) (t (cons 'prin1 (cond (z (list x y z)) (y (list x y)) (x (list x))))))) t lispxhist)) (and (null nodoflg) (prin1 x y z)))) (lispxprin2 (lambda (x y z nodoflg) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cond ((and (eq y t) (nlistp x) (not (stringp x))) (* |The| |atm| |will| |be| |stored|) x) (t (cons 'prin2 (cond (z (list x y z)) (y (list x y)) (x (list x))))))) t lispxhist)) (and (null nodoflg) (prin2 x y z)))) (lispxprintdef (lambda (expr file left def tail nodoflg) (* |wt:| 11-may-76 19 59) (* |so| |uer| |can| |prettyprint| |and| |have| |it| |appear| |on| |history|  |list|) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (list 'lispxprintdef0 expr file left def tail)) t lispxhist)) (and (null nodoflg) (lispxprintdef0 expr file left def tail)))) (lispxprintdef0 (lambda (expr file left def tail) (* |wt:| 11-may-76 19 59) (* |this| |function| |is| |necessar| |to| |implement| |lispxprintdef| |because|  |printdef| |itself| |doesnt| |take| \a |file| |argument.|) (resetform (output file) (printdef expr left def tail)))) (lispxspaces (lambda (x y z nodoflg) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cond ((and (eq y t) (eq x 1)) '" ") (t (cons 'spaces (cond (y (list x y)) (x (list x))))))) t lispxhist)) (and (null nodoflg) (spaces x y)))) (lispxterpri (lambda (x y z nodoflg) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cond ((eq x t) '" ") (t (cons 'terpri (cond (x (list x))))))) t lispxhist)) (and (null nodoflg) (terpri x)))) (lispxtab (lambda (x y z nodoflg) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cons 'tab (cond (z (list x y z)) (y (list x y)) (x (list x))))) t lispxhist)) (and (null nodoflg) (tab x y z)))) (userlispxprint (lambda (x file z nodoflg) (* |wt:| 14-may-76 13 8) (* |this| |defnition| |can| |be| |movd'd| |to| |any| |user| |function| |whose|  |name| |begins| |with| lispx |to| |make| |it| |work| |like| \a |LISPXprining|  |function.| |it| |requires| |that| |the| |file| |argument| |be| |the| |second|  |argument,| |and| |that| |the| |function| |only| |have| |three| |arguments|) ((lambda (pos) (* |This| |has| |the| |avantage| |of|  |working| |both| |compiled|  |andinterpreted.|) (prog (fn) (setq fn (stkname pos)) (relstk pos) (setq fn (cond ((null (strpos 'lispx fn nil nil t)) (help fn)) (t (mkatom (substring fn 6 -1))))) (and lispxprintflg lispxhist (lispxput '*lispxprint* (list (cons fn (nlist x file z))) t lispxhist)) (return (and (null nodoflg) (apply* fn x file z))))) (stknth -1)))) (lispxput (lambda (prop l addflg lst) (prog (y) (and (null lst) (setq lst (caar lispxhistory))) (* |Puts| |property| |at| |top| |level| |of| |entry.|  |Used| |mostly| |for| |calls| |with| prop=error.) (cond ((setq y (cdr (fmemb prop lst))) (frplaca y (cond (addflg (nconc (car y) l)) (t l)))) (t (nconc lst (list prop l)))) (return l)))) ) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \#REDOCNT ARCHIVEFLG ARCHIVEFN ARCHIVELST BOUNDPDUMMY BREAKRESETVALSLST CAR/CDRNIL CHCONLST1 CLEARSTKLST CLISPARRAY CLISPCHARS CLISPFLG CLISPTRANFLG CONSOLETIME CONSOLETIME0 CPUTIME CPUTIME0 CTRLUFLG CUTEFLG DISPLAYTERMFLG DWIMFLG EDITHISTORY EDITIME EDITQUIETFLG EDITSTATS EVALQTFORMS FILERDTBL FIRSTNAME GREETDATES GREETHIST HISTORYCOMS HISTORYSAVEFN HISTORYSAVEFORMS HISTSTR0 HISTSTR2 HISTSTR3 IT LASTHISTORY LISP-RELEASE-VERSION LISPXBUFS LISPXCOMS LISPXFINDSPLST LISPXFNS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS LISPXPRINTFLG LISPXREADFN LISPXSTATS LISPXUSERFN MACSCRATCHSTRING NEWUSERFLG P.A.STATS POSTGREETFORMS PREGREETFORMS PRETTYHEADER RANDSTATE READBUFSOURCE REDOCNT REREADFLG RESETFORMS SYSFILES TOPLISPXBUFS USERHANDLE USERNAME) ) (RPAQQ LISP-RELEASE-VERSION 2.0) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK\: LISPXFINDBLOCK LISPXFIND LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1 (ENTRIES LISPXFIND HISTORYFIND) (LOCALFREEVARS _FLG L LST Z =FLG HISTORYFLG PREDFLG LINE HISTORY TYPE BACKUP QUIETFLG) (NOLINKFNS HISTORYMATCH LISPXGETINPUT)) (BLOCK\: NIL ENTRY# EVALQT GETEXPRESSIONFROMEVENTSPEC GREET GREET0 HISTORYMATCH HISTORYSAVE LISPX LISPX/ LISPX/1 LISPXEVAL LISPXFIND1 LISPXGETINPUT LISPXPRIN1 LISPXPRIN2 LISPXPRINT LISPXPRINTDEF LISPXPRINTDEF0 LISPXPUT LISPXREAD LISPXREADBUF LISPXREADP LISPXSPACES LISPXSTOREVALUE LISPXSUBST LISPXTAB LISPXTERPRI LISPXTYPEAHEAD LISPXUNREAD LISPXUSE LISPXUSE0 LISPXUSE1 LISPXUSEC PRINTHISTORY PRINTHISTORY1 PRINTHISTORY2 USEREXEC USERLISPXPRINT VALUEOF VALUOF (LOCALVARS . T) (SPECVARS LISPXLINE LISPXID LISPXVALUE LISPXLISTFLG HISTORY ID EVENT BREAKRESETVALS VARS GENLST INITLST NAME MESSAGE) (LINKFNS . T) (NOLINKFNS LISPXTYPEAHEAD UNDOLISPX ARCHIVEFN LISPXFIX LISPXUSE LISPXUSE0 LISPXSUBST LISPXFIND HISTORYMATCH PRINTHISTORY DISPLAYTERMP LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT PRINTHISTORY1 PRINTHISTORY2 LISPXFIND HISTORYMATCH LISPXGETINPUT LISPXSUBST ARCHIVEFN LISPXFIX LISPXUSE LISPXUSE0 LISPXSUBST HISTORYMATCH PRINTHISTORY DISPLAYTERMP LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT LISPXTYEAHEAD UNDOLISPX GREETFILENAME)) ) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA VALUEOF) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (DECLARE\: DONTCOPY (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