(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "24-Oct-88 18:24:24" {POOH/N}<POOH>LAFITE>SOURCES>LAFITEMAIL;3
 52612  

      changes to%:  (FNS \LAFITE.GETNEWMAIL1 \LAFITE.RETRIEVEMESSAGES)

      previous date%: " 7-Sep-88 19:00:05" {POOH/N}<POOH>LAFITE>SOURCES>LAFITEMAIL;2)


(* "
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LAFITEMAILCOMS)

(RPAQQ LAFITEMAILCOMS ((COMS (* ; "Retrieving mail") (FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL \LAFITE.GETNEWMAIL1 \LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES \LAFITE.HANDLE.BIG.MESSAGE \LAFITE.FIND.BREAKPOINT)) (COMS (* ; "Mail polling and registration") (FNS \LAFITE.GET.USER.DATA \LAFITE.GUESS.MODE \LAFITE.REGISTER.MODE LAFITECLEARCACHE FULLUSERNAME LAFITE.USER.NAME.FROM.LOGIN LAFITEMAILWATCH \LAFITE.WAKE.WATCHER POLLNEWMAIL \LAFITE.NEW.MAIL.EXISTS PRINTLAFITESTATUS LAFITE.STATUS.WITH.TIME \LAFITE.REINITIALIZING)) (COMS (* ; "Parsing mail files") (FNS PARSEMAILFOLDER PARSEMAILFOLDER1 BADMAILFILE BADMAILFILE.FLAGBYTE VERIFYMAILFOLDER VERIFYFAILED READTOCFILE BADTOCFILE \LAFITE.TOCEOF LA.READCOUNT LA.PRINTCOUNT LA.READSTAMP \LAFITE.VERIFYMSG LA.MSGFROMMEP LA.PRINTSTAMP LA.READSHORTSTRING LA.PRINTSHORTSTRING LA.READSTRING) (FNS LAFITE.PARSE.MSG.FOR.TOC LAFITE.FETCH.TO.FIELD LAFITE.PARSE.HEADER LAFITE.GRAB.DATE LAFITE.READ.LINE.FOR.TOC LAFITE.READ.FORMAT LAFITE.READ.NAME.FIELD LAFITE.READ.ONE.LINE.FOR.TOC LAFITE.READ.TO.EOL LA.SKIP.TO.EOL LAFITE.SKIP.WHITE.SPACE) (FNS \LAFITE.PARSE.MESSAGE) (COMS (VARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.SUBJECTFIELDONLY) (FNS LAFITE.INIT.PARSETABLES LAFITE.MAKE.PARSE.TABLE LAFITE.MAKE.PARSE.TABLE1))) (COMS (INITVARS (*LAFITE-VERIFY-ACTION* NIL) (MAILWATCHWAITTIME 5) (LAFITEFLUSHMAILFLG T) (LAFITETOC.EXT "-Lafite-toc") (LAFITENEWMAILFN NIL) (LAFITENEWMAILTUNE NIL) (LAFITEGETMAILTUNE NIL) (LAFITE.AFTER.GETMAIL.FN NIL)) (INITVARS (\LAFITE.LAST.STATUS)) (ADDVARS (\SYSTEMCACHEVARS \LAFITE.LAST.STATUS))) (DECLARE%: DOEVAL@COMPILE (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-VERIFY-ACTION* DEFAULTREGISTRY LAFITEDEBUGFLG))) (CL:PROCLAIM (QUOTE (GLOBAL LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITENEWMAILFN LAFITENEWMAILTUNE LAFITEIFFROMMETHENSEENFLG MAILWATCHWAITTIME LAFITETOC.EXT))))) (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.SUBJECTFIELDONLY \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD LAFITE.AFTER.GETMAIL.FN) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T))))



(* ; "Retrieving mail")


(DEFINEQ

(\LAFITE.GETMAIL

(LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* bvm%: "25-Mar-84 17:20") (\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.GETMAIL.PROC) (KWOTE WINDOW) (KWOTE MAILFILEDATA) (KWOTE ITEM) (KWOTE MENU)) (QUOTE LAFITEGETMAIL)))
)

(\LAFITE.GETMAIL.FROM.ICON

(LAMBDA (ICONW) (* ; "Edited  3-Jun-88 12:16 by bvm") (* ;; "Called from icon menu--expand the window and run GetMail.") (LAB.DO.COMMAND (PROG1 (WINDOWPROP ICONW (QUOTE ICONFOR)) (EXPANDW ICONW)) (FUNCTION \LAFITE.GETMAIL)))
)

(\LAFITE.GETMAIL.PROC

(LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm%: "11-Nov-84 18:30") (RESETLST (LA.RESETSHADE ITEM MENU) (OBTAIN.MONITORLOCK (fetch FOLDERLOCK of MAILFOLDER) NIL T) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (OBTAIN.MONITORLOCK \LAFITE.MAILSERVERLOCK NIL T) (\LAFITE.GETNEWMAIL MAILFOLDER WINDOW)) (\LAFITE.WAKE.WATCHER))
)

(\LAFITE.GETNEWMAIL

(LAMBDA (FOLDER WINDOW) (* ; "Edited  6-Jun-88 17:40 by bvm") (PROG* ((ALLMODES (LAFITE.ALL.MODES.P :GETMAIL)) (NEWMAILSEEN (for MODE in \LAFITE.ACTIVE.MODES when (OR ALLMODES (EQ (fetch (LAFITEMODEDATA LAFITEOPS) of MODE) \LAFITEMODE)) thereis (for MAILSERVER in (fetch (LAFITEMODEDATA MAILSERVERS) of MODE) thereis (fetch (MAILSERVER NEWMAILP) of MAILSERVER)))) FIRSTMESSAGE NTHTIME) (\LAFITE.OPEN.FOLDER FOLDER (QUOTE APPEND) :OK) (replace (MAILFOLDER FOLDERGETSMAIL) of FOLDER with T) (for *LAFITE-MODE-DATA* in \LAFITE.ACTIVE.MODES when (OR ALLMODES (EQ (fetch (LAFITEMODEDATA LAFITEOPS) of *LAFITE-MODE-DATA*) \LAFITEMODE)) do (for MAILSERVER in (fetch (LAFITEMODEDATA MAILSERVERS) of *LAFITE-MODE-DATA*) bind MESSAGELIST when (AND (OR (NOT NEWMAILSEEN) (fetch (MAILSERVER NEWMAILP) of MAILSERVER)) (PROGN (* ; "I.e., only here if NOBODY reported mail (in which case user is asking for explicit poll), or if watcher already noticed mail") (COND (NTHTIME (LAB.PROMPTPRINT FOLDER "; ")) (T (SETQ NTHTIME T))) (LAB.PROMPTPRINT FOLDER (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) " .. ") (SETQ MESSAGELIST (\LAFITE.GETNEWMAIL1 MAILSERVER FOLDER FIRSTMESSAGE)))) do (LAB.APPENDMESSAGES FOLDER MESSAGELIST) (COND ((NOT FIRSTMESSAGE) (* ; "select the first new message -- all former messages have already been unselected") (SELECTMESSAGE (SETQ FIRSTMESSAGE (CAR MESSAGELIST)) FOLDER) (AND LAFITE.AFTER.GETMAIL.FN (CL:FUNCALL LAFITE.AFTER.GETMAIL.FN FOLDER MESSAGELIST)))))) (if (NULL NTHTIME) then (* ; "No mode had any mail servers") (LAB.PROMPTPRINT FOLDER "No mailboxes known")) (LAB.PROMPTPRINT FOLDER (QUOTE %.)) (COND (FIRSTMESSAGE (* ; "If any mail was retrieved, select the first message and make sure it is visible") (LAB.EXPOSEMESSAGE FOLDER FIRSTMESSAGE) (COND (LAFITEGETMAILTUNE (PLAYTUNE LAFITEGETMAILTUNE))) (PRINTLAFITESTATUS "Finished Retrieving Mail")))))
)

