(FILECREATED "28-Feb-84 13:10:28" {PHYLUM}<LAFITE>LAFITE.;70 273713
changes to: (FNS \LAFITE.HARDCOPY.PROC CHECKLAFITEMAILFOLDERS)
previous date: "22-Feb-84 17:19:03" {PHYLUM}<LAFITE>LAFITE.;69)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation and Bolt Beranek and Newman Inc.)
(PRETTYCOMPRINT LAFITECOMS)
(RPAQQ LAFITECOMS [(COMS (E (SETQ LAFITESYSTEMDATE (DATE)))
(VARS LAFITEVERSION# LAFITESYSTEMDATE))
(FNS LAFITE \LAFITE.START \LAFITEDEFAULTHOST&DIR LAFITEDEFAULTHOST&DIR
MAKELAFITECOMMANDWINDOW DOLAFITEBROWSERCOMMAND \LAFITE.CHECK.NO.SELECTIONS
EXTRACTMENUCOMMAND DOLAFITESENDINGCOMMAND)
(PROP ARGNAMES LAFITE)
(FNS DOMAINLAFITECOMMAND \LAFITE.QUIT)
(COMS (* BROWSE)
(FNS \LAFITE.BROWSE \LAFITE.SUBBROWSE \LAFITE.BROWSE.PROC \LAFITE.PREPARE.BROWSER
GETFOLDERINTOBROWSER DISPLAYFOLDERINBROWSER LAFITE.MAKE.INITIAL.SELECTION
CREATEBROWSERWINDOW))
(COMS (* Browser operations)
(FNS INITBROWSERMAP LAFITEBROWSERBUTTONEVENTFN LOADMAILFOLDER \LAFITE.GETMAILFOLDER
LAFITEBROWSERREPAINTFN LAFITEBROWSERSCROLLFN LAFITEBROWSERRESHAPEFN
LAFITEBROWSERCLOSEFN LAFITEBROWSERSHRINKFN \LAFITE.CLOSE/SHRINK
LAFITEBROWSEREXPANDFN LAFITEBROWSERCURSORMOVEDFN LAFITEBROWSERCURSOROUTFN))
(COMS (* Browser selection)
(FNS BROWSERSELECTMESSAGE BROWSERCHANGEMARK LA.READ.NEW.MARK YPOS.TO.MESSAGE#
MESSAGE#.TO.YPOS)
(FNS LA.CONSIDERRANGE LA.DECONSIDERRANGE LA.RECONSIDERRANGE LA.SELECTRANGE
LA.DESELECTRANGE LA.FIND.SELECTED.MESSAGE LA.UNDOSELECTION LA.VERIFY.SELECTION))
(COMS (* UPDATE)
(FNS \LAFITE.UPDATE \LAFITE.EXPUNGE.PROC \LAFITE.UPDATE.PROC \LAFITE.START.UPDATE
\LAFITE.FINISH.UPDATE \LAFITE.CLOSE.OTHER.FOLDERS)
(FNS FLUSHBROWSERWINDOW ADDMESSAGESTOMAILBROWSER COMPACTMAILFOLDER COMPACTMAILFOLDER1
UPDATEMAILFOLDER UPDATECONTENTSFILE WRITETOCENTRY WRITETOCMARKBYTES
WRITEFOLDERMARKBYTES))
(COMS (* DISPLAY)
(FNS \LAFITE.DISPLAY \LAFITE.DO.DISPLAY SELECTMESSAGETODISPLAY MESSAGEDISPLAYER
\LAFITE.CLOSE.DISPLAYWINDOWS \LAFITE.CLOSE.DISPLAYER))
(COMS (* DELETE & MOVE)
(FNS \LAFITE.DELETE DISPLAYAFTERDELETE \LAFITE.UNDELETE \LAFITE.MOVETO
\LAFITE.MOVETO.PROC \LAFITE.OPEN.DESTINATIONFOLDER))
(COMS (* HARDCOPY)
(FNS \LAFITE.HARDCOPY \LAFITE.HARDCOPY.PROC \LAFITE.HARDCOPY.HEADERS
\LAFITE.MARK.HARDCOPIED \LAFITE.TRANSMIT.HARDCOPY \LAFITE.HARDCOPY.BODIES))
(COMS (* ANSWER)
(FNS \LAFITE.ANSWER \LAFITE.ANSWER.PROC MAKEANSWERFORM LA.PRINTADDRESSES))
(COMS (* FORWARD)
(FNS \LAFITE.FORWARD \LAFITE.FORWARD.PROC MAKEFORWARDFORM LA.OPENTEMPFILE))
(COMS (* FORMS)
(FNS \LAFITE.MESSAGEFORM DERIVEMESSAGEFORMFROMMENU MAKELAFITESUPPORTFORM
MAKELISPSUPPORTFORM MAKEXXXSUPPORTFORM MAKENEWMESSAGEFORM MAKELAFITEFORMSMENU
MAKELAFITEPRIVATEFORMSITEMS MAKELAFITEMAILFOLDERSMENU GETMESSAGEFORMFROMFILE
\LAFITE.FIND.TEMPLATE SAVEMESSAGEFORM))
(INITVARS * LAFITEPROFILEVARS)
(INITVARS * LAFITERANDOMGLOBALS)
(VARS * LAFITEMARKS)
(VARS LAFITEBROWSERMENUITEMS LAFITESENDINGMENUITEMS LAFITECOMMANDMENUITEMS
LAFITESUBBROWSEMENUITEMS LAFITEFORMSMENUITEMS LAFITEUPDATEMENUITEMS
ANOTHERFOLDERMENUITEM)
(ADDVARS (LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM)
"A form to report a Lisp bug or suggestion")
("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM)
"A form to report a Lafite bug or suggestion")))
(INITVARS (LAFITESTATUSWINDOW)
(\ACTIVELAFITEFOLDERS)
(\LAFITEPROFILECHANGED)
(\LAFITE.TEMPFILES)
(PRIMARYEDITORWINDOW)
(LAFITEEDITORWINDOWS)
(LAFITECURRENTEDITORWINDOWS)
(LAFITELASTMESSAGE)
(LAFITEMAILFOLDERS)
(LAFITEFORMFILES)
(LAFITEFOLDERSMENU)
(LAFITEFORMSMENU)
(LAFITESUBBROWSEMENU)
(LAFITECLOSEFNMENU)
(LAFITEUPDATEMENU)
(LAFITEFORMATMENU))
(FNS LA.RESETSHADE LA.REMOVEDUPLICATES COLLECTOLDFILES LA.SETDIFFERENCE NTHMESSAGE
\LAFITE.MAKE.MSGARRAY \LAFITE.ADDMESSAGES.TO.ARRAY)
(COMS (* Display aids)
(CURSORS LA.RIGHTARROWCURSOR LA.CROSSCURSOR)
(BITMAPS LA.SELECTION.BITMAP)
(VARS (BROWSERMARKXPOSITION 8)))
(COMS (* Mail polling and registration)
(FNS MAILSERVERS LAFITECLEARCACHE MAILSERVERTYPE GETMAILSERVEROPS USERINFORMATION
FULLUSERNAME GETREGISTRY GETSIMPLENAME LAFITEMAILWATCH POLLNEWMAIL POLLNEWMAIL1
PRINTLAFITESTATUS)
(ADDVARS (MAILSERVERTYPES)))
(COMS (INITVARS (\LAFITE.READY)
(\LAFITE.LAST.STATUS)
(\LAFITEUSERDATA)
(\LAFITEDEFAULTHOST&DIR))
(ADDVARS (AROUNDEXITFNS LAFITE.AROUNDEXIT)
(\SYSTEMCACHEVARS \LAFITE.READY \LAFITE.LAST.STATUS))
(FNS LAFITE.AROUNDEXIT CHECKLAFITEMAILFOLDERS \LAFITE.REBROWSEFOLDER \LAFITE.AFTERLOGIN)
)
(COMS (* Retrieving mail)
(FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.PROC GETNEWMAIL GETNEWMAIL1
GETNEWMAIL.PRINTMSGCOUNT RETRIEVEMESSAGES))
(COMS (* Sending mail)
(FNS \SENDMESSAGE \LAFITE.AFTER.DELIVER LAFITE.SENDMESSAGE \SENDMESSAGE1 \SENDMESSAGE2
\LAFITE.CHOOSE.MSG.FORMAT \SENDMESSAGEFAIL \CHECKMESSAGEADDRESSES SENDRECIPIENTS
PARSERECIPIENTS PARSE.ARPA.ADDRESS PARSERECIPIENTS1 COLLECTADDRESSES MESSAGEEDITOR
LAFITE.CREATE.EDITOR.WINDOW LA.RESET.TEDIT.SYNTAX GRAYOUTWINDOW BROWSERPROMPTPRINT
\LAFITE.MAYBE.CLEAR.PROMPT LA.CLOSETEMPFILE))
(COMS (* Browser display)
(FNS PRINTMESSAGESUMMARY FIRSTVISIBLEMESSAGE LASTVISIBLEMESSAGE DISPLAYBROWSERLINES
INSUREMESSAGEINBROWSERWINDOW UNSELECTALLMESSAGES SELECTMESSAGE MARKMESSAGE
CHANGEFLAGINFOLDER LA.SHOW.MARK LA.INVERT.MARK.BOX LA.BLT.MARK.BOX
LA.SHOW.DELETION LA.SHOW.SELECTION SEENMESSAGE DELETEMESSAGE UNDELETEMESSAGE))
[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
LAFITE.SKIP.TO.EOL LAFITE.SKIP.WHITE.SPACE)
(COMS (VARS FULLPARSEFIELDS TOCFIELDS TOFIELDONLY)
(FNS LAFITE.INIT.PARSETABLES LAFITE.MAKE.PARSE.TABLE LAFITE.MAKE.PARSE.TABLE1))
(P (MOVD? (QUOTE EVQ)
(QUOTE FIXTHIS]
(COMS (* Low level file functions)
(FNS \LAFITE.WRITE.PROFILE \LAFITE.READ.PROFILE DELETEMAILFOLDER FORGETMAILFILE
\LAFITE.UNCACHE.FOLDER \LAFITE.UNCACHE.MESSAGEFORM OPENMAILFOLDER
\LAFITE.OPENSTREAM \LAFITE.EOF CLOSEMAILFOLDER PROMPTFORFILENAME
\LAFITE.PROMPTFORFOLDER MAILFOLDERBUSY LA.LONGFILENAME PROFILEFILENAME TOCFILENAME
LA.SHORTFILENAME)
(FNS COPY7BITFILE FIXLAURELFILE \LAFITE.BROWSE.LAURELFILE \LAFITE.FIX.LAUREL.FOLDER))
(COMS (* ICON stuff *)
(BITMAPS MSGSENTICON MSGSENTMASK MSGFOLDERICON MSGFOLDERMASK)
(FILES ICONW)
(FNS LA.INITIALIZEICONS LAFITEBROWSERICONFN))
[COMS (FNS \LAFITE.GLOBAL.INIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\LAFITE.GLOBAL.INIT]
(FILES ATTACHEDWINDOW TEDIT MAILCLIENT GRAPEVINE)
(DECLARE: DOEVAL@COMPILE DONTCOPY (COMS * LAFITECOMPILETIME))
(INITRECORDS MAILFOLDER LAFITEMSG)
(SYSRECORDS MAILFOLDER LAFITEMSG)
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA BROWSERPROMPTPRINT
LAFITE])
(RPAQQ LAFITEVERSION# 9)
(RPAQQ LAFITESYSTEMDATE "28-Feb-84 13:10:33")
(DEFINEQ
(LAFITE
[LAMBDA X (* bvm: "13-Jan-84 11:13")
(* * The first argument should be ON or OFF. The second argument, if supplied, is the name of the mailfile Lafite
should browse unless the second argument is NIL in which case no mailfile will be browsed.
If there is no second argument then default to DEFAULTMAILFOLDERNAME mailfile -- currently ACTIVE * *)
(SELECTQ (COND
((ILESSP X 1) (* Lafite called with no args *)
(QUOTE ON))
(T (ARG X 1)))
[ON (COND
((LAFITEACTIVEP)
(QUOTE ON))
((NOT (THIS.PROCESS))
"No Processes!")
(T [\LAFITE.START (COND
((ILEQ X 1)
DEFAULTMAILFOLDERNAME)
(T (ARG X 2]
(QUOTE ON]
(OFF (COND
((LAFITEACTIVEP) (* Lafite was on *)
(\LAFITE.QUIT (ASSOC (QUOTE Quit)
LAFITECOMMANDMENUITEMS)
LAFITEMAINMENU)))
(QUOTE OFF))
(LISPERROR "ILLEGAL ARG" (ARG X 1])
(\LAFITE.START
[LAMBDA (MAILFILE) (* bvm: "22-Feb-84 16:24")
(RESETFORM (CURSOR WAITINGCURSOR)
(\LAFITEDEFAULTHOST&DIR (OR LAFITEDEFAULTHOST&DIR LOGINHOST/DIR))
(SETQ \LAFITE.MAILSERVERLOCK (CREATE.MONITORLOCK "Lafite Mail Servers"))
(* Used by anyone who calls MAILSERVERS or otherwise
tries to muck with \LAFITEUSERDATA)
(SETQ \LAFITE.BROWSELOCK (CREATE.MONITORLOCK "Lafite Browser Control"))
(* Used by anyone creating browsers or otherwise
concerned with changes to \ACTIVELAFITEFOLDERS)
(SETQ \LAFITE.MAINLOCK (CREATE.MONITORLOCK "Lafite Main"))
(* Used by \LAFITE.CLOSE.OTHER.FOLDERS or anyone who
needs access to multiple arbitrary folders)
(SETQ \LAFITE.PROFILELOCK (CREATE.MONITORLOCK "Lafite Profile"))
(SETQ \LAFITE.HARDCOPYLOCK (CREATE.MONITORLOCK "Lafite hardcopy"))
(* Used by anyone reading or writing the Lafite profile)
(COND
((NOT (WINDOWP LAFITESTATUSWINDOW))
(MAKELAFITECOMMANDWINDOW))
(T (CLEARW LAFITESTATUSWINDOW)))
(\LAFITE.READ.PROFILE)
[COND
((NULL LAFITEUPDATEMENU)
(SETQ LAFITEUPDATEMENU
(create MENU
ITEMS ← LAFITEUPDATEMENUITEMS
MENUFONT ← LAFITEMENUFONT
TITLE ← "Update Options"
CENTERFLG ← T]
[COND
((NULL LAFITECLOSEFNMENU)
(SETQ LAFITECLOSEFNMENU (create MENU
ITEMS ←[APPEND LAFITEUPDATEMENUITEMS
(QUOTE (("Don't update file"
(QUOTE ##CLOSE##)
"Just close/shrink the window - don't update it."]
MENUFONT ← LAFITEMENUFONT
TITLE ← "Close/Shrink Options"
CENTERFLG ← T]
(SETQ \LAFITE.READY T)
(COND
(MAILFILE (\LAFITE.BROWSE (ASSOC (QUOTE Browse)
(fetch (MENU ITEMS) of LAFITEMAINMENU))
LAFITEMAINMENU MAILFILE)))
(ADD.PROCESS (CONSTANT (LIST (FUNCTION LAFITEMAILWATCH)))
(QUOTE RESTARTABLE)
(QUOTE HARDRESET))
(pushnew AROUNDEXITFNS (FUNCTION LAFITE.AROUNDEXIT))
(pushnew \AFTERLOGINFNS (FUNCTION \LAFITE.AFTERLOGIN])
(\LAFITEDEFAULTHOST&DIR
[LAMBDA (HOST&DIR) (* DECLARATIONS: (PROPRECORD
(HOST DIRECTORY)))
(* bvm: "26-Jan-84 14:55")
(PROG ((OLDHOST&DIR (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR))
HOST UNPACKEDFIELDS)
(COND
((OR (NULL HOST&DIR)
(EQ OLDHOST&DIR HOST&DIR)) (* User wants the value, or there is no change)
(RETURN HOST&DIR)))
(SETQ UNPACKEDFIELDS (UNPACKFILENAME HOST&DIR)) (* now make sure its a legitimate HOST&DIR *)
(RETURN (COND
((AND (HOSTNAMEP (SETQ HOST (fetch HOST of UNPACKEDFIELDS)))
(DIRECTORYNAMEP HOST&DIR)
(NOT (IGREATERP (LENGTH UNPACKEDFIELDS)
4))) (* set both the visible and invisble variables *)
(SETQ \LAFITEDEFAULTHOST&DIR (create DEFAULTHOST&DIR
DEFAULTHOST ← HOST
DEFAULTDIR ←(fetch DIRECTORY of
UNPACKEDFIELDS)
PACKEDHOST&DIR ← HOST&DIR))
(* reset all the appropriate menus *)
(SETQ LAFITEFOLDERSMENU (SETQ LAFITEFORMSMENU))
OLDHOST&DIR)
(T (ERROR "Invalid HOST/DIRECTORY" HOST&DIR])
(LAFITEDEFAULTHOST&DIR
[LAMBDA (HOST&DIR) (* bvm: "22-Feb-84 16:27")
(* * Temporary definition until we can do it right)
(SETQ LAFITEDEFAULTHOST&DIR HOST&DIR])
(MAKELAFITECOMMANDWINDOW
[LAMBDA NIL (* bvm: "13-Jan-84 11:12")
(PROG (STATUSWINDOW MENUW MENUWREGION POSITION HEIGHT WIDTH)
[SETQ MENUW (MENUWINDOW (SETQ LAFITEMAINMENU (create MENU
ITEMS ← LAFITECOMMANDMENUITEMS
WHENSELECTEDFN ←(FUNCTION
DOMAINLAFITECOMMAND)
CENTERFLG ← T
TITLE ← "L a f i t e"
MENUFONT ← LAFITEMENUFONT
MENUTITLEFONT ← LAFITETITLEFONT]
(SETQ WIDTH (IMAX [fetch (REGION WIDTH) of (SETQ MENUWREGION (WINDOWPROP MENUW
(QUOTE REGION]
LAFITESTATUSWINDOWMINWIDTH))
[SETQ HEIGHT (HEIGHTIFWINDOW (FIX (FTIMES (FONTPROP LAFITEMENUFONT (QUOTE HEIGHT))
1.5]
(SETQ POSITION (OR LAFITESTATUSWINDOWPOSITION (GETBOXPOSITION WIDTH
(IPLUS HEIGHT
(fetch (REGION HEIGHT)
of MENUWREGION))
NIL NIL NIL
"Specify position of the Lafite Command Menu.")))
(SETQ STATUSWINDOW (CREATEW (create REGION
LEFT ←(fetch (POSITION XCOORD) of POSITION)
BOTTOM ←(IPLUS (fetch (POSITION YCOORD) of POSITION)
(fetch (REGION HEIGHT) of MENUWREGION))
WIDTH ← WIDTH
HEIGHT ← HEIGHT)))
(DSPFONT LAFITEMENUFONT STATUSWINDOW)
(ATTACHWINDOW MENUW STATUSWINDOW (QUOTE BOTTOM))
[replace (WINDOWPROP BUTTONEVENTFN) of STATUSWINDOW with (FUNCTION (LAMBDA (WINDOW)
(COND
((LASTMOUSESTATE
(NOT UP))
(SETQ \LAFITE.LAST.STATUS)
(WAKE.PROCESS
(QUOTE LAFITEMAILWATCH]
(OPENW STATUSWINDOW)
(RETURN (SETQ LAFITESTATUSWINDOW STATUSWINDOW])
(DOLAFITEBROWSERCOMMAND
[LAMBDA (ITEM MENU KEY) (* bvm: " 1-Feb-84 15:13")
(ASSURE.LAFITE.READY)
(PROG ((WINDOW (fetch (WINDOWPROP MAINWINDOW) of (WFROMMENU MENU)))
MAILFOLDER)
(SETQ MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))
(COND
((NULL (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER))
(RETURN)))
(APPLY* (EXTRACTMENUCOMMAND ITEM)
WINDOW MAILFOLDER ITEM MENU KEY])
(\LAFITE.CHECK.NO.SELECTIONS
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 12:14")
(COND
((IGREATERP (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)
(fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER))
(BROWSERPROMPTPRINT MAILFOLDER "No messages selected.")
T])
(EXTRACTMENUCOMMAND
[LAMBDA (ITEM) (* DECLARATIONS: (RECORD (LABEL FORM HELPSTRING)))
(* mdy: "20-OCT-82 15:07")
(if (NLISTP ITEM)
then ITEM
elseif (fetch FORM of ITEM)
then (EVAL (fetch FORM of ITEM))
else (fetch LABEL of ITEM])
(DOLAFITESENDINGCOMMAND
[LAMBDA (ITEM MENU KEY) (* bvm: "26-Jan-84 19:18")
(* * this function is invoked by buttoning the menu on top of the "sending" window * *)
(PROG (COMMAND TEXTSTREAM PROC WINDOW)
(SETQ COMMAND (EXTRACTMENUCOMMAND ITEM))
(SELECTQ COMMAND
((##SAVE## ##SEND## ##FORGETIT##)
(* it's one of the commands to leave Tedit -- the SENDINGCOMMAND record is going to be passed back to SENDMESSAGE
thru the call to TEDIT *)
(AND [SETQ PROC (fetch (WINDOWPROP PROCESS) of (SETQ WINDOW (fetch (WINDOWPROP
MAINWINDOW)
of (WFROMMENU
MENU]
(PROCESSPROP PROC (QUOTE BEFOREEXIT)
(QUOTE DON'T))) (* Don't let anyone logout now!)
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(TEDIT.QUIT (SETQ TEXTSTREAM (fetch (WINDOWPROP TEXTSTREAM) of WINDOW))
(create SENDINGCOMMAND
COMMAND ← COMMAND
ITEM ← ITEM
MENU ← MENU
MESSAGE ← TEXTSTREAM)))
(SHOULDNT])
)
(PUTPROPS LAFITE ARGNAMES (ON/OFF MAILFILE))
(DEFINEQ
(DOMAINLAFITECOMMAND
[LAMBDA (ITEM MENU BUTTON) (* bvm: "21-Feb-84 15:24")
(SELECTQ (EXTRACTMENUCOMMAND ITEM)
[##BROWSE## (COND
((EQ BUTTON (QUOTE MIDDLE))
(\LAFITE.SUBBROWSE ITEM MENU))
(T (\LAFITE.BROWSE ITEM MENU]
(##SENDMAIL## (\LAFITE.MESSAGEFORM ITEM MENU BUTTON))
[##QUIT## (COND
((MOUSECONFIRM "LEFT button to 'Quit' - MIDDLE or RIGHT to abort." T)
(ADD.PROCESS (LIST (FUNCTION \LAFITE.QUIT)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE LAFITEQUIT)
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE BEFOREEXIT)
(QUOTE DON'T]
(SHOULDNT])
(\LAFITE.QUIT
[LAMBDA (ITEM MENU) (* bvm: "25-Jan-84 16:11")
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE) (* kill the mail watch process *)
(DEL.PROCESS (FUNCTION LAFITEMAILWATCH))
(PROGN [RESETLST (OBTAIN.MONITORLOCK \LAFITE.BROWSELOCK NIL T)
(OBTAIN.MONITORLOCK \LAFITE.MAINLOCK NIL T)
(for FOLDER in (APPEND \ACTIVELAFITEFOLDERS) bind BROWSERWINDOW
do (COND
((NOT (SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW)
of FOLDER)))
(CLOSEMAILFOLDER FOLDER T))
((OR (fetch (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDER)
(fetch (MAILFOLDER FOLDERNEEDSEXPUNGE) of FOLDER))
(\LAFITE.EXPUNGE.PROC BROWSERWINDOW FOLDER NIL NIL (QUOTE CLOSE)))
(T (CLOSEW (FLUSHBROWSERWINDOW BROWSERWINDOW FOLDER]
(SETQ \ACTIVELAFITEFOLDERS))
(PROGN [for WINDOW in (CONS PRIMARYEDITORWINDOW LAFITEEDITORWINDOWS)
do (* now close the edit and display windows *)
(COND
((WINDOWP WINDOW)
(COND
((OPENWP WINDOW)
(CLOSEW WINDOW))
((WINDOWP (fetch (WINDOWPROP ICONWINDOW) of WINDOW))
(CLOSEW (fetch (WINDOWPROP ICONWINDOW) of WINDOW]
(SETQ LAFITEEDITORWINDOWS (SETQ PRIMARYEDITORWINDOW NIL)))
(COND
(\LAFITEPROFILECHANGED (\LAFITE.WRITE.PROFILE)))
(COND
((WINDOWP LAFITESTATUSWINDOW)
(CLOSEW LAFITESTATUSWINDOW)))
(SETQ AROUNDEXITFNS (REMOVE (FUNCTION LAFITE.AROUNDEXIT)
AROUNDEXITFNS))
(PROGN (for FILE in \LAFITE.TEMPFILES
do (* delete any temp files laying around *)
(CLOSEF? FILE)
(DELFILE FILE))
(SETQ \LAFITE.TEMPFILES))
[SETQ \LAFITEDEFAULTHOST&DIR (SETQ LAFITECLOSEFNMENU (SETQ LAFITEUPDATEMENU (SETQ LAFITEMAINMENU
(SETQ LAFITESTATUSWINDOW NIL]
(LAFITECLEARCACHE])
)
(* BROWSE)
(DEFINEQ
(\LAFITE.BROWSE
[LAMBDA (ITEM MENU FILE LAURELFLG) (* bvm: "21-Feb-84 14:30")
(COND
((OR FILE (SETQ FILE (\LAFITE.PROMPTFORFOLDER)))
(ADD.PROCESS (LIST (FUNCTION \LAFITE.BROWSE.PROC)
(KWOTE (LA.LONGFILENAME (U-CASE FILE)
LAFITEMAIL.EXT))
(KWOTE ITEM)
(KWOTE MENU)
(KWOTE LAURELFLG))
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE NAME)
(QUOTE LAFITEBROWSE])
(\LAFITE.SUBBROWSE
[LAMBDA (ITEM MENU) (* bvm: "21-Feb-84 15:04")
(PROG [(COMMAND (MENU (OR LAFITESUBBROWSEMENU
(SETQ LAFITESUBBROWSEMENU
(create MENU
ITEMS ← LAFITESUBBROWSEMENUITEMS
TITLE ← "Browse subcommands"
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T]
(COND
(COMMAND (APPLY* COMMAND ITEM MENU])
(\LAFITE.BROWSE.PROC
[LAMBDA (FOLDERNAME ITEM MENU LAURELFLG) (* bvm: "21-Feb-84 14:37")
(PROG (MAILFOLDER)
(COND
((SETQ MAILFOLDER (RESETLST (LA.RESETSHADE ITEM MENU)
(\LAFITE.PREPARE.BROWSER FOLDERNAME)))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(COND
(LAURELFLG (\LAFITE.FIX.LAUREL.FOLDER MAILFOLDER)))
(GETFOLDERINTOBROWSER MAILFOLDER])
(\LAFITE.PREPARE.BROWSER
[LAMBDA (FOLDERNAME) (* bvm: "24-Jan-84 15:02")
(WITH.MONITOR
\LAFITE.BROWSELOCK
(PROG (MAILFOLDER BROWSERWINDOW)
(RETURN (COND
((NULL (SETQ MAILFOLDER (\LAFITE.GETMAILFOLDER FOLDERNAME)))
(* Error occurred)
NIL)
((SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(COND
((OPENWP BROWSERWINDOW)
(TOTOPW BROWSERWINDOW))
(T (* Make sure the EXPANDFN runs)
(EXPANDW BROWSERWINDOW)))
NIL)
(T (PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER))
ERRN)
(COND
(STREAM (* Already have folder open, e.g., from MOVETO, but no
browser yet)
(SETFILEINFO STREAM (QUOTE BUFFERS)
LAFITEBUFFERSIZE))
(T [COND
([NULL (SETQ STREAM (CAR (NLSETQ (\LAFITE.OPENSTREAM
FOLDERNAME
(QUOTE INPUT)
(QUOTE OLD)
T]
(COND
((AND (EQ (CAR (SETQ ERRN (ERRORN)))
(PROG1 23
(* File not found)))
(EQ (CADR ERRN)
FOLDERNAME)
(MOUSECONFIRM (CONCAT
"Click LEFT to confirm creating "
FOLDERNAME)
T))
(SETQ STREAM (\LAFITE.OPENSTREAM FOLDERNAME (QUOTE BOTH)
(QUOTE NEW)
T)))
(T (printout PROMPTWINDOW T "Could not open " FOLDERNAME)
(RETURN]
(replace (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER
with (FULLNAME STREAM))
(replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER with STREAM)))
(SETQ BROWSERWINDOW (CREATEBROWSERWINDOW MAILFOLDER))
(RETURN MAILFOLDER])
(GETFOLDERINTOBROWSER
[LAMBDA (MAILFOLDER) (* bvm: "28-Dec-83 16:03")
(COND
((LOADMAILFOLDER MAILFOLDER)
(DISPLAYFOLDERINBROWSER MAILFOLDER])
(DISPLAYFOLDERINBROWSER
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 14:04")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
CLIPREGION MSGDESCRIPTOR)
(CLEARW WINDOW)
(INITBROWSERMAP MAILFOLDER)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with NIL)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of MAILFOLDER with NIL)
(replace (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER with 1)
(replace (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER with 0)
(COND
([AND (SETQ MSGDESCRIPTOR (LAFITE.MAKE.INITIAL.SELECTION MAILFOLDER))
(ILESSP (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)
(fetch (REGION BOTTOM) of (SETQ CLIPREGION (DSPCLIPPINGREGION NIL WINDOW]
(* Quietly scroll so that selected message is in window)
(WYOFFSET (ITIMES [IDIFFERENCE (fetch (LAFITEMSG #) of MSGDESCRIPTOR)
(IQUOTIENT (fetch (REGION HEIGHT) of CLIPREGION)
(ITIMES 2 (fetch (MAILFOLDER
BROWSERFONTHEIGHT)
of MAILFOLDER]
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))
WINDOW)))
(COND
((ZEROP (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(BROWSERPROMPTPRINT MAILFOLDER "Folder is empty."))
(T (DISPLAYBROWSERLINES MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER CLIPREGION)
(LASTVISIBLEMESSAGE MAILFOLDER CLIPREGION])
(LAFITE.MAKE.INITIAL.SELECTION
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 12:10")
(PROG ((LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
MSGDESCRIPTOR MESSAGES)
(COND
((EQ LASTMSG# 0)
(RETURN)))
(SETQ MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(for I from 1 to LASTMSG# when (AND [NOT (fetch (LAFITEMSG SEEN?)
of (SETQ MSGDESCRIPTOR (NTHMESSAGE MESSAGES I]
(NOT (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR)))
do (* Found an unseen, undeleted message.
If we don't find one, the last MSGDESCRIPTOR is the one
to select)
(RETURN))
(SELECTMESSAGE MSGDESCRIPTOR MAILFOLDER)
(RETURN MSGDESCRIPTOR])
(CREATEBROWSERWINDOW
[LAMBDA (MAILFOLDER) (* bvm: "26-Jan-84 17:32")
(* * Build a browser window, which consists of three attached windows: the main BROWSERWINDOW, the
BROWSERMENUWINDOW containing the menu, and a BROWSERPROMPTWINDOW for displaying random info)
(PROG ((TITLE (CONCAT "Mail browser for " (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER)))
BROWSERPROMPTWINDOW BROWSERMENUWINDOW BROWSERMENU BROWSERWINDOW WIDTH HEIGHT MENUREGION
WHOLEREGION)
(SETQ BROWSERMENU (create MENU
ITEMS ← LAFITEBROWSERMENUITEMS
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION DOLAFITEBROWSERCOMMAND)
MENUFONT ← LAFITEMENUFONT))
(SETQ MENUREGION (WINDOWPROP (SETQ BROWSERMENUWINDOW (MENUWINDOW BROWSERMENU))
(QUOTE REGION)))
(SETQ WIDTH (fetch (REGION WIDTH) of MENUREGION))
[SETQ HEIGHT (HEIGHTIFWINDOW (FONTPROP LAFITEBROWSERFONT (QUOTE HEIGHT]
(* * Now figure out where to put it all)
[SETQ WHOLEREGION (COND
((AND (for FOLDER in \ACTIVELAFITEFOLDERS never (fetch (MAILFOLDER BROWSERWINDOW)
of FOLDER))
(type? REGION LAFITEBROWSERREGION))
(COPY LAFITEBROWSERREGION))
(T (PROMPTPRINT "Specify region for " TITLE)
(PROG1 (GETREGION WIDTH (ITIMES HEIGHT 6)
NIL NIL NIL NIL)
(CLRPROMPT]
(SETQ WIDTH (fetch (REGION WIDTH) of WHOLEREGION))
[replace (REGION HEIGHT) of WHOLEREGION with (IDIFFERENCE (fetch (REGION HEIGHT)
of WHOLEREGION)
(IPLUS HEIGHT
(fetch (REGION HEIGHT)
of MENUREGION]
(* Shrink user-supplied region by the combined heights
of the menu and prompt window)
(SETQ BROWSERPROMPTWINDOW
(CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
NIL NIL T))
(WINDOWPROP BROWSERPROMPTWINDOW (QUOTE MINSIZE)
(CONS 0 HEIGHT))
(WINDOWPROP BROWSERPROMPTWINDOW (QUOTE MAXSIZE)
(CONS MAX.SMALLP HEIGHT))
(DSPSCROLL T BROWSERPROMPTWINDOW)
(DSPFONT LAFITEBROWSERFONT BROWSERPROMPTWINDOW)
(SETQ BROWSERWINDOW (CREATEW WHOLEREGION TITLE))
(ATTACHWINDOW BROWSERMENUWINDOW BROWSERWINDOW (QUOTE TOP)
(QUOTE JUSTIFY))
(ATTACHWINDOW BROWSERPROMPTWINDOW BROWSERMENUWINDOW (QUOTE TOP)
(QUOTE JUSTIFY))
(replace (MAILFOLDER ORIGINALBROWSERTITLE) of MAILFOLDER with TITLE)
(WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER)
MAILFOLDER)
(replace (WINDOWPROP SCROLLFN) of BROWSERWINDOW with (FUNCTION LAFITEBROWSERSCROLLFN))
(replace (MAILFOLDER BROWSERWINDOW) of MAILFOLDER with BROWSERWINDOW)
(replace (MAILFOLDER BROWSERMENUWINDOW) of MAILFOLDER with BROWSERMENUWINDOW)
(replace (MAILFOLDER BROWSERMENU) of MAILFOLDER with BROWSERMENU)
(replace (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER with BROWSERPROMPTWINDOW)
(replace (WINDOWPROP REPAINTFN) of BROWSERWINDOW with (FUNCTION LAFITEBROWSERREPAINTFN))
(replace (WINDOWPROP ICONFN) of BROWSERWINDOW with (FUNCTION LAFITEBROWSERICONFN))
(replace (WINDOWPROP BUTTONEVENTFN) of BROWSERWINDOW with (FUNCTION
LAFITEBROWSERBUTTONEVENTFN))
(replace (WINDOWPROP RIGHTBUTTONFN) of BROWSERWINDOW with (FUNCTION
LAFITEBROWSERBUTTONEVENTFN))
(* make sure Lafite has the first CLOSEFN and SHRINKFN
*)
[replace (WINDOWPROP CLOSEFN) of BROWSERWINDOW with (CONS (FUNCTION LAFITEBROWSERCLOSEFN)
(MKLIST (fetch (WINDOWPROP
CLOSEFN)
of BROWSERWINDOW]
[replace (WINDOWPROP SHRINKFN) of BROWSERWINDOW with (CONS (FUNCTION LAFITEBROWSERSHRINKFN)
(MKLIST (fetch (WINDOWPROP
SHRINKFN)
of BROWSERWINDOW]
(WINDOWADDPROP BROWSERWINDOW (QUOTE RESHAPEFN)
(FUNCTION LAFITEBROWSERRESHAPEFN))
(replace (WINDOWPROP CURSORMOVEDFN) of BROWSERWINDOW with (FUNCTION
LAFITEBROWSERCURSORMOVEDFN))
(replace (WINDOWPROP CURSOROUTFN) of BROWSERWINDOW with (FUNCTION LAFITEBROWSERCURSOROUTFN))
(RETURN BROWSERWINDOW])
)
(* Browser operations)
(DEFINEQ
(INITBROWSERMAP
[LAMBDA (MAILFOLDER) (* bvm: " 2-Feb-84 12:08")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
WIDTH HEIGHT TOTALHEIGHT ASCENT DIGITWIDTH SPACEWIDTH XPOS)
(CLEARW WINDOW)
(SETQ LAFITEBROWSERFONT (FONTCREATE LAFITEBROWSERFONT))
(DSPFONT LAFITEBROWSERFONT WINDOW)
(DSPRIGHTMARGIN MAX.SMALLP WINDOW)
(LINELENGTH 10000 WINDOW)
[replace (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER with (SETQ HEIGHT
(FONTPROP LAFITEBROWSERFONT
(QUOTE HEIGHT]
[replace (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER with (SETQ ASCENT
(FONTPROP LAFITEBROWSERFONT
(QUOTE ASCENT]
(replace (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER with (FONTPROP LAFITEBROWSERFONT
(QUOTE DESCENT)))
(replace (MAILFOLDER BROWSERORIGIN) of MAILFOLDER with (IPLUS (DSPYPOSITION NIL WINDOW)
ASCENT))
[replace (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER with (SETQ WIDTH (WINDOWPROP
WINDOW
(QUOTE WIDTH]
(SETQ TOTALHEIGHT (ITIMES (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
HEIGHT))
(replace (WINDOWPROP EXTENT) of WINDOW with (replace (MAILFOLDER BROWSEREXTENT)
of MAILFOLDER
with (create REGION
LEFT ← 0
BOTTOM ←(IDIFFERENCE
(fetch (MAILFOLDER
BROWSERORIGIN)
of MAILFOLDER)
TOTALHEIGHT)
WIDTH ← WIDTH
HEIGHT ← TOTALHEIGHT)))
(* * Now figure out columns for printing toc entries)
(SETQ DIGITWIDTH (CHARWIDTH (CHARCODE 9)
LAFITEBROWSERFONT))
(SETQ SPACEWIDTH (CHARWIDTH (CHARCODE r)
LAFITEBROWSERFONT))
[replace (MAILFOLDER ORDINALXPOS) of MAILFOLDER with (SETQ XPOS (IPLUS BROWSERMARKXPOSITION
(CHARWIDTH
(CHARCODE m)
LAFITEBROWSERFONT)
(LRSH DIGITWIDTH 1]
(* Message # starts here)
[replace (MAILFOLDER DATEXPOS) of MAILFOLDER with (add XPOS (IPLUS (TIMES 2 SPACEWIDTH)
(TIMES 4 DIGITWIDTH]
(* Date starts here. Allow 4 columns of digits plus some
space)
[replace (MAILFOLDER FROMXPOS) of MAILFOLDER with (add XPOS (IPLUS (TIMES 2 DIGITWIDTH)
(TIMES 2 SPACEWIDTH)
(CHARWIDTH (CHARCODE
-)
LAFITEBROWSERFONT)
(STRINGWIDTH
(QUOTE MAY)
LAFITEBROWSERFONT]
(* From field starts here. Allow 3 columns of digits, a
month, and some space)
[replace (MAILFOLDER SUBJECTXPOS) of MAILFOLDER
with (add XPOS (IMAX (TIMES LAFITEMINFROMCHARS (CHARWIDTH (CHARCODE A)
LAFITEBROWSERFONT))
(FIXR (FTIMES LAFITEFROMFRACTION (IDIFFERENCE WIDTH XPOS]
(* Subject field starts here. Space is divided up between From and Subject so that From field gets
LAFITEFROMFRACTION of the available space, but at least LAFITEMINFROMCHARS wide)
(replace (MAILFOLDER FROMMAXXPOS) of MAILFOLDER with (IDIFFERENCE XPOS (TIMES 2 SPACEWIDTH))
) (* From field gets truncated beyond this position)
(replace (MAILFOLDER BROWSERDIGITWIDTH) of MAILFOLDER with DIGITWIDTH])
(LAFITEBROWSERBUTTONEVENTFN
[LAMBDA (WINDOW) (* bvm: " 3-Jan-84 14:43")
(COND
[(INSIDEP (DSPCLIPPINGREGION NIL WINDOW)
(LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(TOTOPW WINDOW)
(RESETLST (PROG [(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(COND
((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T))
(BROWSERSELECTMESSAGE WINDOW]
((LASTMOUSESTATE (ONLY RIGHT))
(DOWINDOWCOM WINDOW))
(T (TOTOPW WINDOW])
(LOADMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "12-Jan-84 15:07")
(* LAFITEVERSION# is used to keep track of changed in internal datastructures that get written out to Lafite TOC
files. If the datastructures change, then just change the version number to LAFITEVERSION#+1 and the rest of
Lafite should adjust appropriately. *)
(PROG ((MAILFILE (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER))
CONTENTSFILE)
(RETURN (COND
((OR (AND (INFILEP (SETQ CONTENTSFILE (TOCFILENAME MAILFILE)))
(READTOCFILE MAILFOLDER CONTENTSFILE))
(PARSEMAILFOLDER MAILFOLDER))
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
" done.")
[replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER
with (for I from 1 to (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
bind (MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)
)
thereis (fetch (LAFITEMSG DELETED?) of (NTHMESSAGE MESSAGES I]
MAILFOLDER)
(T (printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Failed.")
NIL])
(\LAFITE.GETMAILFOLDER
[LAMBDA (FOLDERNAME) (* bvm: "12-Jan-84 15:08")
(* * Locates a MAILFOLDER on FOLDERNAME, or creates one if there is none. The newly created folder does not have a
full name unless FOLDERNAME itself has a version)
(OR (for FOLDER in \ACTIVELAFITEFOLDERS when (OR (EQ (fetch (MAILFOLDER VERSIONLESSFOLDERNAME)
of FOLDER)
FOLDERNAME)
(EQ (fetch (MAILFOLDER FULLFOLDERNAME)
of FOLDER)
FOLDERNAME))
do (RETURN FOLDER))
(PROG ((UNPACKEDNAME (UNPACKFILENAME FOLDERNAME))
VERSIONLESSNAME SHORTNAME NEWFOLDER)
(LISTPUT UNPACKEDNAME (QUOTE VERSION)
NIL)
(SETQ VERSIONLESSNAME (PACKFILENAME UNPACKEDNAME))
[COND
[(AND (NEQ VERSIONLESSNAME FOLDERNAME)
(find old NEWFOLDER in \ACTIVELAFITEFOLDERS suchthat
(EQ (fetch (MAILFOLDER
VERSIONLESSFOLDERNAME)
of NEWFOLDER)
VERSIONLESSNAME)))
(* Found a folder describing a different version)
(COND
((fetch (MAILFOLDER BROWSERWINDOW) of NEWFOLDER)
(printout PROMPTWINDOW T "A different version of " FOLDERNAME
" is already being browsed."
"Multiple versions may not be manipulated at once.")
(RETURN NIL))
(T (* Not being browsed, so just smash the full name)
(replace (MAILFOLDER FULLFOLDERNAME) of NEWFOLDER with FOLDERNAME]
(T (SETQ SHORTNAME (LA.SHORTFILENAME UNPACKEDNAME LAFITEMAIL.EXT))
(SETQ NEWFOLDER (create MAILFOLDER
FULLFOLDERNAME ←(AND (NEQ FOLDERNAME VERSIONLESSNAME)
FOLDERNAME)
VERSIONLESSFOLDERNAME ← VERSIONLESSNAME
SHORTFOLDERNAME ← SHORTNAME
FOLDERLOCK ←(CREATE.MONITORLOCK VERSIONLESSNAME)))
(push \ACTIVELAFITEFOLDERS NEWFOLDER)
(COND
((NOT (FMEMB SHORTNAME (CDR LAFITEMAILFOLDERS)))
(push (CDR LAFITEMAILFOLDERS)
SHORTNAME)
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFOLDERSMENU]
(RETURN NEWFOLDER])
(LAFITEBROWSERREPAINTFN
[LAMBDA (WINDOW REGION) (* bvm: " 3-Jan-84 14:54")
(PROG [(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(AND (NOT (ZEROP (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)))
(fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(RESETLST (COND
((OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T)
(DISPLAYBROWSERLINES MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER REGION)
(LASTVISIBLEMESSAGE MAILFOLDER REGION)))
(T (MAILFOLDERBUSY MAILFOLDER])
(LAFITEBROWSERSCROLLFN
[LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* bvm: " 3-Jan-84 14:53")
(* * only scroll if can get the monitor lock * *)
(RESETLST (PROG [(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(COND
((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T))
(SCROLLBYREPAINTFN WINDOW DX DY CONTINUOUSFLG))
(T (MAILFOLDERBUSY MAILFOLDER])
(LAFITEBROWSERRESHAPEFN
[LAMBDA (WINDOW OLDIMAGEBM OLDREGION) (* bvm: " 3-Jan-84 15:03")
(RESETLST (PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))
(REGION (DSPCLIPPINGREGION NIL WINDOW))
MSG#)
[COND
((NOT (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T)) (* Folder is busy, have to wait until it is ready.
But don't tie up mouse!)
(ALLOW.BUTTON.EVENTS)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T))
((NOT (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER))
(* Browser not functional)
(RETURN (RESHAPEBYREPAINTFN WINDOW OLDIMAGEBM OLDREGION]
(SETQ MSG# (FIRSTVISIBLEMESSAGE MAILFOLDER REGION))
(INITBROWSERMAP MAILFOLDER)
(WYOFFSET (ITIMES (SUB1 MSG#)
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))
WINDOW)
(DISPLAYBROWSERLINES MAILFOLDER MSG# (LASTVISIBLEMESSAGE MAILFOLDER REGION])
(LAFITEBROWSERCLOSEFN
[LAMBDA (BROWSERWINDOW) (* bvm: " 4-Jan-84 14:33")
(\LAFITE.CLOSE/SHRINK BROWSERWINDOW (QUOTE CLOSE])
(LAFITEBROWSERSHRINKFN
[LAMBDA (WINDOW) (* bvm: " 4-Jan-84 14:34")
(\LAFITE.CLOSE/SHRINK WINDOW (QUOTE SHRINK])
(\LAFITE.CLOSE/SHRINK
[LAMBDA (BROWSERWINDOW FLG) (* bvm: " 6-Jan-84 12:39")
(RESETLST (PROG ((MAILFOLDER (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER)))
FN)
(RETURN (COND
[(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T)
(CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(SELECTQ (COND
((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(OR (fetch (MAILFOLDER FOLDERNEEDSUPDATE)
of MAILFOLDER)
(fetch (MAILFOLDER FOLDERNEEDSEXPUNGE)
of MAILFOLDER)))
(SETQ FN (MENU LAFITECLOSEFNMENU)))
(T (QUOTE ##CLOSE##)))
(NIL (QUOTE DON'T))
(##CLOSE## (CLOSEMAILFOLDER MAILFOLDER T)
(\LAFITE.FINISH.UPDATE FLG BROWSERWINDOW
MAILFOLDER T))
(PROGN (ADD.PROCESS (LIST FN (KWOTE BROWSERWINDOW)
(KWOTE MAILFOLDER)
NIL NIL (KWOTE FLG))
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE BEFOREEXIT)
(QUOTE DON'T))
(* Return DON'T now, for UPDATE.PROC will do it later)
(QUOTE DON'T]
(T (printout PROMPTWINDOW T "Browser is busy, can't close")
(QUOTE DON'T])
(LAFITEBROWSEREXPANDFN
[LAMBDA (BROWSERWINDOW) (* bvm: " 5-Jan-84 17:37")
(PROG [(MAILFOLDER (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER]
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG ((FIRSTCHANGEDMSG# (fetch (MAILFOLDER BROWSERUPDATEFROMHERE)
of MAILFOLDER))
(OLDSHRINKFN (MKLIST (fetch (WINDOWPROP SHRINKFN) of BROWSERWINDOW)))
REGION)
(OR (MEMB (FUNCTION LAFITEBROWSERSHRINKFN)
OLDSHRINKFN)
(replace (WINDOWPROP SHRINKFN) of BROWSERWINDOW
with (CONS (FUNCTION LAFITEBROWSERSHRINKFN)
OLDSHRINKFN)))
(* Restore SHRINKFN prop if necessary)
(COND
(FIRSTCHANGEDMSG# (* Browser has changed since shrinking)
[COND
((ZEROP FIRSTCHANGEDMSG#)
(* After expunge)
(DISPLAYFOLDERINBROWSER MAILFOLDER))
(T (DISPLAYBROWSERLINES
MAILFOLDER
[IMAX FIRSTCHANGEDMSG#
(FIRSTVISIBLEMESSAGE MAILFOLDER
(SETQ REGION
(
DSPCLIPPINGREGION NIL BROWSERWINDOW]
(LASTVISIBLEMESSAGE MAILFOLDER REGION]
(replace (MAILFOLDER BROWSERUPDATEFROMHERE)
of MAILFOLDER with NIL])
(LAFITEBROWSERCURSORMOVEDFN
[LAMBDA (WINDOW) (* bvm: "17-Feb-84 15:52")
(PROG ((MAILFOLDER (fetch (WINDOWPROP MAILFOLDER) of WINDOW))
POS)
(SETCURSOR (COND
([AND MAILFOLDER (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(INSIDEP (DSPCLIPPINGREGION NIL WINDOW)
(SETQ POS (CURSORPOSITION NIL WINDOW)))
(OR (ILESSP (fetch XCOORD of POS)
BROWSERMARKXPOSITION)
(IGREATERP (fetch XCOORD of POS)
(fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER]
LA.RIGHTARROWCURSOR)
(T DEFAULTCURSOR])
(LAFITEBROWSERCURSOROUTFN
[LAMBDA (WINDOW) (* rao: "30-JUN-82 15:49")
(SETCURSOR DEFAULTCURSOR])
)
(* Browser selection)
(DEFINEQ
(BROWSERSELECTMESSAGE
[LAMBDA (WINDOW) (* bvm: "17-Feb-84 15:58")
(DECLARE (GLOBALVARS LASTMOUSEBUTTONS)
(SPECVARS TOCSTATE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))
CURSOROK MESSAGES SELECTIONREGION FIRST# LAST# FIRSTVISIBLE# LASTVISIBLE# TOCSTATE SEL#
OLDSEL# CTRLDOWN OLDLASTMOUSEBUTTONS MSG LASTX LASTY MARKRIGHT)
(COND
((ZEROP (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(* Nothing to select)
(RETURN)))
(SETQ SELECTIONREGION (DSPCLIPPINGREGION NIL WINDOW))
(SETQ LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(SETQ FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(SETQ FIRSTVISIBLE# (FIRSTVISIBLEMESSAGE MAILFOLDER SELECTIONREGION))
(SETQ LASTVISIBLE# (LASTVISIBLEMESSAGE MAILFOLDER SELECTIONREGION))
(SETQ MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(SETQ MARKRIGHT (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER))
(* * keep looping until all mouse buttons are up * *)
[do (GETMOUSESTATE)
(COND
[[NOT (INSIDEP SELECTIONREGION (SETQ LASTX (LASTMOUSEX WINDOW))
(SETQ LASTY (LASTMOUSEY WINDOW]
(* I would like to just return here and let the next window take over, but current mouse arrangement means I'll
never get control back unless user lets up on mouse)
(COND
((NEQ TOCSTATE TS.IDLE)
(LA.UNDOSELECTION)
(SETQ OLDSEL#)))
(COND
((LASTMOUSESTATE UP)
(RETURN))
(T (COND
(CURSOROK (SETCURSOR DEFAULTCURSOR)
(SETQ CURSOROK NIL)))
(BLOCK]
((LASTMOUSESTATE UP) (* Make selection permanent)
(SELECTC TOCSTATE
(TS.REPLACING (for MSG selectedin MAILFOLDER
do (replace SELECTED? of MSG with NIL))
(replace SELECTED? of (NTHMESSAGE MESSAGES OLDSEL#)
with T)
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER
with (replace LASTSELECTEDMESSAGE of MAILFOLDER
with OLDSEL#)))
(TS.ADDING (LA.SELECTRANGE MAILFOLDER OLDSEL# OLDSEL# T))
(TS.REMOVING (LA.DESELECTRANGE MAILFOLDER OLDSEL# OLDSEL#))
(TS.EXTENDING.HI (LA.SELECTRANGE MAILFOLDER (ADD1 LAST#)
OLDSEL# CTRLDOWN))
(TS.EXTENDING.LO (LA.SELECTRANGE MAILFOLDER OLDSEL# (SUB1 FIRST#)
CTRLDOWN))
(TS.SHRINKING.HI (LA.DESELECTRANGE MAILFOLDER (ADD1 OLDSEL#)
LAST#))
(TS.SHRINKING.LO (LA.DESELECTRANGE MAILFOLDER FIRST# (SUB1 OLDSEL#)))
NIL)
(RETURN))
((AND (IGEQ LASTX BROWSERMARKXPOSITION)
(ILESSP LASTX MARKRIGHT)) (* Inside mark region)
(COND
((NEQ TOCSTATE TS.IDLE)
(LA.UNDOSELECTION)
(SETQ OLDSEL#)))
(COND
(CURSOROK (SETCURSOR DEFAULTCURSOR)
(SETQ CURSOROK NIL)))
(BROWSERCHANGEMARK MAILFOLDER))
((PROGN (COND
((NOT CURSOROK)
(SETCURSOR LA.RIGHTARROWCURSOR)
(SETQ CURSOROK T)))
(OR (NEQ (SETQ SEL# (YPOS.TO.MESSAGE# (LASTMOUSEY WINDOW)
MAILFOLDER))
OLDSEL#)
(NEQ LASTMOUSEBUTTONS OLDLASTMOUSEBUTTONS)))
[COND
[(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))) (* Deselect this message)
(SELECTC TOCSTATE
(TS.REMOVING (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES
OLDSEL#)
(QUOTE REPLACE)))
(TS.IDLE)
(LA.UNDOSELECTION))
(SETQ TOCSTATE (COND
((fetch SELECTED? of (SETQ MSG (NTHMESSAGE MESSAGES SEL#)))
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE ERASE))
TS.REMOVING)
(T TS.IDLE]
((LASTMOUSESTATE LEFT) (* Set (change) the selection to this single message)
(COND
((EQ TOCSTATE TS.REPLACING)
(LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES OLDSEL#)
(QUOTE ERASE)))
(T (LA.DECONSIDERRANGE FIRSTVISIBLE# LASTVISIBLE#)
(SETQ TOCSTATE TS.REPLACING)))
(LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES SEL#)
(QUOTE REPLACE)))
[(LASTMOUSESTATE MIDDLE) (* Add this message to the selection)
(SELECTC TOCSTATE
(TS.ADDING (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES OLDSEL#)
(QUOTE ERASE)))
(TS.IDLE)
(LA.UNDOSELECTION))
(SETQ TOCSTATE (COND
([NOT (fetch SELECTED? of (SETQ MSG (NTHMESSAGE MESSAGES SEL#]
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE))
TS.ADDING)
(T TS.IDLE]
((LASTMOUSESTATE RIGHT) (* Extend: either up or down, or shrink a selection.
This is messy)
(SELECTC TOCSTATE
[TS.EXTENDING.HI (COND
((IGREATERP SEL# OLDSEL#)
(* Extend further)
(LA.CONSIDERRANGE (ADD1 OLDSEL#)
SEL# CTRLDOWN))
(T (* Shrinking back)
(LA.RECONSIDERRANGE (ADD1 (COND
((IGREATERP SEL#
LAST#)
SEL#)
(T (SETQ TOCSTATE
TS.IDLE)
LAST#)))
OLDSEL#]
[TS.EXTENDING.LO (COND
((ILESSP SEL# OLDSEL#)
(* Extend further)
(LA.CONSIDERRANGE SEL# (SUB1 OLDSEL#)
CTRLDOWN))
(T (* Shrinking back)
(LA.RECONSIDERRANGE OLDSEL#
(SUB1 (COND
((ILESSP SEL# FIRST#)
SEL#)
(T (SETQ TOCSTATE
TS.IDLE)
FIRST#]
[TS.SHRINKING.HI (COND
[(IGEQ SEL# OLDSEL#)
(* Shrinking less)
(LA.RECONSIDERRANGE (ADD1 OLDSEL#)
(COND
((ILESSP SEL# LAST#)
SEL#)
(T (SETQ TOCSTATE TS.IDLE)
LAST#]
((IGEQ SEL# FIRST#)
(* Shrinking further)
(LA.DECONSIDERRANGE (ADD1 SEL#)
OLDSEL#))
(T (* Too far to shrink)
(LA.RECONSIDERRANGE FIRST# LAST#)
(SETQ TOCSTATE TS.IDLE]
[TS.SHRINKING.LO (COND
((ILEQ SEL# OLDSEL#)
(* Shrinking less)
(LA.RECONSIDERRANGE (COND
((IGREATERP SEL# FIRST#)
SEL#)
(T (SETQ TOCSTATE TS.IDLE)
FIRST#))
(SUB1 OLDSEL#)))
((ILEQ SEL# LAST#)
(* Shrinking further)
(LA.DECONSIDERRANGE OLDSEL# (SUB1 SEL#)))
(T (* Too far to shrink)
(LA.RECONSIDERRANGE FIRST# LAST#)
(SETQ TOCSTATE TS.IDLE]
(COND
((NOT (IGREATERP FIRST# LAST#))
(COND
((NEQ TOCSTATE TS.IDLE)
(LA.UNDOSELECTION)))
(SETQ CTRLDOWN (KEYDOWNP (QUOTE CTRL)))
(SETQ TOCSTATE (COND
((IGREATERP SEL# LAST#)
(LA.CONSIDERRANGE (ADD1 LAST#)
SEL# CTRLDOWN)
TS.EXTENDING.HI)
((ILESSP SEL# FIRST#)
(LA.CONSIDERRANGE SEL# (SUB1 FIRST#)
CTRLDOWN)
TS.EXTENDING.LO)
((IGREATERP SEL# (LRSH (IPLUS LAST# FIRST#)
1))
(LA.DECONSIDERRANGE (ADD1 SEL#)
LAST#)
TS.SHRINKING.HI)
(T (LA.DECONSIDERRANGE FIRST# (SUB1 SEL#))
TS.SHRINKING.LO]
(SETQ OLDLASTMOUSEBUTTONS LASTMOUSEBUTTONS)
(SETQ OLDSEL# (AND (NEQ TOCSTATE TS.IDLE)
SEL#]
(COND
((EQ LAFITEVERIFYFLG (QUOTE TOC))
(LA.VERIFY.SELECTION MAILFOLDER])
(BROWSERCHANGEMARK
[LAMBDA (MAILFOLDER) (* bvm: "17-Feb-84 15:46")
(* Called when mouse is inside the "mark" region of a
browser. Tracks mouse while in that region and does
whatever is appropriate)
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(RIGHT (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER))
SEL# OLDSEL# COCKED REGION X Y TOP BOTTOM)
[SETQ BOTTOM (fetch (REGION BOTTOM) of (SETQ REGION (DSPCLIPPINGREGION NIL WINDOW]
(SETQ TOP (fetch (REGION TOP) of REGION))
(do (GETMOUSESTATE)
(COND
((OR (ILESSP (SETQ X (LASTMOUSEX WINDOW))
BROWSERMARKXPOSITION)
(IGREATERP X RIGHT)
(ILESSP (SETQ Y (LASTMOUSEY WINDOW))
BOTTOM)
(IGREATERP Y TOP))
(COND
(COCKED (LA.INVERT.MARK.BOX MAILFOLDER OLDSEL#)))
(RETURN))
((LASTMOUSESTATE UP)
(COND
(COCKED (LA.READ.NEW.MARK MAILFOLDER OLDSEL#)))
(RETURN))
((NEQ (SETQ SEL# (YPOS.TO.MESSAGE# Y MAILFOLDER))
OLDSEL#)
(COND
(COCKED (LA.INVERT.MARK.BOX MAILFOLDER OLDSEL#))
(T (SETQ COCKED T)))
(LA.INVERT.MARK.BOX MAILFOLDER (SETQ OLDSEL# SEL#])
(LA.READ.NEW.MARK
[LAMBDA (MAILFOLDER MSG#) (* bvm: "22-Feb-84 11:51")
(PROG ((MSG (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)
MSG#))
(WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
YPOS MARK)
(RESETSAVE NIL (LIST (QUOTE CLEARW)
(fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)))
(RESETSAVE NIL (LIST (FUNCTION LA.SHOW.MARK)
MSG MAILFOLDER)) (* Display correct mark on exit no matter what happens)
(RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (* So caret flashes in the right place)
(LA.BLT.MARK.BOX MAILFOLDER WINDOW (SETQ YPOS (MESSAGE#.TO.YPOS MSG MAILFOLDER))
(QUOTE REPLACE)
WHITESHADE) (* Erase whatever's there)
(BROWSERPROMPTPRINT MAILFOLDER "Type single character mark, or ESC to abort")
(MOVETO BROWSERMARKXPOSITION YPOS WINDOW)
(COND
((AND (IGEQ (SETQ MARK (\GETKEY))
(CHARCODE SPACE))
(ILEQ MARK (CHARCODE DEL)))
(replace (LAFITEMSG MARKSCHANGED?) of MSG with T)
(COND
((EQ MARK UNSEENMARK) (* Mark unseen)
(replace (LAFITEMSG SEEN?) of MSG with NIL))
(T (replace (LAFITEMSG SEEN?) of MSG with T)))
(replace (LAFITEMSG MARKCHAR) of MSG with MARK])
(YPOS.TO.MESSAGE#
[LAMBDA (YPOS MAILFOLDER) (* bvm: "24-Dec-83 17:45")
(PROG [(N (IQUOTIENT (IPLUS (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
YPOS)
(fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER))
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER]
(RETURN (COND
((ILEQ N 0)
1)
(T (IMIN N (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER])
(MESSAGE#.TO.YPOS
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "24-Dec-83 16:37")
(IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
(ITIMES (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)
(fetch (LAFITEMSG #) of MSGDESCRIPTOR])
)
(DEFINEQ
(LA.CONSIDERRANGE
[LAMBDA (FIRST# LAST# EVENIFDELETED) (* bvm: "14-Feb-84 17:25")
(* * Change display so that messages from FIRST# to LAST# are marked as selected. Deleted messages are not
selected unless EVENIFDELETED is true)
(DECLARE (USEDFREE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(for I from (IMAX FIRST# FIRSTVISIBLE#) to (IMIN LAST# LASTVISIBLE#) bind MSG
do (SETQ MSG (NTHMESSAGE MESSAGES I))
(COND
((OR EVENIFDELETED (NOT (fetch DELETED? of MSG)))
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE])
(LA.DECONSIDERRANGE
[LAMBDA (FIRST# LAST#) (* bvm: "14-Feb-84 17:26")
(* * Change display so that messages from FIRST# to LAST# are marked as unselected.)
(DECLARE (USEDFREE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(for I from (IMAX FIRST# FIRSTVISIBLE#) to (IMIN LAST# LASTVISIBLE#)
do (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES I)
(QUOTE ERASE])
(LA.RECONSIDERRANGE
[LAMBDA (FIRST# LAST#) (* bvm: "14-Feb-84 17:41")
(* * Change display so that messages from FIRST# to LAST# are marked as selected or unselected according to the
truth of the matter.)
(DECLARE (USEDFREE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(for I from (IMAX FIRST# FIRSTVISIBLE#) to (IMIN LAST# LASTVISIBLE#) bind MSG
do (LA.SHOW.SELECTION MAILFOLDER (SETQ MSG (NTHMESSAGE MESSAGES I))
(COND
((fetch SELECTED? of MSG)
(QUOTE REPLACE))
(T (QUOTE ERASE])
(LA.SELECTRANGE
[LAMBDA (MAILFOLDER FIRST# LAST# EVENIFDELETED) (* bvm: "15-Feb-84 15:39")
(* * Mark internally messages FIRST# thru LAST# as selected. Do not select deleted messages unless EVENIFDELETED
is true. Keeps MAILFOLDER:LASTSELECTEDMESSAGE and MAILFOLDER:FIRSTSELECTEDMESSAGE up to date.
Assumes display has already been appropriately modified)
(PROG ((MESSAGES (fetch MESSAGEDESCRIPTORS of MAILFOLDER))
(FIRSTSEL (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(LASTSEL (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
MSG)
[for I from FIRST# to LAST#
do (SETQ MSG (NTHMESSAGE MESSAGES I))
(COND
((OR EVENIFDELETED (NOT (fetch DELETED? of MSG)))
(replace SELECTED? of MSG with T]
(COND
((OR (IGREATERP FIRSTSEL LASTSEL)
(ILESSP FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)))
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER with FIRST#)))
(COND
((OR (IGREATERP FIRSTSEL LASTSEL)
(IGREATERP LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)))
(replace LASTSELECTEDMESSAGE of MAILFOLDER with LAST#])
(LA.DESELECTRANGE
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: "15-Feb-84 15:32")
(* * Mark internally messages FIRST# thru LAST# as unselected. Keeps MAILFOLDER:LASTSELECTEDMESSAGE and
MAILFOLDER:FIRSTSELECTEDMESSAGE up to date. Assumes display has already been appropriately modified)
(COND
((ILEQ FIRST# LAST#)
(PROG ((MESSAGES (fetch MESSAGEDESCRIPTORS of MAILFOLDER)))
(for I from FIRST# to LAST# do (replace SELECTED? of (NTHMESSAGE MESSAGES I)
with NIL))
(COND
[(EQ FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER
with (COND
((LA.FIND.SELECTED.MESSAGE MAILFOLDER (ADD1 LAST#)
(fetch LASTSELECTEDMESSAGE of MAILFOLDER)))
(T (replace LASTSELECTEDMESSAGE of MAILFOLDER with 0)
(* Null selection indicated by first GT last.)
(ADD1 (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER]
((EQ LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(replace LASTSELECTEDMESSAGE of MAILFOLDER
with (OR (LA.FIND.SELECTED.MESSAGE MAILFOLDER (fetch FIRSTSELECTEDMESSAGE
of MAILFOLDER)
(SUB1 FIRST#))
1])
(LA.FIND.SELECTED.MESSAGE
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: "15-Feb-84 12:22")
(find I from FIRST# to LAST# bind (MESSAGES ←(fetch MESSAGEDESCRIPTORS of MAILFOLDER))
suchthat (fetch SELECTED? of (NTHMESSAGE MESSAGES I])
(LA.UNDOSELECTION
[LAMBDA NIL (* bvm: "14-Feb-84 17:43")
(* * Restore browser to state before any selections were attempted)
(DECLARE (USEDFREE FIRSTVISIBLE# LASTVISIBLE# TOCSTATE))
(LA.RECONSIDERRANGE FIRSTVISIBLE# LASTVISIBLE#)
(SETQ TOCSTATE TS.IDLE])
(LA.VERIFY.SELECTION
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 11:53")
(PROG ((FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(#OFMESSAGES (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
SEL)
(COND
[(IGREATERP FIRST# LAST#)
(COND
([SETQ SEL (for I from 1 to #OFMESSAGES collect I when (fetch SELECTED?
of (NTHMESSAGE MESSAGES I]
(HELP "First > Last, but these msgs selected" SEL]
(T [for I from 1 to #OFMESSAGES do (COND
((fetch SELECTED? of (NTHMESSAGE MESSAGES I))
(COND
((ILESSP I FIRST#)
(HELP "First is too high" FIRST#))
((IGREATERP I LAST#)
(HELP "Last is too low" LAST#]
(COND
((AND (EQ FIRST# 1)
(EQ LAST# 1)) (* The only time it is okay for them not to be selected)
)
((NOT (fetch SELECTED? of (NTHMESSAGE MESSAGES FIRST#)))
(HELP "First not selected" FIRST#))
((NOT (fetch SELECTED? of (NTHMESSAGE MESSAGES LAST#)))
(HELP "Last not selected" LAST#])
)
(* UPDATE)
(DEFINEQ
(\LAFITE.UPDATE
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 4-Jan-84 14:29")
(PROG (FN)
(COND
((NOT (OR (fetch (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER)
(fetch (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER)))
(BROWSERPROMPTPRINT MAILFOLDER "No changes since the last Update"))
((SETQ FN (MENU LAFITEUPDATEMENU))
(ADD.PROCESS (LIST FN (KWOTE WINDOW)
(KWOTE MAILFOLDER)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE LAFITEUPDATE)
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE BEFOREEXIT)
(QUOTE DON'T])
(\LAFITE.EXPUNGE.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU CLOSEFLG) (* bvm: "25-Jan-84 16:07")
[RESETLST (\LAFITE.START.UPDATE MAILFOLDER ITEM MENU)
(\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER)
(CLEARW WINDOW)
(UPDATECONTENTSFILE MAILFOLDER (COMPACTMAILFOLDER MAILFOLDER))
(COND
(CLOSEFLG (CLOSEMAILFOLDER MAILFOLDER T)
(replace (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER with 0))
(T (DISPLAYFOLDERINBROWSER MAILFOLDER] (* Do the following outside RESETLST so that Update gets
unshaded)
(\LAFITE.FINISH.UPDATE CLOSEFLG WINDOW MAILFOLDER])
(\LAFITE.UPDATE.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU CLOSEFLG) (* bvm: "12-Jan-84 15:46")
[RESETLST (\LAFITE.START.UPDATE MAILFOLDER ITEM MENU)
(COND
((fetch (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER)
(UPDATEMAILFOLDER MAILFOLDER)
(UPDATECONTENTSFILE MAILFOLDER (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)))
(T (BROWSERPROMPTPRINT MAILFOLDER "No changes since last update")))
(COND
(CLOSEFLG (CLOSEMAILFOLDER MAILFOLDER T] (* Do the following outside RESETLST so that Update gets
unshaded)
(\LAFITE.FINISH.UPDATE CLOSEFLG WINDOW MAILFOLDER])
(\LAFITE.START.UPDATE
[LAMBDA (MAILFOLDER ITEM MENU) (* bvm: "20-Feb-84 12:28")
(* Called under a RESETLST to start an UPDATE or
EXPUNGE)
(LA.RESETSHADE [OR ITEM (ASSOC (QUOTE Update)
(fetch (MENU ITEMS) of (SETQ MENU (fetch (MAILFOLDER BROWSERMENU)
of MAILFOLDER]
MENU)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T) (* Mark folder being updated for benefit of LOGOUT
check)
(replace (MAILFOLDER FOLDERBEINGUPDATED) of MAILFOLDER with T)
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (MAILFOLDER)
(replace (MAILFOLDER FOLDERBEINGUPDATED) of MAILFOLDER with NIL])
MAILFOLDER)) (* Close all other folders, so MoveTo's are up to date)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(\LAFITE.CLOSE.OTHER.FOLDERS MAILFOLDER])
(\LAFITE.FINISH.UPDATE
[LAMBDA (CLOSEFLG WINDOW MAILFOLDER DONTCLOSE) (* bvm: "25-Jan-84 16:11")
(* * Takes care of closing/shrinking WINDOW after an update or expunge. DONTCLOSE is true if neither occurred, in
which case we are being called directly from the CLOSEFN and should not close/shrink the window ourselves)
(SELECTQ CLOSEFLG
[CLOSE (WITH.MONITOR \LAFITE.BROWSELOCK (SETQ WINDOW (FLUSHBROWSERWINDOW WINDOW
MAILFOLDER))
(OR DONTCLOSE (CLOSEW WINDOW))
(COND
([AND (OR (NOT (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER))
(IEQP (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER)
0))
(ZEROP (GETFILEINFO (fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)
(QUOTE LENGTH]
(* FOLDEREOFPTR should always be right, but double-check
with the file itself before deleting)
(DELETEMAILFOLDER MAILFOLDER]
(SHRINK (\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER)
(WINDOWADDPROP WINDOW (QUOTE EXPANDFN)
(FUNCTION LAFITEBROWSEREXPANDFN))
(WINDOWDELPROP WINDOW (QUOTE SHRINKFN)
(FUNCTION LAFITEBROWSERSHRINKFN))
(OR DONTCLOSE (SHRINKW WINDOW)))
NIL)
(COND
(\LAFITEPROFILECHANGED (\LAFITE.WRITE.PROFILE])
(\LAFITE.CLOSE.OTHER.FOLDERS
[LAMBDA (THISFOLDER) (* bvm: " 2-Jan-84 15:25")
(* Closes or flushes output of all Lafite folders except THISFOLDER. If a folder does not have an open browser,
the file is closed; else output is flushed)
(WITH.MONITOR \LAFITE.MAINLOCK (for FOLDER in \ACTIVELAFITEFOLDERS
when (AND (NEQ FOLDER THISFOLDER)
(fetch (MAILFOLDER FOLDERSTREAM) of FOLDER))
do (RESETLST (COND
((OBTAIN.MONITORLOCK (fetch (MAILFOLDER
FOLDERLOCK)
of FOLDER)
T T)
(CLOSEMAILFOLDER
FOLDER
(NULL (OPENWP (fetch (MAILFOLDER
BROWSERWINDOW)
of FOLDER])
)
(DEFINEQ
(FLUSHBROWSERWINDOW
[LAMBDA (WINDOW MAILFOLDER) (* bvm: " 1-Feb-84 15:13")
(\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER)
(WINDOWDELPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION LAFITEBROWSERCLOSEFN))
[replace (MAILFOLDER BROWSERREADY) of MAILFOLDER
with (replace (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER
with (replace (MAILFOLDER BROWSERMENUWINDOW) of MAILFOLDER
with (replace (MAILFOLDER BROWSERWINDOW) of MAILFOLDER
with (replace (MAILFOLDER BROWSERMENU) of MAILFOLDER
with (replace (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER
with NIL]
(WINDOWPROP WINDOW (QUOTE MAILFOLDER)
NIL)
(SETQ \ACTIVELAFITEFOLDERS (DREMOVE MAILFOLDER \ACTIVELAFITEFOLDERS))
(OR (OPENWP WINDOW)
(OPENWP (fetch (WINDOWPROP ICONWINDOW) of WINDOW])
(ADDMESSAGESTOMAILBROWSER
[LAMBDA (FOLDERDATA NEWMESSAGEDESCRIPTORS) (* bvm: " 4-Jan-84 15:10")
(* get the new file length *)
(PROG ((LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of FOLDERDATA))
FIRSTMSG#)
(SETQ FIRSTMSG# (ADD1 LASTMSG#))
[replace (MAILFOLDER FOLDEREOFPTR) of FOLDERDATA with (GETEOFPTR (OPENMAILFOLDER
FOLDERDATA
(QUOTE INPUT]
(for MSGDESCRIPTOR in NEWMESSAGEDESCRIPTORS
do (replace (LAFITEMSG #) of MSGDESCRIPTOR with (add LASTMSG# 1))
(LAFITE.PARSE.MSG.FOR.TOC MSGDESCRIPTOR FOLDERDATA))
(replace (MAILFOLDER #OFMESSAGES) of FOLDERDATA with LASTMSG#)
(replace (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDERDATA with (\LAFITE.ADDMESSAGES.TO.ARRAY
(fetch (MAILFOLDER
MESSAGEDESCRIPTORS)
of FOLDERDATA)
NEWMESSAGEDESCRIPTORS
FIRSTMSG# LASTMSG#))
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDERDATA with T)
(PROG ((REGION (DSPCLIPPINGREGION NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDERDATA)))
(EXTENT (fetch (MAILFOLDER BROWSEREXTENT) of FOLDERDATA))
(HEIGHT (ITIMES LASTMSG# (fetch (MAILFOLDER BROWSERFONTHEIGHT) of FOLDERDATA)))
WINDOW)
(replace (REGION HEIGHT) of EXTENT with HEIGHT)
(replace (REGION BOTTOM) of EXTENT with (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN)
of FOLDERDATA)
HEIGHT))
(WINDOWPROP (SETQ WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDERDATA))
(QUOTE EXTENT)
EXTENT)
(COND
((OPENWP WINDOW) (* If window is visible, update it now)
(DISPLAYBROWSERLINES FOLDERDATA (IMAX FIRSTMSG# (FIRSTVISIBLEMESSAGE FOLDERDATA
REGION))
(LASTVISIBLEMESSAGE FOLDERDATA REGION)))
((NULL (fetch (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDERDATA))
(* Mark browser for display update after being unshrunk)
(replace (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDERDATA with FIRSTMSG#])
(COMPACTMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: " 3-Jan-84 17:13")
(* * Expunge deleted messages from MAILFOLDER -
Copy undeleted messages after the first deleted one into a scratch file and copy the scratch file back into the
main file -
Returns the msg # of the last message before the compacted section)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(LASTGOODMSG# 0)
FOLDERSTREAM MSG)
(* * first see if there are any messages to delete and while doing so collect information for rapidly compacting
the file just in case we have to)
(for MSG# from 1 to LASTMSG# until (fetch (LAFITEMSG DELETED?) of (SETQ MSG
(NTHMESSAGE MESSAGES
MSG#)))
do [COND
((fetch (LAFITEMSG MARKSCHANGED?) of MSG)
(WRITEFOLDERMARKBYTES MSG MAILFOLDER (OR FOLDERSTREAM (SETQ FOLDERSTREAM
(OPENMAILFOLDER MAILFOLDER
(QUOTE BOTH]
(replace (LAFITEMSG SELECTED?) of MSG with NIL)
(SETQ LASTGOODMSG# MSG#))
(COND
((NEQ LASTGOODMSG# LASTMSG#)
(COMPACTMAILFOLDER1 MAILFOLDER (OR FOLDERSTREAM (OPENMAILFOLDER MAILFOLDER
(QUOTE BOTH)))
LASTGOODMSG#)))
(replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER with NIL)
(RETURN LASTGOODMSG#])
(COMPACTMAILFOLDER1
[LAMBDA (MAILFOLDER FOLDERSTREAM LASTGOODMSG#) (* bvm: "12-Jan-84 15:20")
(* * LASTGOODMSG# is the number of the last good message before the region to be compacted.
-
GOODMSGSPTR will be a pointer into the mail file to the end of the last consecutive good message)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(OLDLASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
GOODMSGSPTR MSGDESCRIPTOR NEXTFILEPTR SCRATCHFILE MESSAGELENGTH COMPACTLENGTH START)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Compacting folder... ")
[SETQ GOODMSGSPTR (SETQ NEXTFILEPTR (COND
((ZEROP LASTGOODMSG#)
0)
(T (fetch (LAFITEMSG END) of (NTHMESSAGE MESSAGES LASTGOODMSG#]
(SETQ COMPACTLENGTH (for I from (ADD1 LASTGOODMSG#) to OLDLASTMSG#
unless (fetch (LAFITEMSG DELETED?) of (SETQ MSGDESCRIPTOR
(NTHMESSAGE MESSAGES I)))
sum (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR)))
[COND
((NEQ COMPACTLENGTH 0) (* have to copy the scratch file to the end of the good
messages left in the original file *)
(SETQ SCRATCHFILE (LA.OPENTEMPFILE (QUOTE SCRATCH)
(QUOTE BOTH)
(QUOTE NEW)
COMPACTLENGTH))
(* * now map down the rest of the messages moving the not deleted ones into the scratch file * *)
(for I from (ADD1 LASTGOODMSG#) to OLDLASTMSG# unless (fetch (LAFITEMSG DELETED?)
of (SETQ MSGDESCRIPTOR
(NTHMESSAGE MESSAGES I)))
do (MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER)
(LA.PRINTSTAMP SCRATCHFILE) (* *start*)
(SETQ MESSAGELENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR))
(SETQ START (fetch (LAFITEMSG START) of MSGDESCRIPTOR))
(* Compute this before we possibly alter the
STAMPLENGTH)
(COND
((NEQ (fetch (LAFITEMSG STAMPLENGTH) of MSGDESCRIPTOR)
LAFITESTAMPLENGTH) (* As we compact file, convert all messages to Lafite
format)
(SETQ MESSAGELENGTH (IPLUS (IDIFFERENCE MESSAGELENGTH (fetch (LAFITEMSG
STAMPLENGTH)
of MSGDESCRIPTOR))
LAFITESTAMPLENGTH))
(replace (LAFITEMSG STAMPLENGTH) of MSGDESCRIPTOR with LAFITESTAMPLENGTH)))
(POSITION SCRATCHFILE 0) (* So that LA.PRINTCOUNT doesn't screw up)
(LA.PRINTCOUNT MESSAGELENGTH SCRATCHFILE)
(* total message length)
(LA.PRINTCOUNT LAFITESTAMPLENGTH SCRATCHFILE)
(* length of this header)
(WRITEFOLDERMARKBYTES MSGDESCRIPTOR NIL SCRATCHFILE)
(BOUT SCRATCHFILE (CHARCODE CR))
(COPYBYTES FOLDERSTREAM SCRATCHFILE START (fetch (LAFITEMSG END) of MSGDESCRIPTOR)
)
(replace (LAFITEMSG #) of MSGDESCRIPTOR with (add LASTGOODMSG# 1))
(replace (LAFITEMSG SELECTED?) of MSGDESCRIPTOR with NIL)
(replace (LAFITEMSG BEGIN) of MSGDESCRIPTOR with NEXTFILEPTR)
(add NEXTFILEPTR MESSAGELENGTH)
(SETA MESSAGES LASTGOODMSG# MSGDESCRIPTOR))
(* * set the pointer to the end of the good messages * *)
(SETFILEPTR FOLDERSTREAM GOODMSGSPTR)
(COPYBYTES SCRATCHFILE FOLDERSTREAM 0 -1)
(SETQ SCRATCHFILE (CLOSEF SCRATCHFILE))
(OR (IEQP NEXTFILEPTR (GETFILEPTR FOLDERSTREAM))
(HELP "Miscalculation in COMPACTMAILFOLDER" (LIST NEXTFILEPTR (QUOTE NEQ)
(GETFILEPTR FOLDERSTREAM]
(replace (MAILFOLDER #OFMESSAGES) of MAILFOLDER with LASTGOODMSG#)
(for I from (ADD1 LASTGOODMSG#) to OLDLASTMSG#
do (* Erase entries beyond the new end of messages)
(SETA MESSAGES I NIL))
(SETFILEPTR FOLDERSTREAM NEXTFILEPTR)
(replace (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER with NEXTFILEPTR)
(SETFILEINFO FOLDERSTREAM (QUOTE LENGTH)
NEXTFILEPTR)
(CLOSEMAILFOLDER MAILFOLDER T)
(COND
((EQ LAFITEVERIFYFLG (QUOTE ALL))
(VERIFYMAILFOLDER MAILFOLDER)))
(AND SCRATCHFILE (DELFILE SCRATCHFILE])
(UPDATEMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "12-Jan-84 17:25")
(* * Write out any changed marks in MAILFOLDER, but don't expunge deleted messages)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(BROWSERPROMPTDIRTY (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
OUTSTREAM MSG)
(printout BROWSERPROMPTDIRTY "Writing out changes...")
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
[for MSG# from 1 to (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
do (COND
((fetch (LAFITEMSG MARKSCHANGED?) of (SETQ MSG (NTHMESSAGE MESSAGES MSG#)))
(WRITEFOLDERMARKBYTES MSG MAILFOLDER (OR OUTSTREAM (SETQ OUTSTREAM
(OPENMAILFOLDER MAILFOLDER
(QUOTE OUTPUT]
(CLOSEMAILFOLDER MAILFOLDER)
(printout BROWSERPROMPTDIRTY (COND
(OUTSTREAM " done.")
(T "nothing changed."))
,])
(UPDATECONTENTSFILE
[LAMBDA (MAILFOLDER LASTUNCHANGEDMESSAGE#) (* bvm: "20-Feb-84 12:53")
(* Update the TOC file for MAILFOLDER, assuming that
entries up to LASTUNCHANGEDMESSAGE# are okay.)
(RESETLST (PROG ((TOCFILE (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER)))
(MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(TOCSTART LAFITETOCHEADERLENGTH)
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
FIRSTMSG# TOCSTREAM MSG)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Writing table of contents...")
(COND
((IGREATERP LASTMSG# 0)
[RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(SETQ STREAM (CLOSEF STREAM))
(AND RESETSTATE (DELFILE STREAM]
(SETQ TOCSTREAM (OPENSTREAM TOCFILE (QUOTE BOTH)
(QUOTE OLD/NEW)
NIL
(QUOTE ((TYPE BINARY]
(WHENCLOSE TOCSTREAM (QUOTE CLOSEALL)
(QUOTE NO))
(SETQ LASTUNCHANGEDMESSAGE# (IMIN LASTUNCHANGEDMESSAGE# (fetch (MAILFOLDER
TOCLASTMESSAGE#)
of MAILFOLDER)))
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with 0)
[COND
((ZEROP (GETEOFPTR TOCSTREAM))
(SETQ LASTUNCHANGEDMESSAGE# 0))
((AND (ZEROP LASTUNCHANGEDMESSAGE#)
(NEQ (PROGN (SETFILEPTR TOCSTREAM BYTESPERWORD)
(WORDIN TOCSTREAM))
LAFITEVERSION#)) (* A version number change, rewrite entire toc)
)
(T (* TOC already existed, just update it)
(for MSG# from 1 to LASTUNCHANGEDMESSAGE#
do (COND
((fetch (LAFITEMSG MARKSCHANGED?) of (SETQ MSG (NTHMESSAGE
MESSAGES MSG#)))
(* Message not compacted out, but its mark bytes have
changed)
(SETFILEPTR TOCSTREAM (IPLUS TOCSTART LAFITETOCMARKBYTEOFFSET))
(WRITETOCMARKBYTES MSG TOCSTREAM)
(replace (LAFITEMSG MARKSCHANGED?) of MSG with NIL)))
(add TOCSTART (fetch (LAFITEMSG TOCLENGTH) of MSG]
(SETFILEPTR TOCSTREAM TOCSTART)
(for MSG# from (ADD1 LASTUNCHANGEDMESSAGE#) to LASTMSG#
do (WRITETOCENTRY (NTHMESSAGE MESSAGES MSG#)
TOCSTREAM))
(SETFILEINFO TOCSTREAM (QUOTE LENGTH)
(GETFILEPTR TOCSTREAM))
(SETFILEPTR TOCSTREAM 0) (* Now write the header info)
(WORDOUT TOCSTREAM LAFITETOCPASSWORD)
(WORDOUT TOCSTREAM LAFITEVERSION#)
(FIXPOUT TOCSTREAM (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER))
(WORDOUT TOCSTREAM LASTMSG#))
((SETQ TOCFILE (INFILEP TOCFILE))
(DELFILE TOCFILE)))
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with LASTMSG#)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
" done.")
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with NIL])
(WRITETOCENTRY
[LAMBDA (MSG STREAM) (* bvm: " 4-Jan-84 16:12")
(* * Dumps TOC entry for MSG on STREAM)
(PROG ((LENGTH LAFITETOCOVERHEADPERENTRY)
(MESSAGELENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSG))
DAT NC)
(COND
((IGREATERP MESSAGELENGTH MAX.SMALLP) (* Ugh, length greater than fits in one word.
Would be surprised if this ever happens, but file format
permits it)
(BOUT STREAM (LRSH MESSAGELENGTH BITSPERWORD))
(WORDOUT STREAM (LOGAND MESSAGELENGTH MAX.SMALLP)))
(T (* Normal case, a small length)
(BOUT STREAM 0)
(WORDOUT STREAM MESSAGELENGTH)))
(BOUT STREAM (fetch (LAFITEMSG STAMPLENGTH) of MSG))
(WRITETOCMARKBYTES MSG STREAM)
(PRIN3 [COND
((EQ [SETQ NC (NCHARS (SETQ DAT (fetch (LAFITEMSG DATE) of MSG]
6) (* The usual case)
DAT)
(T (OR (SUBSTRING DAT 1 6)
(CONCAT DAT (ALLOCSTRING (IDIFFERENCE 6 NC)
(CHARCODE SPACE]
STREAM)
(add LENGTH (LA.PRINTSHORTSTRING STREAM (fetch (LAFITEMSG SUBJECT) of MSG)))
(add LENGTH (LA.PRINTSHORTSTRING STREAM (fetch (LAFITEMSG FROM) of MSG)))
(add LENGTH (LA.PRINTSHORTSTRING STREAM (fetch (LAFITEMSG TO) of MSG)))
(replace (LAFITEMSG TOCLENGTH) of MSG with LENGTH)
(replace (LAFITEMSG MARKSCHANGED?) of MSG with NIL])
(WRITETOCMARKBYTES
[LAMBDA (MSG STREAM) (* bvm: "20-Feb-84 12:53")
(BOUT STREAM (fetch (LAFITEMSG MSGFLAGBITS) of MSG))
(BOUT STREAM (fetch (LAFITEMSG MARKCHAR) of MSG])
(WRITEFOLDERMARKBYTES
[LAMBDA (MSG MAILFOLDER OUTSTREAM) (* bvm: "12-Jan-84 17:25")
(* * Write the three magic flag bytes for MSG in MAILFOLDER onto the file itself, given by OUTSTREAM)
[COND
(MAILFOLDER (MAYBEVERIFYMSG MSG MAILFOLDER)
(COND
((fetch (LAFITEMSG MESSAGELENGTHCHANGED?) of MSG)
(* Length is different in core and on file.
This is for scavenging purposes)
(SETFILEPTR OUTSTREAM (fetch (LAFITEMSG BEGIN) of MSG))
(OR (LA.READSTAMP OUTSTREAM)
(HELP))
(LA.PRINTCOUNT (fetch (LAFITEMSG MESSAGELENGTH) of MSG)
OUTSTREAM)
(replace (LAFITEMSG MESSAGELENGTHCHANGED?) of MSG with NIL)))
(SETFILEPTR OUTSTREAM (fetch (LAFITEMSG DELETEFILEPTR) of MSG]
(BOUT OUTSTREAM (COND
((fetch (LAFITEMSG DELETED?) of MSG)
DELETEDFLAG)
(T UNDELETEDFLAG)))
(BOUT OUTSTREAM (COND
((fetch (LAFITEMSG SEEN?) of MSG)
SEENFLAG)
(T UNSEENFLAG)))
(BOUT OUTSTREAM (fetch (LAFITEMSG MARKCHAR) of MSG])
)
(* DISPLAY)
(DEFINEQ
(\LAFITE.DISPLAY
[LAMBDA (WINDOW MAILFOLDER ITEM MENU KEY) (* bvm: "17-Feb-84 17:16")
(PROG (DISPLAYWINDOW)
(COND
([WINDOWP (SETQ DISPLAYWINDOW
(RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR
(fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OR (\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER)
(PROG ((MSGDESCRIPTOR (SELECTMESSAGETODISPLAY WINDOW
MAILFOLDER)))
(RETURN (COND
[MSGDESCRIPTOR (\LAFITE.DO.DISPLAY
MAILFOLDER MSGDESCRIPTOR
(EQ KEY (QUOTE MIDDLE]
(T (BROWSERPROMPTPRINT MAILFOLDER
"No more messages.")
NIL]
(* make sure the display window is on top in case
SHADEITEM put the browser back on top *)
(TOTOPW DISPLAYWINDOW])
(\LAFITE.DO.DISPLAY
[LAMBDA (MAILFOLDER MSGDESCRIPTOR NEWWINDOWFLG) (* bvm: "20-Feb-84 12:37")
(* * Display MSGDESCRIPTOR from MAILFOLDER, using a new window if NEWWINDOWFLG is true, else reusing if possible
the primary window. Returns the window)
(PROG (TEMPMSG INSTREAM DISPLAYWINDOW)
(INSUREMESSAGEINBROWSERWINDOW MAILFOLDER MSGDESCRIPTOR)
(SETQ INSTREAM (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT)))
(MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with NIL)
(* Clear it here in case of abort)
(COPYBYTES INSTREAM (SETQ TEMPMSG (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE OUTPUT)))
(fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR))
(replace (MAILFOLDER CURRENTEOMLENGTH) of MAILFOLDER
with (COND
((AND LAFITEENDOFMESSAGESTR (NOT (fetch (LAFITEMSG FORMATTED?) of MSGDESCRIPTOR)))
(PRIN1 LAFITEENDOFMESSAGESTR TEMPMSG)
(* Append end of message token here.
MESSAGEDISPLAYER will change its font later)
(NCHARS LAFITEENDOFMESSAGESTR))
(T 0)))
(CLOSEF TEMPMSG)
(SETQ DISPLAYWINDOW (MESSAGEDISPLAYER MAILFOLDER (OPENSTREAM TEMPMSG (QUOTE INPUT))
(CONCAT "Message " (fetch (LAFITEMSG #) of
MSGDESCRIPTOR)
" from "
(fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)
" ["
(fetch (LAFITEMSG MESSAGELENGTH)
of MSGDESCRIPTOR)
" chars]")
NEWWINDOWFLG))
(SEENMESSAGE MSGDESCRIPTOR MAILFOLDER)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of MAILFOLDER with TEMPMSG)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with MSGDESCRIPTOR)
(RETURN DISPLAYWINDOW])
(SELECTMESSAGETODISPLAY
[LAMBDA (WINDOW MAILFOLDER) (* bvm: "15-Feb-84 16:15")
(* * Laurel acts differently if there is currently only one message selected or many about whether it unselects
the one that was displayed before. Lafite will follow the same model * *)
(PROG ((CURRENTDISPLAYEDMSG (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER))
(MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
DISPLAYED# MSGDESCRIPTOR)
[COND
((SETQ MSGDESCRIPTOR (COND
((IGREATERP FIRST# LAST#) (* Nothing selected, so nothing to display)
NIL)
((OR (NULL CURRENTDISPLAYEDMSG)
(NOT (fetch (LAFITEMSG SELECTED?) of CURRENTDISPLAYEDMSG)))
(* haven't displayed any yet, or displayed one is not
part of the selection)
(NTHMESSAGE MESSAGES FIRST#))
[(EQ FIRST# LAST#) (* Only one msg selected and it is displayed, so move on
to next undeleted msg)
(for N from (ADD1 (fetch (LAFITEMSG #) of CURRENTDISPLAYEDMSG))
to (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
do (COND
([NOT (fetch (LAFITEMSG DELETED?) of (SETQ MSGDESCRIPTOR
(NTHMESSAGE MESSAGES N]
(* only unselect if there is another message *)
(LA.SHOW.SELECTION MAILFOLDER CURRENTDISPLAYEDMSG (QUOTE ERASE))
(LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE))
(replace (LAFITEMSG SELECTED?) of CURRENTDISPLAYEDMSG with NIL)
(replace (LAFITEMSG SELECTED?) of MSGDESCRIPTOR with T)
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER
with (replace LASTSELECTEDMESSAGE of MAILFOLDER with N))
(RETURN MSGDESCRIPTOR]
(T (* Multiple selections -- Cycle to the next one)
(NTHMESSAGE MESSAGES (OR (LA.FIND.SELECTED.MESSAGE MAILFOLDER
(ADD1 (SETQ DISPLAYED#
(fetch (LAFITEMSG
#)
of
CURRENTDISPLAYEDMSG)))
LAST#)
(LA.FIND.SELECTED.MESSAGE MAILFOLDER FIRST# DISPLAYED#]
(RETURN MSGDESCRIPTOR])
(MESSAGEDISPLAYER
[LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG) (* bvm: "17-Feb-84 17:45")
(* * Displayer for individual messages * *)
(PROG ((CURRENTWINDOWS (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER))
DISPLAYWINDOW TEXTSTREAM EOMCHARS)
[COND
((AND CURRENTWINDOWS (NOT NEWWINDOWFLG))
(replace (WINDOWPROP TITLE) of (SETQ DISPLAYWINDOW (CAR CURRENTWINDOWS)) with TITLE)
(CLEARW DISPLAYWINDOW))
(T (* Create a window to do the editing in.)
(SETQ DISPLAYWINDOW (CREATEW (AND (NOT NEWWINDOWFLG)
(for FOLDER in \ACTIVELAFITEFOLDERS
never (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS)
of FOLDER))
(type? REGION LAFITEDISPLAYREGION)
LAFITEDISPLAYREGION)
TITLE))
(WINDOWADDPROP DISPLAYWINDOW (QUOTE CLOSEFN)
(FUNCTION \LAFITE.CLOSE.DISPLAYER))
(COND
[CURRENTWINDOWS (RPLACD CURRENTWINDOWS (CONS DISPLAYWINDOW (CDR CURRENTWINDOWS]
(T (replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER with (LIST DISPLAYWINDOW]
(* Now let TEDIT display it *)
[SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTFILE DISPLAYWINDOW NIL NIL
(CONS (QUOTE FONT)
(CONS LAFITEDISPLAYFONT (AND LAFITEREADONLYFLG
(QUOTE (READONLY]
(COND
((AND NIL LAFITEENDOFMESSAGESTR)
(TEDIT.SETSEL TEXTSTREAM (ADD1 (GETEOFPTR TEXTSTREAM))
0
(QUOTE LEFT))
(TEDIT.CARETLOOKS TEXTSTREAM LAFITEENDOFMESSAGEFONT)
(TEDIT.INSERT TEXTSTREAM LAFITEENDOFMESSAGESTR (ADD1 (GETEOFPTR TEXTSTREAM)))
(TEDIT.SETSEL TEXTSTREAM 1 0))
([NOT (ZEROP (SETQ EOMCHARS (fetch (MAILFOLDER CURRENTEOMLENGTH) of MAILFOLDER]
(* (TEDIT.INSERT TEXTSTREAM LAFITEENDOFMESSAGESTR
(ADD1 (GETEOFPTR TEXTSTREAM))))
(TEDIT.LOOKS TEXTSTREAM (LIST (QUOTE FONT)
LAFITEENDOFMESSAGEFONT)
(IDIFFERENCE (ADD1 (GETEOFPTR TEXTSTREAM))
EOMCHARS)
EOMCHARS)
(TEDIT.SETSEL TEXTSTREAM 1 0)))
(RETURN DISPLAYWINDOW])
(\LAFITE.CLOSE.DISPLAYWINDOWS
[LAMBDA (FOLDER) (* bvm: "25-Jan-84 16:11")
[for WINDOW in (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER)
do (WINDOWDELPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION \LAFITE.CLOSE.DISPLAYER))
(CLOSEW (OR (OPENWP WINDOW)
(OPENWP (fetch (WINDOWPROP ICONWINDOW) of WINDOW]
(replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER with NIL])
(\LAFITE.CLOSE.DISPLAYER
[LAMBDA (WINDOW) (* bvm: " 1-Feb-84 12:20")
(* called when a display window is explicitly closed)
(for FOLDER in \ACTIVELAFITEFOLDERS bind THESEWINDOWS when (MEMB WINDOW (SETQ THESEWINDOWS
(fetch (MAILFOLDER
FOLDERDISPLAYWINDOWS)
of FOLDER)))
do (* Do we need a monitorlock here?)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of FOLDER with NIL)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of FOLDER with NIL)
(RETURN (replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER with (DREMOVE WINDOW
THESEWINDOWS])
)
(* DELETE & MOVE)
(DEFINEQ
(\LAFITE.DELETE
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 1-Feb-84 14:56")
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OR (\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER)
(for MSGDESCRIPTOR selectedin MAILFOLDER bind I ONEDELETE DELETEDMESSAGE
when (NOT (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR))
do (* delete all the currrently selected messages that
aren't already deleted *)
(DELETEMESSAGE MSGDESCRIPTOR MAILFOLDER)
(COND
((NULL DELETEDMESSAGE)
(SETQ DELETEDMESSAGE MSGDESCRIPTOR)
(SETQ ONEDELETE T))
(ONEDELETE (SETQ ONEDELETE NIL)))
finally (SHADEITEM ITEM MENU WHITESHADE)
(COND
((AND ONEDELETE DELETEDMESSAGE)
(DISPLAYAFTERDELETE DELETEDMESSAGE MAILFOLDER WINDOW MENU])
(DISPLAYAFTERDELETE
[LAMBDA (MSG MAILFOLDER WINDOW MENU) (* bvm: "17-Feb-84 16:07")
(COND
((AND LAFITEDISPLAYAFTERDELETEFLG (EQ MSG (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE)
of MAILFOLDER)))
(* this is the semantics of LAFITEDISPLAYAFTERDELETEFLG
*)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
NEXTMSG)
(COND
([for N from (ADD1 (fetch (LAFITEMSG #) of MSG)) to LASTMSG#
do (COND
[[NOT (fetch (LAFITEMSG DELETED?) of (SETQ NEXTMSG (NTHMESSAGE MESSAGES N]
(RETURN (OR (EQ LAFITEDISPLAYAFTERDELETEFLG (QUOTE ALWAYS))
(NOT (fetch (LAFITEMSG SEEN?) of NEXTMSG))
(AND (fetch (LAFITEMSG MSGFROMMEP) of NEXTMSG)
(for I from (ADD1 N) to LASTMSG#
always (OR [NOT (fetch (LAFITEMSG SEEN?)
of (SETQ NEXTMSG (NTHMESSAGE
MESSAGES I]
(fetch (LAFITEMSG MSGFROMMEP) of NEXTMSG]
((NEQ LAFITEDISPLAYAFTERDELETEFLG (QUOTE ALWAYS))
(RETURN NIL]
(\LAFITE.DISPLAY WINDOW MAILFOLDER (ASSOC (QUOTE Display)
(fetch (MENU ITEMS) of MENU))
MENU])
(\LAFITE.UNDELETE
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 1-Feb-84 14:59")
(RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OR (\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER)
(for MSGDESCRIPTOR selectedin MAILFOLDER when (fetch (LAFITEMSG
DELETED?)
of MSGDESCRIPTOR)
do (UNDELETEMESSAGE MSGDESCRIPTOR MAILFOLDER])
(\LAFITE.MOVETO
[LAMBDA (WINDOW MAILFOLDER ITEM MENU KEY) (* bvm: " 1-Feb-84 15:09")
(PROG ((BROWSERPROMPTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
TOFILE OUTPUTFILE DESTINATIONFOLDER SHORTOUTPUT OLDFILEP ACCELERATED)
(CLEARW BROWSERPROMPTWINDOW)
(COND
((\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER)
(RETURN)))
[SETQ TOFILE (COND
((AND (EQ KEY (QUOTE MIDDLE))
(fetch (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER))
(SETQ ACCELERATED T) (* Accelerator: don't confirm)
(fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of (fetch (MAILFOLDER DEFAULTMOVETOFILE)
of MAILFOLDER)))
(T (MENU (OR LAFITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU]
(SELECTQ TOFILE
(NIL (RETURN))
[##ANOTHERFILE## (COND
((NULL (SETQ TOFILE (PROMPTFORFILENAME BROWSERPROMPTWINDOW)))
(* User aborted)
(CLEARW BROWSERPROMPTWINDOW)
(RETURN]
(SETQ OLDFILEP T))
(SETQ OUTPUTFILE (LA.LONGFILENAME (U-CASE TOFILE)
LAFITEMAIL.EXT))
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(COND
((EQ (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of MAILFOLDER)
OUTPUTFILE) (* a NOP *)
(SHADEITEM ITEM MENU WHITESHADE)
(RETURN)))
(SETQ SHORTOUTPUT (LA.SHORTFILENAME OUTPUTFILE NIL T))
(COND
(ACCELERATED (* Accelerator: don't confirm))
((MOUSECONFIRM (CONCAT "Click LEFT to confirm move to " SHORTOUTPUT (COND
(OLDFILEP "")
((INFILEP OUTPUTFILE)
" [Old File].")
(T " [New File].")))
T BROWSERPROMPTWINDOW))
(T (* abort *)
(SHADEITEM ITEM MENU WHITESHADE)
(RETURN)))
(COND
((SETQ DESTINATIONFOLDER (WITH.MONITOR \LAFITE.BROWSELOCK (\LAFITE.GETMAILFOLDER
OUTPUTFILE)))
(* save the last file moved-to for the accelerator *)
(ADD.PROCESS (LIST (FUNCTION \LAFITE.MOVETO.PROC)
(KWOTE WINDOW)
(KWOTE MAILFOLDER)
(KWOTE DESTINATIONFOLDER)
(KWOTE ITEM)
(KWOTE MENU)
(KWOTE SHORTOUTPUT)
(KWOTE OLDFILEP))
(QUOTE NAME)
(QUOTE LAFITEMOVETO)
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE BEFOREEXIT)
(QUOTE DON'T])
(\LAFITE.MOVETO.PROC
[LAMBDA (WINDOW MAILFOLDER DESTINATIONFOLDER ITEM MENU SHORTOUTPUT OLDFILEP)
(* bvm: "12-Jan-84 15:10")
(PROG (LASTMSGDESCRIPTOR)
[RESETLST (LA.RESETSHADE ITEM MENU)
(PROG (INPUTFILE OUTPUTSTREAM MSGDESCRIPTORS)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T)
[COND
((NOT (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of
DESTINATIONFOLDER)
T T))
(BROWSERPROMPTPRINT MAILFOLDER "Waiting for " SHORTOUTPUT
" to become available...")
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of DESTINATIONFOLDER)
NIL T)
(CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER]
(OPENMAILFOLDER MAILFOLDER (QUOTE INPUT))
(OR (SETQ OUTPUTSTREAM (\LAFITE.OPEN.DESTINATIONFOLDER DESTINATIONFOLDER
OLDFILEP MAILFOLDER))
(RETURN))
[COND
((NEQ (fetch (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER)
DESTINATIONFOLDER)
(replace (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER with
DESTINATIONFOLDER)
(replace (WINDOWPROP TITLE) of WINDOW
with (CONCAT (fetch (MAILFOLDER ORIGINALBROWSERTITLE) of MAILFOLDER)
" -- Default 'Move To': " SHORTOUTPUT]
(SETQ MSGDESCRIPTORS (for MSGDESCRIPTOR selectedin MAILFOLDER
bind NEWMSGDESCRIPTOR NEWLENGTH MARK
collect (SETQ LASTMSGDESCRIPTOR
(AND (NOT NEWMSGDESCRIPTOR)
MSGDESCRIPTOR))
(* Save this for Display After Delete, if there is only
one such message)
(MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER)
(SETFILEPTR OUTPUTSTREAM -1)
(COND
((OR (EQ (SETQ MARK (fetch (LAFITEMSG
MARKCHAR)
of MSGDESCRIPTOR))
MOVETOMARK)
(EQ MARK UNSEENMARK))
(* don't let these marks be copied *)
(SETQ MARK SEENMARK)))
(SETQ NEWLENGTH
(IPLUS (IDIFFERENCE (fetch (LAFITEMSG
MESSAGELENGTH)
of MSGDESCRIPTOR)
(fetch (LAFITEMSG
STAMPLENGTH)
of MSGDESCRIPTOR))
LAFITESTAMPLENGTH))
(* As we copy the message, we turn it into Lafite
format, independent of what format it started in)
(SETQ NEWMSGDESCRIPTOR
(create LAFITEMSG
BEGIN ←(GETFILEPTR OUTPUTSTREAM)
SEEN? ←(fetch (LAFITEMSG SEEN?)
of MSGDESCRIPTOR)
MESSAGELENGTH ← NEWLENGTH
MARKCHAR ← MARK
STAMPLENGTH ← LAFITESTAMPLENGTH
PARSED? ←(fetch (LAFITEMSG
PARSED?)
of MSGDESCRIPTOR)
DATE ←(fetch (LAFITEMSG DATE)
of MSGDESCRIPTOR)
FROM ←(fetch (LAFITEMSG FROM)
of MSGDESCRIPTOR)
SUBJECT ←(fetch (LAFITEMSG
SUBJECT)
of MSGDESCRIPTOR)
TO ←(fetch (LAFITEMSG TO)
of MSGDESCRIPTOR)))
(LA.PRINTSTAMP OUTPUTSTREAM)
(* *start*)
(LA.PRINTCOUNT (fetch (LAFITEMSG
MESSAGELENGTH)
of NEWMSGDESCRIPTOR)
OUTPUTSTREAM)
(* total message length)
(LA.PRINTCOUNT LAFITESTAMPLENGTH
OUTPUTSTREAM)
(* length of this header)
(PROGN
(* Now the 3 flag bytes)
(BOUT OUTPUTSTREAM UNDELETEDFLAG)
(BOUT OUTPUTSTREAM
(COND
((fetch (LAFITEMSG SEEN?)
of MSGDESCRIPTOR)
SEENFLAG)
(T UNSEENFLAG)))
(BOUT OUTPUTSTREAM MARK)
(BOUT OUTPUTSTREAM (CHARCODE CR)))
(COPYBYTES (OPENMAILFOLDER MAILFOLDER
(QUOTE INPUT))
OUTPUTSTREAM
(fetch (LAFITEMSG START)
of MSGDESCRIPTOR)
(fetch (LAFITEMSG END)
of MSGDESCRIPTOR))
(MARKMESSAGE MSGDESCRIPTOR MAILFOLDER
MOVETOMARK)
(* delete it *)
(DELETEMESSAGE MSGDESCRIPTOR MAILFOLDER)
NEWMSGDESCRIPTOR))
(* delete them from FROMFILE *)
(COND
((fetch (MAILFOLDER BROWSERWINDOW) of DESTINATIONFOLDER)
(* now print them in the other window, if up *)
(ADDMESSAGESTOMAILBROWSER DESTINATIONFOLDER MSGDESCRIPTORS]
(COND
(LASTMSGDESCRIPTOR (DISPLAYAFTERDELETE LASTMSGDESCRIPTOR MAILFOLDER WINDOW MENU])
(\LAFITE.OPEN.DESTINATIONFOLDER
[LAMBDA (DESTINATIONFOLDER CHECKOLDFILEP SOURCEFOLDER) (* bvm: "12-Jan-84 15:10")
(* Open DESTINATIONFOLDER for output. Folder may be new, so this is messy. Returns stream on the destination, or
NIL on failure. If CHECKOLDFILEP is true, verifies that file already exists, or interacts with SOURCEFOLDER's
prompt window to confirm)
(PROG ((OUTPUTSTREAM (fetch (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER))
OUTPUTFULLNAME)
[COND
(OUTPUTSTREAM (* Folder is already open, just make sure the access is
right)
(RETURN (COND
((OPENP OUTPUTSTREAM (QUOTE OUTPUT))
OUTPUTSTREAM)
(T (OPENMAILFOLDER DESTINATIONFOLDER (QUOTE BOTH]
(SETQ OUTPUTSTREAM (OR (fetch (MAILFOLDER FULLFOLDERNAME) of DESTINATIONFOLDER)
(fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of DESTINATIONFOLDER)))
(COND
((AND CHECKOLDFILEP (INFILEP OUTPUTSTREAM)) (* We assume files in the Mail Folder menu already
exist, so we have not tested INFILEP until now)
(SETQ CHECKOLDFILEP NIL)))
(SETQ OUTPUTSTREAM (\LAFITE.OPENSTREAM OUTPUTSTREAM (QUOTE BOTH)))
(replace (MAILFOLDER FULLFOLDERNAME) of DESTINATIONFOLDER with (SETQ OUTPUTFULLNAME
(FULLNAME OUTPUTSTREAM)))
(replace (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER with OUTPUTSTREAM)
(RETURN (COND
([AND CHECKOLDFILEP (EQ (GETEOFPTR OUTPUTSTREAM)
0)
(NOT (MOUSECONFIRM (CONCAT "CLick LEFT to confirm creating " OUTPUTFULLNAME
" [New File]")
T
(fetch (MAILFOLDER BROWSERPROMPTWINDOW) of SOURCEFOLDER]
(* The reason we didn't complain until we actually opened the folder is because INFILEP can fail if the file is
busy, in which case we don't want to get a spurious "New File" warning)
(CLOSEMAILFOLDER DESTINATIONFOLDER T)
(DELETEMAILFOLDER DESTINATIONFOLDER))
(T (fetch (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER])
)
(* HARDCOPY)
(DEFINEQ
(\LAFITE.HARDCOPY
[LAMBDA (WINDOW FOLDERDATA ITEM MENU) (* bvm: " 1-Feb-84 15:03")
(ADD.PROCESS (LIST (FUNCTION \LAFITE.HARDCOPY.PROC)
(KWOTE FOLDERDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEHARDCOPIER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(\LAFITE.HARDCOPY.PROC
[LAMBDA (MAILFOLDER ITEM MENU) (* bvm: "28-Feb-84 12:02")
(PROG (LCASEFILENAME TEXTSTREAM MSGLST)
[RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(COND
((NOT (\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER))
(SETQ MSGLST (for MSGDESCRIPTOR selectedin MAILFOLDER
collect MSGDESCRIPTOR))
(SETQ LCASEFILENAME (L-CASE (fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)))
[COND
((AND LAFITEHARDCOPY.MIN.MESSAGES.FOR.TOC
(IGEQ (LENGTH MSGLST)
LAFITEHARDCOPY.MIN.MESSAGES.FOR.TOC))
(SETQ TEXTSTREAM (\LAFITE.HARDCOPY.HEADERS MAILFOLDER
LCASEFILENAME
MSGLST)))
(T (SETQ TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL
(LIST (QUOTE FONT)
LAFITEHARDCOPYFONT]
(\LAFITE.HARDCOPY.BODIES MAILFOLDER TEXTSTREAM MSGLST]
(COND
(TEXTSTREAM (\LAFITE.TRANSMIT.HARDCOPY TEXTSTREAM LCASEFILENAME)
(\LAFITE.MARK.HARDCOPIED MAILFOLDER MSGLST HARDCOPYMARK])
(\LAFITE.HARDCOPY.HEADERS
[LAMBDA (MAILFOLDER LCASEFILENAME MESSAGES INCLUDE#) (* bvm: "22-Feb-84 17:16")
(PROG ((INPUTFILE (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT)))
(OUTPUTFILE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
ENDOFTITLE FROMSTR TEXTSTREAM)
(LINELENGTH MAX.SMALLP OUTPUTFILE)
(printout OUTPUTFILE "Messages from " LCASEFILENAME T "Listed on " (DATE)
T)
(SETQ ENDOFTITLE (ADD1 (GETFILEPTR OUTPUTFILE)))
(for MSG in MESSAGES as N from 1
do (OR (fetch (LAFITEMSG PARSED?) of MSG)
(LAFITE.PARSE.MSG.FOR.TOC MSG MAILFOLDER))
(POSITION OUTPUTFILE 0)
(\BOUT OUTPUTFILE (CHARCODE TAB))
(printout OUTPUTFILE .I1 N ".")
(\BOUT OUTPUTFILE (CHARCODE TAB))
(PRIN1 (OR (fetch (LAFITEMSG DATE) of MSG)
UNSUPPLIEDFIELDSTR)
OUTPUTFILE)
(\BOUT OUTPUTFILE (CHARCODE TAB))
[COND
[(fetch (LAFITEMSG MSGFROMMEP) of MSG)
(PRIN1 "To: " OUTPUTFILE)
(SETQ FROMSTR (OR (fetch (LAFITEMSG TO) of MSG)
(LAFITE.FETCH.TO.FIELD MSG MAILFOLDER]
(T (SETQ FROMSTR (OR (fetch (LAFITEMSG FROM) of MSG)
UNSUPPLIEDFIELDSTR]
(PRIN1 FROMSTR OUTPUTFILE)
(\BOUT OUTPUTFILE (CHARCODE TAB))
(PRIN1 (OR (fetch (LAFITEMSG SUBJECT) of MSG)
UNSUPPLIEDFIELDSTR)
OUTPUTFILE)
(TERPRI OUTPUTFILE))
(SETQ TEXTSTREAM (OPENTEXTSTREAM (OPENSTREAM (CLOSEF OUTPUTFILE)
(QUOTE INPUT))
(AND NIL (CREATEW NIL "Lafite headers"))
NIL NIL (LIST (QUOTE FONT)
LAFITEHARDCOPYFONT)))
(TEDIT.PARALOOKS TEXTSTREAM (QUOTE (QUAD CENTER))
1
(SUB1 ENDOFTITLE))
(TEDIT.PARALOOKS TEXTSTREAM (QUOTE (PARALEADING 40))
(ADD1 ENDOFTITLE)
1) (* Make title centered)
(TEDIT.PARALOOKS TEXTSTREAM (QUOTE (TABS (NIL (20 . RIGHT)
(30 . LEFT)
(80 . LEFT)
(200 . LEFT))
LEFTMARGIN 230))
(ADD1 ENDOFTITLE)
(IDIFFERENCE (GETEOFPTR TEXTSTREAM)
(ADD1 ENDOFTITLE)))
(RETURN TEXTSTREAM])
(\LAFITE.MARK.HARDCOPIED
[LAMBDA (MAILFOLDER MSGS MARK) (* bvm: "22-Feb-84 12:02")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(for MSG in MSGS bind (MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of MAILFOLDER))
when (AND (EQ MSG (NTHMESSAGE MESSAGES (fetch (LAFITEMSG #) of MSG)))
(SELCHARQ (fetch (LAFITEMSG MARKCHAR) of MSG)
((? SPACE H)
T)
NIL))
do (* If message doesn't already have a more interesting
mark, set the hardcopy mark)
(MARKMESSAGE MSG MAILFOLDER MARK])
(\LAFITE.TRANSMIT.HARDCOPY
[LAMBDA (TEXTSTREAM LCASEFILENAME) (* bvm: "22-Feb-84 12:03")
(* * Sends TEXTSTREAM off to be hardcopied, then deletes it)
(WITH.MONITOR \LAFITE.HARDCOPYLOCK (* Because press isn't reentrant yet)
(TEDIT.HARDCOPY TEXTSTREAM NIL NIL (CONCAT "Mail from " LCASEFILENAME)))
(CLOSEF TEXTSTREAM)
(DELFILE TEXTSTREAM])
(\LAFITE.HARDCOPY.BODIES
[LAMBDA (MAILFOLDER TEXTSTREAM MESSAGES CONTINUEFLG INCLUDE#)
(* bvm: "22-Feb-84 12:17")
(for MSGDESCRIPTOR in MESSAGES
bind (NTHTIME ← CONTINUEFLG)
(INPUTFILE ←(OPENMAILFOLDER MAILFOLDER (QUOTE INPUT)))
do (* make sure we're pointing at the end -- TEDIT.INCLUDE
leaves it at the left *)
(TEDIT.SETSEL TEXTSTREAM (ADD1 (GETEOFPTR TEXTSTREAM))
0
(QUOTE LEFT))
(COND
((NULL NTHTIME)
(SETQ NTHTIME T))
((OR LAFITENEWPAGEFLG CONTINUEFLG)
(printout TEXTSTREAM (CONSTANT (CHARACTER (CHARCODE FF)))
T)
(SETQ CONTINUEFLG))
(T (printout TEXTSTREAM T HARDCOPYSEPARATORSTR T T)))
(COND
(INCLUDE# (printout TEXTSTREAM "Message " (fetch (LAFITEMSG #) of MSGDESCRIPTOR)
T T)))
(TEDIT.INCLUDE TEXTSTREAM INPUTFILE (fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR])
)
(* ANSWER)
(DEFINEQ
(\LAFITE.ANSWER
[LAMBDA (WINDOW FOLDERDATA ITEM MENU) (* bvm: " 1-Feb-84 15:08")
(ADD.PROCESS (LIST (FUNCTION \LAFITE.ANSWER.PROC)
(KWOTE WINDOW)
(KWOTE FOLDERDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEANSWERER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(\LAFITE.ANSWER.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 1-Feb-84 15:08")
(PROG (MSGDESCRIPTOR FORM)
[SETQ FORM (RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(COND
((NOT (\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER))
(MAKEANSWERFORM (SETQ MSGDESCRIPTOR
(find MSGDESCRIPTOR selectedin
MAILFOLDER
suchthat T))
MAILFOLDER]
(COND
((AND FORM (\SENDMESSAGE FORM))
(COND
((EQ MSGDESCRIPTOR (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)
(fetch (LAFITEMSG #) of MSGDESCRIPTOR)))
(* If message got expunged since we constructed the
answer form, we can't do anything)
(MARKMESSAGE MSGDESCRIPTOR MAILFOLDER ANSWERMARK])
(MAKEANSWERFORM
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: " 3-Jan-84 15:59")
(PROG (SUBJECT FROM DATE SENDER REPLYTO TO CC ORIGINALREGISTRY OLDFROM OLDREPLYTO OLDTO OLDCC
NEWTO NEWCC OUTSTREAM SELECTPOSITION MSGFIELDS)
(* get the fields from the file or data *)
[SETQ MSGFIELDS (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(LAFITE.PARSE.HEADER (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT))
\LAPARSE.FULL
(fetch (LAFITEMSG START) of
MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR]
(for PAIR in MSGFIELDS do (SELECTQ (CAR PAIR)
(SUBJECT (SETQ SUBJECT (CADR PAIR)))
(SENDER (SETQ SENDER (CADR PAIR)))
(FROM (SETQ FROM (CADR PAIR)))
(DATE (SETQ DATE (CADR PAIR)))
(REPLY-TO (SETQ REPLYTO (CDR PAIR)))
(TO (SETQ TO (CDR PAIR)))
(CC (SETQ CC (CDR PAIR)))
NIL)) (* first parse the strings into recipients *)
(COND
[SENDER (* Sender is a mail address, and has the official
registry)
(SETQ ORIGINALREGISTRY (GETREGISTRY SENDER))
(SETQ OLDFROM (AND FROM (PARSERECIPIENTS FROM ORIGINALREGISTRY]
[FROM (* Have to parse the From field before we can get its
registry)
(SETQ ORIGINALREGISTRY (GETREGISTRY (CAR (SETQ OLDFROM (PARSERECIPIENTS FROM]
(T (BROWSERPROMPTPRINT "Can't reply--no FROM or SENDER field")))
(SETQ OLDREPLYTO (AND REPLYTO (PARSERECIPIENTS REPLYTO ORIGINALREGISTRY)))
(SETQ OLDTO (AND TO (PARSERECIPIENTS TO ORIGINALREGISTRY)))
(SETQ OLDCC (AND CC (PARSERECIPIENTS CC ORIGINALREGISTRY)))
(* * Now construct the TO and CC fields of the reply)
(SETQ NEWTO (OR OLDREPLYTO OLDFROM))
(SETQ NEWCC (LA.SETDIFFERENCE [COND
(OLDREPLYTO (LIST (FULLUSERNAME)))
(T (LA.REMOVEDUPLICATES (APPEND OLDTO OLDCC]
NEWTO)) (* now construct the message form *)
(SETQ OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(LINELENGTH MAX.SMALLP OUTSTREAM) (* Sigh, apparently text streams have linelength)
(printout OUTSTREAM "Subject: ")
(COND
((NOT (UCASE.STREQUAL (SUBSTRING SUBJECT 1 3)
"Re:"))
(printout OUTSTREAM "Re: ")))
(printout OUTSTREAM (OR SUBJECT UNSUPPLIEDFIELDSTR)
T)
(printout OUTSTREAM "In-reply-to: " FROM "'s message of " DATE T)
(printout OUTSTREAM "To: ")
(LA.PRINTADDRESSES NEWTO OUTSTREAM)
(COND
(NEWCC (printout OUTSTREAM "cc: ")
(LA.PRINTADDRESSES NEWCC OUTSTREAM)))
(printout OUTSTREAM T)
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(printout OUTSTREAM MESSAGESTR T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS MESSAGESTR)
(QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
(LA.PRINTADDRESSES
[LAMBDA (ADDRESSLIST STREAM) (* bvm: "20-Dec-83 18:20")
(for ADDR in ADDRESSLIST bind NTHTIME when ADDR
do (COND
(NTHTIME (PRIN1 ", " STREAM))
(T (SETQ NTHTIME T)))
(PRIN1 ADDR STREAM))
(TERPRI STREAM])
)
(* FORWARD)
(DEFINEQ
(\LAFITE.FORWARD
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 1-Feb-84 15:05")
(ADD.PROCESS (LIST (FUNCTION \LAFITE.FORWARD.PROC)
(KWOTE WINDOW)
(KWOTE MAILFOLDER)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEFORWARDER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(\LAFITE.FORWARD.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: "21-Feb-84 17:07")
(PROG (MSGS FORM)
(* the reason to get the MSG#S first is that they may have changed by the time \SENDMESSAGE finishes and then we
would have marked the wrong ones *)
[WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(RESETLST (LA.RESETSHADE ITEM MENU)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(COND
((NOT (\LAFITE.CHECK.NO.SELECTIONS MAILFOLDER))
(SETQ FORM (MAKEFORWARDFORM WINDOW MAILFOLDER
(SETQ MSGS
(for MSG selectedin MAILFOLDER
collect MSG]
(COND
((AND FORM (\SENDMESSAGE FORM))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(for MSG in MSGS bind (MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of MAILFOLDER))
when (EQ MSG (NTHMESSAGE MESSAGES (fetch (LAFITEMSG #) of MSG)))
do (* If message got expunged since we constructed the
forward form, we can't do anything)
(MARKMESSAGE MSG MAILFOLDER FORWARDMARK])
(MAKEFORWARDFORM
[LAMBDA (WINDOW FOLDERDATA MESSAGELIST) (* bvm: "17-Feb-84 15:55")
(PROG ((FOLDER (OPENMAILFOLDER FOLDERDATA (QUOTE INPUT)))
(OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(CURMSG (CAR MESSAGELIST))
SUBJECT SELECTPOSITION SELECTLEN)
(OR (fetch (LAFITEMSG PARSED?) of CURMSG)
(LAFITE.PARSE.MSG.FOR.TOC CURMSG FOLDERDATA))
(printout OUTSTREAM "Subject: ")
(COND
([OR LAFITEFORWARDSUBJECTSTR (NULL (SETQ SUBJECT (fetch (LAFITEMSG SUBJECT) of CURMSG]
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
[SETQ SELECTLEN (NCHARS (SETQ SUBJECT (OR LAFITEFORWARDSUBJECTSTR SUBJECTSTR]
(printout OUTSTREAM SUBJECT))
(T (printout OUTSTREAM "[" (fetch (LAFITEMSG FROM) of CURMSG)
": " SUBJECT "]")))
(printout OUTSTREAM T "To: ")
[COND
((NOT SELECTPOSITION)
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(SETQ SELECTLEN (NCHARS RECIPIENTSSTR]
(printout OUTSTREAM RECIPIENTSSTR T)
(printout OUTSTREAM "cc: " (FULLUSERNAME)
T)
(printout OUTSTREAM T BEGINFORWARDEDMESSAGESTR T T)
(for MSGDESCRIPTOR in MESSAGELIST
do (* make sure we're pointing at the end -- TEDIT.INCLUDE
leaves it at the left *)
(TEDIT.SETSEL OUTSTREAM (ADD1 (GETEOFPTR OUTSTREAM))
0
(QUOTE RIGHT))
(TEDIT.INCLUDE (TEXTOBJ OUTSTREAM)
FOLDER
(fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR))
(printout OUTSTREAM T))
(TEDIT.INSERT OUTSTREAM ENDFORWARDEDMESSAGESTR T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION SELECTLEN (QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
(LA.OPENTEMPFILE
[LAMBDA (EXTENSION ACCESS RECOG LENGTH) (* bvm: "13-Jan-84 11:04")
(PROG [(STREAM (OPENSTREAM (PACKFILENAME (QUOTE HOST)
(COND
((AND LENGTH (IGREATERP LENGTH (UNFOLD 30 BYTESPERPAGE)
))
(QUOTE DSK))
(T LAFITETEMPFILEHOSTNAME))
(QUOTE NAME)
(QUOTE LAFITETEMPORARY)
(QUOTE EXTENSION)
EXTENSION)
(OR ACCESS (QUOTE OUTPUT))
(OR RECOG (QUOTE NEW))
NIL
(AND LENGTH (LIST (LIST (QUOTE LENGTH)
LENGTH]
(RETURN (COND
(STREAM (* save them so they can be deleted by LAFITE.QUIT *)
(WHENCLOSE STREAM (QUOTE CLOSEALL)
(QUOTE NO))
(LINELENGTH MAX.SMALLP STREAM)
(push \LAFITE.TEMPFILES (FULLNAME STREAM))
STREAM])
)
(* FORMS)
(DEFINEQ
(\LAFITE.MESSAGEFORM
[LAMBDA (ITEM MENU BUTTON) (* bvm: " 2-Feb-84 11:24")
(RESETLST (AND ITEM (LA.RESETSHADE ITEM MENU))
(PROG (FORM)
(COND
([SETQ FORM (COND
((EQ BUTTON (QUOTE LEFT))
(MAKENEWMESSAGEFORM))
(T (DERIVEMESSAGEFORMFROMMENU]
(ADD.PROCESS (LIST (FUNCTION \SENDMESSAGE)
(KWOTE FORM))
(QUOTE NAME)
(QUOTE MESSAGESENDER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(DERIVEMESSAGEFORMFROMMENU
[LAMBDA NIL (* bvm: " 2-Feb-84 11:07")
(* * this does special processing on the result of (MENU LAFITEFORMSMENU) * *)
(PROG ([FORMTYPE (MENU (OR LAFITEFORMSMENU (MAKELAFITEFORMSMENU]
REALFORMNAME FULLFORMNAME)
[COND
((NULL FORMTYPE)
(RETURN NIL))
((EQ FORMTYPE (QUOTE ##ANOTHERFORM##)) (* user buttoned "Another Form" *)
(OR (SETQ FORMTYPE (PROMPTFORFILENAME))
(RETURN)))
((DEFINEDP FORMTYPE)
(RETURN (APPLY FORMTYPE)))
((BOUNDP FORMTYPE)
(RETURN (OR (EVALV FORMTYPE)
(MAKENEWMESSAGEFORM]
(RETURN (COND
([SETQ REALFORMNAME (INFILEP (SETQ FULLFORMNAME (LA.LONGFILENAME FORMTYPE
LAFITEFORM.EXT]
(* read the form and return it *)
(COND
((NOT (MEMB REALFORMNAME LAFITEFORMFILES))
(push LAFITEFORMFILES REALFORMNAME)
(SETQ \LAFITEPROFILECHANGED T)
(MAKELAFITEFORMSMENU)))
(GETMESSAGEFORMFROMFILE REALFORMNAME))
(T (printout PROMPTWINDOW T FULLFORMNAME " not found.")
NIL])
(MAKELAFITESUPPORTFORM
[LAMBDA NIL (* bvm: " 5-Jan-84 12:49")
(MAKEXXXSUPPORTFORM "Lafite" LAFITESUPPORT LAFITESYSTEMDATE])
(MAKELISPSUPPORTFORM
[LAMBDA NIL (* bvm: " 5-Jan-84 12:50")
(MAKEXXXSUPPORTFORM "Lisp" LISPSUPPORT])
(MAKEXXXSUPPORTFORM
[LAMBDA (SYSTEMNAME ADDRESS SYSTEMDATE) (* bvm: " 5-Jan-84 12:49")
(PROG (OUTSTREAM SELECTPOSITION)
(SETQ OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(printout OUTSTREAM "Subject: " SYSTEMNAME ": ")
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(printout OUTSTREAM SUBJECTSTR T)
(printout OUTSTREAM "To: " ADDRESS T)
(printout OUTSTREAM "cc: " (FULLUSERNAME)
T)
(COND
(SYSTEMDATE (printout OUTSTREAM SYSTEMNAME "-System-Date: " SYSTEMDATE T)))
(printout OUTSTREAM "Lisp-System-Date: " MAKESYSDATE T)
(SELECTQ (SYSTEMTYPE)
(D (printout OUTSTREAM "Machine-Type: " (L-CASE (MACHINETYPE)
T)
T))
NIL)
(TERPRI OUTSTREAM)
(printout OUTSTREAM MESSAGESTR T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJECTSTR)
(QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
(MAKENEWMESSAGEFORM
[LAMBDA NIL (* M.Yonke " 4-OCT-83 15:09")
(PROG (OUTSTREAM SELECTPOSITION)
(SETQ OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(printout OUTSTREAM "Subject: ")
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(printout OUTSTREAM SUBJECTSTR T)
(printout OUTSTREAM "To: " RECIPIENTSSTR T)
(printout OUTSTREAM "cc: " (FULLUSERNAME)
T T)
(printout OUTSTREAM MESSAGESTR T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJECTSTR)
(QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
(MAKELAFITEFORMSMENU
[LAMBDA NIL (* bvm: "21-Feb-84 14:45")
(SETQ LAFITEFORMSMENU (create MENU
ITEMS ←(APPEND (MAKELAFITEPRIVATEFORMSITEMS
"Use the form defined in this file.")
LAFITESPECIALFORMS LAFITEFORMSMENUITEMS)
TITLE ← "Message Forms"
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T])
(MAKELAFITEPRIVATEFORMSITEMS
[LAMBDA (HELPSTR) (* bvm: "21-Feb-84 14:45")
(for FORMFILE in (SORT LAFITEFORMFILES) when FORMFILE collect (LIST (L-CASE (LA.SHORTFILENAME
FORMFILE
LAFITEFORM.EXT))
(KWOTE FORMFILE)
HELPSTR])
(MAKELAFITEMAILFOLDERSMENU
[LAMBDA NIL (* bvm: " 6-Jan-84 11:26")
(SETQ LAFITEFOLDERSMENU (create MENU
ITEMS ←(APPEND (SORT (CDR LAFITEMAILFOLDERS))
(LIST ANOTHERFOLDERMENUITEM))
TITLE ←(CONCAT "Folders on " (L-CASE (fetch PACKEDHOST&DIR
\LAFITEDEFAULTHOST&DIR)))
CENTERFLG ← T])
(GETMESSAGEFORMFROMFILE
[LAMBDA (FILE) (* bvm: " 2-Feb-84 11:15")
(* * copies the messaage form in the FILE into a text stream * *)
(PROG (INFILE TEMPSTREAM)
(OR FILE (RETURN))
(SETQ INFILE (OPENSTREAM FILE (QUOTE INPUT)))
(SETQ TEMPSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(* * now have to check to see whether it was an old style message form -- i.e. a string -- or a new message form
-- i.e. just text -- and read it into the stream the appropriate way * *)
(COND
[(OR (EQ (BIN INFILE)
(CHARCODE %"))
(EQ (BIN INFILE)
(CHARCODE %"))) (* either the first or second character was a double
quote *)
(* forget the double quotes *)
(COPYBYTES INFILE TEMPSTREAM (GETFILEPTR INFILE)
(SUB1 (GETEOFPTR INFILE]
(T (* just do a straight copy *)
(COPYBYTES INFILE TEMPSTREAM 0 -1)))
(CLOSEF INFILE)
(\LAFITE.FIND.TEMPLATE TEMPSTREAM)
(RETURN TEMPSTREAM])
(\LAFITE.FIND.TEMPLATE
[LAMBDA (TEXTSTREAM) (* bvm: " 2-Feb-84 11:27")
(PROG (SELECTSTART)
(RETURN (COND
((AND NIL (SETQ SELECTSTART (TEDIT.FIND TEXTSTREAM ">>*<<" 1)))
(* Wait until TEDIT.FIND gets fixed)
(* highlight the first "blank" to fill in)
(TEDIT.SETSEL TEXTSTREAM SELECTSTART (IPLUS 2 (IDIFFERENCE (TEDIT.FIND
TEXTSTREAM
"<<"
SELECTSTART)
SELECTSTART))
(QUOTE RIGHT)
T)
T)
(T (TEDIT.SETSEL TEXTSTREAM 1 0 (QUOTE LEFT])
(SAVEMESSAGEFORM
[LAMBDA (MSG) (* bvm: "29-Dec-83 17:41")
(PROG (FORMFILE)
(COND
((SETQ FORMFILE (PROMPTFORFILENAME))
(SETQ FORMFILE (OPENFILE (LA.LONGFILENAME (U-CASE FORMFILE)
LAFITEFORM.EXT)
(QUOTE OUTPUT)))
(COPYBYTES MSG FORMFILE 0 -1)
(CLOSEF FORMFILE)
(COND
((NOT (MEMB FORMFILE LAFITEFORMFILES))
(SETQ LAFITEFORMFILES (APPEND LAFITEFORMFILES (LIST FORMFILE)))
(SETQ \LAFITEPROFILECHANGED T)
(MAKELAFITEFORMSMENU)))
(RETURN FORMFILE])
)
(RPAQQ LAFITEPROFILEVARS ((LAFITEHARDCOPY.MIN.MESSAGES.FOR.TOC)
(LAFITEFROMFRACTION .3)
(LAFITEMINFROMCHARS 15)
(LAFITEIMMEDIATECHANGESFLG)
(LAFITEVERIFYFLG T)
(LAFITEDEFAULTHOST&DIR)
(LAFITEBUFFERSIZE 20)
(MAILWATCHWAITTIME 5)
(LAFITEFLUSHMAILFLG T)
(LAFITEIFFROMMETHENSEENFLG T)
(LAFITEDISPLAYAFTERDELETEFLG T)
(LAFITEREADONLYFLG T)
(LAFITEDELETEDLINEHEIGHT 1)
(LAFITENEWPAGEFLG T)
(LAFITESENDINGFORMAT (QUOTE TEXT))
[LAFITEMENUFONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD]
[LAFITETITLEFONT (FONTCREATE (QUOTE (HELVETICA 12 BOLD]
[LAFITEDISPLAYFONT (FONTCREATE (QUOTE (TIMESROMAN 12]
(LAFITEEDITORFONT LAFITEDISPLAYFONT)
(LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
[LAFITEBROWSERFONT (FONTCREATE (QUOTE (GACHA 10]
(LAFITETOC.EXT (QUOTE -LAFITE-TOC))
(LAFITEPROFILE.NAME (QUOTE LAFITE))
(LAFITEPROFILE.EXT (QUOTE PROFILE))
(LAFITEFORM.EXT (QUOTE LAFITE-FORM))
(DEFAULTMAILFOLDERNAME (QUOTE ACTIVE.MAIL))
(LAFITEMAIL.EXT (QUOTE MAIL))
(LAFITESTATUSWINDOWMINWIDTH 200)
(LAFITESTATUSWINDOWPOSITION (create POSITION XCOORD ← 735 YCOORD ← 650))
(LAFITEBROWSERREGION (create REGION LEFT ← 30 BOTTOM ← 30 WIDTH ← 575 HEIGHT ← 210))
(LAFITEEDITORREGION (create REGION LEFT ← 485 BOTTOM ← 130 WIDTH ← 470 HEIGHT ← 470))
(LAFITEDISPLAYREGION (create REGION LEFT ← 375 BOTTOM ← 25 WIDTH ← 600 HEIGHT ← 335))
(LAFITEENDOFMESSAGESTR "
End of message")
[LAFITEENDOFMESSAGEFONT (FONTCREATE (QUOTE (TIMESROMAN 10 ITALIC]
(LAFITEFORWARDSUBJECTSTR)
(LAFITENEWMAILTUNE)
(LAFITEGETMAILTUNE)
(LAFITEDEBUGFLG)))
(RPAQ? LAFITEHARDCOPY.MIN.MESSAGES.FOR.TOC )
(RPAQ? LAFITEFROMFRACTION .3)
(RPAQ? LAFITEMINFROMCHARS 15)
(RPAQ? LAFITEIMMEDIATECHANGESFLG )
(RPAQ? LAFITEVERIFYFLG T)
(RPAQ? LAFITEDEFAULTHOST&DIR )
(RPAQ? LAFITEBUFFERSIZE 20)
(RPAQ? MAILWATCHWAITTIME 5)
(RPAQ? LAFITEFLUSHMAILFLG T)
(RPAQ? LAFITEIFFROMMETHENSEENFLG T)
(RPAQ? LAFITEDISPLAYAFTERDELETEFLG T)
(RPAQ? LAFITEREADONLYFLG T)
(RPAQ? LAFITEDELETEDLINEHEIGHT 1)
(RPAQ? LAFITENEWPAGEFLG T)
(RPAQ? LAFITESENDINGFORMAT (QUOTE TEXT))
(RPAQ? LAFITEMENUFONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD))))
(RPAQ? LAFITETITLEFONT (FONTCREATE (QUOTE (HELVETICA 12 BOLD))))
(RPAQ? LAFITEDISPLAYFONT (FONTCREATE (QUOTE (TIMESROMAN 12))))
(RPAQ? LAFITEEDITORFONT LAFITEDISPLAYFONT)
(RPAQ? LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
(RPAQ? LAFITEBROWSERFONT (FONTCREATE (QUOTE (GACHA 10))))
(RPAQ? LAFITETOC.EXT (QUOTE -LAFITE-TOC))
(RPAQ? LAFITEPROFILE.NAME (QUOTE LAFITE))
(RPAQ? LAFITEPROFILE.EXT (QUOTE PROFILE))
(RPAQ? LAFITEFORM.EXT (QUOTE LAFITE-FORM))
(RPAQ? DEFAULTMAILFOLDERNAME (QUOTE ACTIVE.MAIL))
(RPAQ? LAFITEMAIL.EXT (QUOTE MAIL))
(RPAQ? LAFITESTATUSWINDOWMINWIDTH 200)
(RPAQ? LAFITESTATUSWINDOWPOSITION (create POSITION XCOORD ← 735 YCOORD ← 650))
(RPAQ? LAFITEBROWSERREGION (create REGION LEFT ← 30 BOTTOM ← 30 WIDTH ← 575 HEIGHT ← 210))
(RPAQ? LAFITEEDITORREGION (create REGION LEFT ← 485 BOTTOM ← 130 WIDTH ← 470 HEIGHT ← 470))
(RPAQ? LAFITEDISPLAYREGION (create REGION LEFT ← 375 BOTTOM ← 25 WIDTH ← 600 HEIGHT ← 335))
(RPAQ? LAFITEENDOFMESSAGESTR "
End of message")
(RPAQ? LAFITEENDOFMESSAGEFONT (FONTCREATE (QUOTE (TIMESROMAN 10 ITALIC))))
(RPAQ? LAFITEFORWARDSUBJECTSTR )
(RPAQ? LAFITENEWMAILTUNE )
(RPAQ? LAFITEGETMAILTUNE )
(RPAQ? LAFITEDEBUGFLG )
(RPAQQ LAFITERANDOMGLOBALS ((LAFITETEMPFILEHOSTNAME (QUOTE CORE))
(UNSUPPLIEDFIELDSTR "---")
(ARPANETGATEWAY.REGISTRY (QUOTE AG))
(LAFITESUPPORT (QUOTE LafiteSupport.pa))
(MESSAGESTR ">>Message<<")
(RECIPIENTSSTR ">>Recipients<<")
(SUBJECTSTR ">>Subject<<")
(LISPSUPPORT (QUOTE LispSupport.pa))
(BEGINFORWARDEDMESSAGESTR " ----- Forwarded Messages -----")
(ENDFORWARDEDMESSAGESTR " ----- End of Forwarded Messages -----")
(HARDCOPYSEPARATORSTR
"------------------------------------------------------------------------")
(LAFITEBUSYWAITTIME 1000)
(LIGHTWAVYSHADE 640)
(LAFITEITEMBUSYSHADE 43605)
(LAFITEEOL "
")))
(RPAQ? LAFITETEMPFILEHOSTNAME (QUOTE CORE))
(RPAQ? UNSUPPLIEDFIELDSTR "---")
(RPAQ? ARPANETGATEWAY.REGISTRY (QUOTE AG))
(RPAQ? LAFITESUPPORT (QUOTE LafiteSupport.pa))
(RPAQ? MESSAGESTR ">>Message<<")
(RPAQ? RECIPIENTSSTR ">>Recipients<<")
(RPAQ? SUBJECTSTR ">>Subject<<")
(RPAQ? LISPSUPPORT (QUOTE LispSupport.pa))
(RPAQ? BEGINFORWARDEDMESSAGESTR " ----- Forwarded Messages -----")
(RPAQ? ENDFORWARDEDMESSAGESTR " ----- End of Forwarded Messages -----")
(RPAQ? HARDCOPYSEPARATORSTR
"------------------------------------------------------------------------")
(RPAQ? LAFITEBUSYWAITTIME 1000)
(RPAQ? LIGHTWAVYSHADE 640)
(RPAQ? LAFITEITEMBUSYSHADE 43605)
(RPAQ? LAFITEEOL "
")
(RPAQQ LAFITEMARKS ((SEENMARK (CHARCODE SP))
(UNSEENMARK (CHARCODE ?))
(MOVETOMARK (CHARCODE m))
(FORWARDMARK (CHARCODE f))
(ANSWERMARK (CHARCODE a))
(HARDCOPYMARK (CHARCODE h))))
(RPAQ SEENMARK (CHARCODE SP))
(RPAQ UNSEENMARK (CHARCODE ?))
(RPAQ MOVETOMARK (CHARCODE m))
(RPAQ FORWARDMARK (CHARCODE f))
(RPAQ ANSWERMARK (CHARCODE a))
(RPAQ HARDCOPYMARK (CHARCODE h))
(RPAQQ LAFITEBROWSERMENUITEMS ((Display (QUOTE \LAFITE.DISPLAY)
"Displays the selected message in the display window.")
(Delete (QUOTE \LAFITE.DELETE)
"Deletes the selected messages.")
(Undelete (QUOTE \LAFITE.UNDELETE)
"Undeletes the selected messages.")
(Answer (QUOTE \LAFITE.ANSWER)
"Prepares a delivery form to reply to the selected message.")
(Forward (QUOTE \LAFITE.FORWARD)
"Prepares a delivery form to forward the selected message(s).")
(Hardcopy (QUOTE \LAFITE.HARDCOPY)
"Sends hardcopy of the selected message(s) to the default printer")
("Move To" (QUOTE \LAFITE.MOVETO)
"Moves the selected message(s) to another mail folder.")
(Update (QUOTE \LAFITE.UPDATE)
"Write out browser changes to the physical mail file.
Option to expunge all deleted messages.")
("Get Mail" (QUOTE \LAFITE.GETMAIL)
"Retrieves new messages and puts them into this mail folder.")))
(RPAQQ LAFITESENDINGMENUITEMS ((Deliver (QUOTE ##SEND##)
"Send the message in the edit window")
("Save Form" (QUOTE ##SAVE##)
"Save the message in a file")
(Abort (QUOTE ##FORGETIT##)
"Just save this message as the 'last message'")))
(RPAQQ LAFITECOMMANDMENUITEMS ((Browse (QUOTE ##BROWSE##)
"Browse another mail file")
("Send Mail" (QUOTE ##SENDMAIL##)
"Open a message composition window; MIDDLE for choice of forms")
(Quit (QUOTE ##QUIT##)
"Update and close all mail files and stop Lafite")))
(RPAQQ LAFITESUBBROWSEMENUITEMS (("Browse" (FUNCTION \LAFITE.BROWSE)
"Browse a mail file")
("Browse Laurel File" (FUNCTION \LAFITE.BROWSE.LAURELFILE)
"Massages Laurel File before browsing with Lafite")
("Forget Folder" (FUNCTION \LAFITE.UNCACHE.FOLDER)
"Remove a folder from list of known folders")
("Forget Message Form" (FUNCTION \LAFITE.UNCACHE.MESSAGEFORM)
"Remove a form from list of known message forms")))
(RPAQQ LAFITEFORMSMENUITEMS (("Last Message" (QUOTE LAFITELASTMESSAGE)
"The previous message form as edited")
("Private Form" (QUOTE ##ANOTHERFORM##)
"You will be asked to specify a filename for the form")
("Standard Form" (FUNCTION MAKENEWMESSAGEFORM)
"A clean message form")))
(RPAQQ LAFITEUPDATEMENUITEMS (("Write out changes only" (QUOTE \LAFITE.UPDATE.PROC)
"Will update physical file to reflect new marks and deletions")
("Expunge deleted messages" (QUOTE \LAFITE.EXPUNGE.PROC)
"Will rewrite mail file, expunging all deleted messages")))
(RPAQQ ANOTHERFOLDERMENUITEM ("** Other Folder **" (QUOTE ##ANOTHERFILE##)
"You will be asked to specify another mail filename"))
(ADDTOVAR LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM)
"A form to report a Lisp bug or suggestion")
("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM)
"A form to report a Lafite bug or suggestion"))
(RPAQ? LAFITESTATUSWINDOW )
(RPAQ? \ACTIVELAFITEFOLDERS )
(RPAQ? \LAFITEPROFILECHANGED )
(RPAQ? \LAFITE.TEMPFILES )
(RPAQ? PRIMARYEDITORWINDOW )
(RPAQ? LAFITEEDITORWINDOWS )
(RPAQ? LAFITECURRENTEDITORWINDOWS )
(RPAQ? LAFITELASTMESSAGE )
(RPAQ? LAFITEMAILFOLDERS )
(RPAQ? LAFITEFORMFILES )
(RPAQ? LAFITEFOLDERSMENU )
(RPAQ? LAFITEFORMSMENU )
(RPAQ? LAFITESUBBROWSEMENU )
(RPAQ? LAFITECLOSEFNMENU )
(RPAQ? LAFITEUPDATEMENU )
(RPAQ? LAFITEFORMATMENU )
(DEFINEQ
(LA.RESETSHADE
[LAMBDA (ITEM MENU) (* bvm: "14-Dec-83 16:51")
(* * Shades ITEM in MENU to indicate Lafite is busy, leaves something on resetlst to unshade it)
(RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE])
(LA.REMOVEDUPLICATES
[LAMBDA (LST) (* bvm: "18-Dec-83 16:07")
(* * a case-independent intersection of LST and LST * *)
(for X in LST bind RESULT unless (for GOOD in RESULT thereis (UCASE.STREQUAL X GOOD))
do (* Collect only if we haven't seen this name before)
(push RESULT X)
finally (RETURN (COND
((CDR RESULT)
(REVERSE RESULT))
(T RESULT])
(COLLECTOLDFILES
[LAMBDA (FILES EXT) (* bvm: " 6-Jan-84 11:05")
(for FILE in FILES when (AND FILE (INFILEP (LA.LONGFILENAME FILE EXT))) collect
(* use only those mail files that do exist *)
FILE])
(LA.SETDIFFERENCE
[LAMBDA (X Y) (* bvm: "20-Dec-83 18:14")
(* * Returns subset of X not in Y, case-independently)
(for ELT in X collect ELT unless (for OTHER in Y thereis (UCASE.STREQUAL ELT OTHER])
(NTHMESSAGE
[LAMBDA (MESSAGES N) (* bvm: " 3-Jan-84 12:11")
(ELT MESSAGES N])
(\LAFITE.MAKE.MSGARRAY
[LAMBDA (SIZE OLDARRAY OLDSIZE) (* bvm: " 3-Jan-84 11:07")
(* * Creates an array at least large enough to hold SIZE message descriptors. If OLDARRAY is given, its elements
up to OLDSIZE are copied into the new array)
(PROG [(NEWARRAY (ARRAY (IMAX (IPLUS SIZE 32)
(CEIL SIZE 64))
(QUOTE POINTER]
[COND
(OLDARRAY (for I from 1 to OLDSIZE do (SETA NEWARRAY I (ELT OLDARRAY I]
(RETURN NEWARRAY])
(\LAFITE.ADDMESSAGES.TO.ARRAY
[LAMBDA (MSGARRAY MESSAGELIST FIRSTMSG# LASTMSG#) (* bvm: " 3-Jan-84 11:26")
(* * Adds to MSGARRAY the messages from MESSAGELIST, which should be numbered FIRSTMSG# thru LASTMSG# -
returns a new array if MSGARRAY wasn't large enough)
[COND
((OR (NULL MSGARRAY)
(IGREATERP LASTMSG# (ARRAYSIZE MSGARRAY)))
(SETQ MSGARRAY (\LAFITE.MAKE.MSGARRAY LASTMSG# MSGARRAY (SUB1 FIRSTMSG#]
(COND
((NEQ (fetch (LAFITEMSG #) of (CAR MESSAGELIST))
FIRSTMSG#)
(SHOULDNT)))
(for MSG in MESSAGELIST as MSG# from FIRSTMSG# do (SETA MSGARRAY MSG# MSG))
MSGARRAY])
)
(* Display aids)
(RPAQ LA.RIGHTARROWCURSOR (CURSORCREATE (READBITMAP) 14 8))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@CH@"
"@AN@"
"@@OH"
"OOON"
"OOON"
"@@OH"
"@AN@"
"@CH@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ LA.CROSSCURSOR (CURSORCREATE (READBITMAP) 8 8))
(16 16
"L@@C"
"N@@G"
"G@@N"
"CHAL"
"ALCH"
"@NG@"
"@GN@"
"@CL@"
"@CL@"
"@GN@"
"@NG@"
"ALCH"
"CHAL"
"G@@N"
"N@@G"
"L@@C")
(RPAQ LA.SELECTION.BITMAP (READBITMAP))
(8 10
"L@@@"
"N@@@"
"O@@@"
"OH@@"
"OL@@"
"OH@@"
"O@@@"
"N@@@"
"L@@@"
"@@@@")
(RPAQQ BROWSERMARKXPOSITION 8)
(* Mail polling and registration)
(DEFINEQ
(MAILSERVERS
[LAMBDA NIL (* DECLARATIONS: (RECORD (TIMESTAMP . MAILSERVERS)))
(* bvm: "13-Jan-84 14:25")
(PROG (USER PASS MAILSERVERS AUTHENTICATED?)
(COND
(\LAFITEUSERDATA (RETURN \LAFITEUSERDATA)))
(COND
((NEQ [SETQ AUTHENTICATED? (GV.AUTHENTICATE (SETQ USER (USERINFORMATION (QUOTE NAME)))
(SETQ PASS (GV.MAKEKEY (USERINFORMATION
(QUOTE PASSWORD]
T)
(printout PROMPTWINDOW T "Cannot authenticate user " USER " because: " (SETQ
\LAFITE.AUTHENTICATION.FAILURE AUTHENTICATED?)
"."))
([NULL (SETQ MAILSERVERS (fetch MAILSERVERS of (GV.EXPAND USER]
(printout PROMPTWINDOW T "There are no mail servers for user " USER))
(T (SETQ \LAFITEUSERDATA
(create LAFITEUSERDATA
FULLUSERNAME ←(FULLUSERNAME)
ENCRYPTEDPASSWORD ← PASS
MAILSERVERS ←(for MAILSERVER in MAILSERVERS bind SERVEROPS SERVERPORT
SERVERDEF
when [SETQ SERVERDEF
(COND
((NULL (SETQ SERVEROPS (GETMAILSERVEROPS MAILSERVER)
))
NIL)
((NULL (SETQ SERVERPORT (APPLY*
(fetch (MAILSERVEROPS SERVERPORTFROMNAME)
of SERVEROPS)
MAILSERVER)))
(printout PROMPTWINDOW T "Can't find address of "
MAILSERVER)
NIL)
(T (create MAILSERVER
MAILPORT ← SERVERPORT
SERVERNAME ← MAILSERVER
MAILSERVEROPS ← SERVEROPS]
collect SERVERDEF)))
(RETURN \LAFITEUSERDATA])
(LAFITECLEARCACHE
[LAMBDA NIL (* M.Yonke "23-AUG-83 11:15")
(SETQ \LAFITEUSERDATA NIL])
(MAILSERVERTYPE
[LAMBDA (MAILSERVERNAME) (* bvm: " 1-Jan-84 17:48")
(* * type is determined by the name currently * *)
(COND
((UCASE.STREQUAL (SUBSTRING MAILSERVERNAME -3)
".MS")
(QUOTE GV))
((UCASE.STREQUAL MAILSERVERNAME "MAXC")
(QUOTE MTP])
(GETMAILSERVEROPS
[LAMBDA (MAILSERVER) (* bvm: " 1-Jan-84 17:36")
(PROG ((SERVERTYPE (MAILSERVERTYPE MAILSERVER))
OPS)
(RETURN (COND
([AND SERVERTYPE (SETQ OPS (OR (ASSOC SERVERTYPE MAILSERVERTYPES)
(AND (EQ SERVERTYPE (QUOTE MTP))
(PROGN (FILESLOAD (SYSLOAD FROM VALUEOF
LISPUSERSDIRECTORIES)
MTP)
(ASSOC SERVERTYPE MAILSERVERTYPES]
(CDR OPS))
(T (printout PROMPTWINDOW T "Lafite cannot retrieve mail from " MAILSERVER)
NIL])
(USERINFORMATION
[LAMBDA (TYPE) (* DECLARATIONS: (RECORD (USERNAME . PASSWORD)))
(* bvm: " 1-Jan-84 17:05")
(SELECTQ TYPE
(NAME (SELECTQ (SYSTEMTYPE)
(D (fetch USERNAME of (\INTERNAL/GETPASSWORD)))
(HELP)))
(PASSWORD (SELECTQ (SYSTEMTYPE)
(D (fetch PASSWORD of (\INTERNAL/GETPASSWORD)))
(HELP)))
(SHOULDNT])
(FULLUSERNAME
[LAMBDA NIL (* bvm: "12-Jan-84 16:34")
(COND
((fetch (LAFITEUSERDATA FULLUSERNAME) of \LAFITEUSERDATA))
(T (PROG (USER REGISTRY SIMPLENAME)
(SETQ USER (USERINFORMATION (QUOTE NAME)))
(SETQ REGISTRY (L-CASE (OR (GETREGISTRY USER)
DEFAULTREGISTRY)))
(SETQ SIMPLENAME (GETSIMPLENAME USER))
(SETQ SIMPLENAME (COND
((U-CASEP SIMPLENAME)
(L-CASE SIMPLENAME T))
(T SIMPLENAME)))
(RETURN (CONCAT SIMPLENAME "." REGISTRY])
(GETREGISTRY
[LAMBDA (NAME) (* rrb "27-AUG-82 14:30")
(* returns the registry field of a name if it has one;
NIL otherwise.)
(* grapevine spec is any part after the last "."
is the registry.)
(PROG ((LOC (STRPOS "." NAME))
NXTLOC)
(if (NULL LOC)
then (* no registry.)
(RETURN NIL))
LP (while (SETQ NXTLOC (STRPOS "." NAME (ADD1 LOC))) do (SETQ LOC NXTLOC))
(RETURN (SUBSTRING NAME (ADD1 LOC)
-1])
(GETSIMPLENAME
[LAMBDA (NAME) (* rrb "27-AUG-82 14:30")
(* returns the simple-name field of a name if it has
one; NIL otherwise.)
(* grapevine spec is any part before the last "."
is the simple-name)
(PROG ((LOC (STRPOS "." NAME))
NXTLOC)
(if (NULL LOC)
then (* no registry.)
(RETURN NAME))
LP (while (SETQ NXTLOC (STRPOS "." NAME (ADD1 LOC))) do (SETQ LOC NXTLOC))
(RETURN (SUBSTRING NAME 1 (SUB1 LOC])
(LAFITEMAILWATCH
[LAMBDA NIL (* bvm: "27-Dec-83 18:46")
(bind (INTERVAL ←(ITIMES MAILWATCHWAITTIME 60000)) while (PROGN
(* Until killed)
T)
do (WITH.MONITOR \LAFITE.MAILSERVERLOCK (POLLNEWMAIL))
(BLOCK INTERVAL])
(POLLNEWMAIL
[LAMBDA NIL (* bvm: " 5-Jan-84 12:31")
(PRINTLAFITESTATUS (COND
((NULL (MAILSERVERS))
(QUOTE NO.MAILSERVER))
((NULL (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA))
(QUOTE NO.MAILBOX))
(T (POLLNEWMAIL1 (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA])
(POLLNEWMAIL1
[LAMBDA (MAILSERVERS) (* bvm: " 1-Jan-84 17:40")
(for MAILSERVER in MAILSERVERS bind POLLNEWMAILVAL NEWMAILFLG NOMAILFLG NOTUPFLG
do (SETQ POLLNEWMAILVAL (APPLY* (fetch (MAILSERVER POLLNEWMAIL) of MAILSERVER)
(FULLUSERNAME)
(fetch (MAILSERVER MAILPORT) of MAILSERVER)))
(SELECTQ POLLNEWMAILVAL
(T (SETQ NEWMAILFLG T)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with POLLNEWMAILVAL))
(NIL (SETQ NOMAILFLG T)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with POLLNEWMAILVAL))
(? (SETQ NOTUPFLG T) (* if the server is down -- don't lets try to get mail
*)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with NIL))
(SHOULDNT))
finally (RETURN (COND
(NEWMAILFLG (* someone has new mail *)
(QUOTE NEW.MAIL))
((AND NOMAILFLG (NULL NOTUPFLG)) (* no one has new mail *)
(QUOTE NO.MAIL))
((AND NOMAILFLG NOTUPFLG) (* no one who was up has new mail but some are down *)
(QUOTE SOME.UP))
(NOTUPFLG (* no one was up *)
(QUOTE NONE.UP])
(PRINTLAFITESTATUS
[LAMBDA (STATUS) (* bvm: " 3-Feb-84 15:27")
(PROG (WINDOW STR)
[SETQ STR (SELECTQ STATUS
[(NEW.MAIL NO.MAILBOX NO.MAILSERVER)
(COND
((EQ STATUS \LAFITE.LAST.STATUS)
(* No change to prompt)
(RETURN))
(T (SELECTQ STATUS
(NEW.MAIL (COND
((AND LAFITENEWMAILTUNE (EQ (MACHINETYPE)
(QUOTE DANDELION)
))
(PLAYTUNE LAFITENEWMAILTUNE)))
(CONCAT "New Mail for " (fetch (LAFITEUSERDATA
FULLUSERNAME)
of \LAFITEUSERDATA))
)
(NO.MAILBOX "No Accessible Mail Boxes")
(CONCAT "Not Logged In: " \LAFITE.AUTHENTICATION.FAILURE]
(CONCAT (SELECTQ STATUS
(NO.MAIL "No New Mail")
(SOME.UP "Some Servers Unavailable")
(NONE.UP "No Mail Servers Responding")
(SHOULDNT))
" at "
(DATE (DATEFORMAT NO.DATE NO.SECONDS CIVILIAN.TIME]
(SETQ \LAFITE.LAST.STATUS NIL)
(CLEARW (SETQ WINDOW (OR (WINDOWP LAFITESTATUSWINDOW)
PROMPTWINDOW)))
(CENTERPRINTINREGION STR NIL WINDOW)
(SETQ \LAFITE.LAST.STATUS STATUS])
)
(ADDTOVAR MAILSERVERTYPES )
(RPAQ? \LAFITE.READY )
(RPAQ? \LAFITE.LAST.STATUS )
(RPAQ? \LAFITEUSERDATA )
(RPAQ? \LAFITEDEFAULTHOST&DIR )
(ADDTOVAR AROUNDEXITFNS LAFITE.AROUNDEXIT)
(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.READY \LAFITE.LAST.STATUS)
(DEFINEQ
(LAFITE.AROUNDEXIT
[LAMBDA (EVENT) (* bvm: "18-Dec-83 16:29")
(SELECTQ EVENT
((BEFORELOGOUT)
(SETQ \LAFITEUSERDATA NIL))
((AFTERLOGOUT AFTERSAVEVM AFTERSYSOUT AFTERMAKESYS)
(CHECKLAFITEMAILFOLDERS))
NIL])
(CHECKLAFITEMAILFOLDERS
[LAMBDA NIL (* bvm: "28-Feb-84 12:49")
(* * On returning from LOGOUT check to see that all the mailfiles are in a consistence state -- the user might
have run Laurel and screwed up Lafite's data, or run Lafite from another machine * *)
(COND
((AND \ACTIVELAFITEFOLDERS (NOT \LAFITE.READY))
(WITH.MONITOR \LAFITE.BROWSELOCK
[COND
((NOT \LAFITE.READY)
(SETQ \ACTIVELAFITEFOLDERS
(for FOLDERDATA in \ACTIVELAFITEFOLDERS bind NEWESTNAME FULLNAME
BROWSERWINDOW
collect FOLDERDATA
when (COND
((NULL (SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW)
of FOLDERDATA)))
(* Not really active, forget it)
NIL)
((COND
((EQ (SETQ NEWESTNAME (INFILEP (fetch (MAILFOLDER
VERSIONLESSFOLDERNAME)
of FOLDERDATA)))
(SETQ FULLNAME (fetch (MAILFOLDER FULLFOLDERNAME)
of FOLDERDATA)))
(COND
((IEQP (GETFILEINFO FULLNAME (QUOTE LENGTH))
(fetch (MAILFOLDER FOLDEREOFPTR) of FOLDERDATA))
(* Assume it hasn't changed if it's the same length)
T)
((OPENWP BROWSERWINDOW)
(CLEARW BROWSERWINDOW)
(ADD.PROCESS (LIST (FUNCTION \LAFITE.REBROWSEFOLDER)
(KWOTE FOLDERDATA))
(QUOTE BEFOREEXIT)
(QUOTE DON'T))
T)
(T (printout PROMPTWINDOW T FULLNAME " has changed")
NIL)))
([OR (NOT NEWESTNAME)
(ILESSP (FILENAMEFIELD NEWESTNAME (QUOTE VERSION))
(FILENAMEFIELD FULLNAME (QUOTE VERSION]
(printout PROMPTWINDOW T "Couldn't find file " FULLNAME)
NIL)
(T (printout PROMPTWINDOW T NEWESTNAME
" is a newer version than is currently being browsed."
T)
NIL))
T)
(T (printout PROMPTWINDOW " - closing its browser window.")
(CLOSEW (FLUSHBROWSERWINDOW BROWSERWINDOW FOLDERDATA))
(CLOSEMAILFOLDER FOLDERDATA T)
NIL]
(SETQ \LAFITE.READY T])
(\LAFITE.REBROWSEFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "22-Feb-84 12:34")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(BROWSERPROMPTPRINT MAILFOLDER "Folder has changed--rebrowsing...")
(CLEARW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(GETFOLDERINTOBROWSER MAILFOLDER)
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T])
(\LAFITE.AFTERLOGIN
[LAMBDA (HOST USER) (* bvm: "13-Jan-84 14:17")
(* Called when LOGIN gets new info.
If HOST = NIL, this is the global login, which means we
should get new data)
(COND
((NULL HOST)
(LAFITECLEARCACHE)
(WAKE.PROCESS (QUOTE LAFITEMAILWATCH])
)
(* Retrieving mail)
(DEFINEQ
(\LAFITE.GETMAIL
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* bvm: "31-Dec-83 19:44")
(ADD.PROCESS (LIST (FUNCTION \LAFITE.GETMAIL.PROC)
(KWOTE WINDOW)
(KWOTE MAILFILEDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE LAFITEGETMAIL)
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE BEFOREEXIT)
(QUOTE DON'T])
(\LAFITE.GETMAIL.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 1-Feb-84 14:58")
(RESETLST (LA.RESETSHADE ITEM MENU)
(OBTAIN.MONITORLOCK (fetch FOLDERLOCK of MAILFOLDER)
NIL T)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OBTAIN.MONITORLOCK \LAFITE.MAILSERVERLOCK NIL T)
(GETNEWMAIL MAILFOLDER WINDOW)
(WAKE.PROCESS (QUOTE LAFITEMAILWATCH])
(GETNEWMAIL
[LAMBDA (MAILFOLDER WINDOW) (* bvm: " 3-Feb-84 15:27")
(PROG ((REPORTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(OUTSTREAM (OPENMAILFOLDER MAILFOLDER (QUOTE APPEND)))
FIRSTMESSAGE)
[for MAILSERVER in (fetch (LAFITEUSERDATA MAILSERVERS) of (MAILSERVERS)) bind MESSAGELIST
NTHTIME
when (PROGN (COND
(NTHTIME (printout REPORTWINDOW "; "))
(T (SETQ NTHTIME T)))
(printout REPORTWINDOW (fetch (MAILSERVER SERVERNAME) of MAILSERVER)
" ..")
(SETQ MESSAGELIST (GETNEWMAIL1 MAILSERVER MAILFOLDER OUTSTREAM REPORTWINDOW))
)
do (ADDMESSAGESTOMAILBROWSER MAILFOLDER MESSAGELIST)
(OR FIRSTMESSAGE (SETQ FIRSTMESSAGE (CAR MESSAGELIST]
(* select the first new message -- all former messages
have already been unselected)
(printout REPORTWINDOW (QUOTE %.))
[COND
(FIRSTMESSAGE (* If any mail was retrieved, select the first message
and make sure it is visible)
(SELECTMESSAGE FIRSTMESSAGE MAILFOLDER)
(INSUREMESSAGEINBROWSERWINDOW MAILFOLDER FIRSTMESSAGE)
(COND
((AND LAFITEGETMAILTUNE (EQ (MACHINETYPE)
(QUOTE DANDELION)))
(PLAYTUNE LAFITEGETMAILTUNE]
(WAKE.PROCESS (QUOTE LAFITEMAILWATCH))
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T])
(GETNEWMAIL1
[LAMBDA (MAILSERVER MAILFOLDER OUTSTREAM REPORTWINDOW) (* bvm: "15-Feb-84 16:21")
(PROG (MESSAGELIST OPENEDINBOX MAILBOX #OFMESSAGES)
(COND
[(SELECTQ (APPLY* (fetch (MAILSERVER POLLNEWMAIL) of MAILSERVER)
(FULLUSERNAME)
(fetch (MAILSERVER MAILPORT) of MAILSERVER))
[T (PRINTLAFITESTATUS (QUOTE NEW.MAIL))
(UNSELECTALLMESSAGES MAILFOLDER)
(SETQ OPENEDINBOX (APPLY* (fetch (MAILSERVER OPENMAILBOX) of MAILSERVER)
(fetch (MAILSERVER MAILPORT) of MAILSERVER)
(fetch (LAFITEUSERDATA FULLUSERNAME) of
\LAFITEUSERDATA)
(fetch (LAFITEUSERDATA ENCRYPTEDPASSWORD)
of \LAFITEUSERDATA)
(fetch (MAILSERVER SERVERNAME) of MAILSERVER]
(NIL (printout REPORTWINDOW " empty")
(RETURN))
NIL)
(SETQ MAILBOX (fetch (OPENEDMAILBOX MAILBOX) of OPENEDINBOX))
(COND
((SETQ #OFMESSAGES (fetch (OPENEDMAILBOX #OFMESSAGES) of OPENEDINBOX))
(GETNEWMAIL.PRINTMSGCOUNT REPORTWINDOW #OFMESSAGES)))
(COND
[(SETQ MESSAGELIST (RETRIEVEMESSAGES MAILSERVER MAILBOX OUTSTREAM MAILFOLDER))
(* first flush the file back out to disk before calling
FLUSH *)
(CLOSEMAILFOLDER MAILFOLDER)
(APPLY* (fetch (MAILSERVER CLOSEMAILBOX) of MAILSERVER)
MAILBOX LAFITEFLUSHMAILFLG)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with NIL)
(printout REPORTWINDOW " done")
(COND
((NULL #OFMESSAGES)
(GETNEWMAIL.PRINTMSGCOUNT REPORTWINDOW (LENGTH MESSAGELIST]
(T (* RETRIEVEMESSAGES already set the file ptr back, etc
*)
(printout REPORTWINDOW " retrieval aborted"]
(T (printout REPORTWINDOW " not responding")
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with NIL)))
(RETURN MESSAGELIST])
(GETNEWMAIL.PRINTMSGCOUNT
[LAMBDA (REPORTWINDOW #OFMESSAGES) (* bvm: " 4-Jan-84 15:44")
(printout REPORTWINDOW " (" #OFMESSAGES (COND
((EQ #OFMESSAGES 1)
" msg")
(T " msgs"))
")"])
(RETRIEVEMESSAGES
[LAMBDA (MAILSERVER MAILBOX OUTSTREAM MAILFOLDER) (* bvm: "23-Jan-84 18:20")
(PROG ((OLDEOFPTR (GETEOFPTR OUTSTREAM)))
(RETURN (CAR (COND
[(ERSETQ (bind (NEXTMESSAGEFN ←(fetch (MAILSERVER NEXTMESSAGE) of MAILSERVER)
)
(RETRIEVEFN ←(fetch (MAILSERVER RETRIEVEMESSAGE)
of MAILSERVER))
(ENDPOS ← OLDEOFPTR)
STARTPOS LENGTHPOS MSGLENGTH NEXTMESSAGERESULT
while (SETQ NEXTMESSAGERESULT (APPLY* NEXTMESSAGEFN MAILBOX))
unless (fetch (NEXTMESSAGE DELETEDFLG) of NEXTMESSAGERESULT)
collect
(* * print the message stamp to the file * *)
(SETFILEPTR OUTSTREAM (SETQ STARTPOS ENDPOS))
(OR (IEQP STARTPOS (GETEOFPTR OUTSTREAM))
(HELP "Confusion in new mail fileptr"))
(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 * *)
(APPLY* RETRIEVEFN MAILBOX OUTSTREAM)
(SETQ MSGLENGTH (IDIFFERENCE (SETQ ENDPOS (GETFILEPTR
OUTSTREAM))
STARTPOS))
(* * go back and print the message length in the stamp * *)
(SETFILEPTR OUTSTREAM LENGTHPOS)
(LA.PRINTCOUNT MSGLENGTH OUTSTREAM)
(create LAFITEMSG
MARKCHAR ← UNSEENMARK
BEGIN ← STARTPOS
MESSAGELENGTH ← MSGLENGTH
STAMPLENGTH ← LAFITESTAMPLENGTH]
(T (* something went drastically wrong!!! -
repair the damage and get out *)
(SETFILEPTR OUTSTREAM OLDEOFPTR)
(SETFILEINFO OUTSTREAM (QUOTE LENGTH)
OLDEOFPTR)
(CLOSEMAILFOLDER MAILFOLDER T) (* open it up again *)
(OPENMAILFOLDER MAILFOLDER (QUOTE APPEND))
NIL])
)
(* Sending mail)
(DEFINEQ
(\SENDMESSAGE
[LAMBDA (FORM) (* bvm: " 2-Feb-84 12:21")
(* * FORM can be a string, file, or stream -
The value of \SENDMESSAGE is T only if the message was actually sent * *)
(bind (CURRENTMESSAGE ← FORM)
EDITORWINDOW EDITORRESULT DONE #SENT
do [SETQ EDITORRESULT (MESSAGEEDITOR CURRENTMESSAGE NIL (AND EDITORRESULT (fetch (
SENDINGCOMMAND MESSAGEWINDOW) of EDITORRESULT]
(SETQ EDITORWINDOW (fetch (SENDINGCOMMAND MESSAGEWINDOW) of EDITORRESULT))
(COND
((NOT (type? SENDINGCOMMAND EDITORRESULT)) (* get out anyway since the user used the TEDIT "quit"
command instead of one of the sending commands *)
(SETQ DONE T))
(T (* the user used the lafite menu to get out rather than
the TEDIT menu so we have to do something *)
(* make sure CURRENTMESSAGE is always a string *)
(SETQ CURRENTMESSAGE (fetch (SENDINGCOMMAND MESSAGE) of EDITORRESULT))
(COND
((NOT (TYPENAMEP CURRENTMESSAGE (QUOTE STREAM)))
(SHOULDNT)))
(SETQ DONE (SELECTQ (fetch (SENDINGCOMMAND COMMAND) of EDITORRESULT)
[##SEND## (first (SETFILEPTR CURRENTMESSAGE 0)
until (NEQ (BIN CURRENTMESSAGE)
(CHARCODE EOL))
do (* hack to get rid of leading CRs *)
(TEDIT.DELETE CURRENTMESSAGE 1 1))
[PROGN (SETFILEPTR CURRENTMESSAGE (SUB1 (GETEOFPTR
CURRENTMESSAGE)
))
(COND
((NEQ (BIN CURRENTMESSAGE)
(CHARCODE EOL))
(* Make sure message ends in eol)
(SETFILEPTR CURRENTMESSAGE -1)
(* Need this because of a tedit bug)
(BOUT CURRENTMESSAGE (CHARCODE EOL]
(SETQ #SENT (FIXP (CAR (ERSETQ (PROGN (GRAYOUTWINDOW
EDITORWINDOW)
(\SENDMESSAGE1
CURRENTMESSAGE]
(##SAVE## (SAVEMESSAGEFORM CURRENTMESSAGE))
(##FORGETIT## T)
(SHOULDNT)))
(SHADEITEM (fetch (SENDINGCOMMAND ITEM) of EDITORRESULT)
(fetch (SENDINGCOMMAND MENU) of EDITORRESULT)
WHITESHADE) (* Unshade command. DOLAFITESENDINGCOMMAND shaded it to
begin with)
))
(COND
(DONE (COND
((NULL #SENT)
(CLOSEW EDITORWINDOW))
(T (* shrink the window *)
(\LAFITE.AFTER.DELIVER EDITORWINDOW #SENT)))
(* make it available for another send *)
(SETQ LAFITECURRENTEDITORWINDOWS (REMOVE EDITORWINDOW LAFITECURRENTEDITORWINDOWS))
(replace (WINDOWPROP MESSAGEFILE) of EDITORWINDOW with NIL)
(SETQ LAFITELASTMESSAGE CURRENTMESSAGE)
(RETURN #SENT))
(T (* Loop if deliver failed or SAVEMESSAGEFORM was
aborted.)])
(\LAFITE.AFTER.DELIVER
[LAMBDA (EDITORWINDOW #SENT) (* bvm: "24-Jan-84 13:22")
(SHRINKW EDITORWINDOW (TITLEDICONW MSGSENTTEMPLATE (CONCAT #SENT " Sent")
LAFITEMENUFONT
[create POSITION
XCOORD ←(IDIFFERENCE (fetch (REGION RIGHT)
of (fetch (WINDOWPROP REGION)
of EDITORWINDOW))
(BITMAPWIDTH MSGSENTICON))
YCOORD ←(IPLUS (IDIFFERENCE
(fetch (REGION TOP)
of (fetch (WINDOWPROP REGION)
of EDITORWINDOW))
(BITMAPHEIGHT MSGSENTICON))
(HEIGHTIFWINDOW (FONTHEIGHT
LAFITEMENUFONT]
T])
(LAFITE.SENDMESSAGE
[LAMBDA (MESSAGEFORM) (* M.Yonke " 4-OCT-83 15:55")
(* * this is the external interface to sending a message * *)
(\SENDMESSAGE1 (OPENTEXTSTREAM MESSAGEFORM])
(\SENDMESSAGE1
[LAMBDA (MSG) (* DECLARATIONS: (RECORD (#OFVALIDRECIPIENTS .
INVALIDRECIPIENTS))) (* bvm: "16-Feb-84 12:31")
(PROG (RECIPIENTS SENDMESSAGERESULT MSGFIELDS FROMFIELD SENDINGFORMAT)
[COND
((NOT (TYPENAMEP MSG (QUOTE STREAM)))
(RETURN (LISPERROR "ILLEGAL ARG" MSG]
(SETQ MSGFIELDS (LAFITE.PARSE.HEADER MSG \LAPARSE.FULL 0 (GETEOFPTR MSG)))
(for PAIR in MSGFIELDS do (SELECTQ (CAR PAIR)
(DATE (\SENDMESSAGEFAIL "User-supplied Date not allowed")
)
[(TO CC)
(SETQ RECIPIENTS (NCONC RECIPIENTS
(PARSERECIPIENTS (CDR PAIR)
NIL T]
[FROM (SETQ FROMFIELD (\CHECKMESSAGEADDRESSES
(PARSERECIPIENTS (CDR PAIR)
NIL T]
(REPLY-TO (\CHECKMESSAGEADDRESSES (PARSERECIPIENTS
(CDR PAIR)
NIL T)))
(SENDER (\SENDMESSAGEFAIL
"User-supplied Sender not allowed"))
(FORMAT (SETQ SENDINGFORMAT (CADR PAIR)))
NIL))
(COND
((NOT (for RECIPENT in RECIPIENTS always RECIPENT))
(* if there is a NIL in RECIPIENTS then PARSERECIPIENTS
couldn't parse something {it already reported it}
therefore just get out now *)
(RETURN NIL))) (* don't let the mail watcher get in the way *)
(SETQ SENDMESSAGERESULT (\SENDMESSAGE2 MSG RECIPIENTS FROMFIELD T SENDINGFORMAT))
(COND
((NULL SENDMESSAGERESULT) (* MS didn't like the recipients list -- this was
already reported by SENDRECIPIENTS *)
(RETURN NIL))
(T (RETURN (fetch #OFVALIDRECIPIENTS of SENDMESSAGERESULT])
(\SENDMESSAGE2
[LAMBDA (MSG RECIPIENTS FROMFIELD ADDDATEANDSENDERPREFIX SENDINGFORMAT)
(* bvm: "22-Feb-84 17:07")
(* * This is the real mail sender for the GrapeVine * *)
(* * MSG is the entire text of the message -- RECIPIENTS is a parsed list of recipients * *)
(PROG (SENDINGSOCKET RECIPIENTSCHECK SENDRESULT DATE&SENDER)
[COND
((NOT (TYPENAMEP MSG (QUOTE STREAM)))
(RETURN (LISPERROR "ILLEGAL ARG" MSG]
(SELECTQ SENDINGFORMAT
((TEXT TEDIT))
[NIL (SETQ SENDINGFORMAT (COND
((NOT (TEDIT.FORMATTEDFILEP MSG))
(QUOTE TEXT))
((\LAFITE.CHOOSE.MSG.FORMAT MSG))
(T (* Aborted)
(RETURN]
(MULTIMEDIA (SETQ SENDINGFORMAT (QUOTE TEDIT)))
(PROGN (printout PROMPTWINDOW T "Unrecognized sending format: " SENDINGFORMAT)
(RETURN NIL)))
(COND
((NULL (MAILSERVERS)) (* MAILSERVERS didn't make it -- get out *)
(printout PROMPTWINDOW T "Can't find a mail server")
(RETURN)))
(as I to 3 until (SETQ SENDINGSOCKET (GV.STARTSEND (FULLUSERNAME)
(fetch (LAFITEUSERDATA ENCRYPTEDPASSWORD)
of \LAFITEUSERDATA)
(FULLUSERNAME)
T))
do (* loop 3 times trying to start this send *)
(DISMISS 1000))
(COND
((NULL SENDINGSOCKET)
(printout PROMPTWINDOW T "Couldn't start sending the message from sender " (
FULLUSERNAME))
(RETURN)))
(COND
((NULL (SETQ RECIPIENTSCHECK (SENDRECIPIENTS SENDINGSOCKET RECIPIENTS)))
(* MS didn't like the recipients list -- this was
already reported by SENDRECIPIENTS *)
(RETURN NIL))) (* Everything is OK *)
(* send code to start sending text *)
(GV.STARTITEM SENDINGSOCKET) (* construct date and who from first *)
[COND
(ADDDATEANDSENDERPREFIX (SETQ DATE&SENDER (CONCAT "Date: " (DATE (DATEFORMAT NO.SECONDS
TIME.ZONE
SPACES))
LAFITEEOL
(COND
(FROMFIELD "Sender: ")
(T "From: "))
(FULLUSERNAME)
LAFITEEOL))
(SELECTQ SENDINGFORMAT
(TEXT (GV.ADDTOITEM SENDINGSOCKET DATE&SENDER))
(TEDIT (TEDIT.INSERT MSG DATE&SENDER 1))
(SHOULDNT] (* stick it on the front *)
(* send the message *)
(GV.ADDTOITEM SENDINGSOCKET (SELECTQ SENDINGFORMAT
(TEXT MSG)
(TEDIT (COERCETEXTOBJ MSG (QUOTE FILE)))
(SHOULDNT)))
(* tell the grapevine to send the message *)
(COND
((EQ (SETQ SENDRESULT (GV.SEND SENDINGSOCKET))
T)
(RETURN RECIPIENTSCHECK))
(T (printout PROMPTWINDOW T "Couldn't complete the sending of the message from sender "
(FULLUSERNAME)
T "reason: " SENDRESULT)
(RETURN NIL])
(\LAFITE.CHOOSE.MSG.FORMAT
[LAMBDA (TEXTSTREAM) (* bvm: "22-Feb-84 17:06")
(* Ask if user intends to retain formatting info, and if
so, send formatted)
(PROG NIL
LP (RETURN (SELECTQ [MENU (OR LAFITEFORMATMENU (SETQ LAFITEFORMATMENU
(create MENU
ITEMS ←[QUOTE (("Send Formatted Message" (QUOTE TEDIT))
("Send Plain Text" (QUOTE TEXT))
("Abort" (QUOTE ABORT]
TITLE ← "Retain formatting information?"
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T]
(TEXT (QUOTE TEXT))
(TEDIT (TEDIT.INSERT TEXTSTREAM "Format: TEdit
" 1)
(QUOTE TEDIT))
(ABORT NIL)
(GO LP])
(\SENDMESSAGEFAIL
[LAMBDA (ERRMSG) (* bvm: "20-Dec-83 12:32")
(ERROR ERRMSG])
(\CHECKMESSAGEADDRESSES
[LAMBDA (ADDRESSES) (* bvm: "20-Dec-83 12:33")
(* Check that each of ADDRESSES is a valid mail
address.)
ADDRESSES])
(SENDRECIPIENTS
[LAMBDA (SOCKET RECIPIENTS) (* DECLARATIONS: (RECORD (#OFVALIDRECIPIENTS .
INVALIDRECIPIENTS)) (RECORD INVALIDRECIPIENT (RECIPIENT# . RECIPIENTNAME)))
(* bvm: " 4-Jan-84 15:37")
(PROG (VALIDITYRESULT)
(COND
[(LISTP RECIPIENTS)
(for R in RECIPIENTS do (GV.ADDRECIPIENT SOCKET R))
(SETQ VALIDITYRESULT (GV.CHECKVALIDITY SOCKET))
(COND
[(LISTP VALIDITYRESULT)
(COND
((EQLENGTH RECIPIENTS (fetch #OFVALIDRECIPIENTS of VALIDITYRESULT))
(* everything went OK *)
(RETURN VALIDITYRESULT))
(T (* GV didn't like some recipients *)
(MAPRINT [for RECIPIENT in (fetch INVALIDRECIPIENTS of VALIDITYRESULT)
collect (* The NTH is so it reports FOO not FOO.PA as returned
from CheckValidity *)
(CAR (NTH RECIPIENTS (fetch (INVALIDRECIPIENT RECIPIENT#)
of RECIPIENT]
PROMPTWINDOW
(CONSTANT (CONCAT LAFITEEOL "Unrecognized recipients: "))
NIL ", ")
(printout PROMPTWINDOW T "Please fix recipients and retry sending.")
(GO FAILED]
(T (printout T PROMPTWINDOW
"Something went wrong after sending recipients to the Grapevine."
T "reason: " VALIDITYRESULT)
(GO FAILED]
(T (printout PROMPTWINDOW T
"No recipients supplied -- please look at your message again.")))
FAILED (* Tell MS to abort this attempt to send a message *)
(* (ABORT) -- this should be a MAILCLIENT function. It isn't at the present time. I will put it in when I find out
what the opcode is to send to GV)
(RETURN NIL])
(PARSERECIPIENTS
[LAMBDA (FIELD REGISTRY INTERNALFLG) (* bvm: "19-Dec-83 17:52")
(LA.REMOVEDUPLICATES (COND
((LISTP FIELD)
(for PIECE in FIELD join (PARSERECIPIENTS1 PIECE REGISTRY INTERNALFLG)))
(T (PARSERECIPIENTS1 FIELD REGISTRY INTERNALFLG])
(PARSE.ARPA.ADDRESS
[LAMBDA (USER HOST INTERNALFLG) (* bvm: "27-Dec-83 10:57")
(COND
(INTERNALFLG (* if INTERNALFLG then build an arpanet address to send
to the GV -- otherwise build it for text in the messge
*)
(PACK* (PACK USER)
"@"
(COND
((MEMB (QUOTE %.)
HOST) (* is (FOO . ARPA) -- just get the FOO *)
(CAR HOST))
(T (PACK HOST)))
"." ARPANETGATEWAY.REGISTRY))
(T (PACK* (PACK USER)
"@"
(COND
((MEMB (QUOTE %.)
HOST) (* is (FOO . ARPA) -- just get the FOO *)
(CAR HOST))
(T (PACK HOST])
(PARSERECIPIENTS1
[LAMBDA (FIELD REGISTRY INTERNALFLG) (* bvm: " 1-Feb-84 14:46")
(PROG (FIELDSTREAM ADDRESSES ADDR TOKEN)
(COND
((NULL FIELD)
(RETURN)))
(SETQ FIELDSTREAM (OPENSTRINGSTREAM FIELD))
[SETFILEINFO FIELDSTREAM (QUOTE ENDOFSTREAMOP)
(FUNCTION (LAMBDA (STREAM) (* Terminate anything in progress)
(CHARCODE ,] (* first just collect all the atoms using a special
readtable *)
(SETQ ADDRESSES (when (SETQ ADDR (until (EQ (SETQ TOKEN (READ FIELDSTREAM
ADDRESSPARSERRDTBL))
(QUOTE ,))
when (PROGN (* Lists are comments)
(NLISTP TOKEN))
collect TOKEN))
collect ADDR repeatuntil (EOFP FIELDSTREAM)))
(RETURN (for ADDRESS in ADDRESSES bind ADDR LOCAL DOMAIN
collect (* ADDRESS will only get rebound if there is an address
with <>'s in it *)
[PROG ($$4 $$3) (* (match ADDRESS with ($ '< ADDRESS←$ '> $)))
(COND
([AND (SETQ $$3 (MEMB (QUOTE <)
ADDRESS))
(SETQ $$4 (MEMB (QUOTE >)
(CDR $$3]
(SETQ ADDRESS (LDIFF (CDR $$3)
$$4]
(COND
((match ADDRESS with (LOCAL←$
'@ DOMAIN←$)) (* have an ARPA Internet address *)
(PARSE.ARPA.ADDRESS LOCAL DOMAIN INTERNALFLG))
(T (* have Xerox Internet address *)
(COND
((MEMB (QUOTE %.)
ADDRESS)
(PACK ADDRESS))
(T (PACK* (PACK ADDRESS)
"."
(OR REGISTRY DEFAULTREGISTRY])
(COLLECTADDRESSES
[LAMBDA (FIELDS) (* M.Yonke " 3-JUN-83 17:12")
(* * FIELDS is a list of atoms and strings -- this function groups them into addresses and returns a list of
addresses -- each one a list of fields * *)
(PROG (ADDRESS REST) (* addresses are separated by commas *)
[SETQ ADDRESS (LDIFF FIELDS (SETQ REST (MEMB (QUOTE ,)
FIELDS]
(* get rid of the comma *)
(SETQ REST (CDR REST))
(RETURN (if (AND ADDRESS REST)
then (* just keep going *)
(CONS ADDRESS (COLLECTADDRESSES REST))
elseif (AND (NOT ADDRESS)
REST)
then (* there was a ", ," in the address or the list started
with a comma *)
(COLLECTADDRESSES REST)
elseif (AND ADDRESS (NOT REST))
then (* at the end *)
(LIST ADDRESS)
else NIL])
(MESSAGEEDITOR
[LAMBDA (MESSAGEFORM TITLE WINDOW) (* bvm: "24-Jan-84 13:10")
(* * Editor for Mail system Lafite -- Handles the process mechanism right * *)
(* * Assumes that it's running in a separate process created above * *)
(PROG (EDITWINDOW EDITRESULT MSGFILE)
(TTY.PROCESS (THIS.PROCESS)) (* Take control of the keyboard *)
(SETQ TITLE (OR TITLE "Message Editor")) (* first locate a window -- creating one if necessary *)
[SETQ EDITWINDOW (COND
((WINDOWP WINDOW))
[(NULL LAFITECURRENTEDITORWINDOWS) (* not currently editing -- use the main edit window *)
(COND
((WINDOWP PRIMARYEDITORWINDOW)
(CLEARW PRIMARYEDITORWINDOW)
PRIMARYEDITORWINDOW)
(T (* Create a window to do the editing in.)
(SETQ PRIMARYEDITORWINDOW (LAFITE.CREATE.EDITOR.WINDOW TITLE
(AND (type? REGION
LAFITEEDITORREGION)
LAFITEEDITORREGION]
[(find WINDOW in LAFITEEDITORWINDOWS suchthat (NOT (MEMB WINDOW
LAFITECURRENTEDITORWINDOWS]
(T (* editing already in progress -- create a new window *)
(LAFITE.CREATE.EDITOR.WINDOW TITLE]
(push LAFITECURRENTEDITORWINDOWS EDITWINDOW)
(replace (WINDOWPROP TITLE) of EDITWINDOW with TITLE)
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(FUNCTION LA.CLOSETEMPFILE)) (* don't let TEDIT close the window *)
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T))
(LA.CLOSETEMPFILE EDITWINDOW)
[COND
((AND (SETQ MSGFILE (fetch (WINDOWPROP MESSAGEFILE) of EDITWINDOW))
(NEQ MSGFILE MESSAGEFORM)
(LITATOM MSGFILE)) (* can delete this since it will be replaced by the new
message form *)
(COND
((DELFILE MSGFILE)
(SETQ \LAFITE.TEMPFILES (DREMOVE MSGFILE \LAFITE.TEMPFILES]
(replace (WINDOWPROP MESSAGEFILE) of EDITWINDOW with MESSAGEFORM)
(replace (WINDOWPROP PROCESS) of EDITWINDOW with (THIS.PROCESS))
(* Associate this process with the edit window *)
[RESETLST (RESETSAVE (LA.RESET.TEDIT.SYNTAX T))
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (WIN)
(COND
(RESETSTATE
(* something bad happened -- cleanup some *)
(WINDOWDELPROP WIN (QUOTE CLOSEFN)
(QUOTE DON'T))
(CLOSEW WIN)
(SETQ LAFITECURRENTEDITORWINDOWS
(REMOVE WIN LAFITECURRENTEDITORWINDOWS]
EDITWINDOW))
(SETQ EDITRESULT (TEDIT MESSAGEFORM EDITWINDOW T (LIST (QUOTE FONT)
LAFITEEDITORFONT]
(COND
((TTY.PROCESSP) (* give back the keyboard *)
(TTY.PROCESS T)))
(WINDOWDELPROP EDITWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T)) (* let the window close *)
(COND
((type? SENDINGCOMMAND EDITRESULT)
(replace (SENDINGCOMMAND MESSAGEWINDOW) of EDITRESULT with EDITWINDOW)
(RETURN EDITRESULT])
(LAFITE.CREATE.EDITOR.WINDOW
[LAMBDA (TITLE WINDOWSPEC) (* bvm: "30-Dec-83 11:39")
(* * Creates a new message editor window)
(PROG ((WINDOW (CREATEMENUEDWINDOW (create MENU
ITEMS ← LAFITESENDINGMENUITEMS
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION DOLAFITESENDINGCOMMAND))
TITLE
(QUOTE TOP)
WINDOWSPEC NIL LAFITEMENUFONT)))
(SETQ WINDOW WINDOW)
(push LAFITEEDITORWINDOWS WINDOW)
(RETURN WINDOW])
(LA.RESET.TEDIT.SYNTAX
[LAMBDA (FLG) (* bvm: "14-Dec-83 16:40")
(* * Make < and > be alphabetic, so that >>Message<< etc work. FLG is NIL to do it, the old codes to undo it)
(COND
(FLG (TEDIT.WORDSET (CHARCODE <)
(CAR FLG))
(TEDIT.WORDSET (CHARCODE >)
(CADR FLG))
NIL)
(T (PROG1 (LIST (TEDIT.WORDGET (CHARCODE >))
(TEDIT.WORDGET (CHARCODE <)))
(TEDIT.WORDSET (CHARCODE <)
(QUOTE TEXT))
(TEDIT.WORDSET (CHARCODE >)
(QUOTE TEXT])
(GRAYOUTWINDOW
[LAMBDA (WINDOW) (* M.Yonke "28-SEP-83 16:06")
(* * gray out a window using LIGHTWAVYSHADE * *)
(if (WINDOWP WINDOW)
then (DSPFILL NIL LIGHTWAVYSHADE (QUOTE PAINT)
WINDOW])
(BROWSERPROMPTPRINT
[LAMBDA FOLDER&ARGS (* bvm: "29-Dec-83 18:09")
(PROG ((MAILFOLDER (ARG FOLDER&ARGS 1))
WINDOW)
(SETQ WINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(CLEARW WINDOW)
(for I from 2 to FOLDER&ARGS do (PRIN3 (ARG FOLDER&ARGS I)
WINDOW))
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T])
(\LAFITE.MAYBE.CLEAR.PROMPT
[LAMBDA (MAILFOLDER) (* bvm: " 1-Feb-84 14:53")
(COND
((fetch (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER)
(CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with NIL])
(LA.CLOSETEMPFILE
[LAMBDA (WINDOW) (* M.Yonke "19-MAY-83 12:04")
(PROG (FILE)
(SETQ FILE (fetch (WINDOWPROP MESSAGEFILE) of WINDOW))
(if (AND FILE (NOT (STRINGP FILE))
(INFILEP FILE))
then (CLOSEF? FILE])
)
(* Browser display)
(DEFINEQ
(PRINTMESSAGESUMMARY
[LAMBDA (MSGDESCRIPTOR MAILFOLDER WINDOW) (* bvm: " 2-Feb-84 12:08")
(PROG (FROMSTR HERE THERE EXTENT MSG#)
(OR (fetch (LAFITEMSG PARSED?) of MSGDESCRIPTOR)
(LAFITE.PARSE.MSG.FOR.TOC MSGDESCRIPTOR MAILFOLDER))
(MOVETO 0 (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)
WINDOW)
(POSITION WINDOW 0)
(LA.SHOW.MARK MSGDESCRIPTOR MAILFOLDER)
(DSPXPOSITION [IPLUS (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER)
(TIMES (fetch (MAILFOLDER BROWSERDIGITWIDTH) of MAILFOLDER)
(COND
((ILESSP (SETQ MSG# (fetch (LAFITEMSG #) of MSGDESCRIPTOR))
10)
3)
((ILESSP MSG# 100)
2)
((ILESSP MSG# 1000)
1)
(T 0]
WINDOW) (* Ugh. Manually right-justify message # given that font
may be variable width)
(PRINTNUM (QUOTE (FIX 1))
MSG# WINDOW)
(DSPXPOSITION (fetch (MAILFOLDER DATEXPOS) of MAILFOLDER)
WINDOW)
(PRIN1 (OR (fetch (LAFITEMSG DATE) of MSGDESCRIPTOR)
UNSUPPLIEDFIELDSTR)
WINDOW)
(DSPXPOSITION (fetch (MAILFOLDER FROMXPOS) of MAILFOLDER)
WINDOW)
[COND
[(fetch (LAFITEMSG MSGFROMMEP) of MSGDESCRIPTOR)
(PRIN1 "To: " WINDOW)
(SETQ FROMSTR (OR (fetch (LAFITEMSG TO) of MSGDESCRIPTOR)
(LAFITE.FETCH.TO.FIELD MSGDESCRIPTOR MAILFOLDER]
(T (SETQ FROMSTR (OR (fetch (LAFITEMSG FROM) of MSGDESCRIPTOR)
UNSUPPLIEDFIELDSTR]
(PRIN1 FROMSTR WINDOW)
(COND
((IGREATERP (SETQ HERE (DSPXPOSITION NIL WINDOW))
(SETQ THERE (fetch (MAILFOLDER FROMMAXXPOS) of MAILFOLDER)))
(* Erase the overflow)
(DSPBACKUP (IDIFFERENCE HERE THERE)
WINDOW)))
(DSPXPOSITION (fetch (MAILFOLDER SUBJECTXPOS) of MAILFOLDER)
WINDOW)
(PRIN1 (OR (fetch (LAFITEMSG SUBJECT) of MSGDESCRIPTOR)
UNSUPPLIEDFIELDSTR)
WINDOW)
(printout WINDOW " [" .I1 (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR)
" chars]")
(* keep track of maximum width printed to. If header is allowed to print on two lines, $$MAXWIDTH$$ was set to
right margin by BUILDBROWSERMAP so this should not reset it.)
(COND
((ILESSP (fetch (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER)
(SETQ HERE (DSPXPOSITION NIL WINDOW)))
(replace (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER with HERE)
(replace (REGION WIDTH) of (SETQ EXTENT (fetch (MAILFOLDER BROWSEREXTENT) of MAILFOLDER)
)
with HERE)
(WINDOWPROP WINDOW (QUOTE EXTENT)
EXTENT)))
[COND
((fetch (LAFITEMSG SELECTED?) of MSGDESCRIPTOR)
(LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE]
(COND
((fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR)
(LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR WINDOW (QUOTE REPLACE])
(FIRSTVISIBLEMESSAGE
[LAMBDA (MAILFOLDER REGION) (* bvm: "22-Dec-83 12:15")
(* Computes number of the first message in MAILFOLDER
that is visible in REGION)
(IMAX 1 (IQUOTIENT (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
(IPLUS (fetch (REGION TOP) of REGION)
(fetch (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER)))
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER])
(LASTVISIBLEMESSAGE
[LAMBDA (MAILFOLDER REGION) (* bvm: "22-Dec-83 12:15")
(* Computes number of the last message in MAILFOLDER
that is visible in REGION)
(IMIN (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
(IQUOTIENT (IPLUS (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
(IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
(fetch (MAILFOLDER BROWSERFONTASCENT)
of MAILFOLDER)))
(SUB1 (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)))
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER])
(DISPLAYBROWSERLINES
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: "22-Dec-83 12:23")
(for MSG# from FIRST# to LAST#
bind (WINDOW ←(fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
do (PRINTMESSAGESUMMARY (NTHMESSAGE MESSAGES MSG#)
MAILFOLDER WINDOW])
(INSUREMESSAGEINBROWSERWINDOW
[LAMBDA (MAILFOLDER MSGDESCRIPTOR) (* bvm: "24-Dec-83 19:00")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(YPOS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER))
CLIPREGION)
(COND
((OR (IGREATERP (fetch (REGION BOTTOM) of (SETQ CLIPREGION (DSPCLIPPINGREGION NIL WINDOW))
)
YPOS)
(ILESSP (fetch (REGION TOP) of CLIPREGION)
YPOS))
(SCROLLBYREPAINTFN WINDOW 0 (IPLUS (fetch (REGION BOTTOM) of CLIPREGION)
(IQUOTIENT (fetch (REGION HEIGHT) of CLIPREGION)
2)
(IMINUS YPOS])
(UNSELECTALLMESSAGES
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 16:21")
(for N from (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER) to (fetch LASTSELECTEDMESSAGE
of MAILFOLDER)
bind (MESSAGES ←(fetch MESSAGEDESCRIPTORS of MAILFOLDER))
do (LA.DESELECTRANGE MAILFOLDER N N)
(LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES N)
(QUOTE ERASE])
(SELECTMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "15-Feb-84 12:34")
(PROG ((N (fetch (LAFITEMSG #) of MSGDESCRIPTOR)))
(LA.SELECTRANGE MAILFOLDER N N T)
(LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE])
(MARKMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER MARK) (* bvm: "21-Feb-84 17:11")
(* * Changes the mark byte of MSGDESCRIPTOR to be MARK. This may also imply something about SEEN?)
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG MARKFILEPTR)
of MSGDESCRIPTOR)
MARK))
(replace (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR with MARK)
(replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with (NEQ MARK UNSEENMARK))
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(LA.SHOW.MARK MSGDESCRIPTOR MAILFOLDER])
(CHANGEFLAGINFOLDER
[LAMBDA (MAILFOLDER PTR FLAG) (* bvm: "27-Dec-83 17:32")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG [(STREAM (OPENMAILFOLDER MAILFOLDER (QUOTE OUTPUT]
(SETFILEPTR STREAM PTR)
(BOUT STREAM FLAG])
(LA.SHOW.MARK
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "17-Feb-84 15:34")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(YPOS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER))
(MARK (fetch (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR)))
(LA.BLT.MARK.BOX MAILFOLDER WINDOW YPOS (QUOTE REPLACE)
WHITESHADE) (* Erase whatever's there)
(COND
((NEQ MARK (CHARCODE SPACE))
(MOVETO BROWSERMARKXPOSITION YPOS WINDOW)
(BOUT WINDOW MARK])
(LA.INVERT.MARK.BOX
[LAMBDA (MAILFOLDER MSG#) (* bvm: "17-Feb-84 14:44")
(LA.BLT.MARK.BOX MAILFOLDER (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)
(MESSAGE#.TO.YPOS (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of MAILFOLDER)
MSG#)
MAILFOLDER)
(QUOTE INVERT)
BLACKSHADE])
(LA.BLT.MARK.BOX
[LAMBDA (MAILFOLDER WINDOW YPOS OPERATION TEXTURE) (* bvm: "17-Feb-84 14:21")
(BITBLT NIL NIL NIL WINDOW BROWSERMARKXPOSITION (IDIFFERENCE YPOS (fetch (MAILFOLDER
BROWSERFONTDESCENT)
of MAILFOLDER))
(IDIFFERENCE (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER)
BROWSERMARKXPOSITION)
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)
(QUOTE TEXTURE)
OPERATION TEXTURE])
(LA.SHOW.DELETION
[LAMBDA (MAILFOLDER MSGDESCRIPTOR WINDOW OPERATION) (* bvm: " 2-Feb-84 12:40")
(* * Draws or erases, for OPERATION = REPLACE or ERASE, the line indicating that MSGDESCRIPTOR is deleted)
(BITBLT NIL 0 0 WINDOW BROWSERMARKXPOSITION (IDIFFERENCE (IPLUS (MESSAGE#.TO.YPOS MSGDESCRIPTOR
MAILFOLDER)
(LRSH (fetch (MAILFOLDER
BROWSERFONTASCENT)
of MAILFOLDER)
1))
(LRSH LAFITEDELETEDLINEHEIGHT 1))
NIL LAFITEDELETEDLINEHEIGHT (QUOTE TEXTURE)
OPERATION BLACKSHADE])
(LA.SHOW.SELECTION
[LAMBDA (MAILFOLDER MSGDESCRIPTOR OPERATION) (* bvm: " 2-Feb-84 12:37")
(* * Displays or erases, per OPERATION = REPLACE or ERASE, the mark indicating that MSGDESCRIPTOR is selected)
(BITBLT LA.SELECTION.BITMAP 0 0 (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)
0
(IPLUS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)
(LRSH (fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER)
1)
-5)
NIL NIL (QUOTE INPUT)
OPERATION])
(SEENMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: " 3-Jan-84 17:10")
(* * causes the "seen character" -- as opposed to the "seen mark" -- to be changed to "S" on the file * *)
(COND
((NULL (fetch (LAFITEMSG SEEN?) of MSGDESCRIPTOR))
(replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with T)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(* write it out on the file *)
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG SEENFILEPTR)
of MSGDESCRIPTOR)
SEENFLAG))
(* only change the mark if it was ? -- it might already
be something more meaningful like an answer mark *)
(COND
((EQ (fetch (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR)
UNSEENMARK)
(MARKMESSAGE MSGDESCRIPTOR MAILFOLDER SEENMARK])
(DELETEMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "26-Jan-84 16:02")
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG DELETEFILEPTR)
of MSGDESCRIPTOR)
DELETEDFLAG))
(replace (LAFITEMSG DELETED?) of MSGDESCRIPTOR with T)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER with T)
(LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)
(QUOTE REPLACE])
(UNDELETEMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "26-Jan-84 16:00")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)))
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG
DELETEFILEPTR)
of MSGDESCRIPTOR)
UNDELETEDFLAG))
(replace (LAFITEMSG DELETED?) of MSGDESCRIPTOR with NIL)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR WINDOW (QUOTE ERASE))
(* undeleted; reprint the header.)
(PRINTMESSAGESUMMARY MSGDESCRIPTOR MAILFOLDER WINDOW])
)
(* Parsing mail files)
(DEFINEQ
(PARSEMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: " 5-Jan-84 12:16")
(PROG ((STREAM (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT)
(QUOTE OLD)))
MESSAGES END)
(SETQ END (GETEOFPTR STREAM))
(RETURN (COND
((OR (ZEROP END)
(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 FOLDERNEEDSUPDATE) of MAILFOLDER
with (NOT (NULL MESSAGES)))
(replace (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER with END)
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with 0)
(replace (MAILFOLDER BROWSERREADY) of MAILFOLDER with T)
MAILFOLDER)
(T (CLOSEMAILFOLDER MAILFOLDER T)
NIL])
(PARSEMAILFOLDER1
[LAMBDA (MAILFOLDER STREAM EOFPTR START FIRSTMSG# NOERROR)
(* bvm: "12-Jan-84 16:02")
(* * 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)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Parsing "
(COND
((ZEROP START)
"folder")
(T "additional msgs"))
(QUOTE ...))
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
(bind CHCOUNT STAMPCOUNT MARK SEEN STARTFLG DELETED LASTMSG (HERE ← START) for MSG# from
FIRSTMSG#
while (ILESSP HERE EOFPTR)
collect (SETFILEPTR STREAM HERE)
(* * the format of the stamp field of a laurel message is -
(*stamp* <c.r.> <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> <c.r.>) -
U.or.D is Undeleted or Deleted -
S.or.U is Seen or Unseen * *)
[COND
((AND (LA.READSTAMP STREAM)
(SETQ CHCOUNT (LA.READCOUNT STREAM))
(SETQ STAMPCOUNT (LA.READCOUNT STREAM))
(IGEQ 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))
finally [COND
((NOT (IEQP HERE EOFPTR))
(BROWSERPROMPTPRINT MAILFOLDER "Warning: last message truncated from "
(fetch (LAFITEMSG MESSAGELENGTH) of LASTMSG)
" to "
(replace (LAFITEMSG MESSAGELENGTH) of LASTMSG
with (IDIFFERENCE (fetch (LAFITEMSG MESSAGELENGTH)
of LASTMSG)
(IDIFFERENCE HERE EOFPTR)))
" bytes. ")
(replace (LAFITEMSG MESSAGELENGTHCHANGED?) of LASTMSG with (replace (LAFITEMSG
MARKSCHANGED?)
of LASTMSG
with T]
(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: " 5-Jan-84 12:11")
(PROGN (printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
" [at msg " .P2 MSG# ": bad flag byte] ")
NIL])
(VERIFYMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "16-Jan-84 12:11")
(DECLARE (SPECVARS MSG# MSG HERE CHCOUNT))
[COND
((NOT (type? MAILFOLDER MAILFOLDER))
(SETQ MAILFOLDER (\DTEST (COND
((WINDOWP MAILFOLDER)
(WINDOWPROP MAILFOLDER (QUOTE MAILFOLDER)))
((LITATOM MAILFOLDER)
(\LAFITE.GETMAILFOLDER MAILFOLDER)))
(QUOTE MAILFOLDER]
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG (STREAM END)
(SETQ STREAM (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT)
(QUOTE OLD)))
(OR (IEQP (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 (ILESSP HERE END)
do (SETFILEPTR STREAM HERE)
[COND
((IGREATERP MSG# LASTMSG#)
(RETURN (VERIFYFAILED "More messages in file than in core"]
(SETQ MSG (NTHMESSAGE MESSAGES MSG#))
(* * the format of the stamp field of a laurel message is -
(*stamp* <c.r.> <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> <c.r.>) -
U.or.D is Undeleted or Deleted -
S.or.U is Seen or Unseen * *)
(COND
((NOT (IEQP (fetch (LAFITEMSG BEGIN) of MSG)
HERE))
(VERIFYFAILED "Message beginning pointer wrong"))
((NOT (LA.READSTAMP STREAM))
(VERIFYFAILED "Bad Stamp"))
([OR (NOT (SETQ CHCOUNT (LA.READCOUNT STREAM)))
(NOT (IEQP CHCOUNT (fetch (LAFITEMSG MESSAGELENGTH)
of MSG]
(VERIFYFAILED "Bad Message Length"))
([OR (NOT (SETQ STAMPCOUNT (LA.READCOUNT STREAM)))
(NOT (IEQP STAMPCOUNT (fetch (LAFITEMSG STAMPLENGTH)
of MSG]
(VERIFYFAILED "Bad Message Length"))
((fetch (LAFITEMSG MARKSCHANGED?) of MSG))
((NOT (EQ (SELECTC (BIN STREAM)
(UNDELETEDFLAG NIL)
(DELETEDFLAG T)
(QUOTE ?))
(fetch (LAFITEMSG DELETED?) of MSG)))
(VERIFYFAILED "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 "Disagreement in seen mark"))
([NOT (OR (EQ (SETQ MARK (BIN STREAM))
(fetch (LAFITEMSG MARKCHAR) of MSG))
(NOT (fetch (LAFITEMSG SEEN?) of MSG]
(VERIFYFAILED "Disagreement in mark byte")))
(add HERE CHCOUNT)
finally (COND
((NOT (IEQP HERE END))
(VERIFYFAILED "Last message too short"]
(RETURN T])
(VERIFYFAILED
[LAMBDA (ERRMSG) (* bvm: "28-Dec-83 16:14")
(DECLARE (USEDFREE MSG#))
(HELP (CONCAT "Error in message " MSG# ": ")
ERRMSG])
(READTOCFILE
[LAMBDA (MAILFOLDER TOCFILE) (* bvm: "22-Feb-84 12:34")
(* * Read TOCFILE into MAILFOLDER)
(* * Format of TOCFILE -
-
<LafitePassword word> <LafiteVersion word> -
<EOF of mailfile integer> -
<last msg# in toc word> -
-
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 (printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Reading table of contents...")
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
(PROG ([TOCSTREAM (OPENSTREAM TOCFILE (QUOTE INPUT)
(QUOTE OLD)
NIL
(QUOTE ((ENDOFSTREAMOP \LAFITE.TOCEOF]
(FOLDERSTREAM (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT)))
(MSGCOUNTGUESS 0)
END FOLDEREOFPTR MESSAGES EXTRAMESSAGES LASTMSG# READMORE TOCVERSION
OLDTOCFORMAT)
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
TOCSTREAM))
(WHENCLOSE TOCSTREAM (QUOTE CLOSEALL)
(QUOTE NO))
(SETFILEPTR TOCSTREAM 0) (* Just in case it was already open)
[COND
((OR (NEQ (WORDIN TOCSTREAM)
LAFITETOCPASSWORD)
(NEQ (SETQ TOCVERSION (WORDIN TOCSTREAM))
LAFITEVERSION#))
(COND
((EQ TOCVERSION 8) (* A slightly different format, still readable)
(printout (fetch BROWSERPROMPTWINDOW of MAILFOLDER)
"(older format)")
(SETQ OLDTOCFORMAT T))
(T (RETURN (BADTOCFILE "Format obsolete, discarding..."]
[COND
([NOT (IEQP (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 (IDIFFERENCE 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
((ZEROP (SETQ LENGTH (BIN TOCSTREAM)))
(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 (IMINUS (IDIFFERENCE
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)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
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]
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER
with T))
(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 BROWSERREADY) of MAILFOLDER with T)
(RETURN T])
(BADTOCFILE
[LAMBDA (ERRMSG CLEARFLG)
(DECLARE (USEDFREE MAILFOLDER TOCSTREAM)) (* bvm: "20-Feb-84 12:41")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)))
(COND
(CLEARFLG (CLEARW WINDOW)))
(printout WINDOW ERRMSG)
(COND
(LAFITEDEBUGFLG (HELP "TOC file error" ERRMSG)))
(DELFILE (CLOSEF TOCSTREAM))
(RETURN 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 MAILFOLDER) (* bvm: "31-Dec-83 19:12")
(PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER)))
(SETFILEPTR STREAM (fetch (LAFITEMSG BEGIN) of MSG))
(OR (LA.READSTAMP STREAM)
(HELP "Lafite is confused about start of message" MSG])
(LA.MSGFROMMEP
[LAMBDA (MSG) (* bvm: "26-Jan-84 16:17")
(PROG ((SENDER (fetch (LAFITEMSG FROM) of MSG))
(ME (FULLUSERNAME)))
(RETURN (replace (LAFITEMSG MSGFROMMEP) of MSG with (OR (UCASE.STREQUAL SENDER ME)
(UCASE.STREQUAL SENDER
(GETSIMPLENAME
ME])
(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) (* bvm: "28-Dec-83 11:42")
(* * Read from STREAM a string written by LA.PRINTSHORTSTRING whose length is stored as the first byte.)
(PROG ((NBYTES (BIN STREAM)))
(RETURN (AND (NEQ NBYTES 0)
(LA.READSTRING STREAM NBYTES])
(LA.PRINTSHORTSTRING
[LAMBDA (STREAM STRING) (* bvm: "28-Dec-83 14:00")
(COND
((NULL STRING)
(BOUT STREAM 0)
1)
(T (PROG ((NBYTES (NCHARS STRING)))
(COND
((IGREATERP NBYTES 255)
(SETQ STRING (SUBSTRING STRING 1 255))
(SETQ NBYTES 255)))
(BOUT STREAM NBYTES)
(PRIN3 STRING STREAM)
(RETURN (ADD1 NBYTES])
(LA.READSTRING
[LAMBDA (STREAM NBYTES) (* bvm: "28-Dec-83 14:40")
(* * Returns a string of length NBYTES composed of the next NBYTES characters of STREAM)
(PROG ((STR (ALLOCSTRING NBYTES))
BASE OFFSET)
(for I from 0 to (SUB1 NBYTES)
bind (BASE ←(fetch (STRINGP BASE) of STR))
(OFFSET ←(fetch (STRINGP OFFST) of STR))
do (\PUTBASEBYTE BASE (IPLUS I OFFSET)
(BIN STREAM)))
(RETURN STR])
)
(DEFINEQ
(LAFITE.PARSE.MSG.FOR.TOC
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "20-Feb-84 12:35")
(COND
((NULL (fetch (LAFITEMSG PARSED?) of MSGDESCRIPTOR))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG [(FOLDERSTREAM (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT]
(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)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER
with T])
(LAFITE.FETCH.TO.FIELD
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "31-Dec-83 17:20")
(* 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 (OPENMAILFOLDER MAILFOLDER (QUOTE INPUT))
\LAPARSE.TOFIELD
(fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR)
T)
UNSUPPLIEDFIELDSTR])
(LAFITE.PARSE.HEADER
[LAMBDA (STREAM PARSETABLE START END ONCEONLY) (* bvm: "19-Dec-83 15:15")
(DECLARE (SPECVARS PARSERESULT)) (* For Parse result functions to access)
(PROG (PARSERESULT TABLE CH CHOICE)
(COND
(START (SETFILEPTR STREAM START)))
TOP (SETQ TABLE PARSETABLE)
LP [SELECTQ (CAR TABLE)
[CHOICE (SETQ CH (UCASECODE (BIN 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)
(APPLY* (CAR TABLE)
STREAM
(CDR TABLE))
(COND
(ONCEONLY (RETURN PARSERESULT))
(T (GO TOP]
(STOP (RETURN PARSERESULT))
(COND
((EQ (SETQ CH (UCASECODE (BIN STREAM)))
(CAR TABLE))
(SETQ TABLE (CDR TABLE))
(GO LP]
(* * Get here if parse of current line failed)
(COND
((AND END (IGEQ (GETFILEPTR STREAM)
END))
(RETURN PARSERESULT)))
[COND
((NEQ CH (CHARCODE EOL))
(SETQ CH (LAFITE.SKIP.TO.EOL STREAM]
(GO TOP])
(LAFITE.GRAB.DATE
[LAMBDA (STREAM) (* bvm: "20-Dec-83 17:44")
(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 (ILEQ CH (CHARCODE 9))
(IGEQ 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: "16-Feb-84 12:34")
(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)) (* bvm: "20-Dec-83 10:49")
(PROG ((FIELD (CAR ARGS))
LINELIST LINE)
[SETQ LINELIST (collect (PROG1 (SETQ LINE (RSTRING STREAM LINEPARSERRDTBL))
(READC STREAM))
repeatwhile (do (SELCHARQ (NTHCHARCODE LINE -1)
((SPACE TAB)
(* Strip off trailing spaces)
(GLC LINE))
(, (* Line terminating in comma continues on next line)
(GLC LINE)
(RETURN (SELCHARQ (\PEEKBIN STREAM)
((SPACE TAB)
(LAFITE.SKIP.WHITE.SPACE
STREAM)
T)
NIL)))
(RETURN NIL]
(for PAIR in PARSERESULT when (EQ (CAR PAIR)
FIELD)
do (RETURN (NCONC PAIR LINELIST)) finally (push PARSERESULT (CONS FIELD LINELIST])
(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) (* bvm: "19-Dec-83 12:18")
(PROG1 (RSTRING STREAM LINEPARSERRDTBL)
(READC STREAM])
(LAFITE.SKIP.TO.EOL
[LAMBDA (STREAM) (* bvm: "19-Dec-83 13:00")
(* * Skips ahead to end of line and eats and returns the end of line character. Probably should do something here
about EOL conventions)
(bind CH repeatwhile (NEQ (BIN STREAM)
(CHARCODE EOL))
finally (RETURN CH])
(LAFITE.SKIP.WHITE.SPACE
[LAMBDA (STREAM) (* bvm: "19-Dec-83 12:35")
(do (SELCHARQ (\PEEKBIN STREAM)
((SPACE TAB)
(BIN STREAM))
(RETURN])
)
(RPAQQ 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)
("TO:" LAFITE.READ.NAME.FIELD TO)
("CC:" LAFITE.READ.NAME.FIELD CC)
("FORMAT:" LAFITE.READ.FORMAT)))
(RPAQQ TOCFIELDS (("DATE:" LAFITE.GRAB.DATE)
("FROM:" LAFITE.READ.LINE.FOR.TOC FROM)
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC SUBJECT)
("FORMAT:" LAFITE.READ.FORMAT)))
(RPAQQ TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
(DEFINEQ
(LAFITE.INIT.PARSETABLES
[LAMBDA NIL (* bvm: "24-Dec-83 19:21")
(SETQ \LAPARSE.FULL (LAFITE.MAKE.PARSE.TABLE FULLPARSEFIELDS))
(SETQ \LAPARSE.TOCFIELDS (LAFITE.MAKE.PARSE.TABLE TOCFIELDS))
(SETQ \LAPARSE.TOFIELD (LAFITE.MAKE.PARSE.TABLE TOFIELDONLY))
(PROGN (SETQ LINEPARSERRDTBL (COPYREADTABLE (QUOTE ORIG)))
(* first make a read table with no breaks and seperators
*)
(for CH in (GETSEPR LINEPARSERRDTBL) do (SETSYNTAX CH (QUOTE OTHER)
LINEPARSERRDTBL))
(for CH in (GETBRK LINEPARSERRDTBL) do (SETSYNTAX CH (QUOTE OTHER)
LINEPARSERRDTBL))
(* % is not ESCAPE -- just a regular char *)
(SETSYNTAX (QUOTE %%)
(QUOTE OTHER)
LINEPARSERRDTBL))
(SETQ ADDRESSPARSERRDTBL (COPYREADTABLE LINEPARSERRDTBL))
(PROGN
(* * make a readtable whose only sepr char is <c.r.> and no break chars * *)
(SETSYNTAX (CHARCODE CR)
(QUOTE SEPRCHAR)
LINEPARSERRDTBL))
(PROGN
(* * set the character syntax right for parsing address lines and address in the lines * *)
(SETSYNTAX (CHARCODE SP)
(QUOTE SEPRCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (CHARCODE TAB)
(QUOTE SEPRCHAR)
ADDRESSPARSERRDTBL) (* "," separates addresses *)
(SETSYNTAX (QUOTE ,)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* "@" separates local-part from domain *)
(SETSYNTAX (QUOTE @)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE %.)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* if "<" is present in an address then the text between
"<" and ">" is the real address -- what BS *)
(SETSYNTAX (QUOTE <)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE >)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* "\" is the "don't interpret the next char" char *)
(SETSYNTAX (QUOTE \)
(QUOTE ESCAPE)
ADDRESSPARSERRDTBL) (* ";" and ":" have to do with private distributions
lists -- don't know when I'll get around to really
recognizing them *)
(SETSYNTAX (QUOTE ;)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE :)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* comments are enclosed in parens -- will just throw
out lists in the parser *)
(SETSYNTAX (QUOTE %()
(QUOTE ORIG)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE %))
(QUOTE ORIG)
ADDRESSPARSERRDTBL) (* make strings strings -- thank god *)
(SETSYNTAX (QUOTE %")
(QUOTE ORIG)
ADDRESSPARSERRDTBL) (* for "local-domains" -- e.g. "[0.1.23.45]" -- not
recommended *)
(SETSYNTAX (QUOTE %[)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE %])
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL])
(LAFITE.MAKE.PARSE.TABLE
[LAMBDA (TABLE) (* bvm: "19-Dec-83 15:12")
(* * Take a list of entries (string resultfn resultargs) and make a table usable by LAFITE.PARSE.HEADER)
(PROG ((PARSETABLE (LAFITE.MAKE.PARSE.TABLE1 TABLE 1)))
(RETURN (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])
)
(MOVD? (QUOTE EVQ)
(QUOTE FIXTHIS))
(* Low level file functions)
(DEFINEQ
(\LAFITE.WRITE.PROFILE
[LAMBDA NIL (* bvm: "13-Jan-84 10:58")
(PROG ((PROFILEFILE (PROFILEFILENAME)))
(WITH.MONITOR \LAFITE.PROFILELOCK (SETQ PROFILEFILE (OPENFILE PROFILEFILE (QUOTE OUTPUT)
(QUOTE NEW)))
(PRIN2 LAFITEMAILFOLDERS PROFILEFILE)
(PRIN1 " " PROFILEFILE)
(PRIN2 LAFITEFORMFILES PROFILEFILE)
(CLOSEF PROFILEFILE))
(SETQ \LAFITEPROFILECHANGED])
(\LAFITE.READ.PROFILE
[LAMBDA NIL (* bvm: " 6-Jan-84 11:16")
(PROG ((PROFILEFILE (PROFILEFILENAME))
NEWFILES)
(SETQ \LAFITEPROFILECHANGED)
(COND
[(INFILEP PROFILEFILE) (* read in the profile file *)
(WITH.MONITOR \LAFITE.PROFILELOCK (OPENFILE PROFILEFILE (QUOTE INPUT))
(SETQ LAFITEMAILFOLDERS (READ PROFILEFILE))
(SETQ LAFITEFORMFILES (READ PROFILEFILE))
(CLOSEF PROFILEFILE))
(COND
((NEQ (CAR LAFITEMAILFOLDERS)
(fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR))
(* Old format)
[SETQ LAFITEMAILFOLDERS (CONS (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)
(for FILE in LAFITEMAILFOLDERS
collect (LA.SHORTFILENAME FILE LAFITEMAIL.EXT]
(SETQ \LAFITEPROFILECHANGED T)))
(COND
([NOT (EQUAL (CDR LAFITEMAILFOLDERS)
(SETQ NEWFILES (COLLECTOLDFILES (CDR LAFITEMAILFOLDERS)
LAFITEMAIL.EXT]
(RPLACD LAFITEMAILFOLDERS NEWFILES)
(SETQ LAFITEFOLDERSMENU)
(SETQ \LAFITEPROFILECHANGED T)))
(COND
([NOT (EQUAL LAFITEFORMFILES (SETQ LAFITEFORMFILES (COLLECTOLDFILES LAFITEFORMFILES
LAFITEFORM.EXT]
(SETQ LAFITEFORMSMENU)
(SETQ \LAFITEPROFILECHANGED T]
(T (SETQ LAFITEMAILFOLDERS (CONS (fetch PACKEDHOST&DIR of \LAFITEDEFAULTHOST&DIR)
(SETQ LAFITEFORMFILES NIL])
(DELETEMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "21-Feb-84 14:55")
(* * deletes the associated files and tells Lafite to forget about that mail file * *)
(PROG (FILE)
(FORGETMAILFILE (OR (fetch (MAILFOLDER SHORTFOLDERNAME) of MAILFOLDER)
(LA.SHORTFILENAME (fetch (MAILFOLDER VERSIONLESSFOLDERNAME)
of MAILFOLDER)
LAFITEMAIL.EXT)))
(CLOSEF? (SETQ FILE (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER)))
(DELFILE FILE)
(SETQ FILE (TOCFILENAME FILE))
(CLOSEF? FILE)
(DELFILE FILE])
(FORGETMAILFILE
[LAMBDA (FILENAME) (* bvm: "21-Feb-84 14:55")
(* * removes FILENAME from the list of known mail files and invalidates the menu cache)
(SETQ LAFITEMAILFOLDERS (DREMOVE FILENAME LAFITEMAILFOLDERS))
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFOLDERSMENU])
(\LAFITE.UNCACHE.FOLDER
[LAMBDA (ITEM MENU) (* bvm: "21-Feb-84 14:58")
(PROG [(FOLDER (MENU (OR LAFITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU]
(COND
(FOLDER (FORGETMAILFILE FOLDER)
(printout PROMPTWINDOW T FOLDER " forgotten."])
(\LAFITE.UNCACHE.MESSAGEFORM
[LAMBDA (ITEM MENU) (* bvm: "21-Feb-84 15:14")
(PROG (FORM)
(COND
((NULL LAFITEFORMFILES)
(printout PROMPTWINDOW T "You have no private message forms"))
((SETQ FORM (MENU (create MENU
ITEMS ←(MAKELAFITEPRIVATEFORMSITEMS
"Forget about this message form")
TITLE ← "Private Forms"
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T)))
(SETQ LAFITEFORMFILES (DREMOVE FORM LAFITEFORMFILES))
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFORMSMENU)
(printout PROMPTWINDOW T FORM " forgotten."])
(OPENMAILFOLDER
[LAMBDA (FOLDER ACCESS RECOG) (* bvm: "12-Jan-84 15:12")
(* * For Interlisp-D its too inefficient to keep opening and closing the mail file so we will keep it open -
If the file wants to be open for INPUT do just that -- it may want to be a read-only mail file -- otherwise open
it for BOTH -
FILE is always a fully qualified file name * *)
(PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER))
[DESIREDACCESS (COND
((EQ ACCESS (QUOTE INPUT))
ACCESS)
(T (QUOTE BOTH]
FILE)
(RETURN (COND
((AND STREAM (OPENP STREAM DESIREDACCESS))
STREAM)
(T (SETQ FILE (\LAFITE.OPENSTREAM (OR [COND
(STREAM
(* Have to close file to reopen for BOTH)
(PROG1 (AND (OPENP STREAM)
(CLOSEF STREAM))
(replace (MAILFOLDER
FOLDERSTREAM)
of FOLDER with NIL]
(fetch (MAILFOLDER FULLFOLDERNAME)
of FOLDER))
DESIREDACCESS RECOG (fetch (MAILFOLDER
BROWSERWINDOW)
of FOLDER)))
(AND (EQ DESIREDACCESS (QUOTE BOTH))
(LINELENGTH MAX.SMALLP FILE)) (* So that LA.PRINTCOUNT won't introduce CR's.
Would be nice if PRINTNUM could be give a PRIN3 mode)
(replace (MAILFOLDER FOLDERSTREAM) of FOLDER with FILE])
(\LAFITE.OPENSTREAM
[LAMBDA (FILE ACCESS RECOG BIGBUFS) (* bvm: " 6-Jan-84 12:24")
[SETQ FILE (OPENSTREAM FILE ACCESS RECOG NIL (CONS (QUOTE (ENDOFSTREAMOP \LAFITE.EOF))
(AND BIGBUFS (LIST (LIST (QUOTE BUFFERS)
LAFITEBUFFERSIZE]
(WHENCLOSE FILE (QUOTE CLOSEALL)
(QUOTE NO))
FILE])
(\LAFITE.EOF
[LAMBDA (STREAM) (* bvm: "27-Dec-83 12:05")
(* End of stream op for Lafite mail folders.
Return endless CR's so that parses eventually stop)
(CHARCODE CR])
(CLOSEMAILFOLDER
[LAMBDA (MAILFOLDER REALLYP) (* bvm: "12-Jan-84 15:13")
(* * This is the companion to OPENMAILFILE)
(PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER)))
(RETURN (COND
((NULL STREAM)
NIL)
(REALLYP (PROG1 (AND (OPENP STREAM)
(CLOSEF STREAM))
(replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER with NIL)))
((OPENP STREAM (QUOTE OUTPUT))
(FLUSHOUTPUT STREAM)
(fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER])
(PROMPTFORFILENAME
[LAMBDA (WINDOW) (* bvm: "26-Jan-84 16:12")
(RESETLST (PROG ((PROMPT "Filename (CR to abort): "))
(RESETSAVE NIL
(LIST (COND
(WINDOW (FUNCTION CLEARW))
(T [SETQ WINDOW
(PROG ((FONT (DEFAULTFONT (QUOTE DISPLAY)))
WIDTH HEIGHT)
[SETQ WIDTH
(WIDTHIFWINDOW (IPLUS (STRINGWIDTH PROMPT FONT)
(ITIMES
50
(CHARWIDTH (CHARCODE
A)
FONT]
[SETQ HEIGHT (HEIGHTIFWINDOW (FONTPROP
FONT
(QUOTE HEIGHT]
(RETURN (CREATEW (create REGION
LEFT ←(IMIN LASTMOUSEX
(IDIFFERENCE
SCREENWIDTH
WIDTH))
BOTTOM ←(IMIN
LASTMOUSEY
(IDIFFERENCE
SCREENHEIGHT
HEIGHT))
WIDTH ← WIDTH
HEIGHT ← HEIGHT]
(FUNCTION CLOSEW)))
WINDOW))
(RETURN (PROMPTFORWORD PROMPT NIL NIL WINDOW])
(\LAFITE.PROMPTFORFOLDER
[LAMBDA (WINDOW) (* bvm: "27-Dec-83 19:12")
(PROG [(FILE (MENU (OR LAFITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU]
(RETURN (SELECTQ FILE
(NIL NIL)
(##ANOTHERFILE## (PROMPTFORFILENAME WINDOW))
FILE])
(MAILFOLDERBUSY
[LAMBDA (MAILFOLDER) (* bvm: "29-Dec-83 18:11")
(RESETFORM (CURSOR LA.CROSSCURSOR)
(BLOCK LAFITEBUSYWAITTIME])
(LA.LONGFILENAME
[LAMBDA (FILENAME EXT) (* DECLARATIONS: (PROPRECORD
(HOST DIRECTORY EXTENSION)))
(* bvm: " 2-Jan-84 15:56")
(* * Composes a (nearly) full-specified filename, filling in defaults from \LAFITEDEFAULTHOST&DIR)
(PROG (FILEFIELDS GIVENHOST GIVENDIR)
(OR FILENAME (RETURN))
(SETQ FILEFIELDS (UNPACKFILENAME FILENAME))
(SETQ GIVENHOST (fetch HOST of FILEFIELDS))
(SETQ GIVENDIR (fetch DIRECTORY of FILEFIELDS))
[COND
((OR (NULL GIVENHOST)
GIVENDIR)
[COND
((NULL GIVENHOST)
(replace HOST of FILEFIELDS with (fetch DEFAULTHOST of \LAFITEDEFAULTHOST&DIR]
(COND
((NULL GIVENDIR)
(replace DIRECTORY of FILEFIELDS with (fetch DEFAULTDIR of \LAFITEDEFAULTHOST&DIR]
(COND
((NULL (fetch EXTENSION of FILEFIELDS))
(replace EXTENSION of FILEFIELDS with EXT)))
(RETURN (PACKFILENAME FILEFIELDS])
(PROFILEFILENAME
[LAMBDA NIL (* bvm: " 2-Jan-84 15:57")
(PACKFILENAME (QUOTE HOST)
(fetch DEFAULTHOST of \LAFITEDEFAULTHOST&DIR)
(QUOTE DIRECTORY)
(fetch DEFAULTDIR of \LAFITEDEFAULTHOST&DIR)
(QUOTE NAME)
LAFITEPROFILE.NAME
(QUOTE EXTENSION)
LAFITEPROFILE.EXT
(QUOTE VERSION)
1])
(TOCFILENAME
[LAMBDA (MAILFILE) (* M.Yonke "12-APR-83 12:44")
(if MAILFILE
then (PACKFILENAME (QUOTE EXTENSION)
(CONCAT (FILENAMEFIELD MAILFILE (QUOTE EXTENSION))
LAFITETOC.EXT)
(QUOTE BODY)
MAILFILE])
(LA.SHORTFILENAME
[LAMBDA (FILE EXT KEEPVERSIONFLG) (* DECLARATIONS: (PROPRECORD
(HOST DEVICE DIRECTORY EXTENSION VERSION)))
(* bvm: " 6-Jan-84 11:02")
(* * returns that shortest file name that is compatible with \LAFITEDEFAULTHOST&DIR and EXT and no version number
-- the result is used in menu creation * *)
(COND
(FILE (PROG [(FILEFIELDS (COND
((LISTP FILE) (* Already unpacked)
(APPEND FILE))
(T (UNPACKFILENAME FILE]
(COND
((EQ (fetch HOST of FILEFIELDS)
(fetch DEFAULTHOST of \LAFITEDEFAULTHOST&DIR))
(replace HOST of FILEFIELDS with NIL)))
(COND
((EQ (fetch DIRECTORY of FILEFIELDS)
(fetch DEFAULTDIR of \LAFITEDEFAULTHOST&DIR))
(replace DIRECTORY of FILEFIELDS with NIL)))
(COND
((EQ EXT (fetch EXTENSION of FILEFIELDS))
(replace EXTENSION of FILEFIELDS with NIL)))
(COND
((NOT KEEPVERSIONFLG)
(replace VERSION of FILEFIELDS with NIL)))
(RETURN (PACKFILENAME FILEFIELDS])
)
(DEFINEQ
(COPY7BITFILE
[LAMBDA (SRCFIL DSTFIL) (* bvm: " 5-Jan-84 10:57")
(RESETLST (PROG (INSTREAM OUTSTREAM CH)
[RESETSAVE NIL (LIST (QUOTE CLOSEF)
(SETQ INSTREAM (OPENSTREAM SRCFIL (QUOTE INPUT)
NIL NIL (QUOTE ((SEQUENTIAL
T)
(ENDOFSTREAMOP
NILL]
[RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(SETQ STREAM (CLOSEF STREAM))
(AND RESETSTATE (DELFILE STREAM]
(SETQ OUTSTREAM (OPENSTREAM
(OR DSTFIL (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME INSTREAM)))
(QUOTE OUTPUT)
(QUOTE NEW)
NIL
(LIST (QUOTE (SEQUENTIAL T))
(LIST (QUOTE LENGTH)
(GETFILEINFO INSTREAM (QUOTE LENGTH]
(while (SETQ CH (BIN INSTREAM)) do (BOUT OUTSTREAM (LOGAND CH 127)))
(RETURN (FULLNAME OUTSTREAM])
(FIXLAURELFILE
[LAMBDA (MAILFILE) (* bvm: "21-Feb-84 14:35")
(PROG (FOLDER)
(COND
((SETQ FOLDER (WITH.MONITOR \LAFITE.BROWSELOCK (\LAFITE.GETMAILFOLDER MAILFILE)))
(\LAFITE.FIX.LAUREL.FOLDER FOLDER])
(\LAFITE.BROWSE.LAURELFILE
[LAMBDA (ITEM MENU FILE) (* bvm: "21-Feb-84 14:30")
(\LAFITE.BROWSE ITEM MENU FILE T])
(\LAFITE.FIX.LAUREL.FOLDER
[LAMBDA (MAILFOLDER) (* bvm: "21-Feb-84 15:16")
(RESETLST (PROG (STREAM CH BROWSERPROMPTWINDOW)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T)
(COND
((SETQ BROWSERPROMPTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW)
of MAILFOLDER))
(printout BROWSERPROMPTWINDOW "Laurel scan... ")))
(SETQ STREAM (OPENMAILFOLDER MAILFOLDER (QUOTE BOTH)))
(RESETSAVE NIL (LIST (QUOTE CLOSEMAILFOLDER)
MAILFOLDER T))
(SETFILEINFO STREAM (QUOTE ENDOFSTREAMOP)
(FUNCTION NILL))
[while (SETQ CH (BIN STREAM)) do (COND
((IGREATERP CH 127)
(\BACKFILEPTR STREAM)
(BOUT STREAM (LOGAND CH 127]
(RETURN (FULLNAME STREAM])
)
(* ICON stuff *)
(RPAQ MSGSENTICON (READBITMAP))
(75 40
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"L@@@@@@@@@@@@@@@@@F@"
"MKFNKL@@@@@@@CN@GOF@"
"LMKEDK@@@@@@FDAFDAF@"
"L@@@@@@@@@@@AILIMOF@"
"MGMMJ@@@@@@@@H@HEAF@"
"MNOFM@@@@@@@FNGFEMF@"
"L@@@@@@@@@@@AIHILEF@"
"MGMNKD@@@@@@@H@HEMF@"
"MMGENL@@@@@@FFGFDAF@"
"L@@@@@@@@@@@AJEIOOF@"
"L@@@@@@@@@@@@EJ@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ MSGSENTMASK (READBITMAP))
(75 40
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ MSGFOLDERICON (READBITMAP))
(100 72
"@OOOOOOOO@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOH@@@@@@@@@@@@@@@@@@"
"C@@@@@@@@L@@@@@@@@@@@@@@@@@@"
"F@@@@@@@@F@@@@@@@@@@@@@@@@@@"
"L@DA@@@@@C@@@@@@@@@@@@@@@@@@"
"L@FC@@@@@C@@@@@@@@@@@@@@@@@@"
"L@EE@HGB@C@@@@@@@@@@@@@@@@@@"
"L@EEADBB@C@@@@@@@@@@@@@@@@@@"
"L@DIBBBB@COOOOOOOOOOOOOOL@@@"
"L@DACNBB@COOOOOOOOOOOOOOL@@@"
"L@DABBGCL@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@@@@@L@@@"
"LOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"LOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"FL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"CL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"AOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"@OOOOOOOOOOOOOOOOOOOOOOOO@@@")
(RPAQ MSGFOLDERMASK (READBITMAP))
(100 72
"@OOOOOOOO@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOH@@@@@@@@@@@@@@@@@@"
"COOOOOOOOL@@@@@@@@@@@@@@@@@@"
"GOOOOOOOON@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOOOOOOOOOOO@@@"
"AOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"@OOOOOOOOOOOOOOOOOOOOOOOO@@@")
(FILESLOAD ICONW)
(DEFINEQ
(LA.INITIALIZEICONS
[LAMBDA NIL (* bvm: "31-Dec-83 17:06")
(SETQ MSGSENTTEMPLATE
(create TITLEDICON
ICON ← MSGSENTICON
MASK ← MSGSENTMASK
TITLEREG ←(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 75
HEIGHT ← 30)))
(SETQ MSGFOLDERTEMPLATE
(create TITLEDICON
ICON ← MSGFOLDERICON
MASK ← MSGFOLDERMASK
TITLEREG ←(create REGION
LEFT ← 8
BOTTOM ← 4
WIDTH ← 88
HEIGHT ← 51])
(LAFITEBROWSERICONFN
[LAMBDA (WINDOW OLDICON) (* bvm: "12-Jan-84 15:13")
(* * the holding place for all the fancy stuff for making an icon for a mail broswer window * *)
(OR (WINDOWP (fetch (WINDOWPROP ICONWINDOW) of WINDOW))
(PROG [(BROWSERREGION (fetch (WINDOWPROP REGION) of WINDOW))
(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(RETURN (TITLEDICONW MSGFOLDERTEMPLATE (COND
(MAILFOLDER (LA.SHORTFILENAME (fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)
LAFITEMAIL.EXT))
(T "??"))
NIL
(create POSITION
XCOORD ←(fetch (REGION LEFT) of BROWSERREGION)
YCOORD ←(fetch (REGION BOTTOM) of BROWSERREGION))
T])
)
(DEFINEQ
(\LAFITE.GLOBAL.INIT
[LAMBDA NIL (* bvm: " 2-Feb-84 11:26")
(* need to do this so you can send a message without
"starting" lafite *)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(COND
((NOT (ASSOC (QUOTE SendMail)
BackgroundMenuCommands))
[SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
(LIST (LIST (QUOTE SendMail)
(KWOTE (LIST (FUNCTION \LAFITE.MESSAGEFORM)))
"Bring up a message sending form."]
(SETQ BackgroundMenu NIL)))
(LAFITE.INIT.PARSETABLES)
(LA.INITIALIZEICONS])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\LAFITE.GLOBAL.INIT)
)
(FILESLOAD ATTACHEDWINDOW TEDIT MAILCLIENT GRAPEVINE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(RPAQQ LAFITECOMPILETIME ((FILES (IMPORT)
MAILCLIENT)
(RECORDS WINDOWPROP LAFITEUSERDATA LAFITEMSG MESSAGEHEADERFIELD MAILFOLDER
MAILSERVER DEFAULTHOST&DIR MAILSERVEROPS MAILADDRESS
SENDINGCOMMAND)
(CONSTANTS (LAFITESTAMPLENGTH 24)
(DELETEDFLAG (CHARCODE D))
(UNDELETEDFLAG (CHARCODE U))
(SEENFLAG (CHARCODE S))
(UNSEENFLAG (CHARCODE U))
(LAFITEDELETEPOSITION 20)
(LAFITESEENPOSITION 21)
(LAFITEMARKPOSITION 22))
(CONSTANTS LAFITETOCPASSWORD LAFITETOCOVERHEADPERENTRY
LAFITETOCHEADERLENGTH LAFITETOCMARKBYTEOFFSET)
(I.S.OPRS SELECTEDIN)
(CONSTANTS * TOCSTATES)
(MACROS UCASE.STREQUAL WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE
LAFITEACTIVEP MAYBEVERIFYMSG ASSURE.LAFITE.READY)
(GLOBALVARS * LAFITEGLOBALS)))
(FILESLOAD (IMPORT)
MAILCLIENT)
[DECLARE: EVAL@COMPILE
(ACCESSFNS WINDOWPROP ( (* The standard Interlisp-D window properties *)
(PROCESS (WINDOWPROP DATUM (QUOTE PROCESS))
(WINDOWPROP DATUM (QUOTE PROCESS)
NEWVALUE))
(CURSORINFN (WINDOWPROP DATUM (QUOTE CURSORINFN))
(WINDOWPROP DATUM (QUOTE CURSORINFN)
NEWVALUE))
(CURSOROUTFN (WINDOWPROP DATUM (QUOTE CURSOROUTFN))
(WINDOWPROP DATUM (QUOTE CURSOROUTFN)
NEWVALUE))
(CURSORMOVEDFN (WINDOWPROP DATUM (QUOTE CURSORMOVEDFN))
(WINDOWPROP DATUM (QUOTE CURSORMOVEDFN)
NEWVALUE))
(BUTTONEVENTFN (WINDOWPROP DATUM (QUOTE BUTTONEVENTFN))
(WINDOWPROP DATUM (QUOTE BUTTONEVENTFN)
NEWVALUE))
(RIGHTBUTTONFN (WINDOWPROP DATUM (QUOTE RIGHTBUTTONFN))
(WINDOWPROP DATUM (QUOTE RIGHTBUTTONFN)
NEWVALUE))
(CLOSEFN (WINDOWPROP DATUM (QUOTE CLOSEFN))
(WINDOWPROP DATUM (QUOTE CLOSEFN)
NEWVALUE))
(OPENFN (WINDOWPROP DATUM (QUOTE OPENFN))
(WINDOWPROP DATUM (QUOTE OPENFN)
NEWVALUE))
(ICONFN (WINDOWPROP DATUM (QUOTE ICONFN))
(WINDOWPROP DATUM (QUOTE ICONFN)
NEWVALUE))
(SHRINKFN (WINDOWPROP DATUM (QUOTE SHRINKFN))
(WINDOWPROP DATUM (QUOTE SHRINKFN)
NEWVALUE))
(EXPANDFN (WINDOWPROP DATUM (QUOTE EXPANDFN))
(WINDOWPROP DATUM (QUOTE EXPANDFN)
NEWVALUE))
(SCROLLFN (WINDOWPROP DATUM (QUOTE SCROLLFN))
(WINDOWPROP DATUM (QUOTE SCROLLFN)
NEWVALUE))
(RESHAPEFN (WINDOWPROP DATUM (QUOTE RESHAPEFN))
(WINDOWPROP DATUM (QUOTE RESHAPEFN)
NEWVALUE))
(REPAINTFN (WINDOWPROP DATUM (QUOTE REPAINTFN))
(WINDOWPROP DATUM (QUOTE REPAINTFN)
NEWVALUE))
(TITLE (WINDOWPROP DATUM (QUOTE TITLE))
(WINDOWPROP DATUM (QUOTE TITLE)
NEWVALUE))
(EXTENT (WINDOWPROP DATUM (QUOTE EXTENT))
(WINDOWPROP DATUM (QUOTE EXTENT)
NEWVALUE))
(ICONWINDOW (WINDOWPROP DATUM (QUOTE ICONWINDOW))
(WINDOWPROP DATUM (QUOTE ICONWINDOW)
NEWVALUE))
(DSP (WINDOWPROP DATUM (QUOTE DSP)))
(REGION (WINDOWPROP DATUM (QUOTE REGION)))
(* Window properties specific to Lafite *)
(MAILFOLDER (WINDOWPROP DATUM (QUOTE MAILFOLDER))
(WINDOWPROP DATUM (QUOTE MAILFOLDER)
NEWVALUE)) (* Window properties specific to MENUEDWINDOWs *)
(MENU (WINDOWPROP DATUM (QUOTE MENU))
(WINDOWPROP DATUM (QUOTE MENU)
NEWVALUE))
(MAINWINDOW (WINDOWPROP DATUM (QUOTE MAINWINDOW))
(WINDOWPROP DATUM (QUOTE MAINWINDOW)
NEWVALUE)) (* Window properties specific to TEDIT *)
(TEXTSTREAM (WINDOWPROP DATUM (QUOTE TEXTSTREAM))
(WINDOWPROP DATUM (QUOTE TEXTSTREAM)
NEWVALUE))
(MESSAGEFILE (WINDOWPROP DATUM (QUOTE MESSAGEFILE))
(WINDOWPROP DATUM (QUOTE MESSAGEFILE)
NEWVALUE))))
(RECORD LAFITEUSERDATA (FULLUSERNAME ENCRYPTEDPASSWORD . MAILSERVERS))
(DATATYPE LAFITEMSG ((PARSED? FLAG)
(DELETED? FLAG)
(SEEN? FLAG)
(FORMATTED? FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(BEGIN POINTER)
(MARKCHAR BYTE)
(MESSAGELENGTH POINTER)
(# WORD)
(STAMPLENGTH WORD)
(TOCLENGTH WORD)
(NIL WORD)
(MESSAGELENGTHCHANGED? FLAG)
(MARKSCHANGED? FLAG)
(SELECTED? FLAG)
(MSGFROMMECHECKED? FLAG)
(MSGFROMMETRUTH FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(DATE POINTER)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)) (* BEGIN is the only absolute pointer into the message
file -- all other positions are relative to BEGIN -- see
the ACCESSFNS *)
(BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
(NIL BITS 5)
(NIL POINTER)))
(BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
(NIL POINTER)))
[ACCESSFNS LAFITEMSG ((END (IPLUS (fetch (LAFITEMSG MESSAGELENGTH) of DATUM)
(fetch (LAFITEMSG BEGIN) of DATUM)))
(START (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
(fetch (LAFITEMSG STAMPLENGTH) of DATUM)))
(SEENFILEPTR (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
LAFITESEENPOSITION))
(MARKFILEPTR (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
LAFITEMARKPOSITION))
(DELETEFILEPTR (IPLUS (fetch (LAFITEMSG BEGIN) of DATUM)
LAFITEDELETEPOSITION))
(MSGFROMMEP (COND
((fetch (LAFITEMSG MSGFROMMECHECKED?) of DATUM)
(fetch (LAFITEMSG MSGFROMMETRUTH) of DATUM))
(T (LA.MSGFROMMEP DATUM)))
(PROG1 (replace (LAFITEMSG MSGFROMMETRUTH) of DATUM
with NEWVALUE)
(replace (LAFITEMSG MSGFROMMECHECKED?)
of DATUM with T])
(RECORD MESSAGEHEADERFIELD (FIELDNAME . FIELDSTRINGS))
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)
(BROWSERREADY FLAG)
(FOLDERNEEDSUPDATE FLAG)
(FOLDERNEEDSEXPUNGE FLAG)
(FOLDERBEINGUPDATED FLAG)
(NIL FLAG)
(NIL FLAG)
(FULLFOLDERNAME POINTER)
(VERSIONLESSFOLDERNAME POINTER)
(SHORTFOLDERNAME POINTER)
(FOLDERSTREAM POINTER)
(MESSAGEDESCRIPTORS POINTER)
(FOLDERLOCK POINTER)
(#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD)
(BROWSERFONTHEIGHT WORD)
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD)
(ORDINALXPOS WORD)
(DATEXPOS WORD)
(FROMXPOS WORD)
(FROMMAXXPOS WORD)
(SUBJECTXPOS WORD)
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD)
(LASTSELECTEDMESSAGE WORD)
(NIL WORD)
(CURRENTEOMLENGTH WORD)
(CURRENTDISPLAYEDSTREAM POINTER)
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(BROWSERSELECTIONREGION POINTER)
(BROWSERWINDOW POINTER)
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER)
(FOLDERDISPLAYWINDOWS POINTER)
(FOLDEREOFPTR POINTER)
(DEFAULTMOVETOFILE POINTER)
(CURRENTDISPLAYEDMESSAGE POINTER)
(BROWSERUPDATEFROMHERE POINTER)
(TOCEOFPTR POINTER)
(FOLDERCREATIONDATE POINTER)
(NIL POINTER)
(NIL POINTER)))
(RECORD MAILSERVER (MAILSERVEROPS MAILPORT NEWMAILFLG SERVERNAME)
(SUBRECORD MAILPORT))
(RECORD DEFAULTHOST&DIR (DEFAULTHOST DEFAULTDIR PACKEDHOST&DIR))
(RECORD MAILSERVEROPS (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX
SERVERPORTFROMNAME))
(RECORD MAILADDRESS (LOCAL DOMAIN) (* this terminology is taken from RFC822 *)
)
(RECORD SENDINGCOMMAND (COMMAND ITEM MENU MESSAGEWINDOW MESSAGE)
[TYPE? (FMEMB (fetch COMMAND of DATUM)
(QUOTE (##SEND## ##SAVE## ##FORGETIT##])
]
(/DECLAREDATATYPE (QUOTE LAFITEMSG)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD
WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER
POINTER)))
(/DECLAREDATATYPE (QUOTE MAILFOLDER)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER
POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(DECLARE: EVAL@COMPILE
(RPAQQ LAFITESTAMPLENGTH 24)
(RPAQ DELETEDFLAG (CHARCODE D))
(RPAQ UNDELETEDFLAG (CHARCODE U))
(RPAQ SEENFLAG (CHARCODE S))
(RPAQ UNSEENFLAG (CHARCODE U))
(RPAQQ LAFITEDELETEPOSITION 20)
(RPAQQ LAFITESEENPOSITION 21)
(RPAQQ LAFITEMARKPOSITION 22)
(CONSTANTS (LAFITESTAMPLENGTH 24)
(DELETEDFLAG (CHARCODE D))
(UNDELETEDFLAG (CHARCODE U))
(SEENFLAG (CHARCODE S))
(UNSEENFLAG (CHARCODE U))
(LAFITEDELETEPOSITION 20)
(LAFITESEENPOSITION 21)
(LAFITEMARKPOSITION 22))
)
(DECLARE: EVAL@COMPILE
(RPAQQ LAFITETOCPASSWORD 45610)
(RPAQQ LAFITETOCOVERHEADPERENTRY 12)
(RPAQQ LAFITETOCHEADERLENGTH 10)
(RPAQQ LAFITETOCMARKBYTEOFFSET 4)
(CONSTANTS LAFITETOCPASSWORD LAFITETOCOVERHEADPERENTRY LAFITETOCHEADERLENGTH LAFITETOCMARKBYTEOFFSET)
)
(DECLARE: EVAL@COMPILE
[I.S.OPR (QUOTE SELECTEDIN)
NIL
(QUOTE (bind ($$MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of BODY))
($$MSG# ← (SUB1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of BODY)))
($$MSGLAST ← (fetch (MAILFOLDER LASTSELECTEDMESSAGE)
of BODY))
until
(IGREATERP (add $$MSG# 1)
$$MSGLAST)
when
(fetch (LAFITEMSG SELECTED?)
of
(SETQ I.V. (NTHMESSAGE $$MESSAGES $$MSG#]
)
(RPAQQ TOCSTATES ((TS.IDLE 0)
(TS.REPLACING 1)
(TS.ADDING 2)
(TS.REMOVING 3)
(TS.EXTENDING.HI 4)
(TS.EXTENDING.LO 5)
(TS.SHRINKING.HI 6)
(TS.SHRINKING.LO 7)))
(DECLARE: EVAL@COMPILE
(RPAQQ TS.IDLE 0)
(RPAQQ TS.REPLACING 1)
(RPAQQ TS.ADDING 2)
(RPAQQ TS.REMOVING 3)
(RPAQQ TS.EXTENDING.HI 4)
(RPAQQ TS.EXTENDING.LO 5)
(RPAQQ TS.SHRINKING.HI 6)
(RPAQQ TS.SHRINKING.LO 7)
(CONSTANTS (TS.IDLE 0)
(TS.REPLACING 1)
(TS.ADDING 2)
(TS.REMOVING 3)
(TS.EXTENDING.HI 4)
(TS.EXTENDING.LO 5)
(TS.SHRINKING.HI 6)
(TS.SHRINKING.LO 7))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS UCASE.STREQUAL MACRO ((X Y)
(EQ (ALPHORDER X Y UPPERCASEARRAY)
(QUOTE EQUAL))))
(PUTPROPS WORDIN DMACRO (= . \WIN))
(PUTPROPS WORDIN MACRO (= . \WIN))
(PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
(\MAKENUMBER (WORDIN STREAM)
(WORDIN STREAM))))
(PUTPROPS WORDOUT DMACRO (= . \WOUT))
(PUTPROPS FIXPOUT DMACRO [OPENLAMBDA (STREAM N)
(PROGN (WORDOUT STREAM (LRSH N 16))
(WORDOUT STREAM (LOGAND N 65535])
(PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
(COND
((AND (IGEQ CHAR (CHARCODE a))
(ILEQ CHAR (CHARCODE z)))
(LOGAND CHAR 95))
(T CHAR))))
(PUTPROPS NTHMESSAGE MACRO (= . ELT))
(PUTPROPS LAFITEACTIVEP MACRO (NIL (WINDOWP LAFITESTATUSWINDOW)))
(PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
(AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER))))
(PUTPROPS ASSURE.LAFITE.READY MACRO (NIL (OR \LAFITE.READY (CHECKLAFITEMAILFOLDERS))))
)
(RPAQQ LAFITEGLOBALS (LAFITEFORMATMENU LAFITEHARDCOPY.MIN.MESSAGES.FOR.TOC LAFITEDEBUGFLG
LAFITEENDOFMESSAGESTR LAFITEENDOFMESSAGEFONT LAFITEGETMAILTUNE
LAFITENEWMAILTUNE LAFITEFORWARDSUBJECTSTR LAFITESPECIALFORMS
LAFITEFROMFRACTION LAFITEMINFROMCHARS \LAFITE.HARDCOPYLOCK
LAFITEVERSION# \LAFITE.AUTHENTICATION.FAILURE LAFITEMAINMENU
\LAFITE.TEMPFILES LAFITEMAIL.EXT \LAFITE.LAST.STATUS
\LAFITE.READY \AFTERLOGINFNS MAILSERVERTYPES
LAFITEIMMEDIATECHANGESFLG LAFITEUPDATEMENU
LAFITEUPDATEMENUITEMS LAFITEVERIFYFLG
LAFITESTATUSWINDOWMINWIDTH \LAFITEPROFILECHANGED
\LAFITE.MAILSERVERLOCK \LAFITE.PROFILELOCK
\ACTIVELAFITEFOLDERS LAFITEIFFROMMETHENSEENFLG
LAFITEREADONLYFLG LAFITENEWPAGEFLG LAFITEDISPLAYAFTERDELETEFLG
LAFITESTATUSWINDOWPOSITION BackgroundMenuCommands
BackgroundMenu LINEPARSERRDTBL LAFITECURRENTEDITORWINDOWS
LAFITELASTMESSAGE LAFITEEDITORWINDOWS PRIMARYEDITORWINDOW
\LAFITE.MAINLOCK AROUNDEXITFNS MSGFOLDERTEMPLATE MSGSENTMASK
MSGFOLDERICON MSGFOLDERMASK LAFITETOC.EXT LAFITEPROFILE.NAME
LAFITEPROFILE.EXT LA.CROSSCURSOR LAFITEBUSYWAITTIME LASTMOUSEX
SCREENWIDTH LASTMOUSEY SCREENHEIGHT LAFITEBUFFERSIZE
LAFITEFORMFILES \LAPARSE.TOFIELD \LAPARSE.TOCFIELDS
LAFITEDELETEDLINEHEIGHT BROWSERMARKXPOSITION
LA.SELECTION.BITMAP LAFITEDISPLAYREGION LAFITEDISPLAYFONT
LIGHTWAVYSHADE LAFITESENDINGMENUITEMS LAFITEEDITORREGION
ADDRESSPARSERRDTBL ARPANETGATEWAY.REGISTRY LAFITEEOL
LAFITESENDINGFORMAT MSGSENTTEMPLATE MSGSENTICON
LAFITEFLUSHMAILFLG LAFITESTATUSWINDOW \LAFITEUSERDATA
DEFAULTREGISTRY LAFITEMAILFOLDERS ANOTHERFOLDERMENUITEM
\LAFITEDEFAULTHOST&DIR LAFITEFORMSMENUITEMS SUBJECTSTR
LAFITETEMPFILEHOSTNAME RECIPIENTSSTR BEGINFORWARDEDMESSAGESTR
ENDFORWARDEDMESSAGESTR FORWARDMARK LISPSUPPORT LAFITESUPPORT
LAFITESYSTEMDATE MAKESYSDATE LAFITEFORM.EXT \LAPARSE.FULL
LAFITEEDITORFONT UPPERCASEARRAY UNSUPPLIEDFIELDSTR MESSAGESTR
ANSWERMARK LAFITEHARDCOPYFONT HARDCOPYSEPARATORSTR MOVETOMARK
UNSEENMARK SEENMARK LAFITEFOLDERSMENU LA.RIGHTARROWCURSOR
DEFAULTCURSOR LAFITECLOSEFNMENU LASTMOUSEBUTTONS
LAFITEITEMBUSYSHADE LAFITEFORMSMENU LAFITEBROWSERMENUITEMS
LAFITEBROWSERREGION LAFITEBROWSERFONT \LAFITE.BROWSELOCK
PROMPTWINDOW LAFITETITLEFONT MAILWATCHWAITTIME LAFITEMENUFONT
WAITINGCURSOR LAFITEDEFAULTHOST&DIR LOGINHOST/DIR
DEFAULTMAILFOLDERNAME LAFITECOMMANDMENUITEMS))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS LAFITEFORMATMENU LAFITEHARDCOPY.MIN.MESSAGES.FOR.TOC LAFITEDEBUGFLG
LAFITEENDOFMESSAGESTR LAFITEENDOFMESSAGEFONT LAFITEGETMAILTUNE LAFITENEWMAILTUNE
LAFITEFORWARDSUBJECTSTR LAFITESPECIALFORMS LAFITEFROMFRACTION LAFITEMINFROMCHARS
\LAFITE.HARDCOPYLOCK LAFITEVERSION# \LAFITE.AUTHENTICATION.FAILURE LAFITEMAINMENU
\LAFITE.TEMPFILES LAFITEMAIL.EXT \LAFITE.LAST.STATUS \LAFITE.READY \AFTERLOGINFNS
MAILSERVERTYPES LAFITEIMMEDIATECHANGESFLG LAFITEUPDATEMENU LAFITEUPDATEMENUITEMS
LAFITEVERIFYFLG LAFITESTATUSWINDOWMINWIDTH \LAFITEPROFILECHANGED \LAFITE.MAILSERVERLOCK
\LAFITE.PROFILELOCK \ACTIVELAFITEFOLDERS LAFITEIFFROMMETHENSEENFLG LAFITEREADONLYFLG
LAFITENEWPAGEFLG LAFITEDISPLAYAFTERDELETEFLG LAFITESTATUSWINDOWPOSITION
BackgroundMenuCommands BackgroundMenu LINEPARSERRDTBL LAFITECURRENTEDITORWINDOWS
LAFITELASTMESSAGE LAFITEEDITORWINDOWS PRIMARYEDITORWINDOW \LAFITE.MAINLOCK AROUNDEXITFNS
MSGFOLDERTEMPLATE MSGSENTMASK MSGFOLDERICON MSGFOLDERMASK LAFITETOC.EXT LAFITEPROFILE.NAME
LAFITEPROFILE.EXT LA.CROSSCURSOR LAFITEBUSYWAITTIME LASTMOUSEX SCREENWIDTH LASTMOUSEY
SCREENHEIGHT LAFITEBUFFERSIZE LAFITEFORMFILES \LAPARSE.TOFIELD \LAPARSE.TOCFIELDS
LAFITEDELETEDLINEHEIGHT BROWSERMARKXPOSITION LA.SELECTION.BITMAP LAFITEDISPLAYREGION
LAFITEDISPLAYFONT LIGHTWAVYSHADE LAFITESENDINGMENUITEMS LAFITEEDITORREGION
ADDRESSPARSERRDTBL ARPANETGATEWAY.REGISTRY LAFITEEOL LAFITESENDINGFORMAT MSGSENTTEMPLATE
MSGSENTICON LAFITEFLUSHMAILFLG LAFITESTATUSWINDOW \LAFITEUSERDATA DEFAULTREGISTRY
LAFITEMAILFOLDERS ANOTHERFOLDERMENUITEM \LAFITEDEFAULTHOST&DIR LAFITEFORMSMENUITEMS
SUBJECTSTR LAFITETEMPFILEHOSTNAME RECIPIENTSSTR BEGINFORWARDEDMESSAGESTR
ENDFORWARDEDMESSAGESTR FORWARDMARK LISPSUPPORT LAFITESUPPORT LAFITESYSTEMDATE MAKESYSDATE
LAFITEFORM.EXT \LAPARSE.FULL LAFITEEDITORFONT UPPERCASEARRAY UNSUPPLIEDFIELDSTR MESSAGESTR
ANSWERMARK LAFITEHARDCOPYFONT HARDCOPYSEPARATORSTR MOVETOMARK UNSEENMARK SEENMARK
LAFITEFOLDERSMENU LA.RIGHTARROWCURSOR DEFAULTCURSOR LAFITECLOSEFNMENU LASTMOUSEBUTTONS
LAFITEITEMBUSYSHADE LAFITEFORMSMENU LAFITEBROWSERMENUITEMS LAFITEBROWSERREGION
LAFITEBROWSERFONT \LAFITE.BROWSELOCK PROMPTWINDOW LAFITETITLEFONT MAILWATCHWAITTIME
LAFITEMENUFONT WAITINGCURSOR LAFITEDEFAULTHOST&DIR LOGINHOST/DIR DEFAULTMAILFOLDERNAME
LAFITECOMMANDMENUITEMS)
)
)
(/DECLAREDATATYPE (QUOTE MAILFOLDER)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER
POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE LAFITEMSG)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD
WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER
POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)
(BROWSERREADY FLAG)
(FOLDERNEEDSUPDATE FLAG)
(FOLDERNEEDSEXPUNGE FLAG)
(FOLDERBEINGUPDATED FLAG)
(NIL FLAG)
(NIL FLAG)
(FULLFOLDERNAME POINTER)
(VERSIONLESSFOLDERNAME POINTER)
(SHORTFOLDERNAME POINTER)
(FOLDERSTREAM POINTER)
(MESSAGEDESCRIPTORS POINTER)
(FOLDERLOCK POINTER)
(#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD)
(BROWSERFONTHEIGHT WORD)
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD)
(ORDINALXPOS WORD)
(DATEXPOS WORD)
(FROMXPOS WORD)
(FROMMAXXPOS WORD)
(SUBJECTXPOS WORD)
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD)
(LASTSELECTEDMESSAGE WORD)
(NIL WORD)
(CURRENTEOMLENGTH WORD)
(CURRENTDISPLAYEDSTREAM POINTER)
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(BROWSERSELECTIONREGION POINTER)
(BROWSERWINDOW POINTER)
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER)
(FOLDERDISPLAYWINDOWS POINTER)
(FOLDEREOFPTR POINTER)
(DEFAULTMOVETOFILE POINTER)
(CURRENTDISPLAYEDMESSAGE POINTER)
(BROWSERUPDATEFROMHERE POINTER)
(TOCEOFPTR POINTER)
(FOLDERCREATIONDATE POINTER)
(NIL POINTER)
(NIL POINTER)))
(DATATYPE LAFITEMSG ((PARSED? FLAG)
(DELETED? FLAG)
(SEEN? FLAG)
(FORMATTED? FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(BEGIN POINTER)
(MARKCHAR BYTE)
(MESSAGELENGTH POINTER)
(# WORD)
(STAMPLENGTH WORD)
(TOCLENGTH WORD)
(NIL WORD)
(MESSAGELENGTHCHANGED? FLAG)
(MARKSCHANGED? FLAG)
(SELECTED? FLAG)
(MSGFROMMECHECKED? FLAG)
(MSGFROMMETRUTH FLAG)
(NIL FLAG)
(NIL FLAG)
(NIL FLAG)
(DATE POINTER)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)))
]
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA BROWSERPROMPTPRINT LAFITE)
)
(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7689 17022 (LAFITE 7699 . 8777) (\LAFITE.START 8779 . 11233) (\LAFITEDEFAULTHOST&DIR
11235 . 12569) (LAFITEDEFAULTHOST&DIR 12571 . 12801) (MAKELAFITECOMMANDWINDOW 12803 . 14638) (
DOLAFITEBROWSERCOMMAND 14640 . 15137) (\LAFITE.CHECK.NO.SELECTIONS 15139 . 15489) (EXTRACTMENUCOMMAND
15491 . 15901) (DOLAFITESENDINGCOMMAND 15903 . 17020)) (17073 19804 (DOMAINLAFITECOMMAND 17083 . 17789
) (\LAFITE.QUIT 17791 . 19802)) (19824 30589 (\LAFITE.BROWSE 19834 . 20296) (\LAFITE.SUBBROWSE 20298
. 20699) (\LAFITE.BROWSE.PROC 20701 . 21166) (\LAFITE.PREPARE.BROWSER 21168 . 23105) (
GETFOLDERINTOBROWSER 23107 . 23315) (DISPLAYFOLDERINBROWSER 23317 . 24960) (
LAFITE.MAKE.INITIAL.SELECTION 24962 . 25874) (CREATEBROWSERWINDOW 25876 . 30587)) (30621 44875 (
INITBROWSERMAP 30631 . 34460) (LAFITEBROWSERBUTTONEVENTFN 34462 . 35076) (LOADMAILFOLDER 35078 . 36351
) (\LAFITE.GETMAILFOLDER 36353 . 38616) (LAFITEBROWSERREPAINTFN 38618 . 39245) (LAFITEBROWSERSCROLLFN
39247 . 39773) (LAFITEBROWSERRESHAPEFN 39775 . 40900) (LAFITEBROWSERCLOSEFN 40902 . 41078) (
LAFITEBROWSERSHRINKFN 41080 . 41251) (\LAFITE.CLOSE/SHRINK 41253 . 42624) (LAFITEBROWSEREXPANDFN 42626
. 44063) (LAFITEBROWSERCURSORMOVEDFN 44065 . 44719) (LAFITEBROWSERCURSOROUTFN 44721 . 44873)) (44906
56749 (BROWSERSELECTMESSAGE 44916 . 53122) (BROWSERCHANGEMARK 53124 . 54472) (LA.READ.NEW.MARK 54474
. 55944) (YPOS.TO.MESSAGE# 55946 . 56434) (MESSAGE#.TO.YPOS 56436 . 56747)) (56750 63189 (
LA.CONSIDERRANGE 56760 . 57405) (LA.DECONSIDERRANGE 57407 . 57884) (LA.RECONSIDERRANGE 57886 . 58529)
(LA.SELECTRANGE 58531 . 59778) (LA.DESELECTRANGE 59780 . 61182) (LA.FIND.SELECTED.MESSAGE 61184 .
61497) (LA.UNDOSELECTION 61499 . 61847) (LA.VERIFY.SELECTION 61849 . 63187)) (63209 68508 (
\LAFITE.UPDATE 63219 . 63872) (\LAFITE.EXPUNGE.PROC 63874 . 64549) (\LAFITE.UPDATE.PROC 64551 . 65225)
(\LAFITE.START.UPDATE 65227 . 66278) (\LAFITE.FINISH.UPDATE 66280 . 67699) (
\LAFITE.CLOSE.OTHER.FOLDERS 67701 . 68506)) (68509 85530 (FLUSHBROWSERWINDOW 68519 . 69450) (
ADDMESSAGESTOMAILBROWSER 69452 . 71826) (COMPACTMAILFOLDER 71828 . 73394) (COMPACTMAILFOLDER1 73396 .
78062) (UPDATEMAILFOLDER 78064 . 79147) (UPDATECONTENTSFILE 79149 . 82435) (WRITETOCENTRY 82437 .
84078) (WRITETOCMARKBYTES 84080 . 84321) (WRITEFOLDERMARKBYTES 84323 . 85528)) (85551 94861 (
\LAFITE.DISPLAY 85561 . 86517) (\LAFITE.DO.DISPLAY 86519 . 88624) (SELECTMESSAGETODISPLAY 88626 .
91226) (MESSAGEDISPLAYER 91228 . 93528) (\LAFITE.CLOSE.DISPLAYWINDOWS 93530 . 94011) (
\LAFITE.CLOSE.DISPLAYER 94013 . 94859)) (94888 108085 (\LAFITE.DELETE 94898 . 95913) (
DISPLAYAFTERDELETE 95915 . 97327) (\LAFITE.UNDELETE 97329 . 97870) (\LAFITE.MOVETO 97872 . 100484) (
\LAFITE.MOVETO.PROC 100486 . 105868) (\LAFITE.OPEN.DESTINATIONFOLDER 105870 . 108083)) (108107 114128
(\LAFITE.HARDCOPY 108117 . 108442) (\LAFITE.HARDCOPY.PROC 108444 . 109683) (\LAFITE.HARDCOPY.HEADERS
109685 . 111878) (\LAFITE.MARK.HARDCOPIED 111880 . 112592) (\LAFITE.TRANSMIT.HARDCOPY 112594 . 113024)
(\LAFITE.HARDCOPY.BODIES 113026 . 114126)) (114148 119180 (\LAFITE.ANSWER 114158 . 114501) (
\LAFITE.ANSWER.PROC 114503 . 115548) (MAKEANSWERFORM 115550 . 118867) (LA.PRINTADDRESSES 118869 .
119178)) (119201 123694 (\LAFITE.FORWARD 119211 . 119557) (\LAFITE.FORWARD.PROC 119559 . 120830) (
MAKEFORWARDFORM 120832 . 122796) (LA.OPENTEMPFILE 122798 . 123692)) (123713 131359 (
\LAFITE.MESSAGEFORM 123723 . 124233) (DERIVEMESSAGEFORMFROMMENU 124235 . 125468) (
MAKELAFITESUPPORTFORM 125470 . 125658) (MAKELISPSUPPORTFORM 125660 . 125825) (MAKEXXXSUPPORTFORM
125827 . 126888) (MAKENEWMESSAGEFORM 126890 . 127611) (MAKELAFITEFORMSMENU 127613 . 128009) (
MAKELAFITEPRIVATEFORMSITEMS 128011 . 128349) (MAKELAFITEMAILFOLDERSMENU 128351 . 128745) (
GETMESSAGEFORMFROMFILE 128747 . 130016) (\LAFITE.FIND.TEMPLATE 130018 . 130761) (SAVEMESSAGEFORM
130763 . 131357)) (140445 143359 (LA.RESETSHADE 140455 . 140801) (LA.REMOVEDUPLICATES 140803 . 141347)
(COLLECTOLDFILES 141349 . 141698) (LA.SETDIFFERENCE 141700 . 142002) (NTHMESSAGE 142004 . 142133) (
\LAFITE.MAKE.MSGARRAY 142135 . 142669) (\LAFITE.ADDMESSAGES.TO.ARRAY 142671 . 143357)) (143933 152636
(MAILSERVERS 143943 . 145622) (LAFITECLEARCACHE 145624 . 145772) (MAILSERVERTYPE 145774 . 146105) (
GETMAILSERVEROPS 146107 . 146692) (USERINFORMATION 146694 . 147180) (FULLUSERNAME 147182 . 147766) (
GETREGISTRY 147768 . 148497) (GETSIMPLENAME 148499 . 149228) (LAFITEMAILWATCH 149230 . 149607) (
POLLNEWMAIL 149609 . 150001) (POLLNEWMAIL1 150003 . 151318) (PRINTLAFITESTATUS 151320 . 152634)) (
152914 156425 (LAFITE.AROUNDEXIT 152924 . 153223) (CHECKLAFITEMAILFOLDERS 153225 . 155541) (
\LAFITE.REBROWSEFOLDER 155543 . 156002) (\LAFITE.AFTERLOGIN 156004 . 156423)) (156454 163212 (
\LAFITE.GETMAIL 156464 . 156852) (\LAFITE.GETMAIL.PROC 156854 . 157288) (GETNEWMAIL 157290 . 158894) (
GETNEWMAIL1 158896 . 160985) (GETNEWMAIL.PRINTMSGCOUNT 160987 . 161224) (RETRIEVEMESSAGES 161226 .
163210)) (163238 186054 (\SENDMESSAGE 163248 . 166498) (\LAFITE.AFTER.DELIVER 166500 . 167216) (
LAFITE.SENDMESSAGE 167218 . 167468) (\SENDMESSAGE1 167470 . 169434) (\SENDMESSAGE2 169436 . 172840) (
\LAFITE.CHOOSE.MSG.FORMAT 172842 . 173649) (\SENDMESSAGEFAIL 173651 . 173784) (\CHECKMESSAGEADDRESSES
173786 . 174061) (SENDRECIPIENTS 174063 . 176012) (PARSERECIPIENTS 176014 . 176339) (
PARSE.ARPA.ADDRESS 176341 . 177095) (PARSERECIPIENTS1 177097 . 178891) (COLLECTADDRESSES 178893 .
180054) (MESSAGEEDITOR 180056 . 183504) (LAFITE.CREATE.EDITOR.WINDOW 183506 . 184067) (
LA.RESET.TEDIT.SYNTAX 184069 . 184634) (GRAYOUTWINDOW 184636 . 184913) (BROWSERPROMPTPRINT 184915 .
185386) (\LAFITE.MAYBE.CLEAR.PROMPT 185388 . 185742) (LA.CLOSETEMPFILE 185744 . 186052)) (186083
198835 (PRINTMESSAGESUMMARY 186093 . 189267) (FIRSTVISIBLEMESSAGE 189269 . 189838) (LASTVISIBLEMESSAGE
189840 . 190562) (DISPLAYBROWSERLINES 190564 . 190989) (INSUREMESSAGEINBROWSERWINDOW 190991 . 191663)
(UNSELECTALLMESSAGES 191665 . 192139) (SELECTMESSAGE 192141 . 192437) (MARKMESSAGE 192439 . 193188) (
CHANGEFLAGINFOLDER 193190 . 193506) (LA.SHOW.MARK 193508 . 194086) (LA.INVERT.MARK.BOX 194088 . 194495
) (LA.BLT.MARK.BOX 194497 . 194980) (LA.SHOW.DELETION 194982 . 195594) (LA.SHOW.SELECTION 195596 .
196130) (SEENMESSAGE 196132 . 197240) (DELETEMESSAGE 197242 . 197958) (UNDELETEMESSAGE 197960 . 198833
)) (198867 217377 (PARSEMAILFOLDER 198877 . 200001) (PARSEMAILFOLDER1 200003 . 203470) (BADMAILFILE
203472 . 204290) (BADMAILFILE.FLAGBYTE 204292 . 204556) (VERIFYMAILFOLDER 204558 . 207760) (
VERIFYFAILED 207762 . 207966) (READTOCFILE 207968 . 213164) (BADTOCFILE 213166 . 213610) (
\LAFITE.TOCEOF 213612 . 213888) (LA.READCOUNT 213890 . 214309) (LA.PRINTCOUNT 214311 . 214516) (
LA.READSTAMP 214518 . 214947) (\LAFITE.VERIFYMSG 214949 . 215314) (LA.MSGFROMMEP 215316 . 215703) (
LA.PRINTSTAMP 215705 . 216071) (LA.READSHORTSTRING 216073 . 216426) (LA.PRINTSHORTSTRING 216428 .
216838) (LA.READSTRING 216840 . 217375)) (217378 225199 (LAFITE.PARSE.MSG.FOR.TOC 217388 . 219307) (
LAFITE.FETCH.TO.FIELD 219309 . 220002) (LAFITE.PARSE.HEADER 220004 . 221256) (LAFITE.GRAB.DATE 221258
. 222490) (LAFITE.READ.LINE.FOR.TOC 222492 . 222862) (LAFITE.READ.FORMAT 222864 . 223246) (
LAFITE.READ.NAME.FIELD 223248 . 224234) (LAFITE.READ.ONE.LINE.FOR.TOC 224236 . 224416) (
LAFITE.READ.TO.EOL 224418 . 224597) (LAFITE.SKIP.TO.EOL 224599 . 224984) (LAFITE.SKIP.WHITE.SPACE
224986 . 225197)) (225808 231029 (LAFITE.INIT.PARSETABLES 225818 . 229126) (LAFITE.MAKE.PARSE.TABLE
229128 . 229673) (LAFITE.MAKE.PARSE.TABLE1 229675 . 231027)) (231110 242618 (\LAFITE.WRITE.PROFILE
231120 . 231580) (\LAFITE.READ.PROFILE 231582 . 233121) (DELETEMAILFOLDER 233123 . 233790) (
FORGETMAILFILE 233792 . 234139) (\LAFITE.UNCACHE.FOLDER 234141 . 234454) (\LAFITE.UNCACHE.MESSAGEFORM
234456 . 235133) (OPENMAILFOLDER 235135 . 236673) (\LAFITE.OPENSTREAM 236675 . 237031) (\LAFITE.EOF
237033 . 237338) (CLOSEMAILFOLDER 237340 . 237927) (PROMPTFORFILENAME 237929 . 239017) (
\LAFITE.PROMPTFORFOLDER 239019 . 239332) (MAILFOLDERBUSY 239334 . 239520) (LA.LONGFILENAME 239522 .
240656) (PROFILEFILENAME 240658 . 241050) (TOCFILENAME 241052 . 241341) (LA.SHORTFILENAME 241343 .
242616)) (242619 244882 (COPY7BITFILE 242629 . 243588) (FIXLAURELFILE 243590 . 243873) (
\LAFITE.BROWSE.LAURELFILE 243875 . 244040) (\LAFITE.FIX.LAUREL.FOLDER 244042 . 244880)) (251400 252763
(LA.INITIALIZEICONS 251410 . 251940) (LAFITEBROWSERICONFN 251942 . 252761)) (252764 253484 (
\LAFITE.GLOBAL.INIT 252774 . 253482)))))
STOP