(\LAFITE.GETNEWMAIL1

(LAMBDA (MAILSERVER MAILFOLDER NTHTIME) (* ; "Edited 24-Oct-88 17:43 by bvm") (PROG (MESSAGELIST OPENRESULT MAILBOX %#OFMESSAGES OUTSTREAM) (SETQ OPENRESULT (CL:FUNCALL (fetch (MAILSERVER OPENMAILBOX) of MAILSERVER) (fetch (MAILSERVER MAILPORT) of MAILSERVER) (fetch (LAFITEMODEDATA FULLUSERNAME) of *LAFITE-MODE-DATA*) (fetch (LAFITEMODEDATA CREDENTIALS) of *LAFITE-MODE-DATA*) MAILSERVER)) (SELECTQ (COND ((LISTP OPENRESULT) (SETQ MAILBOX (fetch (OPENEDMAILBOX MAILBOX) of OPENRESULT))) (T OPENRESULT)) (EMPTY (* ; "Nothing to retrieve") (LAB.PROMPTPRINT MAILFOLDER "empty") (RETURN NIL)) (NIL (* ; "No response")) (COND (MAILBOX (COND ((NOT NTHTIME) (PRINTLAFITESTATUS "Retrieving Mail") (UNSELECTALLMESSAGES MAILFOLDER))) (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE APPEND) :OK) (COND ((SETQ %#OFMESSAGES (LISTGET (fetch (OPENEDMAILBOX PROPERTIES) of OPENRESULT) (QUOTE %#OFMESSAGES))) (\LAFITE.GETNEWMAIL# MAILFOLDER %#OFMESSAGES))) (RETURN (COND ((SETQ MESSAGELIST (\LAFITE.RETRIEVEMESSAGES MAILSERVER MAILBOX MAILFOLDER)) (COND ((NULL %#OFMESSAGES) (\LAFITE.GETNEWMAIL# MAILFOLDER (LENGTH MESSAGELIST)))) MESSAGELIST)))))) (LAB.PROMPTPRINT MAILFOLDER "not responding") (COND ((CDR (LISTP OPENRESULT)) (* ; "Say more about why not responding") (LAB.PROMPTPRINT MAILFOLDER " (" (fetch (OPENEDMAILBOX PROPERTIES) of OPENRESULT) ")")))))
)

(\LAFITE.GETNEWMAIL#

(LAMBDA (MAILFOLDER %#OFMESSAGES) (* bvm%: " 4-Feb-86 12:17") (LAB.PROMPTPRINT MAILFOLDER "(" %#OFMESSAGES (COND ((EQ %#OFMESSAGES 1) " msg") (T " msgs")) ") "))
)

(\LAFITE.RETRIEVEMESSAGES

(LAMBDA (MAILSERVER MAILBOX MAILFOLDER) (* ; "Edited 24-Oct-88 17:42 by bvm") (CAR (ERSETQ (LET* ((OUTSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE APPEND) :OK)) (ORIGEOF (GETEOFPTR OUTSTREAM)) SUCCESS) (if (NOT (= ORIGEOF (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER))) then (* ; "Oops, something snuck in here.  Ordinarily this is caught when we open the file, so probably this is result of internal bug") (SETQ ORIGEOF (GETEOFPTR (SETQ OUTSTREAM (\LAFITE.FOLDER.CHANGED MAILFOLDER OUTSTREAM (QUOTE BOTH) :OK))))) (CL:UNWIND-PROTECT (LET* ((WINDOW (fetch BROWSERPROMPTWINDOW of MAILFOLDER)) (XPOS (AND WINDOW (DSPXPOSITION NIL WINDOW))) (NEXTMESSAGEFN (fetch (MAILSERVER NEXTMESSAGE) of MAILSERVER)) (RETRIEVEFN (fetch (MAILSERVER RETRIEVEMESSAGE) of MAILSERVER)) (ENDPOS ORIGEOF) (COUNTER 0) (MODEBITS (fetch (LAFITEMODEDATA MODEINDEX) of *LAFITE-MODE-DATA*)) MESSAGELIST STARTPOS LENGTHPOS MSGLENGTH NEXTMESSAGERESULT MSG EXTRAMESSAGES) (while (SETQ NEXTMESSAGERESULT (CL:FUNCALL NEXTMESSAGEFN MAILBOX)) unless (AND (LISTP NEXTMESSAGERESULT) (LISTGET NEXTMESSAGERESULT (QUOTE DELETED))) do (* ; "print the message stamp to the file") (SETFILEPTR OUTSTREAM (SETQ STARTPOS ENDPOS)) (COND ((NOT (= STARTPOS (GETEOFPTR OUTSTREAM))) (HELP "Lafite is confused about where the end of the file is.") (* ; "If the user cleverly returns from here, god help us") (SETFILEPTR OUTSTREAM (SETQ STARTPOS (GETEOFPTR OUTSTREAM))))) (LA.PRINTSTAMP OUTSTREAM) (SETQ LENGTHPOS (GETFILEPTR OUTSTREAM)) (PRIN3 "00000 00024 UU " OUTSTREAM) (BOUT OUTSTREAM (CHARCODE CR)) (* ; "now get the message and put it in the file") (CL:FUNCALL RETRIEVEFN MAILBOX OUTSTREAM) (SETQ MSGLENGTH (- (SETQ ENDPOS (GETFILEPTR OUTSTREAM)) STARTPOS)) (* ; "go back and print the message length in the stamp") (SETQ MSG (create LAFITEMSG MARKCHAR ← UNSEENMARK BEGIN ← STARTPOS STAMPLENGTH ← LAFITESTAMPLENGTH MESSAGELENGTH ← MSGLENGTH MODEBITS ← MODEBITS)) (COND ((> MSGLENGTH 99999) (* ; "Too big for this crufty format to handle") (SETQ EXTRAMESSAGES (\LAFITE.HANDLE.BIG.MESSAGE OUTSTREAM MAILFOLDER MSG MSGLENGTH)) (SETQ MSGLENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSG)) (SETQ ENDPOS (GETEOFPTR OUTSTREAM)))) (SETFILEPTR OUTSTREAM LENGTHPOS) (LA.PRINTCOUNT MSGLENGTH OUTSTREAM) (push MESSAGELIST MSG) (COND (EXTRAMESSAGES (for M in EXTRAMESSAGES do (push MESSAGELIST M)) (SETQ EXTRAMESSAGES))) (COND (XPOS (DSPXPOSITION XPOS WINDOW) (printout WINDOW |.I1| (add COUNTER 1)))) finally (COND (XPOS (* ; "Prepare to overwrite counter with 'done'") (DSPXPOSITION XPOS WINDOW))) (SETQ SUCCESS T) (RETURN (REVERSE MESSAGELIST)))) (* ;; "Cleanups: Do this whether we were successful or not") (if (NULL SUCCESS) then (* ; "Retrieval error somewhere.  Dispose of what we have retrieved") (LAB.PROMPTPRINT MAILFOLDER " retrieval aborted") (SETFILEPTR OUTSTREAM ORIGEOF) (SETFILEINFO OUTSTREAM (QUOTE LENGTH) ORIGEOF)) (\LAFITE.CLOSE.FOLDER MAILFOLDER (NULL SUCCESS)) (* ; "Force output on the mail file so we're sure we have it") (CL:FUNCALL (fetch (MAILSERVER CLOSEMAILBOX) of MAILSERVER) MAILBOX (AND SUCCESS LAFITEFLUSHMAILFLG)) (* ; "Tell server we're thru, flushing if successful") (if SUCCESS then (LAB.PROMPTPRINT MAILFOLDER "done")))))))
)

(\LAFITE.HANDLE.BIG.MESSAGE

(LAMBDA (OUTSTREAM MAILFOLDER MSG TOTALLENGTH) (* bvm%: "11-Mar-85 23:41") (* ;; "Called when we receive a message that is longer than our mail file format accommodates.  Breaks it into two or more messages of suitable length, and returns them") (PROG ((TEMPFILE (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (TEMPSTART 0) MSGLENGTH CRPOS SPACEPOS OUTSTREAMSTART RESTLENGTH HERE NEXTLENGTH LENGTHPOS HEADERLENGTH MSGFIELDS) (SETQ MSGFIELDS (LAFITE.PARSE.HEADER OUTSTREAM \LAPARSE.FULL (fetch (LAFITEMSG START) of MSG) (fetch (LAFITEMSG END) of MSG))) (* ; "get header info") (SETQ MSGLENGTH (\LAFITE.FIND.BREAKPOINT OUTSTREAM (fetch (LAFITEMSG BEGIN) of MSG) 99999)) (* ; "New length of first part of message") (COPYBYTES OUTSTREAM TEMPFILE (SETQ OUTSTREAMSTART (+ (fetch (LAFITEMSG BEGIN) of MSG) MSGLENGTH)) (+ OUTSTREAMSTART (SETQ TOTALLENGTH (- TOTALLENGTH MSGLENGTH)))) (* ; "Save rest of message in TEMPFILE") (replace (LAFITEMSG MESSAGELENGTH) of MSG with MSGLENGTH) (SETFILEPTR OUTSTREAM OUTSTREAMSTART) (RETURN (while (NEQ TOTALLENGTH 0) collect (LA.PRINTSTAMP OUTSTREAM) (* ; "Print a new header for next continuation part") (SETQ LENGTHPOS (GETFILEPTR OUTSTREAM)) (PRIN3 "00000 00024 UU " OUTSTREAM) (BOUT OUTSTREAM (CHARCODE CR)) (POSITION OUTSTREAM 0) (LINELENGTH MAX.SMALLP OUTSTREAM) (for PAIR in (REVERSE MSGFIELDS) do (* ; "Reconstruct some of header") (SELECTQ (CAR PAIR) ((Date Sender From) (printout OUTSTREAM (CAR PAIR) ": " (CADR PAIR) T)) ((To cc Reply-to) (for X in (CDR PAIR) do (printout OUTSTREAM (CAR PAIR) ": " X T))) NIL)) (printout OUTSTREAM "Subject: (continuation of previous message)" T T) (SETQ HEADERLENGTH (- (SETQ HERE (GETFILEPTR OUTSTREAM)) OUTSTREAMSTART)) (* ; "This is how much we added by putting in a message header and the stamp section") (COND ((> (SETQ NEXTLENGTH (+ (SETQ RESTLENGTH TOTALLENGTH) HEADERLENGTH)) 99999) (* ; "Need to break up still more") (SETQ RESTLENGTH (\LAFITE.FIND.BREAKPOINT TEMPFILE TEMPSTART (- 99999 HEADERLENGTH))) (SETQ NEXTLENGTH (+ RESTLENGTH HEADERLENGTH)))) (SETFILEPTR OUTSTREAM LENGTHPOS) (LA.PRINTCOUNT NEXTLENGTH OUTSTREAM) (* ; "Store correct length of this segment") (SETFILEPTR OUTSTREAM HERE) (SETFILEPTR TEMPFILE TEMPSTART) (COPYBYTES TEMPFILE OUTSTREAM RESTLENGTH) (PROG1 (create LAFITEMSG MARKCHAR ← UNSEENMARK BEGIN ← OUTSTREAMSTART MESSAGELENGTH ← NEXTLENGTH STAMPLENGTH ← LAFITESTAMPLENGTH) (SETQ OUTSTREAMSTART (+ OUTSTREAMSTART NEXTLENGTH)) (SETQ TEMPSTART (+ TEMPSTART RESTLENGTH)) (SETQ TOTALLENGTH (- TOTALLENGTH RESTLENGTH)))))))
)

(\LAFITE.FIND.BREAKPOINT

(LAMBDA (STREAM START LENGTH) (* bvm%: " 7-Nov-84 14:07") (* ;;; "Looks for a good breaking place in STREAM somewhere short of LENGTH beyond START.  Returns a new length less than or equal to LENGTH") (SETFILEPTR STREAM (+ START LENGTH -200)) (for I from 199 to 1 by -1 bind CRPOS SPACEPOS do (* ; "look for a space or cr to make a pleasant break") (SELCHARQ (\BIN STREAM) ((SPACE TAB) (SETQ SPACEPOS I)) (CR (SETQ CRPOS I)) NIL) finally (* ; "Break after the last CR, or last space if no CR") (RETURN (- LENGTH (OR CRPOS SPACEPOS 0)))))
)
)



(* ; "Mail polling and registration")


(DEFINEQ

(\LAFITE.GET.USER.DATA

(LAMBDA (MODE DONTWAIT RECOMPUTE) (* ; "Edited  7-Jun-88 19:31 by bvm") (* ;;; "Return the mode data for specified MODE, or the current mode if NIL.  This function is in charge of setting \LAFITEUSERDATA") (COND ((NOT (OR (LISTP MODE) (SETQ MODE (if MODE then (ASSOC MODE LAFITEMODELST) else (OR \LAFITEMODE (\LAFITE.INFER.MODE)))))) (SETQ \LAFITE.AUTHENTICATION.FAILURE "No Mode") NIL) ((AND (NOT RECOMPUTE) (ASSOC MODE \LAFITE.ACTIVE.MODES))) ((NOT DONTWAIT) (WITH.MONITOR \LAFITE.MAILSERVERLOCK (* ; "Let's not have everyone try this at once") (ALLOW.BUTTON.EVENTS) (* ; "Make sure not to trap the mouse") (LET ((DATA (ASSOC MODE \LAFITE.ACTIVE.MODES))) (if RECOMPUTE then (SETQ \LAFITE.ACTIVE.MODES (DREMOVE DATA \LAFITE.ACTIVE.MODES)) (SETQ DATA NIL)) (COND (DATA) (T (\LAFITE.REGISTER.MODE MODE) (* ; "In case it hasn't been done yet") (PRINTLAFITESTATUS (LAFITE.STATUS.WITH.TIME (CONCAT "Authenticating" (AND (OR (NEQ MODE \LAFITEMODE) (LAFITE.SHOW.MODE.P)) (CONCAT " " (fetch (LAFITEOPS LAFITEMODE) of MODE)))))) (if (SETQ DATA (CL:FUNCALL (fetch (LAFITEOPS AUTHENTICATOR) of MODE))) then (replace (LAFITEMODEDATA LAFITEOPS) of DATA with MODE) (push \LAFITE.ACTIVE.MODES DATA) DATA))))))))
)

(\LAFITE.GUESS.MODE

(LAMBDA (MSG) (* ; "Edited  9-May-88 18:40 by bvm") (* ;; "Try to figure out the mode of the message.  If we're sure about it, fix the message, too.") (if (NULL (CDR \LAFITE.ACTIVE.MODES)) then (* ; "Only one mode, assume it's that one, but don't bother recording this fact") (fetch (LAFITEMODEDATA LAFITEMODE) of (CAR \LAFITE.ACTIVE.MODES)) else (LET (BESTMODE OKMODE) (for *LAFITE-MODE-DATA* in \LAFITE.ACTIVE.MODES do (CASE (CL:FUNCALL (fetch (LAFITEMODEDATA MESSAGEP) of *LAFITE-MODE-DATA*) MSG) ((T) (* ; "Definitely this type") (RETURN (SETQ BESTMODE *LAFITE-MODE-DATA*))) (? (* ; "Could be this type") (if (NOT OKMODE) then (SETQ OKMODE *LAFITE-MODE-DATA*) else (SETQ OKMODE T))))) (if (OR BESTMODE (AND (SETQ BESTMODE OKMODE) (NEQ BESTMODE T))) then (* ; "Found it, or found an ok one with no competitors.") (replace (LAFITEMSG MODEBITS) of MSG with (fetch (LAFITEMODEDATA MODEINDEX) of BESTMODE)) (fetch (LAFITEMODEDATA LAFITEMODE) of BESTMODE)))))
)

(\LAFITE.REGISTER.MODE

(LAMBDA (MODEDATA) (* ; "Edited  6-May-88 15:15 by bvm") (* ;; "Take note of this element of LAFITEMODELST.  Currently this just means adding the mode to the index-to-name list *LAFITE-WELL-KNOWN-MODES*.") (if (NOT (FMEMB (fetch (LAFITEOPS LAFITEMODE) of MODEDATA) *LAFITE-WELL-KNOWN-MODES*)) then (* ; "Register this mode") (LET ((N (fetch (LAFITEOPS MODEINDEX) of MODEDATA))) (while (<= (LENGTH *LAFITE-WELL-KNOWN-MODES*) N) do (* ; "Make sure mode list has at least n+1 elements (zeroth elt is NIL for mode = unknown).") (SETQ *LAFITE-WELL-KNOWN-MODES* (NCONC1 *LAFITE-WELL-KNOWN-MODES* NIL))) (CL:SETF (CL:NTH N *LAFITE-WELL-KNOWN-MODES*) (fetch (LAFITEOPS LAFITEMODE) of MODEDATA)))) MODEDATA)
)

(LAFITECLEARCACHE

(LAMBDA (RECURSIVEP) (* ; "Edited 13-Jun-88 12:47 by bvm") (* ;; "Called when login has changed, or we otherwise want to reauthenticate.  If WAKEFLG, then recompute them right now.") (RESETLST (if (OBTAIN.MONITORLOCK \LAFITE.MAILSERVERLOCK (NULL RECURSIVEP) T) then (SETQ \LAFITE.ACTIVE.MODES NIL) (\LAFITE.WAKE.WATCHER) else (* ; "Spawn process to do it when the lock becomes free") (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION LAFITECLEARCACHE)) T))))))
)

(FULLUSERNAME

(LAMBDA (UNPACKEDFLG) (* ; "Edited 13-Jun-88 11:12 by bvm") (LET (DATA) (COND ((AND \LAFITE.ACTIVE.MODES (SETQ DATA (ASSOC \LAFITEMODE \LAFITE.ACTIVE.MODES))) (COND (UNPACKEDFLG (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of DATA)) (T (fetch (LAFITEMODEDATA FULLUSERNAME) of DATA)))) ((AND (OR \LAFITEMODE (\LAFITE.INFER.MODE)) (EQ (fetch (LAFITEOPS LAFITEMODE) of \LAFITEMODE) (QUOTE NS))) (* ; "Special-case NS username when not yet authenticated--use login name with colon, letting sendmail do the defaulting later") (CONCAT (CAR (LAFITE.USER.NAME.FROM.LOGIN T)) ":")) (T (LAFITE.USER.NAME.FROM.LOGIN UNPACKEDFLG)))))
)

(LAFITE.USER.NAME.FROM.LOGIN

(LAMBDA (UNPACKEDFLG RECOMPUTE) (* ; "Edited  7-Sep-88 11:49 by bvm") (* ;; "Return name of current logged in user.  If UNPACKEDFLG return it as a gv cons, else a string fullname.reg") (if (OR RECOMPUTE (NULL \LAFITE.CURRENT.USER)) then (\INTERNAL/GETPASSWORD) (* ; "Insure logged in") (LET ((USER (USERNAME NIL NIL T)) DOT REGISTRY SIMPLENAME) (COND ((NOT (SETQ DOT (STRPOS "." USER))) (SETQ SIMPLENAME USER) (SETQ REGISTRY DEFAULTREGISTRY)) (T (SETQ SIMPLENAME (SUBSTRING USER 1 (SUB1 DOT))) (SETQ REGISTRY (SUBATOM USER (ADD1 DOT))))) (COND ((U-CASEP SIMPLENAME) (* ; "If user had the caps lock on when logging in, lowercase the name") (SETQ SIMPLENAME (L-CASE SIMPLENAME T)))) (if REGISTRY then (* ; "Silly grapevine code requires registry be a symbol.  Make it lowercase to be nice") (SETQ REGISTRY (MKATOM (L-CASE REGISTRY)))) (SETQ \LAFITE.CURRENT.USER (CONS (if REGISTRY then (CONCAT SIMPLENAME "." REGISTRY) else SIMPLENAME) (CONS SIMPLENAME REGISTRY))))) (COND (UNPACKEDFLG (CDR \LAFITE.CURRENT.USER)) (T (CAR \LAFITE.CURRENT.USER))))
)

(LAFITEMAILWATCH

(LAMBDA NIL (* ; "Edited 13-Jun-88 11:05 by bvm") (bind (INTERVAL ← (ITIMES MAILWATCHWAITTIME 60000)) (FIRSTTIME ← T) CONTINUANCE while (PROGN (* ; "Until killed") T) do (SETQ CONTINUANCE (WITH.MONITOR \LAFITE.MAILSERVERLOCK (POLLNEWMAIL FIRSTTIME))) (BLOCK (if (AND CONTINUANCE (< CONTINUANCE INTERVAL)) then (* ; "Some server wants to be contacted within this period") CONTINUANCE else INTERVAL)) (SETQ FIRSTTIME NIL)))
)

(\LAFITE.WAKE.WATCHER

(LAMBDA NIL (* ; "Edited 13-Jun-88 12:41 by bvm") (* ;; "Wakes the LAFITEMAILWATCH process in response to various actions") (PROG ((P (FIND.PROCESS (QUOTE LAFITEMAILWATCH)))) (COND (P (WAKE.PROCESS P)) ((EQ \LAFITE.ACTIVE T) (* ; "Process got killed somehow;  reinstate it") (\LAFITE.PROCESS (LIST (FUNCTION LAFITEMAILWATCH)) NIL T (QUOTE HARDRESET))))))
)

(POLLNEWMAIL

(LAMBDA (RESTARTFLG) (* ; "Edited 29-Jul-88 14:39 by bvm") (* ;; "Poll for new mail.  Value returned, if non-NIL, is the %"continuance%"--the number of milliseconds within which some server would like to be contacted again.") (PROG ((ALLMODES (LAFITE.ALL.MODES.P :POLL)) PRIMARYMODE FAILEDMODES NOTUPFLG NOMAILFLG NEWMAILMODES MINCONTINUANCE STATUS) (if (OR RESTARTFLG (NULL \LAFITE.ACTIVE.MODES)) then (* ; "Need to get authenticated") (\LAFITE.GET.USER.DATA) (if ALLMODES then (* ; "Also make sure to get data for non-primary modes") (SETQ FAILEDMODES (for MODE in LAFITEMODELST unless (OR (NLISTP (CDR MODE)) (\LAFITE.GET.USER.DATA MODE)) collect (CONS \LAFITE.AUTHENTICATION.FAILURE MODE)))) (if (NULL \LAFITE.ACTIVE.MODES) then (* ; "Didn't get anywhere!") (PRINTLAFITESTATUS (COND (\LAFITEMODE (QUOTE NO.MAILSERVER)) (LAFITEMODELST (QUOTE MODE.NOT.SET)) (T (QUOTE NO.MODE)))) (RETURN NIL) else (for PAIR in FAILEDMODES do (* ; "Show which modes failed") (PRINTOUT PROMPTWINDOW T "Lafite " (fetch (LAFITEOPS LAFITEMODE) of (CDR PAIR)) " mode suspended") (if (CAR PAIR) then (PRINTOUT PROMPTWINDOW " because: " (CAR PAIR)))) (for MODE in \LAFITE.ACTIVE.MODES when (NULL (fetch (LAFITEMODEDATA MAILSERVERS) of MODE)) do (* ; "This mode has no mail servers, so will not be able to check/retrieve mail.  Print this info just the first time we fail") (PRINTOUT PROMPTWINDOW T "There are no " (fetch (LAFITEMODEDATA LAFITEMODE) of MODE) " mail servers for " (fetch (LAFITEMODEDATA SHORTUSERNAME) of MODE)))) else (* ; "Make sure we at least have data for primary mode") (\LAFITE.GET.USER.DATA)) (SETQ NEWMAILMODES (for *LAFITE-MODE-DATA* in \LAFITE.ACTIVE.MODES when (AND (OR ALLMODES (EQ (fetch (LAFITEMODEDATA LAFITEOPS) of *LAFITE-MODE-DATA*) \LAFITEMODE)) (for MAILSERVER in (fetch (LAFITEMODEDATA MAILSERVERS) of *LAFITE-MODE-DATA*) bind N do (SETQ STATUS (CL:FUNCALL (fetch (MAILSERVER POLLNEWMAIL) of MAILSERVER) (fetch (MAILSERVER MAILPORT) of MAILSERVER) (fetch (LAFITEMODEDATA FULLUSERNAME) of *LAFITE-MODE-DATA*) (fetch (LAFITEMODEDATA CREDENTIALS) of *LAFITE-MODE-DATA*) MAILSERVER)) (COND ((AND (SETQ N (fetch (MAILSERVER CONTINUANCE) of MAILSERVER)) (OR (NULL MINCONTINUANCE) (< N MINCONTINUANCE))) (SETQ MINCONTINUANCE N))) (replace (MAILSERVER NEWMAILP) of MAILSERVER with (SELECTQ STATUS (T (SETQ $$VAL T)) (NIL (SETQ NOMAILFLG T) NIL) (? (* ; "I guess the server is down") (SETQ NOTUPFLG T) NIL) (SHOULDNT))))) collect *LAFITE-MODE-DATA*)) (if NEWMAILMODES then (if (NOT (EQUAL NEWMAILMODES \LAFITE.LAST.STATUS)) then (* ; "only do this if something has changed") (PRINTLAFITESTATUS (CONCAT "New " (if (OR (SETQ PRIMARYMODE (ASSOC \LAFITEMODE NEWMAILMODES)) (LAFITE.ALL.MODES.P :GETMAIL)) then (* ; "The new mail is in the primary mode, or GetMail will retrieve it anyway") "" else (* ; "Make clear the mode we're talking about") (CONCAT (fetch (LAFITEMODEDATA LAFITEMODE) of (CAR NEWMAILMODES)) " ")) "Mail for " (fetch (LAFITEMODEDATA SHORTUSERNAME) of (OR PRIMARYMODE (CAR NEWMAILMODES))) (if (CDR NEWMAILMODES) then (* ; "Identify the other modes with new mail") (LET ((LST (QUOTE (")")))) (for MODE in NEWMAILMODES unless (EQ MODE PRIMARYMODE) do (push LST "," (fetch (LAFITEMODEDATA LAFITEMODE) of MODE))) (CONCATLIST (CONS " (+" (CDR LST)))) else ""))) (if NIL then (* ; "That might have been clearer as follows, but it's 30 times slower (over 1/10 sec on Dorado), which I'd rather not do in the background") (CL:FORMAT NIL "New ~@[~A ~]Mail for ~A~@[ (~{+~A~})~]" (COND ((NOT (OR (SETQ PRIMARYMODE (ASSOC \LAFITEMODE NEWMAILMODES)) (LAFITE.ALL.MODES.P :GETMAIL))) (* ; "Make clear the mode we're talking about, since this is not the mode GetMail will retrieve in") (fetch (LAFITEMODEDATA LAFITEMODE) of (CAR NEWMAILMODES)))) (fetch (LAFITEMODEDATA SHORTUSERNAME) of (OR PRIMARYMODE (CAR NEWMAILMODES))) (for MODE in NEWMAILMODES unless (EQ MODE PRIMARYMODE) collect (fetch (LAFITEMODEDATA LAFITEMODE) of MODE)))) (SETQ \LAFITE.LAST.STATUS NEWMAILMODES) (\LAFITE.NEW.MAIL.EXISTS)) else (* ; "Nobody reported new mail.  Reason could be one of several") (PRINTLAFITESTATUS (if NOTUPFLG then (if NOMAILFLG then (* ; "Somebody responded") (QUOTE SOME.UP) else (QUOTE NONE.UP)) elseif NOMAILFLG then (* ; "every server reports no new mail") (QUOTE NO.MAIL) else (* ; "No server reported anything") (QUOTE NO.MAILBOX)))) (RETURN MINCONTINUANCE)))
)

(\LAFITE.NEW.MAIL.EXISTS

(LAMBDA NIL (* ; "Edited  8-Jun-88 12:10 by bvm") (* ;; "Called when the Poll function has discovered new mail.") (COND (LAFITENEWMAILTUNE (PLAYTUNE LAFITENEWMAILTUNE))) (COND (LAFITENEWMAILFN (CL:FUNCALL LAFITENEWMAILFN))))
)

(PRINTLAFITESTATUS

(LAMBDA (STATUS) (* ; "Edited 13-Jun-88 11:16 by bvm") (PROG ((WINDOW (WINDOWP LAFITESTATUSWINDOW)) STR EXCESSWIDTH REG) (OR WINDOW (RETURN)) (SETQ STR (OR (STRINGP STATUS) (SELECTQ STATUS ((NO.MAILBOX NO.MAILSERVER NO.MODE MODE.NOT.SET) (COND ((EQ STATUS \LAFITE.LAST.STATUS) (* ; "No change to prompt") (RETURN)) (T (SELECTQ STATUS (NO.MAILBOX "No Accessible Mail Boxes") (NO.MODE "No Mail Handler Loaded") (MODE.NOT.SET "Mode Not Set") (CONCAT "Not Logged In: " \LAFITE.AUTHENTICATION.FAILURE))))) (LAFITE.STATUS.WITH.TIME (SELECTQ STATUS (NO.MAIL "No New Mail") (SOME.UP "Some Servers Unavailable") (NONE.UP "No Mail Servers Responding") (SHOULDNT)))))) (SETQ \LAFITE.LAST.STATUS NIL) (CLEARW WINDOW) (COND ((> (SETQ EXCESSWIDTH (- (ADD1 (STRINGWIDTH STR WINDOW)) (WINDOWPROP WINDOW (QUOTE WIDTH)))) 0) (SETQ REG (WINDOWREGION WINDOW)) (* ; "String wider than window, so widen window.  The extra +1 is because it seems that printing a string exactly the width of the window still tries to wrap the last character.") (add (fetch WIDTH of REG) EXCESSWIDTH) (MAKEWITHINREGION REG) (RESHAPEALLWINDOWS WINDOW REG) (SETQ EXCESSWIDTH 0))) (MOVETO (IQUOTIENT (- EXCESSWIDTH) 2) (WINDOWPROP WINDOW (QUOTE YPOS)) WINDOW) (PRIN3 STR WINDOW) (SETQ \LAFITE.LAST.STATUS STATUS)))
)

(LAFITE.STATUS.WITH.TIME

(LAMBDA (STR) (* ; "Edited  9-May-88 15:41 by bvm") (* ; "Add current time to STR") (CONCAT STR " at " (DATE (DATEFORMAT NO.DATE NO.SECONDS CIVILIAN.TIME))))
)

(\LAFITE.REINITIALIZING

(LAMBDA (FIRSTTIME) (* ; "Edited  9-May-88 15:51 by bvm") (* ;; "This guy alters status to show we're (re)initializing") (PRINTLAFITESTATUS (LAFITE.STATUS.WITH.TIME (if FIRSTTIME then "Initializing" else "Reinitializing"))))
)
)



(* ; "Parsing mail files")


(DEFINEQ

(PARSEMAILFOLDER

(LAMBDA (MAILFOLDER) (* ; "Edited 23-Sep-87 18:27 by bvm:") (LET* ((STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :IGNORE)) (END (GETEOFPTR STREAM)) MESSAGES) (COND ((OR (EQ END 0) (SETQ MESSAGES (PARSEMAILFOLDER1 MAILFOLDER STREAM END 0 1))) (replace (MAILFOLDER %#OFMESSAGES) of MAILFOLDER with (COND (MESSAGES (CAR MESSAGES)) (T 0))) (replace (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER with (AND MESSAGES (\LAFITE.ADDMESSAGES.TO.ARRAY NIL (CDR MESSAGES) 1 (CAR MESSAGES)))) (replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with 0) (replace (MAILFOLDER BROWSERREADY) of MAILFOLDER with T) MAILFOLDER) (T (\LAFITE.CLOSE.FOLDER MAILFOLDER T) NIL))))
)

(PARSEMAILFOLDER1

(LAMBDA (MAILFOLDER STREAM EOFPTR START FIRSTMSG# NOERROR) (* ; "Edited  8-Jun-88 14:54 by bvm") (DECLARE (SPECVARS MAILFOLDER STREAM EOFPTR START HERE LASTMSG)) (* ; "Strictly for debugging") (* ;;; "Parse MAILFOLDER starting at byte START until end of file at EOFPTR.  FIRSTMSG# is the ordinal to assign to the first message.  Returns (lastmsg#  . messagedescriptors), or NIL if there was any problem.  If NOERROR is true, does not publicly complain about errors, but quietly returns NIL") (LAB.PROMPTPRINT MAILFOLDER "Parsing " (COND ((EQ START 0) "folder") (T "additional msgs")) (QUOTE |...|)) (LET* ((HERE START) (WINDOW (fetch BROWSERPROMPTWINDOW of MAILFOLDER)) (XPOS (AND WINDOW (DSPXPOSITION NIL WINDOW))) CHCOUNT STAMPCOUNT MARK SEEN STARTFLG DELETED LASTMSG) (for MSG# from FIRSTMSG# while (< HERE EOFPTR) collect (SETFILEPTR STREAM HERE) (* ;; "the format of the stamp field of a laurel message is:") (* ;; "*start* <cr> <length of message in 5 ascii chars> <sp> <length of stamp in 5 ascii chars> <sp> <the char U or D> <the char S or U> <any char> <cr>") (* ;; "U or D means Undeleted or Deleted; S or U means Seen or Unseen") (COND ((AND (LA.READSTAMP STREAM) (SETQ CHCOUNT (LA.READCOUNT STREAM)) (SETQ STAMPCOUNT (LA.READCOUNT STREAM)) (>= CHCOUNT STAMPCOUNT))) (T (RETURN (BADMAILFILE MAILFOLDER HERE MSG# "Bad header or previous message length is incorrect" LASTMSG NOERROR)))) (* ;; "now read in the status characters and save their pointers") (SETQ DELETED (SELECTC (BIN STREAM) (UNDELETEDFLAG NIL) (DELETEDFLAG T) (BADMAILFILE.FLAGBYTE MAILFOLDER MSG#))) (* ; "read the U for Undeleted") (SETQ SEEN (SELECTC (BIN STREAM) (UNSEENFLAG NIL) (SEENFLAG T) ((CHARCODE N) (* ; "For some reason, there are files with this for the Seen mark, so allow it") T) (BADMAILFILE.FLAGBYTE MAILFOLDER MSG#))) (* ; "read the U for unseen") (SETQ MARK (BIN STREAM)) (* ; "read the mark char") (PROG1 (SETQ LASTMSG (create LAFITEMSG %# ← MSG# BEGIN ← HERE MESSAGELENGTH ← CHCOUNT MARKCHAR ← (OR (AND (NOT SEEN) UNSEENMARK) MARK) SEEN? ← SEEN DELETED? ← DELETED STAMPLENGTH ← STAMPCOUNT)) (LAFITE.PARSE.MSG.FOR.TOC LASTMSG MAILFOLDER) (add HERE CHCOUNT) (COND (XPOS (DSPXPOSITION XPOS WINDOW) (printout WINDOW |.I1| MSG#)))) finally (COND (XPOS (* ; "Prepare to overwrite counter with 'done'") (DSPXPOSITION XPOS WINDOW))) (COND ((NOT (= HERE EOFPTR)) (LAB.FORMAT MAILFOLDER T "Warning: last message truncated from ~D to ~D bytes. " (fetch (LAFITEMSG MESSAGELENGTH) of LASTMSG) (replace (LAFITEMSG MESSAGELENGTH) of LASTMSG with (- (fetch (LAFITEMSG MESSAGELENGTH) of LASTMSG) (- HERE EOFPTR)))) (replace (LAFITEMSG MESSAGELENGTHCHANGED?) of LASTMSG with (replace (LAFITEMSG MARKSCHANGED?) of LASTMSG with T)) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)) (T (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with NIL))) (RETURN (CONS (fetch (LAFITEMSG %#) of LASTMSG) $$VAL)))))
)

(BADMAILFILE

(LAMBDA (MAILFOLDER HERE MSG# ERRSTR LASTMSG NOERROR) (* bvm%: "20-Feb-84 12:42") (COND ((OR (NOT NOERROR) LAFITEDEBUGFLG) (PROG ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))) (CLEARW BROWSERWINDOW) (printout BROWSERWINDOW "Cannot parse file " (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER) " near message " |.P2| MSG# ", byte " |.P2| HERE " because: " ERRSTR) (COND (LASTMSG (printout BROWSERWINDOW T "Last message was:" T "Date: " (fetch (LAFITEMSG DATE) of LASTMSG) T "From: " (fetch (LAFITEMSG FROM) of LASTMSG) T "Subject: " (fetch (LAFITEMSG SUBJECT) of LASTMSG)))) (COND (LAFITEDEBUGFLG (HELP "Mail file parsing error" ERRSTR)))))) NIL)
)

(BADMAILFILE.FLAGBYTE

(LAMBDA (MAILFOLDER MSG#) (* bvm%: "24-Feb-86 12:08") (LAB.PROMPTPRINT MAILFOLDER " [at msg " MSG# ": bad flag byte] ") NIL)
)

(VERIFYMAILFOLDER

(LAMBDA (MAILFOLDER) (* ; "Edited 23-Aug-88 15:47 by bvm") (DECLARE (SPECVARS MSG# MSG HERE CHCOUNT)) (COND ((NOT (type? MAILFOLDER MAILFOLDER)) (SETQ MAILFOLDER (\DTEST (COND ((WINDOWP MAILFOLDER) (WINDOWPROP MAILFOLDER (QUOTE MAILFOLDER))) ((OR (LITATOM MAILFOLDER) (STRINGP MAILFOLDER)) (LAFITE.OBTAIN.FOLDER MAILFOLDER (QUOTE INPUT)))) (QUOTE MAILFOLDER))))) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (PROG (STREAM END) (SETQ STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :OK)) (COND ((NOT (= (SETQ END (GETEOFPTR STREAM)) (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER))) (HELP "Length of file does not match Folder's idea of length" (LIST END)))) (bind CHCOUNT STAMPCOUNT MARK MSG (HERE ← 0) (MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (LASTMSG# ← (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) for MSG# from 1 while (< HERE END) do (SETFILEPTR STREAM HERE) (COND ((> MSG# LASTMSG#) (RETURN (VERIFYFAILED MSG# "More messages in file than in core")))) (SETQ MSG (NTHMESSAGE MESSAGES MSG#)) (* ;; "the format of the stamp field of a laurel message is:") (* ;; "*start* <cr> <length of message in 5 ascii chars> <sp> <length of stamp in 5 ascii chars> <sp> <the char U or D> <the char S or U> <any char> <cr>") (* ;; "U or D means Undeleted or Deleted; S or U means Seen or Unseen") (COND ((NOT (= (fetch (LAFITEMSG BEGIN) of MSG) HERE)) (VERIFYFAILED MSG# "Message beginning pointer wrong")) ((NOT (LA.READSTAMP STREAM)) (VERIFYFAILED MSG# "Bad Stamp")) ((OR (NOT (SETQ CHCOUNT (LA.READCOUNT STREAM))) (NOT (= CHCOUNT (fetch (LAFITEMSG MESSAGELENGTH) of MSG)))) (VERIFYFAILED MSG# "Bad Message Length")) ((OR (NOT (SETQ STAMPCOUNT (LA.READCOUNT STREAM))) (NOT (= STAMPCOUNT (fetch (LAFITEMSG STAMPLENGTH) of MSG)))) (VERIFYFAILED MSG# "Bad Message Length")) ((fetch (LAFITEMSG MARKSCHANGED?) of MSG)) ((NOT (EQ (SELECTC (BIN STREAM) (UNDELETEDFLAG NIL) (DELETEDFLAG T) (QUOTE ?)) (fetch (LAFITEMSG DELETED?) of MSG))) (VERIFYFAILED MSG# "Disagreement in delete mark")) ((NOT (EQ (SELECTC (BIN STREAM) (UNSEENFLAG NIL) (SEENFLAG T) (QUOTE ?)) (fetch (LAFITEMSG SEEN?) of MSG))) (* ; "Figure out how to handle seen from me") (VERIFYFAILED MSG# "Disagreement in seen mark")) ((NOT (OR (EQ (SETQ MARK (BIN STREAM)) (fetch (LAFITEMSG MARKCHAR) of MSG)) (NOT (fetch (LAFITEMSG SEEN?) of MSG)))) (VERIFYFAILED MSG# "Disagreement in mark byte"))) (add HERE CHCOUNT) finally (COND ((NOT (= HERE END)) (VERIFYFAILED MSG# "Last message too short")))) (RETURN T))))
)

(VERIFYFAILED

(LAMBDA (MSG# ERRMSG) (* ; "Edited  6-May-88 15:47 by bvm") (HELP (CONCAT "Error in message " MSG# ": ") ERRMSG))
)

(READTOCFILE

(LAMBDA (MAILFOLDER TOCFILE) (* ; "Edited  4-May-88 16:36 by bvm") (* ;;; "Read TOCFILE into MAILFOLDER") (* ;;; "Format of TOCFILE: <LafitePassword word> <LafiteVersion word> <EOF of mailfile integer> <last msg# in toc word> --- that preamble is followed by one entry per message, of the form: <messagelength 3 bytes> <stamplength byte> <del&seen flags byte> <mark byte> <date 6 bytes> <subject ShortString> <From ShortString> <To ShortString>") (DECLARE (SPECVARS MAILFOLDER TOCSTREAM)) (RESETLST (LAB.PROMPTPRINT MAILFOLDER "Reading table of contents...") (PROG ((TOCSTREAM (\LAFITE.OPENSTREAM TOCFILE (QUOTE INPUT) (QUOTE OLD) (FUNCTION \LAFITE.TOCEOF))) (FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :IGNORE)) (MSGCOUNTGUESS 0) END FOLDEREOFPTR MESSAGES EXTRAMESSAGES LASTMSG# READMORE TOCVERSION OLDTOCFORMAT) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) TOCSTREAM)) (COND ((OR (NEQ (WORDIN TOCSTREAM) LAFITETOCPASSWORD) (NEQ (SETQ TOCVERSION (WORDIN TOCSTREAM)) LAFITEVERSION#)) (COND ((EQ TOCVERSION 8) (* ; "A slightly different format, still readable") (LAB.PROMPTPRINT MAILFOLDER "(older format)") (SETQ OLDTOCFORMAT T)) (T (RETURN (BADTOCFILE "Format obsolete, discarding...")))))) (COND ((NOT (= (SETQ END (FIXPIN TOCSTREAM)) (SETQ FOLDEREOFPTR (GETEOFPTR FOLDERSTREAM)))) (* ; "Maybe new messages have been added to file") (SETFILEPTR FOLDERSTREAM END) (COND ((NOT (LA.READSTAMP FOLDERSTREAM)) (RETURN (BADTOCFILE "It does not agree with mail folder..."))) (T (SETQ READMORE T) (SETQ MSGCOUNTGUESS (IQUOTIENT (- FOLDEREOFPTR END) 500)))))) (add MSGCOUNTGUESS (SETQ LASTMSG# (WORDIN TOCSTREAM))) (SETQ MESSAGES (\LAFITE.MAKE.MSGARRAY MSGCOUNTGUESS)) (for I from 1 to LASTMSG# bind MSG LENGTH (START ← (GETFILEPTR TOCSTREAM)) (MESSAGESTART ← 0) do (* ; "Message length is 3 bytes long because it can be greater than MAX.SMALLP, though most unlikely") (SETQ LENGTH (COND ((EQ (SETQ LENGTH (BIN TOCSTREAM)) 0) (WORDIN TOCSTREAM)) (T (\MAKENUMBER LENGTH (WORDIN TOCSTREAM))))) (SETQ MSG (create LAFITEMSG %# ← I BEGIN ← MESSAGESTART MESSAGELENGTH ← LENGTH)) (add MESSAGESTART LENGTH) (replace (LAFITEMSG STAMPLENGTH) of MSG with (BIN TOCSTREAM)) (COND (OLDTOCFORMAT (replace (LAFITEMSG PARSED&DELETED&SEENBITS) of MSG with (BIN TOCSTREAM))) (T (replace (LAFITEMSG MSGFLAGBITS) of MSG with (BIN TOCSTREAM)))) (replace (LAFITEMSG MARKCHAR) of MSG with (BIN TOCSTREAM)) (replace (LAFITEMSG DATE) of MSG with (LA.READSTRING TOCSTREAM 6)) (replace (LAFITEMSG SUBJECT) of MSG with (LA.READSHORTSTRING TOCSTREAM)) (replace (LAFITEMSG FROM) of MSG with (LA.READSHORTSTRING TOCSTREAM)) (replace (LAFITEMSG TO) of MSG with (LA.READSHORTSTRING TOCSTREAM)) (replace (LAFITEMSG TOCLENGTH) of MSG with (- (- START (SETQ START (GETFILEPTR TOCSTREAM))))) (SETA MESSAGES I MSG)) (replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with (COND ((EQ TOCVERSION LAFITEVERSION#) LASTMSG#) (T (* ; "Will have to rewrite toc next time") 0))) (COND (READMORE (COND ((SETQ EXTRAMESSAGES (PARSEMAILFOLDER1 MAILFOLDER FOLDERSTREAM FOLDEREOFPTR END (ADD1 LASTMSG#) T)) (SETQ MESSAGES (\LAFITE.ADDMESSAGES.TO.ARRAY MESSAGES (CDR EXTRAMESSAGES) (ADD1 LASTMSG#) (SETQ LASTMSG# (CAR EXTRAMESSAGES))))) (T (RETURN (BADTOCFILE "Couldn't parse new messages, trying from scratch..." T)))))) (replace (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER with MESSAGES) (replace (MAILFOLDER %#OFMESSAGES) of MAILFOLDER with LASTMSG#) (replace (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER with FOLDEREOFPTR) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with NIL) (replace (MAILFOLDER BROWSERREADY) of MAILFOLDER with T) (RETURN T))))
)

(BADTOCFILE

(LAMBDA (ERRMSG CLEARFLG) (DECLARE (USEDFREE MAILFOLDER TOCSTREAM)) (* ; "Edited  9-Sep-87 19:39 by bvm:") (COND (CLEARFLG (LAB.PROMPTPRINT MAILFOLDER T))) (LAB.PROMPTPRINT MAILFOLDER ERRMSG) (COND (LAFITEDEBUGFLG (HELP "TOC file error" ERRMSG))) (DELFILE (CLOSEF TOCSTREAM)) (* ; "Return NIL to tell loader to parse from scratch") NIL)
)

(\LAFITE.TOCEOF

(LAMBDA (STREAM) (* bvm%: "28-Dec-83 11:39") (* ;;; "Unexpected end of file on TOC, flush it") (RETFROM (QUOTE READTOCFILE) (BADTOCFILE "Malformed table of contents, discarding...")))
)

(LA.READCOUNT

(LAMBDA (STREAM) (* bvm%: "22-Dec-83 18:21") (bind CH VAL do (COND ((AND (ILEQ (SETQ CH (BIN STREAM)) (CHARCODE 9)) (IGEQ CH (CHARCODE 0))) (SETQ VAL (IPLUS (IDIFFERENCE CH (CHARCODE 0)) (COND (VAL (ITIMES VAL 10)) (T 0))))) ((EQ CH (CHARCODE SPACE)) (RETURN VAL)) (T (RETURN NIL)))))
)

(LA.PRINTCOUNT

(LAMBDA (COUNT STREAM) (* bvm%: "27-Dec-83 12:56") (PRINTNUM (QUOTE (FIX 5 10 T)) COUNT STREAM) (BOUT STREAM (CHARCODE SPACE)))
)

(LA.READSTAMP

(LAMBDA (STREAM) (* bvm%: "22-Dec-83 18:23") (AND (EQ (BIN STREAM) (CHARCODE *)) (EQ (BIN STREAM) (CHARCODE s)) (EQ (BIN STREAM) (CHARCODE t)) (EQ (BIN STREAM) (CHARCODE a)) (EQ (BIN STREAM) (CHARCODE r)) (EQ (BIN STREAM) (CHARCODE t)) (EQ (BIN STREAM) (CHARCODE *)) (EQ (BIN STREAM) (CHARCODE CR))))
)

(\LAFITE.VERIFYMSG

(LAMBDA (MSG FOLDER) (* ; "Edited 18-Jul-88 13:02 by bvm") (* ;; "Verify that this message starts points at an actual message start in the folder.  If not, something is wrong with the toc--rebrowse, or take the action given by *LAFITE-VERIFY-ACTION*.") (PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER))) (SETFILEPTR STREAM (fetch (LAFITEMSG BEGIN) of MSG)) (COND ((NOT (LA.READSTAMP STREAM)) (if *LAFITE-VERIFY-ACTION* then (* ; "Caller anticipated this, and has provided an action") (CL:FUNCALL *LAFITE-VERIFY-ACTION* MSG FOLDER STREAM) else (LET ((CHANGED (fetch (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDER))) (ALLOW.BUTTON.EVENTS) (* ; "Don't hoard mouse") (LAB.FORMAT FOLDER "Lafite's table of contents is inconsistent at message #~D; the folder will have to be reparsed.~@[  However, you have unsaved changes.~]" (fetch (LAFITEMSG %#) of MSG) CHANGED) (\LAFITE.REBROWSE.FOLDER FOLDER STREAM (OR CHANGED (AND LAFITEDEBUGFLG (HELP "TOC inconsistent"))) NIL NIL :ABORT T)))))))
)

(LA.MSGFROMMEP

(LAMBDA (MSG) (* ; "Edited  6-Jun-88 15:50 by bvm") (* ;; "True if the message is from the current user.") (AND \LAFITE.ACTIVE.MODES (PROG ((MODE (fetch (LAFITEMSG MODE) of MSG)) *LAFITE-MODE-DATA*) (if MODE then (if (NULL (SETQ *LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE T))) then (* ; "We know the mode, but haven't gotten authenticated yet, so say NIL for now but be willing to change later") (RETURN NIL)) elseif (SETQ MODE (\LAFITE.GUESS.MODE MSG)) then (SETQ *LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE T))) (RETURN (replace (LAFITEMSG MSGFROMMEP) of MSG with (AND *LAFITE-MODE-DATA* (CL:FUNCALL (fetch (LAFITEMODEDATA MESSAGE-FROM-SELFP) of *LAFITE-MODE-DATA*) MSG)))))))
)

(LA.PRINTSTAMP

(LAMBDA (STREAM) (* bvm%: "27-Dec-83 12:54") (PROGN (BOUT STREAM (CHARCODE *)) (BOUT STREAM (CHARCODE s)) (BOUT STREAM (CHARCODE t)) (BOUT STREAM (CHARCODE a)) (BOUT STREAM (CHARCODE r)) (BOUT STREAM (CHARCODE t)) (BOUT STREAM (CHARCODE *)) (BOUT STREAM (CHARCODE CR))))
)

(LA.READSHORTSTRING

(LAMBDA (STREAM) (* ; "Edited 10-Sep-87 14:21 by bvm:") (* ;;; "Read from STREAM a string written by LA.PRINTSHORTSTRING whose length is stored as the first byte.") (LET ((NBYTES (BIN STREAM))) (COND ((NEQ NBYTES 0) (LA.READSTRING STREAM NBYTES (if (EQ (\PEEKBIN STREAM) 255) then (* ; "a fat string.  It is stored on the file in non-runcoded format.") (BIN STREAM) T))))))
)

(LA.PRINTSHORTSTRING

(LAMBDA (STREAM STRING) (* ; "Edited 10-Sep-87 14:02 by bvm:") (* ;; "Store string on toc file.  Format is: number of chars (as a byte), followed by chars.  If string is fat, then chars are two bytes per char and are prefixed by a 255 (impossible thin char).") (COND ((NULL STRING) (BOUT STREAM 0) 1) (T (LET ((NBYTES (NCHARS STRING)) (BASE (fetch (STRINGP BASE) of STRING)) (OFF (fetch (STRINGP OFFST) of STRING))) (COND ((> NBYTES 255) (* ; "truncate string") (SETQ NBYTES 255))) (BOUT STREAM NBYTES) (if (fetch (STRINGP FATSTRINGP) of STRING) then (BOUT STREAM 255) (\BOUTS STREAM BASE (UNFOLD OFF 2) (UNFOLD NBYTES 2)) (+ 2 (UNFOLD NBYTES 2)) else (\BOUTS STREAM BASE OFF NBYTES) (+ 1 NBYTES))))))
)

(LA.READSTRING

(LAMBDA (STREAM NC FATP) (* ; "Edited 10-Sep-87 14:22 by bvm:") (* ;;; "Returns a string of length NC composed of the next NC (or 2*NC if fatp) bytes of STREAM") (LET ((STR (ALLOCSTRING NC NIL NIL FATP))) (\BINS STREAM (fetch (STRINGP BASE) of STR) 0 (if FATP then (UNFOLD NC 2) else NC)) STR))
)
)
(DEFINEQ

(LAFITE.PARSE.MSG.FOR.TOC

(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* ; "Edited 23-Sep-87 18:33 by bvm:") (COND ((NULL (fetch (LAFITEMSG PARSED?) of MSGDESCRIPTOR)) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (PROG ((FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT))) (for PAIR in (LAFITE.PARSE.HEADER FOLDERSTREAM \LAPARSE.TOCFIELDS (fetch (LAFITEMSG START) of MSGDESCRIPTOR) (fetch (LAFITEMSG END) of MSGDESCRIPTOR)) do (SELECTQ (CAR PAIR) (From (replace (LAFITEMSG FROM) of MSGDESCRIPTOR with (CADR PAIR))) (Subject (replace (LAFITEMSG SUBJECT) of MSGDESCRIPTOR with (CADR PAIR))) (Date (replace (LAFITEMSG DATE) of MSGDESCRIPTOR with (CADR PAIR))) (Format (SELECTQ (CADR PAIR) ((TEDIT MULTIMEDIA) (replace (LAFITEMSG FORMATTED?) of MSGDESCRIPTOR with T)) NIL)) NIL)) (replace (LAFITEMSG PARSED?) of MSGDESCRIPTOR with T) (COND ((fetch (LAFITEMSG MSGFROMMEP) of MSGDESCRIPTOR) (* ; "Get the TO field while we're at it, since TOC display will want it") (LAFITE.FETCH.TO.FIELD MSGDESCRIPTOR MAILFOLDER) (COND ((AND LAFITEIFFROMMETHENSEENFLG (NOT (fetch (LAFITEMSG SEEN?) of MSGDESCRIPTOR))) (replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with T) (replace (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR with SEENMARK) (replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T))))))))))
)

(LAFITE.FETCH.TO.FIELD

(LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* ; "Edited 23-Sep-87 18:35 by bvm:") (* ;; "Fetch just the TO field of a message") (OR (fetch (LAFITEMSG TO) of MSGDESCRIPTOR) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (replace (LAFITEMSG TO) of MSGDESCRIPTOR with (OR (LAFITE.PARSE.HEADER (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT) \LAPARSE.TOFIELD (fetch (LAFITEMSG START) of MSGDESCRIPTOR) (fetch (LAFITEMSG END) of MSGDESCRIPTOR) T) UNSUPPLIEDFIELDSTR)))))
)

(LAFITE.PARSE.HEADER

(LAMBDA (STREAM PARSETABLE START END ONCEONLY CHECKEOF) (* ; "Edited 22-Aug-88 16:32 by bvm") (PROG (PARSERESULT PARSEBEGIN TABLE CH CHOICE) (DECLARE (SPECVARS PARSERESULT PARSEBEGIN)) (* ; "For Parse result functions to access") (COND (START (SETFILEPTR STREAM START))) TOP (SETQ TABLE PARSETABLE) (SETQ PARSEBEGIN (GETFILEPTR STREAM)) LP (SELECTQ (CAR TABLE) (CHOICE (SETQ CH (UCASECODE (READCCODE STREAM))) (COND ((find old CHOICE in (CDR TABLE) suchthat (EQ (CAR CHOICE) CH)) (SETQ TABLE (CDR CHOICE)) (GO LP)))) (RESULT (SETQ TABLE (CDR TABLE)) (LAFITE.SKIP.WHITE.SPACE STREAM) (CL:FUNCALL (CAR TABLE) STREAM (CDR TABLE)) (COND (ONCEONLY (GO EXIT)) (T (GO NEXTLINE)))) (STOP (COND ((AND CHECKEOF (EQ CH (CHARCODE EOL))) (push PARSERESULT (LIST (QUOTE EOF) PARSEBEGIN)))) (GO EXIT)) (COND ((EQ (SETQ CH (UCASECODE (READCCODE STREAM))) (CAR TABLE)) (SETQ TABLE (CDR TABLE)) (GO LP)))) (* ;; "Get here if parse of current line failed") (COND (CHECKEOF (* ; "See if current line is end of header") (COND ((do (SELCHARQ CH ((CR TAB SPACE) (* ; "Whitespace before a colon is illegal") (push PARSERESULT (LIST (QUOTE EOF) PARSEBEGIN T)) (RETURN T)) (%: (LA.SKIP.TO.EOL STREAM CH) (RETURN NIL)) (SETQ CH (READCCODE STREAM)))) (GO EXIT)))) (T (LA.SKIP.TO.EOL STREAM CH))) NEXTLINE (COND ((COND (END (< (GETFILEPTR STREAM) END)) (T (NOT (\EOFP STREAM)))) (GO TOP))) EXIT (replace CHARSET of STREAM with 0) (* ; "Don't let any temporary change in charset affect future operations.  This is not a call to CHARSET because of stupid bug that causes it to write a charset change!!!") (RETURN PARSERESULT)))
)

(LAFITE.GRAB.DATE

(LAMBDA (STREAM) (* bvm%: "12-Nov-84 17:21") (DECLARE (USEDFREE PARSERESULT)) (push PARSERESULT (LIST (QUOTE Date) (PROG ((DATESTR (LAFITE.READ.TO.EOL STREAM)) CH) (for I from 1 bind do (* ; "Now hack to strip off prefix day of week, such as 'Mon, 19 Dec 83 --'") (COND ((NULL (SETQ CH (NTHCHARCODE DATESTR I))) (* ; "No digits at all?") (RETURN DATESTR)) ((EQ CH (CHARCODE %,)) (* ; "Assume initial prefix was a day of the week") (repeatwhile (EQ (NTHCHARCODE DATESTR (add I 1)) (CHARCODE SPACE))) (RETURN (SETQ DATESTR (SUBSTRING DATESTR I NIL DATESTR)))) ((AND (<= CH (CHARCODE 9)) (>= CH (CHARCODE 0))) (* ; "Digit encountered before comma, must not be day of week") (RETURN DATESTR)))) (RETURN (OR (SUBSTRING DATESTR 1 6 DATESTR) DATESTR))))))
)

(LAFITE.READ.LINE.FOR.TOC

(LAMBDA (STREAM ARGS) (* bvm%: "19-Dec-83 14:08") (DECLARE (USEDFREE PARSERESULT)) (PROG ((STR (LAFITE.READ.TO.EOL STREAM))) (COND ((IGREATERP (NCHARS STR) 255) (SETQ STR (SUBSTRING STR 1 255 STR)))) (push PARSERESULT (LIST (CAR ARGS) STR))))
)

(LAFITE.READ.FORMAT

(LAMBDA (STREAM) (* bvm%: "12-Nov-84 17:21") (DECLARE (USEDFREE PARSERESULT)) (PROG ((STR (LAFITE.READ.TO.EOL STREAM))) (while (EQ (NTHCHARCODE STR -1) (CHARCODE SPACE)) do (GLC STR)) (push PARSERESULT (LIST (QUOTE Format) (MKATOM (U-CASE STR))))))
)

(LAFITE.READ.NAME.FIELD

(LAMBDA (STREAM ARGS) (DECLARE (USEDFREE PARSERESULT)) (* ; "Edited 11-Jun-88 17:54 by bvm") (* ;; "For reading FROM, TO, etc.  Just read the line, trim blanks, and return string.  Can be more than one occurrence, so PARSERESULT value is a list.") (PROG ((LINE (LAFITE.READ.TO.EOL STREAM))) (do (SELCHARQ (NTHCHARCODE LINE -1) ((SPACE TAB %,) (* ; "Strip off trailing spaces") (GLC LINE)) (RETURN NIL))) (if (> (NCHARS LINE) 0) then (* ; "Ignore empty fields") (for PAIR in PARSERESULT bind (FIELD ← (CAR ARGS)) when (EQ (CAR PAIR) FIELD) do (RETURN (NCONC1 PAIR LINE)) finally (push PARSERESULT (LIST FIELD LINE))))))
)

(LAFITE.READ.ONE.LINE.FOR.TOC

(LAMBDA (STREAM) (* bvm%: "19-Dec-83 14:10") (SETQ PARSERESULT (LAFITE.READ.TO.EOL STREAM))))

(LAFITE.READ.TO.EOL

(LAMBDA (STREAM) (* ; "Edited 22-Aug-88 16:24 by bvm") (* ;;; "Reads everything in STREAM up to next EOL and returns it as a string.  If the next line starts with whitespace, it is assumed to be a continuation line, and it is returned as part of the result as well.  See RFC 822") (PROG (RESULT LINE) LP (SETQ LINE (CL:READ-LINE STREAM)) (SETQ RESULT (COND (RESULT (* ; "EOL and leading whitespace are considered to be syntactically a single space.") (CONCAT RESULT " " LINE)) (T LINE))) (SELCHARQ (PEEKCCODE STREAM T) ((SPACE TAB) (LAFITE.SKIP.WHITE.SPACE STREAM) (GO LP)) NIL) (RETURN RESULT)))
)

(LA.SKIP.TO.EOL

(LAMBDA (STREAM LASTCH) (* ; "Edited 28-Jul-88 16:23 by bvm") (* ;;; "Flush to end of this field.  LASTCH is the last char read before this") (PROG* ((CSET (LLSH (fetch CHARSET of STREAM) 8)) (EOLC (fetch (STREAM EOLCONVENTION) of STREAM)) (EOLCHAR (SELECTC EOLC (LF.EOLC (CHARCODE LF)) (CHARCODE CR)))) (if (EQ LASTCH (CHARCODE EOL)) then (* ; "We're already there") (GO PEEK)) LP (* ;; "Eat chars til eol.  Optimize here with \NSIN because this operation wants to be fast, while READCCODE is slow.") (repeatuntil (EQ (\NSIN STREAM CSET CSET) EOLCHAR)) (if (AND (EQ EOLC CRLF.EOLC) (EQ (\PEEKBIN STREAM T) (CHARCODE LF))) then (* ; "Eat the lf after the cr") (\BIN STREAM)) PEEK (SELCHARQ (\NSPEEK STREAM CSET CSET T) ((SPACE TAB) (* ; "Continuation line, keep eating") (GO LP)) NIL)))
)

(LAFITE.SKIP.WHITE.SPACE

(LAMBDA (STREAM) (* ; "Edited  9-Sep-87 19:07 by bvm:") (bind (CSET ← (LLSH (fetch CHARSET of STREAM) 8)) do (SELCHARQ (\NSPEEK STREAM CSET CSET T) ((SPACE TAB) (\NSIN STREAM CSET CSET)) (RETURN))))
)
)
(DEFINEQ

(\LAFITE.PARSE.MESSAGE

(LAMBDA (MAILFOLDER MSGDESCRIPTOR TABLE) (* ; "Edited 23-Sep-87 18:20 by bvm:") (* ;; "Return an alist of the header fields of MSGDESCRIPTOR specified by TABLE, which defaults to \LAPARSE.FULL.   Aborts if folder has changed out from under.") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (LAFITE.PARSE.HEADER (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT) (OR TABLE \LAPARSE.FULL) (fetch (LAFITEMSG START) of MSGDESCRIPTOR) (fetch (LAFITEMSG END) of MSGDESCRIPTOR))))
)
)

(RPAQQ LA.FULLPARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT)))

(RPAQQ LA.TOCFIELDS (("DATE:" LAFITE.GRAB.DATE) ("FROM:" LAFITE.READ.LINE.FOR.TOC From) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)))

(RPAQQ LA.TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))

(RPAQQ LA.SUBJECTFIELDONLY (("SUBJECT:" LAFITE.READ.ONE.LINE.FOR.TOC)))
(DEFINEQ

(LAFITE.INIT.PARSETABLES

(LAMBDA NIL (* ; "Edited 13-Oct-87 11:20 by bvm:") (SETQ \LAPARSE.FULL (LAFITE.MAKE.PARSE.TABLE LA.FULLPARSEFIELDS)) (SETQ \LAPARSE.TOCFIELDS (LAFITE.MAKE.PARSE.TABLE LA.TOCFIELDS)) (SETQ \LAPARSE.TOFIELD (LAFITE.MAKE.PARSE.TABLE LA.TOFIELDONLY)) (SETQ \LAPARSE.SUBJECTFIELD (LAFITE.MAKE.PARSE.TABLE LA.SUBJECTFIELDONLY)))
)

(LAFITE.MAKE.PARSE.TABLE

(LAMBDA (TABLE) (* ; "Edited 23-Sep-87 12:44 by bvm:") (* ;;; "Take a list of entries (string resultfn resultargs) and make a table usable by LAFITE.PARSE.HEADER") (LET ((PARSETABLE (LAFITE.MAKE.PARSE.TABLE1 (for ENTRY in TABLE collect (CONS (CL:STRING-UPCASE (CAR ENTRY)) (CDR ENTRY))) 1))) (CONS (QUOTE CHOICE) (NCONC PARSETABLE (CONSTANT (BQUOTE (((\, (CHARCODE CR)) STOP) ((\,@ (CHARCODE (* S T A R T *))) STOP))))))))
)

(LAFITE.MAKE.PARSE.TABLE1

(LAMBDA (TABLE I) (* bvm%: "30-Dec-83 11:12") (* ;;; "Subfunction of LAFITE.MAKE.PARSE.TABLE that builds a parsetable from the entries in TABLE splitting on character I") (PROG (ENTRY OTHERENTRIES DONE CHOICELIST CH) (for TAIL on TABLE unless (FMEMB (CAR TAIL) DONE) do (SETQ CH (NTHCHARCODE (CAR (SETQ ENTRY (CAR TAIL))) I)) (COND ((NULL CH) (* ; "Shouldn't happen: can't distinguish two them") (ERROR (CAR ENTRY) "is an initial prefix of another entry"))) (push CHOICELIST (CONS CH (COND ((NOT (SETQ OTHERENTRIES (for X in (CDR TAIL) collect X when (EQ (NTHCHARCODE (CAR X) I) CH)))) (* ; "This is the only choice") (NCONC (for J from (ADD1 I) while (SETQ CH (NTHCHARCODE (CAR ENTRY) J)) collect CH) (CONS (QUOTE RESULT) (CDR ENTRY)))) (T (SETQ DONE (APPEND OTHERENTRIES DONE)) (CONS (QUOTE CHOICE) (LAFITE.MAKE.PARSE.TABLE1 (CONS ENTRY OTHERENTRIES) (ADD1 I)))))))) (RETURN CHOICELIST)))
)
)

(RPAQ? *LAFITE-VERIFY-ACTION* NIL)

(RPAQ? MAILWATCHWAITTIME 5)

(RPAQ? LAFITEFLUSHMAILFLG T)

(RPAQ? LAFITETOC.EXT "-Lafite-toc")

(RPAQ? LAFITENEWMAILFN NIL)

(RPAQ? LAFITENEWMAILTUNE NIL)

(RPAQ? LAFITEGETMAILTUNE NIL)

(RPAQ? LAFITE.AFTER.GETMAIL.FN NIL)

(RPAQ? \LAFITE.LAST.STATUS)

(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.LAST.STATUS)
(DECLARE%: DOEVAL@COMPILE 

(CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-VERIFY-ACTION* DEFAULTREGISTRY LAFITEDEBUGFLG)))

(CL:PROCLAIM (QUOTE (GLOBAL LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITENEWMAILFN LAFITENEWMAILTUNE LAFITEIFFROMMETHENSEENFLG MAILWATCHWAITTIME LAFITETOC.EXT)))
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.SUBJECTFIELDONLY \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD LAFITE.AFTER.GETMAIL.FN)
)


(FILESLOAD (SOURCE) LAFITEDECLS)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2669 13345 (\LAFITE.GETMAIL 2679 . 2911) (\LAFITE.GETMAIL.FROM.ICON 2913 . 3170) (
\LAFITE.GETMAIL.PROC 3172 . 3515) (\LAFITE.GETNEWMAIL 3517 . 5419) (\LAFITE.GETNEWMAIL1 5421 . 6783) (
\LAFITE.GETNEWMAIL# 6785 . 6973) (\LAFITE.RETRIEVEMESSAGES 6975 . 10208) (\LAFITE.HANDLE.BIG.MESSAGE 
10210 . 12773) (\LAFITE.FIND.BREAKPOINT 12775 . 13343)) (13392 25754 (\LAFITE.GET.USER.DATA 13402 . 
14628) (\LAFITE.GUESS.MODE 14630 . 15613) (\LAFITE.REGISTER.MODE 15615 . 16342) (LAFITECLEARCACHE 
16344 . 16818) (FULLUSERNAME 16820 . 17457) (LAFITE.USER.NAME.FROM.LOGIN 17459 . 18538) (
LAFITEMAILWATCH 18540 . 18984) (\LAFITE.WAKE.WATCHER 18986 . 19368) (POLLNEWMAIL 19370 . 23753) (
\LAFITE.NEW.MAIL.EXISTS 23755 . 24010) (PRINTLAFITESTATUS 24012 . 25306) (LAFITE.STATUS.WITH.TIME 
25308 . 25496) (\LAFITE.REINITIALIZING 25498 . 25752)) (25790 41354 (PARSEMAILFOLDER 25800 . 26485) (
PARSEMAILFOLDER1 26487 . 29411) (BADMAILFILE 29413 . 30098) (BADMAILFILE.FLAGBYTE 30100 . 30252) (
VERIFYMAILFOLDER 30254 . 32785) (VERIFYFAILED 32787 . 32920) (READTOCFILE 32922 . 36549) (BADTOCFILE 
36551 . 36905) (\LAFITE.TOCEOF 36907 . 37112) (LA.READCOUNT 37114 . 37418) (LA.PRINTCOUNT 37420 . 
37568) (LA.READSTAMP 37570 . 37890) (\LAFITE.VERIFYMSG 37892 . 38903) (LA.MSGFROMMEP 38905 . 39611) (
LA.PRINTSTAMP 39613 . 39904) (LA.READSHORTSTRING 39906 . 40305) (LA.PRINTSHORTSTRING 40307 . 41035) (
LA.READSTRING 41037 . 41352)) (41355 48577 (LAFITE.PARSE.MSG.FOR.TOC 41365 . 42673) (
LAFITE.FETCH.TO.FIELD 42675 . 43180) (LAFITE.PARSE.HEADER 43182 . 44805) (LAFITE.GRAB.DATE 44807 . 
45579) (LAFITE.READ.LINE.FOR.TOC 45581 . 45855) (LAFITE.READ.FORMAT 45857 . 46131) (
LAFITE.READ.NAME.FIELD 46133 . 46781) (LAFITE.READ.ONE.LINE.FOR.TOC 46783 . 46910) (LAFITE.READ.TO.EOL
 46912 . 47534) (LA.SKIP.TO.EOL 47536 . 48344) (LAFITE.SKIP.WHITE.SPACE 48346 . 48575)) (48578 49108 (
\LAFITE.PARSE.MESSAGE 48588 . 49106)) (49777 51521 (LAFITE.INIT.PARSETABLES 49787 . 50140) (
LAFITE.MAKE.PARSE.TABLE 50142 . 50595) (LAFITE.MAKE.PARSE.TABLE1 50597 . 51519)))))
STOP