(FILECREATED "18-AUG-83 16:45:35" {PHYLUM}<YONKE>LAFITE.;184 190321
changes to: (VARS LAFITECOMS)
(FNS SENDMAIL PRINTMESSAGESUMMARY ADDSENDMAILTOBACKGROUNDMENU)
previous date: "18-AUG-83 13:50:43" {PHYLUM}<YONKE>LAFITE.;183)
(* Copyright (c) 1982, 1983 by Xerox Corporation and Bolt Beranek and Newman Inc.)
(PRETTYCOMPRINT LAFITECOMS)
(RPAQQ LAFITECOMS [(* THESE COMS NEED RADICAL REORGAINIZATION *)
(* 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. *)
(VARS (LAFITEVERSION# 5))
(E (SETQ LAFITESYSTEMDATE (LA.DATE)))
(VARS LAFITESYSTEMDATE)
(FNS LAFITE LAFITEON LAFITEINIT LAFITEDEFAULTHOST&DIR MAKELAFITECOMMANDWINDOW
DOLAFITEBROWSERCOMMAND EXTRACTMENUCOMMAND DOLAFITESENDINGCOMMAND LAFITE.GETMAIL
GETMAIL.PROC LAFITE.UPDATE UPDATE.PROC CHECKLAFITEMAILFOLDERS HIGHESTVERSIONP
EMPTYMAILFOLDERP FILELENGTHMATCHESDATAP)
(PROP ARGNAMES LAFITE)
(FNS DOMAINLAFITECOMMAND LAFITE.BROWSE BROWSE.PROC LAFITE.MESSAGEFORM LAFITE.QUIT)
(FNS LAFITEBROWSERBUTTONEVENTFN BROWSERSELECTMESSAGE GETMAILFOLDER BUILDBROWSERMAP
LAFITEBROWSERREPAINTFN LAFITEBROWSERSCROLLFN LAFITEBROWSERRESHAPEFN
LAFITEBROWSERAFTERMOVEFN LAFITEBROWSERCLOSEFN LAFITEBROWSERCURSORMOVEDFN
LAFITEBROWSERCURSOROUTFN)
(FNS CLOSEMAILBROWSER ADDMESSAGESTOMAILBROWSER COMPACTMAILFOLDER)
(FNS LAFITE.DISPLAY NEXTMESSAGETODISPLAY)
(FNS LAFITE.DELETE DISPLAYAFTERDELETE LAFITE.UNDELETE LAFITE.MOVETO MOVETO.PROC
LAFITE.HARDCOPY HARDCOPY.PROC)
(FNS LAFITE.ANSWER ANSWER.PROC MAKEANSWERFORM GETANOTHERFORM MAKELAFITESUPPORTFORM
MAKELISPSUPPORTFORM)
(FNS LAFITE.FORWARD FORWARD.PROC MAKEFORWARDFORM LA.OPENTEMPFILE)
(FNS MAKENEWMESSAGEFORM MAKELAFITEFORMSMENU MAKELAFITEMAILFOLDERSMENU GETMESSAGEFORM
SAVEMESSAGEFORM UPDATECONTENTSFILE)
(INITVARS (CAN'TAUTHENTICATESTR "Cannot authenticate user -- reason: ")
(CAN'TGETMAILSERVERSSTR "Can't get any mail servers.")
(CONFLICTINGVERSION#STR1 " has multiple versions.")
(CONFLICTINGVERSION#STR2
"Please resolve this (or set LAFITEUSEHIGHESTVERSIONFLG to T) and browse again.")
(UNSUPPLIEDFIELDSTR "---")
(NOMOREMESSAGESSTR "No more messages.")
(NOMESSAGESSELECTEDSTR "No messages selected.")
[LAFITEMENUFONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD]
[LAFITETITLEFONT (FONTCREATE (QUOTE (HELVETICA 12 BOLD]
[LAFITEDISPLAYFONT (FONTCREATE (QUOTE (TIMESROMAN 12]
[LAFITEEDITORFONT (FONTCREATE (QUOTE (TIMESROMAN 12]
[LAFITEHARDCOPYFONT (FONTCREATE (QUOTE (TIMESROMAN 12]
[LAFITEBROWSERFONT (FONTCREATE (QUOTE (GACHA 10]
(ARPANETGATEWAY.REGISTRY (QUOTE AG))
(LAFITESUPPORT (QUOTE Yonke.pa))
(LAFITESUBJECTSTR "Lafite: >>Subject<<")
(LISPSUPPORT (QUOTE LispSupport.pa))
(LISPSUBJECTSTR "Lisp: >>Subject<<")
(NEWMAILSTR "You Have New Mail - ")
(NOMAILSTR "No New Mail At ")
(NOMAILSERVERSSTR "All Mail Servers Down At ")
(NOINBOXESSTR "No Accessible Mail Boxes")
(NOTCONNECTEDSTR "Not Connected To Mail Server")
(BEGINFORWARDEDMESSAGESTR " ----- Fowarded Messages -----")
(ENDFORWARDEDMESSAGESTR " ----- End of Forwarded Messages -----")
(HARDCOPYSEPARATORSTR
"------------------------------------------------------------------------")
(LAFITETITLE "L a f i t e")
(SEENMARK (CHARACTER (CHARCODE SP)))
(UNSEENMARK (QUOTE ?))
(MOVETOMARK (QUOTE m))
(FORWARDMARK (QUOTE f))
(ANSWERMARK (QUOTE a))
(FILENAMEPROMPT "> ")
(LAFITEEOL "
")
(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))
(LAFITEDISPLAYDELETEDMESSAGEFLG NIL)
(LAFITEDISPLAYAFTERDELETEFLG T)
(LAFITEREADONLYFLG T)
(LAFITENEWPAGEFLG T)
(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)
))
(VARS LAFITEBROWSERMENUITEMS LAFITESENDINGMENUITEMS LAFITECOMMANDMENUITEMS
LAFITEFORMSMENUITEMS LAFITECLOSEFNMENUITEMS ANOTHERFOLDERMENUITEM)
(INITVARS (LAFITEDEFAULTHOST&DIR)
(LAFITEUSEHIGHESTVERSIONFLG))
(VARS (LAFITEFLASHWAITTIME 250)
(LAFITEBUSYWAITTIME 1000)
(LIGHTWAVYSHADE 640)
(LAFITEITEMBUSYSHADE 43605)
(LAFITEEDITWINDOW)
(LAFITECOMMANDWINDOW)
(PRIMARYDISPLAYWINDOW)
(LAFITEDISPLAYWINDOWS)
(PRIMARYEDITORWINDOW)
(LAFITEEDITORWINDOWS)
(LAFITECURRENTEDITORWINDOWS)
(LAFITELASTMESSAGE)
(LAFITEMAILWATCHPROCESS)
(LAFITEMAILFOLDERS)
(LAFITEFORMFILES)
(LAFAITEFOLDERSMENU)
(LAFITESENDINGMENU)
(LAFITEFORMSMENU)
(LAFITECLOSEFNMENU))
(FNS LA.MOUSECONFIRM LA.STRPOS LA.REMOVEDUPLICATES NTHITEM LASTITEM)
(CURSORS LA.RIGHTARROWCURSOR LA.CONFIRMCURSOR LA.CROSSCURSOR)
(BITMAPS LA.SELECTION.BITMAP)
(VARS (BROWSERSELECTLIMITXPOSITION 35)
(BROWSERMARKXPOSITION 10))
(* Low level polling)
(FNS MAILSERVERLOGIN MAILSERVERTYPE USERINFORMATION FULLUSERNAME GETREGISTRY GETSIMPLENAME
LAFITEMAILWATCH POLLNEWMAIL POLLNEWMAIL1 LA.STATUSTIME LA.DATE PRINTLAFITESTATUS)
(MACROS WITHOUT.MAILWATCH)
(INITVARS (MAILWATCHWAITTIME 5))
(VARS (\LAFITEUSERDATA)
(\LAFITEDEFAULTHOST&DIR))
(ADDVARS (BEFORELOGOUTFORMS (SETQ \LAFITEUSERDATA NIL)))
(FNS LAFITEAFTERLOGOUT)
(* Low level mail retrieval functions)
(FNS GETNEWMAIL RETRIEVEMESSAGES)
(* this var should be T but for the time being lets keep it NIL *)
(INITVARS (LAFITEFLUSHMAILFLG NIL))
(* Low level sending functions)
(FNS SENDMAIL SENDMESSAGE SENDMESSAGE1 SENDMESSAGE2 CHECKRECIPIENTS CHECKRECIPIENT
FIXRECIPIENTS SENDRECIPIENTS PARSERECIPIENTS DELETETRAILINGSPACES COLLECTADDRESSES
ADDRESSESTOSTRING LA.TIMEZONE LA.CLOSEW! LA.FLASHWINDOW MESSAGEEDITOR GRAYOUTWINDOW
GETBROWSERPROMPTWINDOW MESSAGEDISPLAYER LA.CLOSETEMPFILE)
(* Low level printing and message header parsing coms)
(* these vars are used in the ACCESSFNS of MESSAGEDESCRIPTOR and model Laurel mail file
format *)
(CONSTANTS (LAFITEDELETEPOSITION 20)
(LAFITESEENPOSITION 21)
(LAFITEMARKPOSITION 22))
(FNS PRINTMESSAGESUMMARY MESSAGEFROMMEP LA.BROWSERTAB MARKMESSAGESELECTED
MARKMESSAGEUNSELECTED UNSELECTMESSAGE SELECTMESSAGE MARKMESSAGE MARKMESSAGEMARK
SEENMESSAGE MARKMESSAGEDELETED MARKMESSAGEUNDELETED DELETEMESSAGE UNDELETEMESSAGE
GETMESSAGEFIELDFORSUMMARY GETMESSAGEFIELD GETMESSAGEFIELDFROMSTRING
GETMESSAGEFIELDFROMFOLDER)
(MACROS WITHOUT.MAILWATCH)
(SPECVARS $$MAXWIDTH$$)
(FNS SETUPPARSETABLES PARSEMAILFOLDER)
(* Low level file functions)
(FNS MAKEMAILFOLDER WRITEPROFILEFILE READPROFILEFILE DELETEMAILFOLDER FORGETMAILFOLDER
OPENMAILFOLDER CLOSEMAILFOLDER INSUREMESSAGEINBROWSERWINDOW PROMPTFORFILENAME
MAILFOLDERBUSY LA.LONGFILENAME PROFILEFILENAME TOCFILENAME LA.SHORTFILENAME
ADDSENDMAILTOBACKGROUNDMENU)
(FNS LA.GETFILELOCK)
(COMS (* ICON stuff *)
(BITMAPS MSGSENTICON MSGSENTMASK MSGFOLDERICON MSGFOLDERMASK)
(FILES ICONW)
[VARS (MSGFOLDERTEMPLATE (create TITLEDICON ICON ← MSGFOLDERICON MASK ← MSGFOLDERMASK
TITLEREG ←
(create REGION LEFT ← 10 BOTTOM ← 10 WIDTH ← 130
HEIGHT ← 60)))
(MSGSENTTEMPLATE (create TITLEDICON ICON ← MSGSENTICON MASK ← MSGSENTMASK
TITLEREG ←
(create REGION LEFT ← 0 BOTTOM ← 0 WIDTH ← 75 HEIGHT ←
30]
(FNS LAFITEBROWSERICONFN))
(COMS (* need to do this so you can send a message without "starting" lafite *)
(P (ADDSENDMAILTOBACKGROUNDMENU)
(SETUPPARSETABLES)))
(FILES MENUEDWINDOW TEDIT MAILCLIENT GRAPEVINE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (IMPORT)
MAILCLIENT))
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY (RECORDS WINDOWPROP LAFITEUSERDATA
MESSAGEDESCRIPTOR MAILFILEDATA
MAILSERVER MAILADDRESS SENDINGCOMMAND))
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY (RECORDS LAFITEBROWSERLINK LAFITEMONITORLINK))
(INITRECORDS LAFITEBROWSERLINK LAFITEMONITORLINK)
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA LAFITE])
(* THESE COMS NEED RADICAL REORGAINIZATION *)
(* 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. *)
(RPAQQ LAFITEVERSION# 5)
(RPAQQ LAFITESYSTEMDATE "18 Aug 83 16:46 PDT")
(DEFINEQ
(LAFITE
[LAMBDA X (* M.Yonke " 1-AUG-83 16:58")
(* * 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 (if (ILESSP X 1)
then (* Lafite called with no args *)
(QUOTE ON)
else (ARG X 1))
(ON [if (NOT (WINDOWP LAFITECOMMANDWINDOW))
then (* Lafite isn't currently on *)
(if (NOT (THIS.PROCESS))
then (printout T "Process world must be on!" T)
else (LAFITEON (if (ILEQ X 1)
then DEFAULTMAILFOLDERNAME
else (ARG X 2]
(QUOTE ON))
(OFF (if (WINDOWP LAFITECOMMANDWINDOW)
then (* Lafite was on *)
(LAFITE.QUIT (ASSOC (QUOTE Quit)
LAFITECOMMANDMENUITEMS)
LAFITECOMMANDWINDOW)))
(LISPERROR "ILLEGAL ARG" (ARG X 1])
(LAFITEON
[LAMBDA (MAILFILE) (* M.Yonke " 1-AUG-83 16:32")
(RESETFORM (CURSOR WAITINGCURSOR)
(LAFITEDEFAULTHOST&DIR (OR LAFITEDEFAULTHOST&DIR LOGINHOST/DIR))
(LAFITEINIT (MAKEMAILFOLDER MAILFILE))
(SETQ LAFITEMAILWATCHPROCESS (ADD.PROCESS (CONSTANT (LIST (FUNCTION LAFITEMAILWATCH)))
(QUOTE RESTARTABLE)
(QUOTE HARDRESET)))
(push AFTERLOGOUTFORMS (CONSTANT (LIST (FUNCTION LAFITEAFTERLOGOUT])
(LAFITEINIT
[LAMBDA (MAILFILE) (* M.Yonke "18-AUG-83 13:19")
(READPROFILEFILE)
(SETQ LAFITEMAILFOLDERS (for FILE in LAFITEMAILFOLDERS when (AND FILE (INFILEP FILE))
collect (* use only those mail files that do exist *)
FILE))
(SETQ LAFITEFORMFILES (for FILE in LAFITEFORMFILES when (AND FILE (INFILEP FILE)) collect
(* use only those form files that do exist *)
FILE))
(WRITEPROFILEFILE)
(SETQ LAFAITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU LAFITEMAILFOLDERS))
(SETQ LAFITEFORMSMENU (MAKELAFITEFORMSMENU LAFITEFORMFILES))
(* convert to milliseconds *)
(SETQ \MAILWATCHWAITTIME (ITIMES MAILWATCHWAITTIME 60000))
(if (NOT (WINDOWP LAFITECOMMANDWINDOW))
then (SETQ LAFITEPROMPTWINDOW (MAKELAFITECOMMANDWINDOW LAFITECOMMANDMENUITEMS))
(SETQ LAFITECOMMANDWINDOW (fetch (WINDOWPROP MENUWINDOW) of LAFITEPROMPTWINDOW))
else (CLEARW LAFITEPROMPTWINDOW))
(if (NULL LAFITECLOSEFNMENU)
then (SETQ LAFITECLOSEFNMENU
(create MENU
ITEMS ← LAFITECLOSEFNMENUITEMS
MENUFONT ← LAFITEMENUFONT
TITLE ← "Close Options"
CENTERFLG ← T)))
(if MAILFILE
then (LAFITE.BROWSE MAILFILE (ASSOC (QUOTE Browse)
LAFITECOMMANDMENUITEMS)
(CAR (fetch (WINDOWPROP MENU) of LAFITECOMMANDWINDOW])
(LAFITEDEFAULTHOST&DIR
[LAMBDA (HOST&DIR) (* DECLARATIONS: (PROPRECORD
(HOST DIRECTORY)))
(* M.Yonke " 1-AUG-83 17:01")
(PROG (TEMPHOST&DIR OLDHOST&DIR)
(if (NULL HOST&DIR)
then (* user only wants to know where Lafite is looking at *)
(RETURN \LAFITEDEFAULTHOST&DIR)
else (SETQ OLDHOST&DIR \LAFITEDEFAULTHOST&DIR)
(if (EQ OLDHOST&DIR HOST&DIR)
then (* have already done the work -- just return *)
(RETURN HOST&DIR))
(SETQ TEMPHOST&DIR (UNPACKFILENAME HOST&DIR))
(* now make sure its a legitimate HOST&DIR *)
(if (AND (HOSTNAMEP (fetch HOST of TEMPHOST&DIR))
(* The OR is because the user may not be connected to
HOST in which case DIRECTORYNAMEP will fail with just
directory *)
(OR (DIRECTORYNAMEP (fetch DIRECTORY of TEMPHOST&DIR))
(DIRECTORYNAMEP HOST&DIR))
(NOT (IGREATERP (LENGTH TEMPHOST&DIR)
4)))
then (* set both the visible and invisble variables *)
(SETQ LAFITEDEFAULTHOST&DIR (SETQ \LAFITEDEFAULTHOST&DIR HOST&DIR))
(* reset all the appropriate menus *)
(SETQ LAFAITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU LAFITEMAILFOLDERS))
(SETQ LAFITEFORMSMENU (MAKELAFITEFORMSMENU LAFITEFORMFILES))
(RETURN OLDHOST&DIR)
else (ERRORX (LIST 27 HOST&DIR])
(MAKELAFITECOMMANDWINDOW
[LAMBDA (MENUITEMS) (* M.Yonke "11-AUG-83 12:43")
(PROG (POSITION REGION COMMANDWINDOW MENU)
(if LAFITESTATUSWINDOWPOSITION
then (SETQ POSITION LAFITESTATUSWINDOWPOSITION)
else (printout PROMPTWINDOW T "Specify position of the Lafite Command Menu.")
(SETQ POSITION (GETPOSITION))
(CLRPROMPT))
[SETQ REGION (create REGION
LEFT ←(fetch (POSITION XCOORD) of POSITION)
BOTTOM ←(fetch (POSITION YCOORD) of POSITION)
WIDTH ← 0 (* MAKEMENUEDWINDOW will fix this *)
HEIGHT ←(HEIGHTIFWINDOW (ITIMES 2 (FONTPROP LAFITEMENUFONT
(QUOTE HEIGHT]
(RESETLST (* make the title font big for the main Lafite menu *)
(RESETSAVE (DSPFONT LAFITETITLEFONT WindowTitleDisplayStream)
(LIST (FUNCTION DSPFONT)
(DSPFONT NIL WindowTitleDisplayStream)
WindowTitleDisplayStream))
(SETQ COMMANDWINDOW (MAKEMENUEDWINDOW MENUITEMS NIL (QUOTE BOTTOM)
REGION LAFITETITLE LAFITEMENUFONT)))
(DSPFONT LAFITEMENUFONT COMMANDWINDOW)
[SETQ MENU (CAR (fetch (WINDOWPROP MENU) of (fetch (WINDOWPROP MENUWINDOW)
of COMMANDWINDOW]
(replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION DOMAINLAFITECOMMAND))
(RETURN COMMANDWINDOW])
(DOLAFITEBROWSERCOMMAND
[LAMBDA (ITEM MENU KEY) (* M.Yonke "11-AUG-83 13:51")
(* * the reason for the arg is because they are going to be used freely by those functions which take a long time
so that they can highlight the menu item and there names are to common to use freely without the !!s * *)
(PROG (WINDOW MAILFILEDATA)
(SETQ WINDOW (fetch (WINDOWPROP MAINWINDOW) of (WFROMMENU MENU)))
(SETQ MAILFILEDATA (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
(SELECTQ (EXTRACTMENUCOMMAND ITEM)
(##UPDATE## (LAFITE.UPDATE WINDOW MAILFILEDATA ITEM MENU))
(##GETMAIL## (LAFITE.GETMAIL WINDOW MAILFILEDATA ITEM MENU))
(if (NULL (fetch (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW))
then (printout PROMPTWINDOW T NOMESSAGESSELECTEDSTR)
(LA.FLASHWINDOW WINDOW)
else (SELECTQ (EXTRACTMENUCOMMAND ITEM)
(##DELETE## (LAFITE.DELETE WINDOW MAILFILEDATA ITEM MENU))
(##UNDELETE## (LAFITE.UNDELETE WINDOW MAILFILEDATA ITEM MENU))
(##DISPLAY## (LAFITE.DISPLAY WINDOW MAILFILEDATA
(EQ KEY (QUOTE MIDDLE))
ITEM MENU))
(##ANSWER## (LAFITE.ANSWER MAILFILEDATA ITEM MENU))
(##FORWARD## (LAFITE.FORWARD MAILFILEDATA ITEM MENU))
(##HARDCOPY## (LAFITE.HARDCOPY MAILFILEDATA ITEM MENU))
(##MOVETO## (LAFITE.MOVETO WINDOW MAILFILEDATA
(if (AND (EQ KEY (QUOTE MIDDLE))
(fetch (WINDOWPROP MOVETOFILE)
of WINDOW))
else (U-CASE (MENU LAFAITEFOLDERSMENU)
))
ITEM MENU KEY))
(SHOULDNT ITEM])
(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) (* M.Yonke "29-JUN-83 12:43")
(* * this function is invoked by buttoning the menu on top of the "sending" window * *)
(PROG (COMMAND TEXTSTREAM)
(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 *)
(TEDIT.QUIT [SETQ TEXTSTREAM (fetch (WINDOWPROP TEXTSTREAM)
of (fetch (WINDOWPROP MAINWINDOW)
of (WFROMMENU MENU]
(create SENDINGCOMMAND
COMMAND ← COMMAND
ITEM ← ITEM
MENU ← MENU
MESSAGE ← TEXTSTREAM)))
(SHOULDNT])
(LAFITE.GETMAIL
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* M.Yonke "10-AUG-83 11:24")
(ADD.PROCESS (LIST (FUNCTION GETMAIL.PROC)
(KWOTE WINDOW)
(KWOTE MAILFILEDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE LAFITEGETMAIL)
(QUOTE RESTARTABLE)
(QUOTE NO])
(GETMAIL.PROC
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* M.Yonke "11-AUG-83 13:12")
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(PROG (MAILFILE)
(if (POLLNEWMAIL)
then (SETQ MAILFILE (fetch (MAILFILEDATA FILENAME)
of MAILFILEDATA))
(for MSGDESCRIPTOR
in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
when (fetch (MESSAGEDESCRIPTOR SELECTED?)
of MSGDESCRIPTOR)
do (* first undo all old selections *)
(UNSELECTMESSAGE MSGDESCRIPTOR WINDOW))
(replace (WINDOWPROP CURRENTDISPLAYED#) of WINDOW
with NIL) (* now we know the TOC file is bad so delete it *)
(DELFILE (TOCFILENAME MAILFILE))
(GETNEWMAIL MAILFILE WINDOW)
(* get the new mail *)
(POLLNEWMAIL) (* update "new mail" message *)])
(LAFITE.UPDATE
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* M.Yonke " 1-AUG-83 16:42")
(if (LA.MOUSECONFIRM "LEFT button to 'Update' - MIDDLE or RIGHT to abort.")
then (ADD.PROCESS (LIST (FUNCTION UPDATE.PROC)
(KWOTE WINDOW)
(KWOTE MAILFILEDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE LAFITEUPDATE)
(QUOTE RESTARTABLE)
(QUOTE NO])
(UPDATE.PROC
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* M.Yonke " 1-AUG-83 16:36")
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(PROG (FILENAME MENUWINDOW)
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(GRAYOUTWINDOW WINDOW)
(WRITEPROFILEFILE)
(COMPACTMAILFOLDER FILENAME MAILFILEDATA)
(CLEARW WINDOW)
(BUILDBROWSERMAP (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
(fetch (MAILFILEDATA FILENAME) of MAILFILEDATA)
WINDOW)
(replace (WINDOWPROP CURRENTDISPLAYED#) of WINDOW with NIL)
(replace (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW with NIL)
(NEXTMESSAGETODISPLAY WINDOW MAILFILEDATA])
(CHECKLAFITEMAILFOLDERS
[LAMBDA NIL (* M.Yonke "10-AUG-83 11:26")
(* * 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 * *)
(if (WINDOWP LAFITECOMMANDWINDOW)
then (for WINDOW in (fetch (WINDOWPROP LAFITEBROWSERWINDOWS) of LAFITECOMMANDWINDOW)
bind MAILFILEDATA FILENAME
do (SETQ MAILFILEDATA (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(if (INFILEP FILENAME)
then (if (HIGHESTVERSIONP FILENAME)
then (if (NOT (FILELENGTHMATCHESDATAP FILENAME MAILFILEDATA))
then (* either it grew or shrunk *)
(printout PROMPTWINDOW T "The file " FILENAME
" has changed - reparsing "
FILENAME " ... ")
(SETQ MAILFILEDATA (GETMAILFOLDER FILENAME))
(printout PROMPTWINDOW "done.")
(CLEARW WINDOW)
(BUILDBROWSERMAP (fetch (MAILFILEDATA
MESSAGEDESCRIPTORS)
of MAILFILEDATA)
FILENAME WINDOW)
(NEXTMESSAGETODISPLAY WINDOW MAILFILEDATA))
else (printout T FILENAME CONFLICTINGVERSION#STR1 T
CONFLICTINGVERSION#STR2)
(CLOSEMAILBROWSER WINDOW MAILFILEDATA))
else (printout PROMPTWINDOW T "Couldn't find file " FILENAME
" - closing its browser window.")
(CLOSEW WINDOW])
(HIGHESTVERSIONP
[LAMBDA (MAILFILENAME) (* M.Yonke "12-APR-83 12:42")
(* * find out if there is a higher version number of this file * *)
(if MAILFILENAME
then (if (EQP (FILENAMEFIELD MAILFILENAME (QUOTE VERSION))
(FILENAMEFIELD (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
MAILFILENAME))
(QUOTE VERSION)))
then T
elseif [AND (OPENP MAILFILENAME)
(NOT (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
MAILFILENAME]
then
(* * THIS IS A KLUDGE FOR INTERLISP-D THAT SHOULD GO AWAY SOON AND THE EQP CHECK WILL BE ENOUGH * *)
T])
(EMPTYMAILFOLDERP
[LAMBDA (MAILFILE) (* M.Yonke "14-JUN-83 12:19")
(EQP (GETFILEINFO MAILFILE (QUOTE LENGTH))
0])
(FILELENGTHMATCHESDATAP
[LAMBDA (MAILFILE MAILFILEDATA) (* M.Yonke "13-APR-83 10:29")
(EQP (GETFILEINFO MAILFILE (QUOTE LENGTH))
(fetch (MAILFILEDATA MAILFILEOLDEOFPTR) of MAILFILEDATA])
)
(PUTPROPS LAFITE ARGNAMES (ON/OFF MAILFILE))
(DEFINEQ
(DOMAINLAFITECOMMAND
[LAMBDA (ITEM MENU BUTTON) (* M.Yonke " 1-AUG-83 17:01")
(PROG (FORMTYPE TEMP)
(SELECTQ (EXTRACTMENUCOMMAND ITEM)
(##BROWSE## (if (SETQ TEMP (U-CASE (MENU LAFAITEFOLDERSMENU)))
then (LAFITE.BROWSE TEMP ITEM MENU)))
(##SENDMAIL## (LAFITE.MESSAGEFORM ITEM MENU BUTTON))
[##QUIT## (if (LA.MOUSECONFIRM "LEFT button to 'Quit' - MIDDLE or RIGHT to abort.")
then (ADD.PROCESS (LIST (FUNCTION LAFITE.QUIT)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE LAFITEQUIT)
(QUOTE RESTARTABLE)
(QUOTE NO]
(SHOULDNT])
(LAFITE.BROWSE
[LAMBDA (FILE ITEM MENU) (* M.Yonke " 1-AUG-83 16:32")
(PROG (BROWSERWINDOW MAILFILE)
(if [WINDOWP (SETQ BROWSERWINDOW (fetch LAFITEBROWSERWINDOW of (SETQ MAILFILE
(MAKEMAILFOLDER FILE]
then (* browser was just closed *)
(OPENW BROWSERWINDOW)
else (ADD.PROCESS (LIST (FUNCTION BROWSE.PROC)
(KWOTE MAILFILE)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE NAME)
(QUOTE LAFITEBROWSE])
(BROWSE.PROC
[LAMBDA (MAILFILE ITEM MENU) (* M.Yonke "16-AUG-83 16:55")
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(if MAILFILE
then (WITH.MONITOR
(LA.GETFILELOCK MAILFILE)
(PROG (BROWSERWINDOW MAILFILEDATA TITLE CLOSEFNPROP)
(SETQ MAILFILEDATA (GETMAILFOLDER MAILFILE))
(SETQ MAILFILE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(if (NULL MAILFILE)
then (* must have gotten NIL from the "Browse" Lafite menu
command *)
(RETURN))
(if (OR (NULL (SETQ BROWSERWINDOW
(fetch LAFITEBROWSERWINDOW of MAILFILE)))
(AND (fetch (WINDOWPROP LAFITEBROWSERWINDOWS)
of LAFITECOMMANDWINDOW)
(NOT (MEMB BROWSERWINDOW
(fetch (WINDOWPROP LAFITEBROWSERWINDOWS)
of LAFITECOMMANDWINDOW)))
(EQUAL (fetch (WINDOWPROP REGION) of BROWSERWINDOW)
LAFITEBROWSERREGION)))
then
(* either there wasn't a window or there was but it was "closed" and there is another one -- which would be in
LAFITEBROWSERREGION -- and BROWSERWINDOW takes up the same space as LAFITEBROWSERREGION *)
(SETQ TITLE (CONCAT "Mail browser for " MAILFILE))
(SETQ BROWSERWINDOW
(MAKEMENUEDWINDOW LAFITEBROWSERMENUITEMS TITLE
(QUOTE TOP)
(AND (NULL (fetch (WINDOWPROP
LAFITEBROWSERWINDOWS)
of LAFITECOMMANDWINDOW))
(type? REGION LAFITEBROWSERREGION)
LAFITEBROWSERREGION)))
(replace LAFITEBROWSERWINDOW of MAILFILE with BROWSERWINDOW)
(* save the browse window in the main menu window *)
(WINDOWADDPROP LAFITECOMMANDWINDOW
(QUOTE LAFITEBROWSERWINDOWS)
BROWSERWINDOW)
(* take off what MENUEDWINDOW put on *)
(replace (WINDOWPROP ORIGINALTITLE) of BROWSERWINDOW
with TITLE)
(replace (WINDOWPROP OPENFN)
of (fetch (WINDOWPROP MENUWINDOW) of BROWSERWINDOW)
with NIL) (* set the right margin BIG *)
(DSPRIGHTMARGIN MAX.SMALLP BROWSERWINDOW)
(DSPFONT LAFITEBROWSERFONT BROWSERWINDOW)
elseif (ACTIVEWP BROWSERWINDOW)
else (OPENW BROWSERWINDOW))
(replace (WINDOWPROP LAFITEDATA) of BROWSERWINDOW with MAILFILEDATA)
(replace (WINDOWPROP SCROLLFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERSCROLLFN))
(replace (WINDOWPROP REPAINTFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERREPAINTFN))
(replace (WINDOWPROP ICONFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERICONFN))
(BUILDBROWSERMAP (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
MAILFILE BROWSERWINDOW)
(NEXTMESSAGETODISPLAY BROWSERWINDOW MAILFILEDATA)
(* * now that the browser is up and the map is built, put on the Lafite window manipulation functions * *)
(replace (WINDOWPROP BUTTONEVENTFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERBUTTONEVENTFN))
(replace (WINDOWPROP RIGHTBUTTONFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERBUTTONEVENTFN))
(* make sure Lafite has the first CLOSEFN *)
(SETQ CLOSEFNPROP (fetch (WINDOWPROP CLOSEFN) of BROWSERWINDOW))
(replace (WINDOWPROP CLOSEFN) of BROWSERWINDOW
with (if (OR (NULL CLOSEFNPROP)
(LISTP CLOSEFNPROP))
then (CONS (FUNCTION LAFITEBROWSERCLOSEFN)
CLOSEFNPROP)
else (LIST (FUNCTION LAFITEBROWSERCLOSEFN)
CLOSEFNPROP)))
(WINDOWADDPROP BROWSERWINDOW (QUOTE CLOSEFN)
(FUNCTION LAFITEBROWSERCLOSEFN))
(WINDOWADDPROP BROWSERWINDOW (QUOTE RESHAPEFN)
(FUNCTION LAFITEBROWSERRESHAPEFN))
(WINDOWADDPROP BROWSERWINDOW (QUOTE AFTERMOVEFN)
(FUNCTION LAFITEBROWSERAFTERMOVEFN))
(replace (WINDOWPROP CURSORMOVEDFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERCURSORMOVEDFN))
(replace (WINDOWPROP CURSOROUTFN) of BROWSERWINDOW
with (FUNCTION LAFITEBROWSERCURSOROUTFN))
(* save the data *)
(replace (MENU WHENSELECTEDFN)
of (CAR (fetch (WINDOWPROP MENU)
of (fetch (WINDOWPROP MENUWINDOW) of BROWSERWINDOW)))
with (FUNCTION DOLAFITEBROWSERCOMMAND])
(LAFITE.MESSAGEFORM
[LAMBDA (ITEM MENU BUTTON) (* M.Yonke "26-JUL-83 13:19")
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(PROG (FORMTYPE)
(ADD.PROCESS [LIST (FUNCTION SENDMESSAGE)
(if (EQ BUTTON (QUOTE LEFT))
then (MAKENEWMESSAGEFORM)
else (SETQ FORMTYPE (U-CASE (MENU LAFITEFORMSMENU)))
(SELECTQ FORMTYPE
(##NEWMESSAGE## (MAKENEWMESSAGEFORM))
(##LAFITESUPPORT## (MAKELAFITESUPPORTFORM))
(##LISPSUPPORT## (MAKELISPSUPPORTFORM))
(##LASTMESSAGE## LAFITELASTMESSAGE)
(##ANOTHERFORM## (if (GETANOTHERFORM)
else
(* couldn't find a form to sendmail -- just get out and
don't call SENDMAIL *)
(RETURN)))
(if FORMTYPE
then (if (GETANOTHERFORM FORMTYPE)
else
(* ditto *)
(RETURN]
(QUOTE NAME)
(QUOTE MESSAGESENDER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(LAFITE.QUIT
[LAMBDA (ITEM MENU) (* M.Yonke "17-AUG-83 13:16")
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE) (* kill the mail watch process *)
(DEL.PROCESS (FUNCTION LAFITEMAILWATCH))
[for WINDOW in (CONS PRIMARYEDITORWINDOW (APPEND LAFITEEDITORWINDOWS LAFITEDISPLAYWINDOWS))
do (* now close the edit and display windows *)
(if (WINDOWP WINDOW)
then (if (ACTIVEWP WINDOW)
then (CLOSEW WINDOW)
elseif (WINDOWP (fetch (WINDOWPROP ICONWINDOW) of WINDOW))
then (CLOSEW (fetch (WINDOWPROP ICONWINDOW) of WINDOW]
(SETQ LAFITEEDITORWINDOWS (SETQ LAFITEDISPLAYWINDOWS (SETQ PRIMARYDISPLAYWINDOW NIL)))
(for WINDOW in (fetch (WINDOWPROP LAFITEBROWSERWINDOWS) of LAFITECOMMANDWINDOW)
when (WINDOWP WINDOW)
do (* A list of browse windows)
(CLOSEMAILBROWSER WINDOW (fetch (WINDOWPROP LAFITEDATA) of WINDOW)))
(WRITEPROFILEFILE)
(replace (WINDOWPROP LAFITEBROWSERWINDOWS) of LAFITECOMMANDWINDOW with NIL)
(CLRHASH LAFITE.FILE.TO.WINDOW.HARRAY)
(CLRHASH LAFITE.FILE.TO.MONITOR.HARRAY) (* closing the main window will also close the menu
window *)
(if (WINDOWP LAFITEPROMPTWINDOW)
then (CLOSEW LAFITEPROMPTWINDOW))
(SETQ AFTERLOGOUTFORMS (REMOVE (CONSTANT (LIST (FUNCTION LAFITEAFTERLOGOUT)))
AFTERLOGOUTFORMS))
(for FILE in (WINDOWPROP LAFITECOMMANDWINDOW (QUOTE LAFITETEMPFILES))
do (* delete any temp files laying around *)
(CLOSEF? FILE)
(DELFILE FILE)) (* finally wipe out the main Lafite windows *)
(SETQ \LAFITEDEFAULTHOST&DIR NIL)
(SETQ LAFITECOMMANDWINDOW (SETQ LAFITEPROMPTWINDOW NIL))
(SETQ \LAFITEUSERDATA NIL])
)
(DEFINEQ
(LAFITEBROWSERBUTTONEVENTFN
[LAMBDA (WINDOW) (* M.Yonke "10-AUG-83 11:35")
(if (INSIDEP (create REGION using (DSPCLIPPINGREGION NIL WINDOW)
LEFT ← 0 WIDTH ← BROWSERSELECTLIMITXPOSITION)
(LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
then [RESETLST (PROG (LOCK FILENAME)
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW)))
(if (SETQ LOCK (OBTAIN.MONITORLOCK (LA.GETFILELOCK FILENAME)
T T))
then (RESETSAVE NIL (LIST (FUNCTION RELEASE.MONITORLOCK)
LOCK))
(BROWSERSELECTMESSAGE WINDOW)
else (MAILFOLDERBUSY FILENAME]
elseif (LASTMOUSESTATE (ONLY RIGHT))
then (DOWINDOWCOM WINDOW)
else (TOTOPW WINDOW])
(BROWSERSELECTMESSAGE
[LAMBDA (WINDOW) (* M.Yonke " 8-AUG-83 15:16")
(PROG (MAILFILEDATA MSGDESCRIPTOR SETSEL ADDSEL EXTEND CURRENT#S MSG# FIRST# LAST# TEMP#S)
(* * keep looping until all mouse buttons are up * *)
(SETQ MAILFILEDATA (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
(until (MOUSESTATE UP) bind CURRENTADDSELMSG
when (INSIDEP (create REGION using (DSPCLIPPINGREGION NIL WINDOW)
LEFT ← 0 WIDTH ← BROWSERSELECTLIMITXPOSITION)
(LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
do (SETQ SETSEL (LASTMOUSESTATE LEFT))
(SETQ ADDSEL (LASTMOUSESTATE MIDDLE))
(SETQ EXTEND (LASTMOUSESTATE RIGHT))
[SETQ MSGDESCRIPTOR (find MSGDESCRIPTOR
in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA)
bind [YPOS ←(IPLUS (LASTMOUSEY WINDOW)
(FONTPROP WINDOW (QUOTE DESCENT]
suchthat (IGREATERP YPOS
(fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of MSGDESCRIPTOR]
(SETQ CURRENT#S (SORT (fetch (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW)))
[if (NULL MSGDESCRIPTOR)
elseif (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))
then (UNSELECTMESSAGE MSGDESCRIPTOR WINDOW)
elseif (NULL CURRENT#S)
then (* just make MSGDESCRIPTOR selected *)
(SELECTMESSAGE MSGDESCRIPTOR WINDOW)
elseif SETSEL
then (for MSG# in CURRENT#S
do (if (NOT (EQP MSG# (fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR)))
then (UNSELECTMESSAGE (NTHITEM (fetch (MAILFILEDATA
MESSAGEDESCRIPTORS)
of MAILFILEDATA)
MSG#)
WINDOW)))
(SELECTMESSAGE MSGDESCRIPTOR WINDOW)
elseif ADDSEL
then (if CURRENTADDSELMSG
then (if (NEQ CURRENTADDSELMSG MSGDESCRIPTOR)
then (UNSELECTMESSAGE CURRENTADDSELMSG WINDOW)
(SETQ CURRENTADDSELMSG MSGDESCRIPTOR)
(SELECTMESSAGE MSGDESCRIPTOR WINDOW))
else (SETQ CURRENTADDSELMSG MSGDESCRIPTOR)
(SELECTMESSAGE MSGDESCRIPTOR WINDOW))
elseif EXTEND
then (* have to find all the messages between MSGDESCRIPTOR
and the one selected *)
(SETQ MSG# (fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR))
(if [AND (SETQ TEMP#S (MEMB MSG# CURRENT#S))
(NOT (EQUAL TEMP#S CURRENT#S))
(NOT (EQP MSG# (LASTITEM CURRENT#S]
then (* shrink selection *)
(for I in (if (IGEQ (IQUOTIENT (LENGTH CURRENT#S)
2)
(LENGTH TEMP#S))
then TEMP#S
else (LDIFFERENCE CURRENT#S TEMP#S))
do (UNSELECTMESSAGE (NTHITEM (fetch (MAILFILEDATA
MESSAGEDESCRIPTORS)
of MAILFILEDATA)
I)
WINDOW))
else [if (ILESSP MSG# (CAR CURRENT#S))
then (* before *)
(SETQ FIRST# MSG#)
(SETQ LAST# (SUB1 (CAR CURRENT#S)))
else (SETQ LAST# MSG#) (* after *)
(SETQ FIRST# (ADD1 (LASTITEM CURRENT#S]
(for I from FIRST# to LAST#
do (SELECTMESSAGE (NTHITEM (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
I)
WINDOW]
finally (replace (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW
with (SORT (fetch (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW])
(GETMAILFOLDER
[LAMBDA (FILE) (* M.Yonke " 4-AUG-83 11:06")
(PROG (MAILFILE MAILFILEDATA CONTENTSFILE DONEFLG MSGDESCRIPTORS)
(* MAKEMAILFOLDER returns the FULL filename for the
mailfile *)
(if (NULL (SETQ MAILFILE (MAKEMAILFOLDER FILE)))
then (GO BADFILE))
(if (AND (NOT LAFITEUSEHIGHESTVERSIONFLG)
(NOT (HIGHESTVERSIONP MAILFILE)))
then (printout PROMPTWINDOW T (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
MAILFILE)
CONFLICTINGVERSION#STR1 T CONFLICTINGVERSION#STR2)
(GO BADFILE))
(if (INFILEP (SETQ CONTENTSFILE (TOCFILENAME MAILFILE)))
then (SETQ CONTENTSFILE (OPENFILE CONTENTSFILE (QUOTE INPUT)))
(SETQ MAILFILEDATA (READ CONTENTSFILE))
(CLOSEF CONTENTSFILE) (* now check to see if the TOC file's data checks with
the mailfile itself *)
(if (AND (if (EQP LAFITEVERSION# (fetch (MAILFILEDATA LAFITEVERSION#)
of MAILFILEDATA))
else (printout PROMPTWINDOW T
"Lafite has changed it's internal format since this file was last written.")
NIL)
(FILELENGTHMATCHESDATAP MAILFILE MAILFILEDATA))
then (* everything looks OK *)
(RETURN MAILFILEDATA)
else (printout PROMPTWINDOW T "Having to parse " MAILFILE " ... ")
(SETQ DONEFLG T))
(if (NEQ MAILFILE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
then (* someone did on rename of FOO.* to FIE.* *)
(replace (MAILFILEDATA FILENAME) of MAILFILEDATA with MAILFILE)))
(* * If we got this far, either there wasn't a TOC data file or it had a bad format so we now have to reparse the
entire message file * *)
(if [OR (EMPTYMAILFOLDERP MAILFILE)
(SETQ MSGDESCRIPTORS (CAR (NLSETQ (PARSEMAILFOLDER MAILFILE]
then [SETQ MAILFILEDATA
(create MAILFILEDATA
FILENAME ← MAILFILE
MESSAGEDESCRIPTORS ← MSGDESCRIPTORS
LAFITEVERSION# ← LAFITEVERSION#
MAILFILEOLDEOFPTR ←(GETFILEINFO MAILFILE (QUOTE LENGTH]
(if DONEFLG
then (printout PROMPTWINDOW "done."))
(RETURN MAILFILEDATA)
else (printout PROMPTWINDOW T "Couldn't parse file " MAILFILE ".")
(GO BADFILE))
BADFILE
(FORGETMAILFOLDER MAILFILE])
(BUILDBROWSERMAP
[LAMBDA (MSGDESCRIPTORS FILE WINDOW ADDFLG) (* M.Yonke " 1-AUG-83 16:43")
(PROG (OFILE NEWMESSAGEDESCRIPTORS OLDMESSAGEDESCRIPTORS $$MAXWIDTH$$)
(DECLARE (SPECVARS $$MAXWIDTH$$))
(WITH.MONITOR
(LA.GETFILELOCK FILE)
(DSPRIGHTMARGIN MAX.SMALLP WINDOW)
(LINELENGTH 1000 WINDOW) (* printing headers to arbitrary width, $$MAXWIDTH$$ is
set by PRINTHEADER.)
(SETQ $$MAXWIDTH$$ (OR (fetch (REGION WIDTH) of (fetch (WINDOWPROP EXTENT) of WINDOW))
0))
(SETQ OLDMESSAGEDESCRIPTORS (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW)))
(SETQ OFILE (OPENMAILFOLDER FILE (QUOTE INPUT)))
(* first get the Y position right *)
(if (AND OLDMESSAGEDESCRIPTORS ADDFLG)
then (DSPYPOSITION (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of (LASTITEM OLDMESSAGEDESCRIPTORS))
WINDOW)
(TERPRI WINDOW)
else (CLEARW WINDOW))
(SETQ NEWMESSAGEDESCRIPTORS (for MSGDESCRIPTOR in MSGDESCRIPTORS as MSGCOUNT
from (if ADDFLG
then (ADD1 (LENGTH OLDMESSAGEDESCRIPTORS))
else 1)
collect (replace (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of MSGDESCRIPTOR
with (DSPYPOSITION NIL WINDOW))
(PRINTMESSAGESUMMARY MSGDESCRIPTOR MSGCOUNT OFILE
WINDOW)
MSGDESCRIPTOR))
(replace (MAILFILEDATA MESSAGEDESCRIPTORS) of (fetch (WINDOWPROP LAFITEDATA) of WINDOW)
with (if ADDFLG
then (APPEND OLDMESSAGEDESCRIPTORS NEWMESSAGEDESCRIPTORS)
else NEWMESSAGEDESCRIPTORS))
[replace (WINDOWPROP EXTENT) of WINDOW
with (create REGION
LEFT ← 0
BOTTOM ←(IDIFFERENCE (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE DESCENT)))
WIDTH ← $$MAXWIDTH$$
HEIGHT ←(IPLUS
(IDIFFERENCE (OR [fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of (CAR (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of (fetch (WINDOWPROP LAFITEDATA)
of WINDOW]
(DSPYPOSITION NIL WINDOW))
(DSPYPOSITION NIL WINDOW))
(FONTPROP WINDOW (QUOTE HEIGHT]
(CLOSEMAILFOLDER FILE])
(LAFITEBROWSERREPAINTFN
[LAMBDA (WINDOW REGION) (* M.Yonke "26-JUL-83 14:42")
(DECLARE (SPECVARS $$MAXWIDTH$$))
(PROG ((MAILFILEDATA (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
[TOP (IPLUS (fetch (REGION TOP) of REGION)
(FONTPROP WINDOW (QUOTE DESCENT]
[BOTTOM (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
(FONTPROP WINDOW (QUOTE ASCENT]
($$MAXWIDTH$$ 0)
FILE)
(SETQ FILE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
RETRY
(for MSGDESCRIPTOR in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA)
as MSGCOUNT from (fetch (MESSAGEDESCRIPTOR #)
of (CAR (fetch (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA)))
eachtime (if (NOT (FIXP (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)))
then (* rebuild map -- something is wrong *)
(BUILDBROWSERMAP (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
FILE WINDOW)
(GO RETRY))
when (AND (IGREATERP TOP (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR))
(ILESSP BOTTOM (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)))
do (MOVETO 0 (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)
WINDOW)
(PRINTMESSAGESUMMARY MSGDESCRIPTOR MSGCOUNT FILE WINDOW)
repeatwhile (ILESSP BOTTOM (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of MSGDESCRIPTOR])
(LAFITEBROWSERSCROLLFN
[LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* M.Yonke "10-AUG-83 11:36")
(* * only scroll if can get the monitor lock * *)
(RESETLST (PROG (LOCK FILENAME)
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW)))
(if (SETQ LOCK (OBTAIN.MONITORLOCK (LA.GETFILELOCK FILENAME)
T T))
then (RESETSAVE NIL (LIST (FUNCTION RELEASE.MONITORLOCK)
LOCK))
(SCROLLBYREPAINTFN WINDOW DX DY CONTINUOUSFLG)
else (MAILFOLDERBUSY FILENAME])
(LAFITEBROWSERRESHAPEFN
[LAMBDA (WINDOW) (* M.Yonke "28-JUL-83 11:48")
(CLEARW WINDOW)
(DSPRIGHTMARGIN MAX.SMALLP WINDOW) (* this got changed during the reshape *)
(replace (WINDOWPROP BROWSERPROMPTWINDOW) of WINDOW with NIL)
(INSUREMESSAGEINBROWSERWINDOW WINDOW
(NTHITEM (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
(OR (FIXP (CAR (fetch (WINDOWPROP CURRENTMESSAGENUMBERS)
of WINDOW)))
1])
(LAFITEBROWSERAFTERMOVEFN
[LAMBDA (WINDOW) (* M.Yonke "22-JUL-83 15:38")
(replace (WINDOWPROP BROWSERPROMPTWINDOW) of WINDOW with NIL])
(LAFITEBROWSERCLOSEFN
[LAMBDA (BROWSERWINDOW) (* M.Yonke "17-AUG-83 11:54")
(SELECTQ (MENU LAFITECLOSEFNMENU)
(##UPDATE## (SHADEITEM (ASSOC (QUOTE Update)
LAFITEBROWSERMENUITEMS)
(CAR (fetch (WINDOWPROP MENU)
of (fetch (WINDOWPROP MENUWINDOW) of BROWSERWINDOW)))
LAFITEITEMBUSYSHADE
(fetch (WINDOWPROP MENUWINDOW) of BROWSERWINDOW))
(* CLOSEMAILBROWSER will really close the window when
its done *)
(ADD.PROCESS (LIST (FUNCTION CLOSEMAILBROWSER)
(KWOTE BROWSERWINDOW)
(KWOTE (fetch (WINDOWPROP LAFITEDATA) of BROWSERWINDOW)))
(QUOTE RESTARTABLE)
(QUOTE NO)))
((NIL ##DON'T##) (* either buttoned out of the menu or selected don't *)
(QUOTE DON'T))
(##CLOSE## (CLOSEMAILFOLDER (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA) of BROWSERWINDOW))
T)
NIL)
(SHOULDNT])
(LAFITEBROWSERCURSORMOVEDFN
[LAMBDA (WINDOW) (* M.Yonke " 8-AUG-83 14:47")
(SETCURSOR (if (INSIDEP (create REGION using (DSPCLIPPINGREGION NIL WINDOW)
LEFT ← 0 WIDTH ← BROWSERSELECTLIMITXPOSITION)
(CURSORPOSITION NIL WINDOW))
then LA.RIGHTARROWCURSOR
else DEFAULTCURSOR])
(LAFITEBROWSERCURSOROUTFN
[LAMBDA (WINDOW) (* rao: "30-JUN-82 15:49")
(SETCURSOR DEFAULTCURSOR])
)
(DEFINEQ
(CLOSEMAILBROWSER
[LAMBDA (WINDOW MAILFILEDATA) (* M.Yonke " 1-AUG-83 16:37")
(* * This is the real workhorse of closing a mail browser * *)
(PROG (FILENAME)
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(GRAYOUTWINDOW WINDOW)
(COMPACTMAILFOLDER FILENAME MAILFILEDATA)
(replace (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW with NIL)
(replace (WINDOWPROP CURRENTDISPLAYED#) of WINDOW with NIL)
(replace (WINDOWPROP LAFITEDATA) of WINDOW with NIL)
(if (fetch (WINDOWPROP MESSAGEFILE) of WINDOW)
then (DELFILE (fetch (WINDOWPROP MESSAGEFILE) of WINDOW))
(replace (WINDOWPROP MESSAGEFILE) of WINDOW with NIL))
(* now get rid of Lafite's knowledge of this browser
window *)
(WINDOWDELPROP LAFITECOMMANDWINDOW (QUOTE LAFITEBROWSERWINDOWS)
WINDOW) (* finally, disassociate the window from the filename *)
(replace LAFITEBROWSERWINDOW of FILENAME with NIL)
(CLOSEMAILFOLDER FILENAME T)
(CLEARW WINDOW)
(LA.CLOSEW! WINDOW)
(LA.CLOSEW! (fetch (WINDOWPROP MENUWINDOW) of WINDOW))
(if (EMPTYMAILFOLDERP FILENAME)
then (DELETEMAILFOLDER FILENAME])
(ADDMESSAGESTOMAILBROWSER
[LAMBDA (MAILFILE NEWMESSAGEDESCRIPTORS) (* M.Yonke "30-JUN-83 10:18")
(PROG (OLDMESSAGEDESCRIPTORS MAILFILEDATA WINDOW)
(if (SETQ WINDOW (fetch LAFITEBROWSERWINDOW of MAILFILE))
then (SETQ MAILFILEDATA (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
(SETQ OLDMESSAGEDESCRIPTORS (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA))
(* get the new file length *)
(replace (MAILFILEDATA MAILFILEOLDEOFPTR) of MAILFILEDATA
with (GETFILEINFO MAILFILE (QUOTE LENGTH)))
(* (INSUREMESSAGEINBROWSERWINDOW WINDOW
(CAR (LAST OLDMESSAGEDESCRIPTORS))))
(BUILDBROWSERMAP NEWMESSAGEDESCRIPTORS MAILFILE WINDOW T])
(COMPACTMAILFOLDER
[LAMBDA (FILE MAILFILEDATA) (* M.Yonke "18-AUG-83 13:28")
(PROG (SCRATCHFILE MAILFILE FIRSTMSGDESCRIPTORS LASTGOODMSGDESCRIPTOR RESTMSGDESCRIPTORS
GOODMSGSPTR)
(* * 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 -
GOODMSGSPTR will be a pointer into the mail file to the end of the last consecutive good message -
RESTMSGDESCRIPTORS will be the rest of the message descriptors to map down * *)
(SETQ GOODMSGSPTR (for MSGDESCRIPTORS on (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
bind MSGDESCRIPTOR eachtime (SETQ MSGDESCRIPTOR (CAR MSGDESCRIPTORS))
until (fetch (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR)
sum (replace (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR
with NIL)
(SETQ FIRSTMSGDESCRIPTORS
(DOCOLLECT MSGDESCRIPTOR FIRSTMSGDESCRIPTORS))
(fetch (MESSAGEDESCRIPTOR MESSAGELENGTH) of MSGDESCRIPTOR)
finally (SETQ FIRSTMSGDESCRIPTORS (ENDCOLLECT FIRSTMSGDESCRIPTORS))
(SETQ RESTMSGDESCRIPTORS MSGDESCRIPTORS)
(RETURN $$VAL))) (* the BOTH is so the (SETFILEINFO MAILFILE 'LENGTH
GOODMSGSPTR) will work farther down -
it has to be open for output *)
(SETQ MAILFILE (OPENMAILFOLDER FILE (QUOTE BOTH)))
(if (NULL RESTMSGDESCRIPTORS)
then (* nothing was deleted *)
(GO OUT))
(DELFILE (TOCFILENAME MAILFILE))
(* * if we got here we have some deleted messages -- open up a scratch file * *)
(SETQ SCRATCHFILE (LA.OPENTEMPFILE (QUOTE SCRATCH)
(QUOTE OUTPUT)
(QUOTE NEW)))
(* * now map down the rest of the messages moving the not deleted ones in the scratch file * *)
(SETQ LASTGOODMSGDESCRIPTOR (LASTITEM FIRSTMSGDESCRIPTORS))
(SETQ RESTMSGDESCRIPTORS (for MSGDESCRIPTOR in RESTMSGDESCRIPTORS
bind (MSG# ←(ADD1 (OR (fetch (MESSAGEDESCRIPTOR #)
of LASTGOODMSGDESCRIPTOR)
0)))
(FILEPTR ←(OR (AND LASTGOODMSGDESCRIPTOR
(fetch (MESSAGEDESCRIPTOR END)
of LASTGOODMSGDESCRIPTOR))
0))
when (NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRIPTOR))
collect (COPYBYTES MAILFILE SCRATCHFILE
(fetch (MESSAGEDESCRIPTOR BEGIN)
of MSGDESCRIPTOR)
(fetch (MESSAGEDESCRIPTOR END)
of MSGDESCRIPTOR))
(replace (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR
with MSG#)
(replace (MESSAGEDESCRIPTOR SELECTED?)
of MSGDESCRIPTOR with NIL)
(replace (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of MSGDESCRIPTOR with NIL)
(replace (MESSAGEDESCRIPTOR BEGIN) of MSGDESCRIPTOR
with FILEPTR)
(add FILEPTR (fetch (MESSAGEDESCRIPTOR MESSAGELENGTH)
of MSGDESCRIPTOR))
(add MSG# 1)
MSGDESCRIPTOR))
(CLOSEF SCRATCHFILE)
(* * set the pointer to the end of the good messages * *)
(SETFILEPTR MAILFILE GOODMSGSPTR)
[if (NULL RESTMSGDESCRIPTORS)
then (* special case -- the last n messages were deleted --
can ignore the scratch file *)
(replace (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA
with FIRSTMSGDESCRIPTORS)
(replace (MAILFILEDATA MAILFILEOLDEOFPTR) of MAILFILEDATA with GOODMSGSPTR)
(SETFILEPTR MAILFILE GOODMSGSPTR)
(SETFILEINFO MAILFILE (QUOTE LENGTH)
GOODMSGSPTR)
(CLOSEF MAILFILE)
else (* have to copy the scratch file to the end of the good
messages left in the original file *)
(SETQ SCRATCHFILE (OPENFILE SCRATCHFILE (QUOTE INPUT)))
(SETQ MAILFILE (OPENFILE MAILFILE (QUOTE APPEND)))
(COPYBYTES SCRATCHFILE MAILFILE)
(SETFILEINFO MAILFILE (QUOTE LENGTH)
(GETFILEPTR MAILFILE))
(CLOSEF MAILFILE)
(CLOSEF SCRATCHFILE)
(replace (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA
with (APPEND FIRSTMSGDESCRIPTORS RESTMSGDESCRIPTORS))
(replace (MAILFILEDATA MAILFILEOLDEOFPTR) of MAILFILEDATA
with (GETFILEINFO MAILFILE (QUOTE LENGTH]
OUT (DELFILE SCRATCHFILE)
(UPDATECONTENTSFILE MAILFILE MAILFILEDATA])
)
(DEFINEQ
(LAFITE.DISPLAY
[LAMBDA (WINDOW MAILFILEDATA NEWWINDOWFLG ITEM MENU) (* M.Yonke "17-AUG-83 12:08")
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(PROG (MSGDESCRIPTOR FROMFILE IFILE TEMPMSG DISPLAYWINDOW)
(SETQ FROMFILE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(SETQ MSGDESCRIPTOR (NEXTMESSAGETODISPLAY WINDOW MAILFILEDATA))
(if MSGDESCRIPTOR
then (INSUREMESSAGEINBROWSERWINDOW WINDOW MSGDESCRIPTOR)
(replace (WINDOWPROP CURRENTDISPLAYED#) of WINDOW
with (fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR))
(SETQ IFILE (OPENMAILFOLDER FROMFILE (QUOTE INPUT)))
(SETQ TEMPMSG (LA.OPENTEMPFILE (QUOTE DISPLAY)
(QUOTE OUTPUT)))
(if TEMPMSG
then (COPYBYTES IFILE TEMPMSG (fetch (MESSAGEDESCRIPTOR START)
of MSGDESCRIPTOR)
(fetch (MESSAGEDESCRIPTOR END)
of MSGDESCRIPTOR)))
(CLOSEF TEMPMSG)
(CLOSEMAILFOLDER IFILE)
(SEENMESSAGE MSGDESCRIPTOR WINDOW FROMFILE)
(SETQ DISPLAYWINDOW
(MESSAGEDISPLAYER TEMPMSG
(CONCAT "Message "
(fetch (MESSAGEDESCRIPTOR #)
of MSGDESCRIPTOR)
" from " FROMFILE " ["
(fetch (MESSAGEDESCRIPTOR MESSAGELENGTH)
of MSGDESCRIPTOR)
" chars]")
NEWWINDOWFLG))
else (printout PROMPTWINDOW T NOMOREMESSAGESSTR)
(* so that it will come to the top at the end of this
function *)
(SETQ DISPLAYWINDOW PRIMARYDISPLAYWINDOW)
(LA.FLASHWINDOW WINDOW))
(SHADEITEM ITEM MENU WHITESHADE) (* now make sure the display window is on top in case
SHADEITEM put the browser back on top *)
(if (WINDOWP DISPLAYWINDOW)
then (TOTOPW DISPLAYWINDOW])
(NEXTMESSAGETODISPLAY
[LAMBDA (WINDOW MAILFILEDATA) (* M.Yonke " 1-JUL-83 11:03")
(* * 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 (DISPLAYED# CURRENT#S MSGDESCRIPTOR MSGDESCRIPTORS)
(SETQ DISPLAYED# (fetch (WINDOWPROP CURRENTDISPLAYED#) of WINDOW))
(SETQ CURRENT#S (fetch (WINDOWPROP CURRENTMESSAGENUMBERS) of WINDOW))
(SETQ MSGDESCRIPTORS (fetch (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA))
(if (EQLENGTH CURRENT#S 0)
then (* just find the first unseen message *)
(if [SETQ MSGDESCRIPTOR (find MSGDESCRIPTOR in MSGDESCRIPTORS
suchthat (AND (NOT (fetch (MESSAGEDESCRIPTOR SEEN?)
of MSGDESCRIPTOR))
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRIPTOR]
else (SETQ MSGDESCRIPTOR (LASTITEM MSGDESCRIPTORS)))
elseif (EQLENGTH CURRENT#S 1)
then (* this is the ONE SELECTED case *)
[if (NULL DISPLAYED#)
then (* haven't displayed any yet *)
(SETQ MSGDESCRIPTOR (NTHITEM MSGDESCRIPTORS (CAR CURRENT#S)))
elseif (EQP DISPLAYED# (CAR CURRENT#S))
then (* its time to bump by one *)
(if (SETQ MSGDESCRIPTOR (NTHITEM MSGDESCRIPTORS (ADD1 DISPLAYED#)))
then (* only unselect if there is another message *)
(UNSELECTMESSAGE (NTHITEM MSGDESCRIPTORS DISPLAYED#)
WINDOW))
else (SETQ MSGDESCRIPTOR (NTHITEM MSGDESCRIPTORS (CAR CURRENT#S]
(* now just make sure it's not deleted *)
[if (AND (NOT LAFITEDISPLAYDELETEDMESSAGEFLG)
(fetch (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR))
then (* find the next undeleted message *)
(UNSELECTMESSAGE MSGDESCRIPTOR WINDOW)
(SETQ MSGDESCRIPTOR (find MSGDESCRIPTOR in (NTH MSGDESCRIPTORS
(ADD1 (CAR CURRENT#S)))
suchthat (NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRIPTOR]
elseif DISPLAYED#
then [if (MEMB DISPLAYED# CURRENT#S)
then (* just cycle through the list *)
[SETQ MSGDESCRIPTOR (NTHITEM MSGDESCRIPTORS
(if (CADR (MEMB DISPLAYED# CURRENT#S))
else (CAR CURRENT#S]
else (* grab the first one *)
(SETQ MSGDESCRIPTOR (NTHITEM MSGDESCRIPTORS (CAR CURRENT#S]
elseif [SETQ MSGDESCRIPTOR (find MSGDESCRIPTOR in MSGDESCRIPTORS
suchthat (AND (NOT (fetch (MESSAGEDESCRIPTOR SEEN?)
of MSGDESCRIPTOR))
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRIPTOR]
else (SETQ MSGDESCRIPTOR (LASTITEM MSGDESCRIPTORS)))
(if MSGDESCRIPTOR
then (SELECTMESSAGE MSGDESCRIPTOR WINDOW)
(INSUREMESSAGEINBROWSERWINDOW WINDOW MSGDESCRIPTOR))
(RETURN MSGDESCRIPTOR])
)
(DEFINEQ
(LAFITE.DELETE
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* M.Yonke "10-AUG-83 11:39")
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(for MSGDESCRIPTOR in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS) of MAILFILEDATA)
bind NEXTMSGDESCRIPTOR when (AND (fetch (MESSAGEDESCRIPTOR SELECTED?)
of MSGDESCRIPTOR)
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRIPTOR)))
collect (* delete all the currrently selected messages *)
(DELETEMESSAGE MSGDESCRIPTOR WINDOW)
(fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR)
finally (SHADEITEM ITEM MENU WHITESHADE)
(if (EQLENGTH $$VAL 1)
then (DISPLAYAFTERDELETE (CAR $$VAL)
MAILFILEDATA WINDOW MENU])
(DISPLAYAFTERDELETE
[LAMBDA (MSG# MAILFILEDATA WINDOW MENU) (* M.Yonke " 4-AUG-83 11:15")
(PROG (NEXTMSGDESCRIPTOR)
(if (AND (FIXP MSG#)
LAFITEDISPLAYAFTERDELETEFLG)
then (* this is the semantics of LAFITEDISPLAYAFTERDELETEFLG
*)
(if (AND (EQP MSG# (fetch (WINDOWPROP CURRENTDISPLAYED#) of WINDOW))
(SETQ NEXTMSGDESCRIPTOR (NTHITEM (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
(ADD1 MSG#)))
(SELECTQ LAFITEDISPLAYAFTERDELETEFLG
[T (* Laurel semantics *)
(AND (NOT (fetch (MESSAGEDESCRIPTOR SEEN?)
of NEXTMSGDESCRIPTOR))
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of NEXTMSGDESCRIPTOR]
(ALWAYS (* Hardy semantics *)
T)
NIL))
then (LAFITE.DISPLAY WINDOW MAILFILEDATA NIL (ASSOC (QUOTE Display)
LAFITEBROWSERMENUITEMS)
MENU])
(LAFITE.UNDELETE
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* M.Yonke "10-AUG-83 11:43")
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(for MSGDESCRIPTOR in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
when (AND (fetch (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR)
(fetch (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR))
do (UNDELETEMESSAGE MSGDESCRIPTOR WINDOW])
(LAFITE.MOVETO
[LAMBDA (WINDOW MAILFILEDATA TOFILE ITEM MENU KEY) (* M.Yonke "17-AUG-83 12:11")
(WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(PROG (FROMFILE OUTPUTFILE SHORTFROM SHORTOUTPUT BROWSERPROMPTWINDOW OLDFILEP)
(if (NULL TOFILE)
then (* just get out -- user buttoned outside the menu *)
(RETURN))
(if (NULL (SETQ OUTPUTFILE (LA.LONGFILENAME TOFILE LAFITEMAIL.EXT)))
then (CLOSEW (GETBROWSERPROMPTWINDOW WINDOW))
(RETURN))
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(SETQ OLDFILEP (NEQ TOFILE (QUOTE ##ANOTHERFILE##)))
(* this is the wrong test but it is quick -- we will
have to fix this after the confirmation *)
(SETQ FROMFILE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(if (EQ FROMFILE OUTPUTFILE)
then (* a NOP *)
(SHADEITEM ITEM MENU WHITESHADE)
(RETURN))
(SETQ BROWSERPROMPTWINDOW (GETBROWSERPROMPTWINDOW WINDOW))
(SETQ SHORTFROM (LA.SHORTFILENAME FROMFILE NIL T))
(SETQ SHORTOUTPUT (LA.SHORTFILENAME OUTPUTFILE NIL T))
(if (EQ KEY (QUOTE MIDDLE))
then (* don't confirm -- just do it and tell the user what
you are doing *)
(printout BROWSERPROMPTWINDOW "Moving messages from " SHORTFROM
" to "
SHORTOUTPUT
(if OLDFILEP
then " [Old File]."
else " [New File]."))
else (if (LA.MOUSECONFIRM (CONCAT "Moving messages from " SHORTFROM " to "
SHORTOUTPUT
(if OLDFILEP
then " [Old File]."
else " [New File].")
LAFITEEOL
"LEFT button to confirm move - MIDDLE or RIGHT to abort move.")
BROWSERPROMPTWINDOW NIL T)
else (* abort *)
(CLOSEW BROWSERPROMPTWINDOW)
(SHADEITEM ITEM MENU WHITESHADE)
(RETURN))) (* save the last file moved-to for the accelerator *)
(if (NULL OLDFILEP)
then (* now that its confirmed, really make one *)
(SETQ OUTPUTFILE (MAKEMAILFOLDER OUTPUTFILE)))
(replace (WINDOWPROP MOVETOFILE) of WINDOW with OUTPUTFILE)
(replace (WINDOWPROP TITLE) of WINDOW
with (CONCAT (fetch (WINDOWPROP ORIGINALTITLE) of WINDOW)
" -- Move To: " SHORTOUTPUT))
(if (NULL (INFILEP OUTPUTFILE))
then (* make sure to make one -- should have done this above
but it takes too much time *)
(SETQ OUTPUTFILE (MAKEMAILFOLDER OUTPUTFILE)))
(ADD.PROCESS (LIST (FUNCTION MOVETO.PROC)
(KWOTE WINDOW)
(KWOTE MAILFILEDATA)
(KWOTE FROMFILE)
(KWOTE OUTPUTFILE)
(KWOTE ITEM)
(KWOTE MENU)
(KWOTE KEY)
(KWOTE BROWSERPROMPTWINDOW))
(QUOTE NAME)
(QUOTE LAFITEMOVETO)
(QUOTE RESTARTABLE)
(QUOTE NO])
(MOVETO.PROC
[LAMBDA (WINDOW MAILFILEDATA FROMFILE TOFILE ITEM MENU KEY BROWSERPROMPTWINDOW)
(* M.Yonke "17-AUG-83 11:50")
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(PROG (INPUTFILE OUTPUTFILE MSGDESCRIPTORS LASTMSGDESCRIPTOR)
(WITH.MONITOR (LA.GETFILELOCK FROMFILE)
(WITH.MONITOR
(LA.GETFILELOCK TOFILE)
(SETQ OUTPUTFILE (OPENMAILFOLDER TOFILE (QUOTE APPEND)))
(SETQ INPUTFILE (OPENMAILFOLDER FROMFILE (QUOTE INPUT)))
(* EOF *)
(SETQ MSGDESCRIPTORS
(for MSGDESCRIPTOR
in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
bind NEWMSGDESCRIPTOR
when (AND (fetch (MESSAGEDESCRIPTOR SELECTED?)
of MSGDESCRIPTOR)
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRIPTOR)))
collect (SETQ LASTMSGDESCRIPTOR MSGDESCRIPTOR)
(SETQ NEWMSGDESCRIPTOR
(create MESSAGEDESCRIPTOR
BEGIN ←(GETFILEPTR OUTPUTFILE)
# ← NIL
SELECTED? ← NIL
BROWSERYPOSITION ← NIL
copying MSGDESCRIPTOR))
(COPYBYTES INPUTFILE OUTPUTFILE
(fetch (MESSAGEDESCRIPTOR BEGIN)
of MSGDESCRIPTOR)
(fetch (MESSAGEDESCRIPTOR END)
of MSGDESCRIPTOR))
(MARKMESSAGE MSGDESCRIPTOR WINDOW INPUTFILE
MOVETOMARK)
(* delete it *)
(DELETEMESSAGE MSGDESCRIPTOR WINDOW)
NEWMSGDESCRIPTOR))
(CLOSEMAILFOLDER OUTPUTFILE)
(CLOSEMAILFOLDER INPUTFILE)
(* have to close it because ADDMESSAGESTOMAILBROWSER
opens it form input *)
(* delete them from FROMFILE *)
(if (fetch LAFITEBROWSERWINDOW of OUTPUTFILE)
then (* now print them in the other window, if up *)
(ADDMESSAGESTOMAILBROWSER OUTPUTFILE MSGDESCRIPTORS)
else (* really close the mail file since there isn't a
browser around *)
(CLOSEMAILFOLDER OUTPUTFILE T))
(if (WINDOWP BROWSERPROMPTWINDOW)
then (CLEARW BROWSERPROMPTWINDOW)
(CLOSEW BROWSERPROMPTWINDOW))
(if (EQLENGTH MSGDESCRIPTORS 1)
then (DISPLAYAFTERDELETE (fetch (MESSAGEDESCRIPTOR #)
of LASTMSGDESCRIPTOR)
MAILFILEDATA WINDOW MENU])
(LAFITE.HARDCOPY
[LAMBDA (MAILFILEDATA ITEM MENU) (* M.Yonke "29-JUN-83 10:53")
(ADD.PROCESS (LIST (FUNCTION HARDCOPY.PROC)
(KWOTE MAILFILEDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEHARDCOPIER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(HARDCOPY.PROC
[LAMBDA (MAILFILEDATA ITEM MENU) (* M.Yonke " 1-AUG-83 16:43")
(PROG (IFILE OFILE FILENAME LCASEFILENAME)
[RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(SETQ LCASEFILENAME (L-CASE FILENAME))
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(SETQ IFILE (OPENMAILFOLDER FILENAME (QUOTE INPUT)))
[SETQ OFILE (if (PRINTINGHOST)
then (* a press printer is available so TEDIT.HARDCOPY it
later instead of just LPTing it *)
(LA.OPENTEMPFILE (QUOTE HARDCOPY))
else (OPENFILE (QUOTE {LPT})
(QUOTE OUTPUT]
(for MSGDESCRITOR in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
when (AND (fetch (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRITOR)
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?)
of MSGDESCRITOR)))
bind TEMPFILEPTR
do (printout OFILE "Message " (fetch (MESSAGEDESCRIPTOR #)
of MSGDESCRITOR)
" from " LCASEFILENAME T T)
(COPYBYTES IFILE OFILE (fetch (MESSAGEDESCRIPTOR START)
of MSGDESCRITOR)
(fetch (MESSAGEDESCRIPTOR END) of MSGDESCRITOR))
(SETQ TEMPFILEPTR (GETFILEPTR OFILE))
(if LAFITENEWPAGEFLG
then (printout OFILE (CONSTANT
(CHARACTER (CHARCODE FF)))
T)
else (printout OFILE T HARDCOPYSEPARATORSTR T T))
finally (* set the file point before the last message separator
*)
(SETFILEPTR OFILE TEMPFILEPTR)
(SETFILEINFO OFILE (QUOTE LENGTH)
TEMPFILEPTR)
(CLOSEF OFILE)
(CLOSEMAILFOLDER IFILE]
(if (PRINTINGHOST)
then (* CLOSEF didn't automatically print it *)
(RESETVARS ((TEDIT.DEFAULT.FONT LAFITEHARDCOPYFONT))
(TEDIT.HARDCOPY (OPENTEXTSTREAM OFILE)
NIL NIL (CONCAT "Mail from " LCASEFILENAME)))
(* have to close it again because TEDIT.HARDCOPY left it
open *)
(CLOSEF OFILE))
(DELFILE OFILE])
)
(DEFINEQ
(LAFITE.ANSWER
[LAMBDA (MAILFILEDATA ITEM MENU) (* M.Yonke "30-JUN-83 10:18")
(ADD.PROCESS (LIST (FUNCTION ANSWER.PROC)
(KWOTE (find MSGDESCRIPTOR in (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
suchthat (fetch (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR)))
(KWOTE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEANSWERER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(ANSWER.PROC
[LAMBDA (MSGDESCRIPTOR FILENAME ITEM MENU) (* M.Yonke "18-AUG-83 13:14")
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(if (SENDMESSAGE (RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(MAKEANSWERFORM MSGDESCRIPTOR FILENAME)))
then (MARKMESSAGE MSGDESCRIPTOR (fetch LAFITEBROWSERWINDOW of FILENAME)
FILENAME ANSWERMARK])
(MAKEANSWERFORM
[LAMBDA (MSGDESCRIPTOR FILENAME) (* M.Yonke "18-AUG-83 13:47")
(PROG (FORM FILE SUBJECT ALREADYREPLY FROM DATE REPLYTO TO CC ORIGINALREGISTRY OLDFROM OLDREPLYTO
OLDTO OLDCC NEWTO NEWCC) (* get the fields from the file or data *)
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(SETQ FILE (OPENMAILFOLDER FILENAME (QUOTE INPUT)))
(SETQ SUBJECT (GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE SUBJECT)
FILE))
(SETQ ALREADYREPLY (LA.STRPOS "Re:" SUBJECT))
(SETQ FROM (OR (GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE SENDER)
FILE)
(GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE FROM)
FILE)))
(SETQ ORIGINALREGISTRY (OR (GETREGISTRY FROM)
DEFAULTREGISTRY))
(SETQ DATE (GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE DATE)
FILE))
(SETQ REPLYTO (GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE REPLY-TO)
FILE T))
(SETQ TO (GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE TO)
FILE))
(SETQ CC (GETMESSAGEFIELD MSGDESCRIPTOR (QUOTE CC)
FILE))
(CLOSEMAILFOLDER FILE)) (* first parse the strings into recipients *)
(SETQ OLDFROM (AND FROM (PARSERECIPIENTS FROM NIL ORIGINALREGISTRY)))
(SETQ OLDREPLYTO (AND REPLYTO (PARSERECIPIENTS REPLYTO NIL ORIGINALREGISTRY)))
(SETQ OLDTO (AND TO (PARSERECIPIENTS TO NIL ORIGINALREGISTRY)))
(SETQ OLDCC (AND CC (PARSERECIPIENTS CC NIL ORIGINALREGISTRY)))
(* now make strings out of them *)
[SETQ NEWCC (APPEND (if OLDREPLYTO
then (FULLUSERNAME)
else OLDTO)
(if (AND OLDCC (NOT OLDREPLYTO))
then OLDCC
else (FULLUSERNAME]
(SETQ NEWTO (OR OLDREPLYTO OLDFROM))
[SETQ NEWCC (ADDRESSESTOSTRING (DREMOVE (CAR NEWTO)
(LA.REMOVEDUPLICATES NEWCC]
(SETQ NEWTO (ADDRESSESTOSTRING NEWTO)) (* now construct the message form *)
(SETQ FORM (CONCAT "Subject: " (if ALREADYREPLY
then ""
else "Re: ")
SUBJECT LAFITEEOL "In-reply-to: " FROM "'s message of " DATE LAFITEEOL
"To: "
NEWTO
(if NEWCC
then (CONCAT LAFITEEOL "cc: " NEWCC)
else "")
LAFITEEOL LAFITEEOL ">>Message<<"))
(RETURN FORM])
(GETANOTHERFORM
[LAMBDA (FORMNAME) (* M.Yonke "22-JUL-83 14:28")
(PROG (FULLFORMNAME REALFORMNAME)
(SETQ FULLFORMNAME (LA.LONGFILENAME (if FORMNAME
else
(* user buttoned "another form" so will have to ask him for the nameof the file -- this is taken care of in
LA.LONGFILENAME by passing the special atom ##ANOTHERFORM## *)
(QUOTE ##ANOTHERFORM##))
LAFITEFORM.EXT))
(* make sure its there *)
(SETQ REALFORMNAME (INFILEP FULLFORMNAME))
(if REALFORMNAME
then (* read the form and return it *)
(if (NOT (MEMB REALFORMNAME LAFITEFORMFILES))
then (push LAFITEFORMFILES REALFORMNAME)
(SETQ LAFITEFORMSMENU (MAKELAFITEFORMSMENU LAFITEFORMFILES)))
(RETURN (GETMESSAGEFORM REALFORMNAME])
(MAKELAFITESUPPORTFORM
[LAMBDA NIL (* M.Yonke "17-AUG-83 12:15")
(CONCAT "Subject: " LAFITESUBJECTSTR LAFITEEOL "To: " LAFITESUPPORT LAFITEEOL "cc: " LISPSUPPORT
", "
(FULLUSERNAME)
LAFITEEOL "Lafite-System-Date: " LAFITESYSTEMDATE LAFITEEOL "Lisp-System-Date: "
MAKESYSDATE LAFITEEOL LAFITEEOL ">>Message<<" LAFITEEOL])
(MAKELISPSUPPORTFORM
[LAMBDA NIL (* M.Yonke "17-AUG-83 12:17")
(CONCAT "Subject: " LISPSUBJECTSTR LAFITEEOL "To: " LISPSUPPORT LAFITEEOL "cc: " (FULLUSERNAME)
LAFITEEOL "Lisp-System-Date: " MAKESYSDATE LAFITEEOL LAFITEEOL ">>Message<<" LAFITEEOL])
)
(DEFINEQ
(LAFITE.FORWARD
[LAMBDA (MAILFILEDATA ITEM MENU) (* M.Yonke "29-JUN-83 10:53")
(ADD.PROCESS (LIST (FUNCTION FORWARD.PROC)
(KWOTE MAILFILEDATA)
(KWOTE (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE NAME)
(QUOTE MESSAGEFORWARDER)
(QUOTE RESTARTABLE)
(QUOTE NO])
(FORWARD.PROC
[LAMBDA (MAILFILEDATA FILENAME ITEM MENU) (* M.Yonke "10-AUG-83 11:42")
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(PROG (MSG#S 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 *)
(RESETLST (RESETSAVE (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
ITEM MENU WHITESHADE))
(SETQ MSG#S (fetch (WINDOWPROP CURRENTMESSAGENUMBERS)
of (fetch LAFITEBROWSERWINDOW of FILENAME)))
(SETQ FORM (MAKEFORWARDFORM MAILFILEDATA)))
(if (SENDMESSAGE FORM)
then (for MSG# in MSG#S
bind (BROWSERWINDOW ←(fetch LAFITEBROWSERWINDOW of FILENAME))
do (MARKMESSAGE (NTHITEM (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
MSG#)
BROWSERWINDOW FILENAME FORWARDMARK])
(MAKEFORWARDFORM
[LAMBDA (MAILFILEDATA) (* M.Yonke " 8-AUG-83 15:25")
(WITH.MONITOR (LA.GETFILELOCK FILENAME)
(PROG (FILENAME IFILE OFILE CURMSG CURRENT#S)
(SETQ FILENAME (fetch (MAILFILEDATA FILENAME) of MAILFILEDATA))
(SETQ IFILE (OPENMAILFOLDER FILENAME (QUOTE INPUT)))
(SETQ OFILE (LA.OPENTEMPFILE (QUOTE FORM)
(QUOTE OUTPUT)))
(SETQ CURRENT#S (fetch (WINDOWPROP CURRENTMESSAGENUMBERS)
of (fetch LAFITEBROWSERWINDOW of FILENAME)))
(SETQ CURMSG (NTHITEM (fetch (MAILFILEDATA MESSAGEDESCRIPTORS)
of MAILFILEDATA)
(CAR CURRENT#S)))
(printout OFILE "Subject: " "[" (GETMESSAGEFIELD CURMSG (QUOTE FROM)
IFILE)
": "
(GETMESSAGEFIELD CURMSG (QUOTE SUBJECT)
IFILE)
"]" T)
(printout OFILE "To: >>Recipients<<" T)
(printout OFILE "cc: " (FULLUSERNAME)
T)
(printout OFILE T BEGINFORWARDEDMESSAGESTR T T)
(for MSGDESCRIPTOR in (fetch MESSAGEDESCRIPTORS of MAILFILEDATA)
when (AND (fetch (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR)
(NOT (fetch (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR)))
do (COPYBYTES IFILE OFILE (fetch (MESSAGEDESCRIPTOR START)
of MSGDESCRIPTOR)
(fetch (MESSAGEDESCRIPTOR END) of MSGDESCRIPTOR))
(printout OFILE T))
(printout OFILE T ENDFORWARDEDMESSAGESTR T)
(CLOSEMAILFOLDER IFILE)
(CLOSEF OFILE)
(RETURN OFILE])
(LA.OPENTEMPFILE
[LAMBDA (EXTENSION ACCESS RECOG) (* M.Yonke "20-MAY-83 17:15")
(PROG (FILE)
[SETQ FILE (OPENFILE (PACKFILENAME (QUOTE HOST)
(QUOTE CORE)
(QUOTE NAME)
(QUOTE LAFITETEMPORARY)
(QUOTE EXTENSION)
EXTENSION)
(OR ACCESS (QUOTE OUTPUT))
(OR RECOG (QUOTE NEW]
(if FILE
then (* save them so they can be deleted by LAFITE.QUIT *)
(WINDOWADDPROP LAFITECOMMANDWINDOW (QUOTE LAFITETEMPFILES)
FILE)
(RETURN FILE])
)
(DEFINEQ
(MAKENEWMESSAGEFORM
[LAMBDA NIL (* M.Yonke "27-JUL-83 10:35")
(CONCAT "Subject: >>Subject<<" LAFITEEOL "To: >>Recipients<<" LAFITEEOL "cc: " (FULLUSERNAME)
LAFITEEOL LAFITEEOL ">>Message<<" LAFITEEOL])
(MAKELAFITEFORMSMENU
[LAMBDA (FORMS) (* M.Yonke "20-MAY-83 11:21")
(create MENU
ITEMS ←(APPEND [SORT (for FORM in FORMS when FORM
collect (L-CASE (LA.SHORTFILENAME FORM LAFITEFORM.EXT]
LAFITEFORMSMENUITEMS)
TITLE ← "Message Forms"
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T])
(MAKELAFITEMAILFOLDERSMENU
[LAMBDA (MAILFOLDERNAMES) (* M.Yonke " 1-AUG-83 16:59")
(create MENU
ITEMS ←(APPEND [SORT (for FOLDER in MAILFOLDERNAMES when FOLDER
collect (L-CASE (LA.SHORTFILENAME FOLDER LAFITEMAIL.EXT]
(LIST ANOTHERFOLDERMENUITEM))
TITLE ←(CONCAT " Mail Folders [" (L-CASE \LAFITEDEFAULTHOST&DIR)
"] ")
MENUFONT ← LAFITEMENUFONT
CENTERFLG ← T])
(GETMESSAGEFORM
[LAMBDA (FILE) (* M.Yonke "30-JUN-83 10:35")
(AND FILE (PROG1 [READ (SETQ FILE (OPENFILE FILE (QUOTE INPUT]
(CLOSEF FILE])
(SAVEMESSAGEFORM
[LAMBDA (MSG) (* M.Yonke "22-JUL-83 13:57")
(PROG (FORMFILE)
(SETQ FORMFILE (LA.LONGFILENAME (QUOTE ##ANOTHERFILE##)
LAFITEFORM.EXT))
[PRIN2 MSG (SETQ FORMFILE (OPENFILE FORMFILE (QUOTE OUTPUT]
(CLOSEF FORMFILE)
(if (MEMB FORMFILE LAFITEFORMFILES)
else (SETQ LAFITEFORMFILES (APPEND LAFITEFORMFILES (LIST FORMFILE)))
(SETQ LAFITEFORMSMENU (MAKELAFITEFORMSMENU LAFITEFORMFILES)))
(RETURN FORMFILE])
(UPDATECONTENTSFILE
[LAMBDA (MAILFILE MAILFILEDATA) (* M.Yonke "30-JUN-83 10:40")
(* * This function assumes that if there is a TOC file then it is a good one -- who ever calls this function must
make sure to delete the old TOC file first * *)
(if MAILFILE
then (PROG (CONTENTSFILE)
(if (INFILEP (SETQ CONTENTSFILE (TOCFILENAME MAILFILE)))
else (WITH.MONITOR (LA.GETFILELOCK CONTENTSFILE)
(PRIN2 MAILFILEDATA (OPENFILE CONTENTSFILE (QUOTE OUTPUT)))
(CLOSEF CONTENTSFILE)))
(RETURN MAILFILEDATA])
)
(RPAQ? CAN'TAUTHENTICATESTR "Cannot authenticate user -- reason: ")
(RPAQ? CAN'TGETMAILSERVERSSTR "Can't get any mail servers.")
(RPAQ? CONFLICTINGVERSION#STR1 " has multiple versions.")
(RPAQ? CONFLICTINGVERSION#STR2
"Please resolve this (or set LAFITEUSEHIGHESTVERSIONFLG to T) and browse again.")
(RPAQ? UNSUPPLIEDFIELDSTR "---")
(RPAQ? NOMOREMESSAGESSTR "No more messages.")
(RPAQ? NOMESSAGESSELECTEDSTR "No messages selected.")
(RPAQ? LAFITEMENUFONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD))))
(RPAQ? LAFITETITLEFONT (FONTCREATE (QUOTE (HELVETICA 12 BOLD))))
(RPAQ? LAFITEDISPLAYFONT (FONTCREATE (QUOTE (TIMESROMAN 12))))
(RPAQ? LAFITEEDITORFONT (FONTCREATE (QUOTE (TIMESROMAN 12))))
(RPAQ? LAFITEHARDCOPYFONT (FONTCREATE (QUOTE (TIMESROMAN 12))))
(RPAQ? LAFITEBROWSERFONT (FONTCREATE (QUOTE (GACHA 10))))
(RPAQ? ARPANETGATEWAY.REGISTRY (QUOTE AG))
(RPAQ? LAFITESUPPORT (QUOTE Yonke.pa))
(RPAQ? LAFITESUBJECTSTR "Lafite: >>Subject<<")
(RPAQ? LISPSUPPORT (QUOTE LispSupport.pa))
(RPAQ? LISPSUBJECTSTR "Lisp: >>Subject<<")
(RPAQ? NEWMAILSTR "You Have New Mail - ")
(RPAQ? NOMAILSTR "No New Mail At ")
(RPAQ? NOMAILSERVERSSTR "All Mail Servers Down At ")
(RPAQ? NOINBOXESSTR "No Accessible Mail Boxes")
(RPAQ? NOTCONNECTEDSTR "Not Connected To Mail Server")
(RPAQ? BEGINFORWARDEDMESSAGESTR " ----- Fowarded Messages -----")
(RPAQ? ENDFORWARDEDMESSAGESTR " ----- End of Forwarded Messages -----")
(RPAQ? HARDCOPYSEPARATORSTR
"------------------------------------------------------------------------")
(RPAQ? LAFITETITLE "L a f i t e")
(RPAQ? SEENMARK (CHARACTER (CHARCODE SP)))
(RPAQ? UNSEENMARK (QUOTE ?))
(RPAQ? MOVETOMARK (QUOTE m))
(RPAQ? FORWARDMARK (QUOTE f))
(RPAQ? ANSWERMARK (QUOTE a))
(RPAQ? FILENAMEPROMPT "> ")
(RPAQ? LAFITEEOL "
")
(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? LAFITEDISPLAYDELETEDMESSAGEFLG NIL)
(RPAQ? LAFITEDISPLAYAFTERDELETEFLG T)
(RPAQ? LAFITEREADONLYFLG T)
(RPAQ? LAFITENEWPAGEFLG T)
(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))
(RPAQQ LAFITEBROWSERMENUITEMS ((Display (QUOTE ##DISPLAY##)
"Displays the selected message in the display window.")
(Delete (QUOTE ##DELETE##)
"Deletes the selected messages.")
(Undelete (QUOTE ##UNDELETE##)
"Undeletes the selected messages.")
(Answer (QUOTE ##ANSWER##)
"Put up a answer form for the selected message in an edit window.")
(Forward (QUOTE ##FORWARD##)
"Put up a forward form for the selected message in an edit window.")
(Hardcopy (QUOTE ##HARDCOPY##)
"Hardcopy the selected messages.")
("Move To" (QUOTE ##MOVETO##)
"Move the selected messages to another mail file.")
(Update (QUOTE ##UPDATE##)
"Really delete the indicated messages and renumber the remaining messages.")
("Get Mail" (QUOTE ##GETMAIL##)
"Retrieves any new messages and put them into this mail file.")))
(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")
("Message Form" (QUOTE ##SENDMAIL##)
"Create a message form and put it in an edit window.")
(Quit (QUOTE ##QUIT##)
"Update and close all mail files and stop Lafite")))
(RPAQQ LAFITEFORMSMENUITEMS (("Clean Form" (QUOTE ##NEWMESSAGE##)
"A clean message form")
("Last Message" (QUOTE ##LASTMESSAGE##)
"The previous message form as edited")
("Lisp Report" (QUOTE ##LISPSUPPORT##)
"A form to report a Lisp bug or suggestion")
("Lafite Report" (QUOTE ##LAFITESUPPORT##)
"A form to report a Lafite bug or suggestion")
("Another Form" (QUOTE ##ANOTHERFORM##)
"You will be asked to specify a filename for the form")))
(RPAQQ LAFITECLOSEFNMENUITEMS (("Update and Close" (QUOTE ##UPDATE##)
"Update the mail browser and close the browser window.")
("Just Close" (QUOTE ##CLOSE##)
"Just close the window - don't update it.")
("Don't Close" (QUOTE ##DON'T##)
"Don't close the browser window.")))
(RPAQQ ANOTHERFOLDERMENUITEM ("Another Folder" (QUOTE ##ANOTHERFILE##)
"You will be asked to specify another mail filename"))
(RPAQ? LAFITEDEFAULTHOST&DIR )
(RPAQ? LAFITEUSEHIGHESTVERSIONFLG )
(RPAQQ LAFITEFLASHWAITTIME 250)
(RPAQQ LAFITEBUSYWAITTIME 1000)
(RPAQQ LIGHTWAVYSHADE 640)
(RPAQQ LAFITEITEMBUSYSHADE 43605)
(RPAQQ LAFITEEDITWINDOW NIL)
(RPAQQ LAFITECOMMANDWINDOW NIL)
(RPAQQ PRIMARYDISPLAYWINDOW NIL)
(RPAQQ LAFITEDISPLAYWINDOWS NIL)
(RPAQQ PRIMARYEDITORWINDOW NIL)
(RPAQQ LAFITEEDITORWINDOWS NIL)
(RPAQQ LAFITECURRENTEDITORWINDOWS NIL)
(RPAQQ LAFITELASTMESSAGE NIL)
(RPAQQ LAFITEMAILWATCHPROCESS NIL)
(RPAQQ LAFITEMAILFOLDERS NIL)
(RPAQQ LAFITEFORMFILES NIL)
(RPAQQ LAFAITEFOLDERSMENU NIL)
(RPAQQ LAFITESENDINGMENU NIL)
(RPAQQ LAFITEFORMSMENU NIL)
(RPAQQ LAFITECLOSEFNMENU NIL)
(DEFINEQ
(LA.MOUSECONFIRM
[LAMBDA (PROMPTSTRING WINDOW CLOSEWINDOWFLG DON'TCLEARWINDOWFLG)
(* M.Yonke "19-JUL-83 12:18")
(* * Changes the cursor to a "little mouse"; prints a prompt; and waits for the user to press and then release a
mouse button. If the LEFT was the final one release then return T otherwise return NIL -- uses PROMPTWINDOW unless
provided a window * *)
(RESETFORM (CURSOR LA.CONFIRMCURSOR)
(PROG (LEFTDOWN CONFIRMWINDOW)
(SETQ CONFIRMWINDOW (OR WINDOW PROMPTWINDOW))
(CLEARW CONFIRMWINDOW)
(PRIN3 (OR PROMPTSTRING
"LEFT button for 'yes' - MIDDLE or RIGHT button for 'no'.")
CONFIRMWINDOW)
UNTILDOWN
(if (MOUSESTATE (OR LEFT MIDDLE RIGHT))
else (GO UNTILDOWN))
(SETQ LEFTDOWN (LASTMOUSESTATE (ONLY LEFT)))
(* left originally down? *)
UNTILUP
(if (MOUSESTATE (OR LEFT MIDDLE RIGHT))
then (if [AND LEFTDOWN (LASTMOUSESTATE (AND (OR MIDDLE RIGHT)
(NOT LEFT]
then (* started with LEFT but has switched -- changed his
mind *)
(SETQ LEFTDOWN NIL)
(GO UNTILUP)
else (* get the state of LEFT and wait for up)
(SETQ LEFTDOWN (LASTMOUSESTATE LEFT))
(GO UNTILUP))
else (* finally must be (LASTMOUSESTATE UP) *)
(if CLOSEWINDOWFLG
then (CLOSEW CONFIRMWINDOW)
elseif (NULL DON'TCLEARWINDOWFLG)
then (CLEARW CONFIRMWINDOW))
(RETURN LEFTDOWN])
(LA.STRPOS
[LAMBDA (PAT STRING START SKIP ANCHOR TAIL) (* M.Yonke "30-JUN-83 10:47")
(* * a case independent STRPOS -- actually ought to be done with a casearray arg to STRPOS -- will do this later *
*)
(STRPOS (U-CASE PAT)
(U-CASE STRING)
START SKIP ANCHOR TAIL])
(LA.REMOVEDUPLICATES
[LAMBDA (X) (* M.Yonke "18-AUG-83 13:45")
(* * a case-independent intersection * *)
(PROG [(R (LIST NIL))
(YY (U-CASE (COPY X]
(DECLARE (LOCALVARS R YY))
LP (if (NLISTP X)
then (RETURN (CAR R))
elseif (NOT (MEMBER (U-CASE (CAR X))
(CDR YY)))
then (TCONC R (CAR X)))
(SETQ X (CDR X))
(SETQ YY (CDR YY))
(GO LP])
(NTHITEM
[LAMBDA (LST N) (* M.Yonke "30-JUN-83 10:41")
(CAR (NTH LST N])
(LASTITEM
[LAMBDA (LST) (* M.Yonke "30-JUN-83 10:42")
(CAR (LAST LST])
)
(RPAQ LA.RIGHTARROWCURSOR (CURSORCREATE (READBITMAP) 7 9))
(16 16
"@@@@"
"@@@@"
"@F@@"
"@CH@"
"@AN@"
"@@GH"
"OOON"
"OOOO"
"OOON"
"@@GH"
"@AN@"
"@CH@"
"@F@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ LA.CONFIRMCURSOR (CURSORCREATE (READBITMAP) 8 8))
(16 16
"GOOL"
"D@@D"
"ELID"
"ELID"
"ELID"
"ELID"
"ELID"
"ELID"
"ELID"
"D@@D"
"D@@D"
"D@@D"
"D@@D"
"D@@D"
"D@@D"
"GOOL")(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))
(10 10
"L@@@"
"O@@@"
"OL@@"
"OO@@"
"OOL@"
"OOL@"
"OO@@"
"OL@@"
"O@@@"
"L@@@")
(RPAQQ BROWSERSELECTLIMITXPOSITION 35)
(RPAQQ BROWSERMARKXPOSITION 10)
(* Low level polling)
(DEFINEQ
(MAILSERVERLOGIN
[LAMBDA NIL (* DECLARATIONS: (RECORD (NAME . PASSWORD))
(RECORD (TIMESTAMP . MAILSERVERS)))
(* M.Yonke "10-AUG-83 11:10")
(if (NULL \LAFITEUSERDATA)
then
(PROG (USER MAILSERVERS CHECKUSER)
(if (EQ [SETQ CHECKUSER (AUTHENTICATE (fetch NAME of (USERINFORMATION))
(fetch PASSWORD of (USERINFORMATION]
T)
then (SETQ USER (fetch NAME of (USERINFORMATION)))
(SETQ MAILSERVERS (fetch MAILSERVERS of (GV.EXPAND USER)))
(if (NULL MAILSERVERS)
then (printout PROMPTWINDOW T CAN'TGETMAILSERVERSSTR)
else [SETQ \LAFITEUSERDATA
(create LAFITEUSERDATA
FULLNAME ←(FULLUSERNAME)
ENCRYPTEDPASSWORD ←(MAKEKEY (fetch PASSWORD
of (USERINFORMATION)))
MAILSERVERS ←(for MAILSERVER in MAILSERVERS
bind SERVERTYPE
collect
(SETQ SERVERTYPE
(MAILSERVERTYPE MAILSERVER))
(create
MAILSERVER
(SETQ GVPORT
(SELECTQ
SERVERTYPE
(GV (ETHERPORT (READCONNECT
MAILSERVER)))
(MTP (ETHERPORT MAILSERVER))
(SHOULDNT)))
(SETQ NAME MAILSERVER)
(SETQ SERVERTYPE SERVERTYPE]
(if (find MS in (fetch (LAFITEUSERDATA MAILSERVERS)
of \LAFITEUSERDATA)
suchthat (EQ (fetch (MAILSERVER SERVERTYPE) of MS)
(QUOTE MTP)))
then (* only load MTP if there is a server of that type *)
(OR (GETD (FUNCTION MTP.POLLNEWMAIL))
(FILESLOAD MTP)))
(RETURN \LAFITEUSERDATA))
else (printout PROMPTWINDOW T CAN'TAUTHENTICATESTR CHECKUSER ".")))
else \LAFITEUSERDATA])
(MAILSERVERTYPE
[LAMBDA (MAILSERVERNAME) (* M.Yonke "21-JUN-83 14:53")
(* * type is determined by the name currently * *)
(if (STRPOS ".ms" MAILSERVERNAME -3 NIL -1)
then (QUOTE GV)
elseif (STREQUAL (U-CASE MAILSERVERNAME)
"MAXC")
then (QUOTE MTP)
else (printout PROMPTWINDOW T "Lafite cannot retrieve mail from " MAILSERVERNAME)
(QUOTE UNKNOWN])
(USERINFORMATION
[LAMBDA NIL (* M.Yonke "18-MAR-83 14:10")
(SELECTQ (SYSTEMTYPE)
(D (\INTERNAL/GETPASSWORD NIL))
(HELP])
(FULLUSERNAME
[LAMBDA NIL (* DECLARATIONS: (RECORD (NAME . PASSWORD)))
(* M.Yonke "27-JUL-83 10:38")
(if (fetch (LAFITEUSERDATA FULLNAME) of \LAFITEUSERDATA)
else (PROG (USER)
(SETQ USER (fetch NAME of (USERINFORMATION)))
(RETURN (CONCAT (if (U-CASEP USER)
then (L-CASE USER T)
else USER)
"."
(L-CASE DEFAULTREGISTRY])
(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 (* M.Yonke "26-MAY-83 11:34")
(do (POLLNEWMAIL)
(BLOCK \MAILWATCHWAITTIME])
(POLLNEWMAIL
[LAMBDA NIL (* M.Yonke "26-JUL-83 14:11")
(if (MAILSERVERLOGIN)
then (if (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA)
then (SELECTQ (POLLNEWMAIL1 (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA))
(T (PRINTLAFITESTATUS (CONCAT NEWMAILSTR (LA.STATUSTIME)))
T)
(NIL (PRINTLAFITESTATUS (CONCAT NOMAILSTR (LA.STATUSTIME)))
NIL)
(? (PRINTLAFITESTATUS (CONCAT NOMAILSERVERSSTR (LA.STATUSTIME)))
NIL)
(SHOULDNT))
else (* real user but no inboxes *)
(PRINTLAFITESTATUS NOINBOXESSTR)
NIL)
else (* just couldn't make it so report it *)
(PRINTLAFITESTATUS NOTCONNECTEDSTR)
NIL])
(POLLNEWMAIL1
[LAMBDA (MAILSERVERS) (* M.Yonke "10-AUG-83 12:11")
(for MAILSERVER in MAILSERVERS bind POLLNEWMAILVAL NEWMAILFLG
do (SELECTQ (SETQ POLLNEWMAILVAL (SELECTQ (fetch (MAILSERVER SERVERTYPE) of MAILSERVER)
(GV (GV.POLLNEWMAIL (FULLUSERNAME)
(fetch (MAILSERVER MAILPORT)
of MAILSERVER)))
(MTP (MTP.POLLNEWMAIL (FULLUSERNAME)
(fetch (MAILSERVER MAILPORT)
of MAILSERVER)))
(SHOULDNT)))
(T (SETQ NEWMAILFLG POLLNEWMAILVAL)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with POLLNEWMAILVAL))
(NIL (replace (MAILSERVER NEWMAILFLG) of MAILSERVER with POLLNEWMAILVAL))
(? (if (NULL NEWMAILFLG)
then (SETQ NEWMAILFLG POLLNEWMAILVAL))
(* if the server is down -- don't lets try to get mail
*)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER with NIL))
(SHOULDNT))
finally
(* NEWMAILFLG is T if any mail server said "yes" -- NIL if they all said "no" -- or ? if they were all "down" --
pass this back to POLLNEWMAIL *)
(RETURN NEWMAILFLG])
(LA.STATUSTIME
[LAMBDA NIL (* M.Yonke "27-MAY-83 12:44")
(* * returns the time appropriate for printing out the "No new mail at ..." * *)
(* * currently this is system dependent code since Interlisp-D doesn't support dates nearly as well as
Interlisp-10 or Interlisp-Jericho * *)
(SELECTQ (SYSTEMTYPE)
(D (* this is a hack *)
(SUBSTRING (DATE)
11 -4))
(L-CASE (GDATE (IDATE)
(DATEFORMAT NO.DATE NO.SECONDS CIVILIAN.TIME])
(LA.DATE
[LAMBDA NIL (* M.Yonke " 5-JUN-83 15:02")
(* * returns the time appropriate for printing out the in the message header * *)
(* * currently this is system dependent code since Interlisp-D doesn't support dates nearly as well as
Interlisp-10 or Interlisp-Jericho * *)
(SELECTQ (SYSTEMTYPE)
(D (* according to RFC822 the date shouldn't have hyphens
-- they should be spaces -- hence the SUBST *)
(CONCAT [APPLY (FUNCTION CONCAT)
(SUBST " " (QUOTE -)
(UNPACK (CONCAT (L-CASE (SUBSTRING (DATE)
1 -4)
T]
" "
(LA.TIMEZONE)))
(L-CASE (DATE (DATEFORMAT NO.SECONDS TIME.ZONE SPACES))
T])
(PRINTLAFITESTATUS
[LAMBDA (STR) (* M.Yonke "21-JUN-83 14:56")
(PROG ((WINDOW (OR (WINDOWP LAFITEPROMPTWINDOW)
PROMPTWINDOW)))
(CLEARW WINDOW)
(CENTERPRINTINREGION STR NIL WINDOW])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS WITHOUT.MAILWATCH MACRO (FORMS
(CONS (FUNCTION RESETLST)
(CONS [QUOTE (RESETSAVE (AND LAFITEMAILWATCHPROCESS
(SUSPEND.PROCESS LAFITEMAILWATCHPROCESS))
(LIST (QUOTE AND)
LAFITEMAILWATCHPROCESS
(LIST (FUNCTION WAKE.PROCESS)
LAFITEMAILWATCHPROCESS]
FORMS))))
)
(RPAQ? MAILWATCHWAITTIME 5)
(RPAQQ \LAFITEUSERDATA NIL)
(RPAQQ \LAFITEDEFAULTHOST&DIR NIL)
(ADDTOVAR BEFORELOGOUTFORMS (SETQ \LAFITEUSERDATA NIL))
(DEFINEQ
(LAFITEAFTERLOGOUT
[LAMBDA NIL (* M.Yonke " 1-AUG-83 16:35")
(CHECKLAFITEMAILFOLDERS])
)
(* Low level mail retrieval functions)
(DEFINEQ
(GETNEWMAIL
[LAMBDA (FILE WINDOW) (* M.Yonke "17-AUG-83 12:05")
(WITH.MONITOR
(LA.GETFILELOCK FILE)
(PROG (OUTFILE OUTSTREAM ALLRETRIEVEDRESULTS REPORTWINDOW)
(SETQ REPORTWINDOW (GETBROWSERPROMPTWINDOW WINDOW))
(SETQ OUTFILE (OPENMAILFOLDER FILE (QUOTE APPEND)))
(SETQ OUTSTREAM (GETSTREAM OUTFILE))
(SETQ ALLRETRIEVEDRESULTS
(for MAILSERVER in (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA)
bind OPENEDINBOX MAILSERVERNAME MAILBOX #OFMESSAGES
eachtime (SETQ MAILSERVERNAME (fetch (MAILSERVER NAME) of MAILSERVER))
when (AND (fetch (MAILSERVER NEWMAILFLG) of MAILSERVER)
(SELECTQ (fetch (MAILSERVER SERVERTYPE) of MAILSERVER)
((GV MTP)
(SETQ RETRIEVEDRESULT NIL)
(if (SETQ OPENEDINBOX
(SELECTQ (fetch (MAILSERVER SERVERTYPE) of MAILSERVER)
(GV (GV.OPENMAILBOX
(fetch (MAILSERVER MAILPORT)
of MAILSERVER)
(FULLUSERNAME)
(fetch (LAFITEUSERDATA ENCRYPTEDPASSWORD)
of \LAFITEUSERDATA)))
(MTP (MTP.OPENMAILBOX (fetch (MAILSERVER
MAILPORT)
of MAILSERVER)
(FULLUSERNAME)
NIL
(fetch (MAILSERVER NAME)
of MAILSERVER)))
NIL))
then (SETQ MAILBOX (fetch (OPENEDMAILBOX MAILBOX)
of OPENEDINBOX))
(if (SETQ #OFMESSAGES
(fetch (OPENEDMAILBOX #OFMESSAGES)
of OPENEDINBOX))
then (printout REPORTWINDOW "retrieving "
#OFMESSAGES (if (EQ #OFMESSAGES 1)
then " message"
else " messages")
" from " MAILSERVERNAME " ... ")
else (printout REPORTWINDOW
"retrieving messages from "
MAILSERVERNAME " ... "))
(SETQ RETRIEVEDRESULT
(RETRIEVEMESSAGES MAILSERVER MAILBOX OUTSTREAM))
(if RETRIEVEDRESULT
then (* first flush the file back out to disk before calling
FLUSH to GV *)
(CLOSEMAILFOLDER OUTSTREAM)
(SELECTQ (fetch (MAILSERVER SERVERTYPE)
of MAILSERVER)
(GV (GV.CLOSEMAILBOX MAILBOX
LAFITEFLUSHMAILFLG))
(MTP (MTP.CLOSEMAILBOX MAILBOX
LAFITEFLUSHMAILFLG))
NIL)
(replace (MAILSERVER NEWMAILFLG)
of MAILSERVER with NIL)
(printout REPORTWINDOW "done." T)
else (* RETRIEVEMESSAGES already set the file ptr back, etc
*)
(printout REPORTWINDOW
"couldn't complete - please try again."
T))
else (printout REPORTWINDOW MAILSERVERNAME " not responding."
T)
(replace (MAILSERVER NEWMAILFLG) of MAILSERVER
with NIL))
RETRIEVEDRESULT)
(SHOULDNT)))
collect RETRIEVEDRESULT))
(CLOSEMAILFOLDER OUTSTREAM)
(for RETRIEVEDRESULT in ALLRETRIEVEDRESULTS do (ADDMESSAGESTOMAILBROWSER FILE
RETRIEVEDRESULT))
(* select the first new message -- all former messages have already been unselected -
the reason this is done rather than calling NEXTMESSAGETODISPLAY is that even if there are unseen messages the
user wants to be placed at the first of the newly retrieved messages *)
(* select the first of the new messages *)
(SELECTMESSAGE (CAAR ALLRETRIEVEDRESULTS)
(fetch LAFITEBROWSERWINDOW of OUTFILE))
(INSUREMESSAGEINBROWSERWINDOW (fetch LAFITEBROWSERWINDOW of OUTFILE)
(CAAR ALLRETRIEVEDRESULTS))
(ADD.PROCESS (LIST (QUOTE PROGN)
(QUOTE (BLOCK 10000))
(LIST (FUNCTION CLEARW)
(KWOTE REPORTWINDOW))
(LIST (FUNCTION CLOSEW)
(KWOTE REPORTWINDOW)))
(QUOTE NAME)
(QUOTE CLOSENEWMAILREPORTWINDOW)
(QUOTE RESTARTABLE)
(QUOTE NO])
(RETRIEVEMESSAGES
[LAMBDA (MAILSERVER MAILBOX OUTSTREAM) (* M.Yonke "18-AUG-83 13:30")
(while (SETQ NEXTMESSAGERESULT (SELECTQ (fetch (MAILSERVER SERVERTYPE) of MAILSERVER)
(GV (GV.NEXTMESSAGE MAILBOX))
(MTP (MTP.NEXTMESSAGE MAILBOX))
(SHOULDNT)))
when (NOT (fetch (NEXTMESSAGE DELETEDFLG) of NEXTMESSAGERESULT))
bind NEXTMESSAGERESULT STARTPOS LENGTHPOS MSGLENGTH (OLDEOFPTR ←(GETEOFPTR OUTSTREAM))
collect
(* * print the message stamp to the file * *)
(SETFILEPTR OUTSTREAM -1)
(SETQ STARTPOS (GETFILEPTR OUTSTREAM))
(PRIN3 "*start*" OUTSTREAM)
(TERPRI OUTSTREAM)
(SETQ LENGTHPOS (GETFILEPTR OUTSTREAM))
(PRIN3 "00000 00024 UU " OUTSTREAM)
(TERPRI OUTSTREAM)
(* * now get the message and put it in the file * *)
(if [CAR (ERSETQ (SELECTQ (fetch (MAILSERVER SERVERTYPE) of MAILSERVER)
(GV (GV.RETRIEVEMESSAGE MAILBOX OUTSTREAM))
(MTP (MTP.RETRIEVEMESSAGE MAILBOX OUTSTREAM))
(SHOULDNT]
then (TERPRI OUTSTREAM)
(SETQ MSGLENGTH (IDIFFERENCE (GETFILEPTR OUTSTREAM)
STARTPOS))
(* * go back and print the message length in the stamp * *)
(SETFILEPTR OUTSTREAM LENGTHPOS)
(PRINTNUM (QUOTE (FIX 5 10 T))
MSGLENGTH OUTSTREAM)
(create MESSAGEDESCRIPTOR
MARKCHAR ← UNSEENMARK
BEGIN ← STARTPOS
MESSAGELENGTH ← MSGLENGTH
STAMPLENGTH ← 24)
else (* something went drastically wrong!!! -
repair the damage and get out *)
(SETFILEPTR OUTSTREAM OLDEOFPTR)
(SETFILEINFO OUTSTREAM (QUOTE LENGTH)
OLDEOFPTR)
(CLOSEMAILFOLDER OUTSTREAM T) (* open it up again *)
(OPENMAILFOLDER OUTSTREAM (QUOTE APPEND))
(RETURN NIL])
)
(* this var should be T but for the time being lets keep it NIL *)
(RPAQ? LAFITEFLUSHMAILFLG NIL)
(* Low level sending functions)
(DEFINEQ
(SENDMAIL
[LAMBDA NIL (* M.Yonke "18-AUG-83 15:41")
(* * this is the way to send a mesage even if lafite is not running -- this function is also invoked by an item in
the background menu * *)
(ADD.PROCESS (QUOTE (SENDMESSAGE))
(QUOTE NAME)
(QUOTE SENDMAIL)
(QUOTE RESTARTABLE)
(QUOTE NO])
(SENDMESSAGE
[LAMBDA (FORM) (* M.Yonke "18-AUG-83 13:05")
(* * FORM can be a string, file, or stream -
The value of SENDMESSAGE is T only if the message was actually sent * *)
(OR FORM (SETQ FORM (MAKENEWMESSAGEFORM)))
(if FORM
then (PROG (CURRENTMESSAGE EDITORWINDOW EDITORRESULT COMMAND DONE REALLYSENT #SENT ICONW
(CLOSEWINDOWFLG T))
(SETQ CURRENTMESSAGE FORM)
(RETURN (until DONE
do (SETQ EDITORRESULT (MESSAGEEDITOR CURRENTMESSAGE NIL
(fetch (SENDINGCOMMAND
MESSAGEWINDOW)
of EDITORRESULT)))
(SETQ EDITORWINDOW (fetch (SENDINGCOMMAND MESSAGEWINDOW)
of EDITORRESULT))
(if (type? SENDINGCOMMAND EDITORRESULT)
then (* the user used the lafite menu to get out rather than
the TEDIT menu so we have to do something *)
[RESETLST (RESETSAVE (SHADEITEM (fetch (SENDINGCOMMAND ITEM)
of EDITORRESULT)
(fetch (SENDINGCOMMAND MENU)
of EDITORRESULT)
LAFITEITEMBUSYSHADE)
(LIST (FUNCTION SHADEITEM)
(fetch (SENDINGCOMMAND ITEM)
of EDITORRESULT)
(fetch (SENDINGCOMMAND MENU)
of EDITORRESULT)
WHITESHADE))
(SETQ COMMAND (fetch (SENDINGCOMMAND COMMAND)
of EDITORRESULT))
(* make sure CURRENTMESSAGE is always a string *)
(SETQ CURRENTMESSAGE (fetch (SENDINGCOMMAND MESSAGE)
of EDITORRESULT))
(if (STRINGP CURRENTMESSAGE)
elseif (OR (TYPENAMEP CURRENTMESSAGE (QUOTE STREAM))
(INFILEP CURRENTMESSAGE))
then (SETQ CURRENTMESSAGE
(COERCETEXTOBJ CURRENTMESSAGE
(QUOTE STRINGP)))
else (SHOULDNT))
(SETQ DONE
(SELECTQ COMMAND
(##SEND##
(SETQ CLOSEWINDOWFLG NIL)
(SETQ REALLYSENT
(if (FIXP (SETQ #SENT
(SENDMESSAGE1
CURRENTMESSAGE
EDITORWINDOW)))
then T
else NIL)))
(##SAVE## (SAVEMESSAGEFORM CURRENTMESSAGE)
T)
(##FORGETIT## T)
(SHOULDNT]
else (* get out anyway since the user used the TEDIT "quit"
command instead of one of the sending commands *)
(SETQ DONE T))
finally
(if (OR CLOSEWINDOWFLG (NULL REALLYSENT))
then (CLOSEW EDITORWINDOW)
else (* close the menu *)
(CLOSEW (fetch (WINDOWPROP MENUWINDOW) of EDITORWINDOW))
(* shrink the window *)
(SHRINKW EDITORWINDOW
(TITLEDICONW
MSGSENTTEMPLATE
(CONCAT #SENT " Sent")
LAFITEMENUFONT
(create POSITION
XCOORD ←(IDIFFERENCE
(fetch (REGION RIGHT)
of (fetch (WINDOWPROP REGION)
of EDITORWINDOW))
(BITMAPWIDTH MSGSENTICON))
YCOORD ←(IDIFFERENCE
(fetch (REGION TOP)
of (fetch (WINDOWPROP REGION)
of EDITORWINDOW))
(BITMAPHEIGHT MSGSENTICON)))
T))) (* make it available for another send *)
(SETQ LAFITECURRENTEDITORWINDOWS
(REMOVE EDITORWINDOW LAFITECURRENTEDITORWINDOWS))
(SETQ LAFITELASTMESSAGE CURRENTMESSAGE)
(RETURN REALLYSENT])
(SENDMESSAGE1
[LAMBDA (MSG WINDOW) (* DECLARATIONS: (RECORD (#OFVALIDRECIPIENTS .
INVALIDRECIPIENTS))) (* M.Yonke "18-AUG-83 12:26")
(PROG (RECIPIENTS SENDMESSAGERESULT)
(GRAYOUTWINDOW WINDOW) (* "gray out" window*)
(SETQ RECIPIENTS (APPEND (PARSERECIPIENTS MSG (QUOTE TO)
NIL T)
(PARSERECIPIENTS MSG (QUOTE CC)
NIL T)))
(if (NOT (for RECIPENT in RECIPIENTS always RECIPENT))
then (* 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 *)
(WITHOUT.MAILWATCH (SETQ SENDMESSAGERESULT (SENDMESSAGE2 MSG RECIPIENTS)))
(if (NULL SENDMESSAGERESULT)
then (* MS didn't like the recipients list -- this was
already reported by SENDRECIPIENTS *)
(RETURN NIL)
else (RETURN (fetch #OFVALIDRECIPIENTS of SENDMESSAGERESULT])
(SENDMESSAGE2
[LAMBDA (MSG RECIPIENTS) (* M.Yonke "28-JUL-83 12:44")
(* * 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)
(if (NULL (MAILSERVERLOGIN))
then (* MAILSERVERLOGIN didn't make it -- get out *)
(printout PROMPTWINDOW T CAN'TESTABLISHCONNECTIONSTR)
(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 *)
(DISMISSS 1000))
(if (NULL SENDINGSOCKET)
then (printout PROMPTWINDOW T "Couldn't start sending the message from sender "
(FULLUSERNAME))
(RETURN))
(SETQ RECIPIENTSCHECK (SENDRECIPIENTS SENDINGSOCKET RECIPIENTS))
(if (NULL RECIPIENTSCHECK)
then (* MS didn't like the recipients list -- this was
already reported by SENDRECIPIENTS *)
(RETURN NIL)
else (* Everything is OK *)
(* send date and who from first *)
(GV.STARTITEM SENDINGSOCKET) (* send code to start sending text *)
(GV.ADDTOITEM SENDINGSOCKET "Date: ")
(GV.ADDTOITEM SENDINGSOCKET (LA.DATE))
(GV.ADDTOITEM SENDINGSOCKET LAFITEEOL)
(if (GETMESSAGEFIELD MSG (QUOTE FROM))
then (GV.ADDTOITEM SENDINGSOCKET "Sender: ")
else (GV.ADDTOITEM SENDINGSOCKET "From: "))
(GV.ADDTOITEM SENDINGSOCKET (FULLUSERNAME))
(GV.ADDTOITEM SENDINGSOCKET LAFITEEOL) (* start sending the header *)
(GV.ADDTOITEM SENDINGSOCKET MSG) (* send the rest of the message *)
(* tell the grapevine to send the message *)
(if (EQ (SETQ SENDRESULT (GV.SEND SENDINGSOCKET))
T)
then (RETURN RECIPIENTSCHECK)
else (printout PROMPTWINDOW T
"Couldn't complete the sending of the message from sender "
(FULLUSERNAME)
T "reason: " SENDRESULT)
(RETURN NIL])
(CHECKRECIPIENTS
[LAMBDA (RECIPIENTS) (* M.Yonke "26-MAY-83 11:34")
(* This checks to make sure everyone on the list RECIPIENTS are valid GV recipients or ARPAnet addresses.
-
Note: MSEXAND recognizes ARPAnet addresses as valid. -
This function returns the names if any that are not valid as a list otherwise T.)
(for RECIPIENT in RECIPIENTS bind TEMPNAME when (SELECTQ (CAR (CHECKRECIPIENT RECIPIENT))
(T
(* a good one *)
NIL)
(BadRName
(* a bad one *)
T)
(SHOULDNT))
collect RECIPIENT finally (if (NULL $$VAL)
then (RETURN T])
(CHECKRECIPIENT
[LAMBDA (RECIP) (* M.Yonke " 3-JUN-83 12:26")
(* * If recipient is an atom then just call MSExpand other have to apply MSExpand * *)
(if (LISTP RECIP)
then (APPLY (FUNCTION MS.EXPAND)
RECIP)
else (MS.EXPAND RECIP])
(FIXRECIPIENTS
[LAMBDA (RECIPIENTS) (* M.Yonke " 3-JUN-83 12:27")
(* * try striping off ↑ or putting one on at end of RECIPIENT and try again before giving up *)
(for RECIPIENT in RECIPIENTS bind TEMPNAME when [AND (LITATOM RECIPIENT)
(PROGN [SETQ TEMPNAME
(if (EQ (NTHCHAR RECIPIENT)
(QUOTE ↑))
then (SUBATOM RECIPIENT 1 -2)
else (PACK* RECIPIENT
(QUOTE ↑]
(SELECTQ (MS.EXPAND TEMPNAME)
(T NIL)
(BadRName T)
(SHOULDNT]
collect RECIPIENT])
(SENDRECIPIENTS
[LAMBDA (SOCKET RECIPIENTS) (* DECLARATIONS: (RECORD (#OFVALIDRECIPIENTS .
INVALIDRECIPIENTS)) (RECORD INVALIDRECIPIENT (RECIPIENT# . RECIPIENTNAME)))
(* M.Yonke " 1-JUL-83 11:51")
(PROG (VALIDITYRESULT)
(if (LISTP RECIPIENTS)
then (for R in RECIPIENTS do (GV.ADDRECIPIENT SOCKET R))
(SETQ VALIDITYRESULT (GV.CHECKVALIDITY SOCKET))
(if (LISTP VALIDITYRESULT)
then (if (EQLENGTH RECIPIENTS (fetch #OFVALIDRECIPIENTS of VALIDITYRESULT))
then (* everything went OK *)
(RETURN VALIDITYRESULT)
else (* 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 *)
(NTHITEM RECIPIENTS
(fetch (INVALIDRECIPIENT RECIPIENT#)
of RECIPIENT)))
PROMPTWINDOW
(CONSTANT (CONCAT LAFITEEOL "Unrecognized recipients: "))
NIL ", ")
(printout PROMPTWINDOW T
"Please fix recipients and retry sending.")
(GO FAILED))
else (printout T PROMPTWINDOW
"Something went wrong after sending recipients to the Grapevine."
T "reason: " VALIDITYRESULT)
(GO FAILED))
else (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 (MESSAGE FIELDNAME REGISTRY INTERNALFLG) (* M.Yonke "18-AUG-83 13:47")
(PROG (FIELD FIELDS ADDRESSES GENERATEDADDRESSES)
(if (NULL FIELDNAME)
then (* if no fieldname then MSG is already the string we
want *)
(if MESSAGE
then (SETQ FIELD MESSAGE)
else (RETURN))
elseif (SETQ FIELD (GETMESSAGEFIELD MESSAGE FIELDNAME))
else (RETURN)) (* HAVE TO DO THIS BECAUSE THE EOFP LOOP GOES INTO AN
INFINITE LOOP WITH TRAILING SPACES *)
(SETQ FIELD (SUBSTRING (DELETETRAILINGSPACES FIELD)
1 -1)) (* first just collect all the atoms using a special
readtable *)
(SETQ FIELDS (until (EOFP FIELD) bind RESULT
when (AND [SETQ RESULT (CAR (NLSETQ (READ FIELD ADDRESSPARSERRDTBL]
(NLISTP RESULT))
collect (* only collect atoms and strings -- lists are just
comments and should be thrown away *)
RESULT)) (* convert FIELDS into a list of addresses *)
(SETQ ADDRESSES (COLLECTADDRESSES FIELDS))
[SETQ GENERATEDADDRESSES
(for ADDRESS in ADDRESSES bind ADDR LOCAL DOMAIN
collect (* ADDRESS will only get rebound if there is an address
with <>'s in it *)
(* (match ADDRESS with ($ '< ADDRESS←$ '> $)))
[PROG ($$4 $$3)
(COND
([AND (SETQ $$3 (MEMB (QUOTE <)
ADDRESS))
(SETQ $$4 (MEMB (QUOTE >)
(CDR $$3]
(SETQ ADDRESS (LDIFF (CDR $$3)
$$4]
(SETQ ADDR (if (match ADDRESS with (LOCAL←$
'@ DOMAIN←$))
then (* have an ARPA Internet address *)
(create MAILADDRESS
LOCAL ← LOCAL
DOMAIN ← DOMAIN)
else (* have Xerox Internet address *)
(create MAILADDRESS
LOCAL ← ADDRESS)))
(if ADDR
then (* make an arpanet address *)
(if (fetch (MAILADDRESS DOMAIN) of ADDR)
then (* if INTERNALFLG then build an arpanet address to send
to the GV -- otherwise build it for text in the messge
*)
[if INTERNALFLG
then (PACK* (PACK (fetch (MAILADDRESS LOCAL) of ADDR))
"@"
(if (MEMB (QUOTE %.)
(fetch (MAILADDRESS DOMAIN)
of ADDR))
then
(* is (FOO . ARPA) -- just get the FOO *)
(fetch (MAILADDRESS LOCAL)
of (fetch (MAILADDRESS DOMAIN)
of ADDR))
else (PACK (fetch (MAILADDRESS DOMAIN)
of ADDR)))
"." ARPANETGATEWAY.REGISTRY)
else (PACK* (PACK (fetch (MAILADDRESS LOCAL) of ADDR))
"@"
(if (MEMB (QUOTE %.)
(fetch (MAILADDRESS DOMAIN)
of ADDR))
then
(* is (FOO . ARPA) -- just get the FOO *)
(fetch (MAILADDRESS LOCAL)
of (fetch (MAILADDRESS DOMAIN)
of ADDR))
else (PACK (fetch (MAILADDRESS DOMAIN)
of ADDR]
else (if (MEMB (QUOTE %.)
(fetch (MAILADDRESS LOCAL) of ADDR))
then (PACK (fetch (MAILADDRESS LOCAL) of ADDR))
else (PACK* (PACK (fetch (MAILADDRESS LOCAL) of ADDR))
"."
(OR REGISTRY DEFAULTREGISTRY]
(SETQ GENERATEDADDRESSES (for ADDR in GENERATEDADDRESSES when ADDR collect ADDR))
(RETURN (LA.REMOVEDUPLICATES GENERATEDADDRESSES])
(DELETETRAILINGSPACES
[LAMBDA (STR) (* M.Yonke "29-JUN-83 15:10")
(SETQ STR (MKSTRING STR))
(until [NEQ (NTHCHAR STR -1)
(CONSTANT (CHARACTER (CHARCODE SP]
do (GLC STR))
STR])
(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])
(ADDRESSESTOSTRING
[LAMBDA (ADDRESSLIST) (* M.Yonke "17-AUG-83 12:33")
(if ADDRESSLIST
then (PROG (LST)
(if [SETQ LST (CDR (for ADDR in ADDRESSLIST when ADDR join (LIST ", " ADDR]
then (RETURN (APPLY (FUNCTION CONCAT)
LST])
(LA.TIMEZONE
[LAMBDA NIL (* Beau " 7-SEP-82 12:24")
(PROG ((SCR ""))
(RETURN (CONCAT [SELECTQ \TimeZoneComp
(5 "E")
(6 "C")
(7 "M")
(8 "P")
(PROG1 "Greenwich " (SETQ SCR (CONCAT " + " \TimeZoneComp]
(if \DayLightSavings
then "D"
else "S")
"T" SCR])
(LA.CLOSEW!
[LAMBDA (WINDOW) (* M.Yonke "30-JUN-83 10:51")
(* makes sure to close the window by first removing any
CLOSEFN properties *)
(replace (WINDOWPROP CLOSEFN) of WINDOW with NIL)
(CLOSEW WINDOW])
(LA.FLASHWINDOW
[LAMBDA (WINDOW HOWMANYTIMES) (* M.Yonke "11-AUG-83 14:02")
(to (OR HOWMANYTIMES 2)
do (INVERTW WINDOW)
(DISMISS LAFITEFLASHWAITTIME)
(INVERTW WINDOW)
(DISMISS LAFITEFLASHWAITTIME])
(MESSAGEEDITOR
[LAMBDA (MESSAGEFORM TITLE WINDOW) (* M.Yonke "28-JUL-83 12:14")
(* * Editor for Mail system Lafite -- Handles the process mechanism right * *)
(* * Assumes that it's running in a separate process created above * *)
(PROG (EDITWINDOW EDITRESULT TEMPWINDOW)
(SETQ TITLE (OR TITLE "Message Editor")) (* first locate a window -- creating one if necessary *)
(SETQ EDITWINDOW (if (WINDOWP WINDOW)
elseif (NULL LAFITECURRENTEDITORWINDOWS)
then (* not currently editing -- use the main edit window *)
[if (WINDOWP PRIMARYEDITORWINDOW)
then (CLEARW PRIMARYEDITORWINDOW)
PRIMARYEDITORWINDOW
else (* Create a window to do the editing in.)
(SETQ PRIMARYEDITORWINDOW
(MAKEMENUEDWINDOW LAFITESENDINGMENUITEMS TITLE
(QUOTE TOP)
(AND (type? REGION LAFITEEDITORREGION)
LAFITEEDITORREGION]
elseif (find WINDOW in LAFITEEDITORWINDOWS
suchthat (NOT (MEMB WINDOW LAFITECURRENTEDITORWINDOWS)))
else (* editing already in progress -- create a new window *)
(SETQ TEMPWINDOW (MAKEMENUEDWINDOW LAFITESENDINGMENUITEMS TITLE
(QUOTE TOP)))
(* save it on a list of edit windows *)
(push LAFITEEDITORWINDOWS TEMPWINDOW)
TEMPWINDOW))
(push LAFITECURRENTEDITORWINDOWS EDITWINDOW)
(replace (WINDOWPROP TITLE) of EDITWINDOW with TITLE)
(DSPFONT LAFITEEDITORFONT EDITWINDOW)
(replace (MENU WHENSELECTEDFN) of (CAR (fetch (WINDOWPROP MENU)
of (fetch (WINDOWPROP MENUWINDOW) of EDITWINDOW)))
with (FUNCTION DOLAFITESENDINGCOMMAND))
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(FUNCTION LA.CLOSETEMPFILE)) (* don't let TEDIT close the window *)
(WINDOWADDPROP EDITWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T))
(LA.CLOSETEMPFILE EDITWINDOW)
[if (AND (fetch (WINDOWPROP MESSAGEFILE) of EDITWINDOW)
(NEQ (fetch (WINDOWPROP MESSAGEFILE) of EDITWINDOW)
MESSAGEFORM)
(LITATOM (fetch (WINDOWPROP MESSAGEFILE) of EDITWINDOW)))
then (* can delete this since it will be replaced by the new
message form *)
(if (DELFILE (fetch (WINDOWPROP MESSAGEFILE) of EDITWINDOW))
then (WINDOWDELPROP LAFITECOMMANDWINDOW (QUOTE LAFITETEMPFILES)
(fetch (WINDOWPROP MESSAGEFILE) of EDITWINDOW]
(replace (WINDOWPROP MESSAGEFILE) of EDITWINDOW with MESSAGEFORM)
(replace (WINDOWPROP PROCESS) of EDITWINDOW with (THIS.PROCESS))
(* Associate this process with the edit window *)
(TTY.PROCESS (THIS.PROCESS)) (* Take control of the keyboard *)
(RESETLST [RESETSAVE (TEDIT.WORDSET (QUOTE >)
(TEDIT.WORDGET (QUOTE A)))
(LIST (FUNCTION TEDIT.WORDSET)
(QUOTE (QUOTE >))
(TEDIT.WORDGET (QUOTE >]
[RESETSAVE (TEDIT.WORDSET (QUOTE <)
(TEDIT.WORDGET (QUOTE A)))
(LIST (FUNCTION TEDIT.WORDSET)
(QUOTE (QUOTE <))
(TEDIT.WORDGET (QUOTE <]
(SETQ EDITRESULT (\TEDIT1 MESSAGEFORM EDITWINDOW T)))
(WINDOWDELPROP EDITWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T)) (* let the window close *)
(TTY.PROCESS T) (* give back the keyboard *)
(if (type? SENDINGCOMMAND EDITRESULT)
then (replace (SENDINGCOMMAND MESSAGEWINDOW) of EDITRESULT with EDITWINDOW)
(RETURN EDITRESULT])
(GRAYOUTWINDOW
[LAMBDA (WINDOW) (* M.Yonke "23-FEB-83 11:12")
(* * gray out a window using LIGHTWAVYSHADE * *)
(DSPFILL NIL LIGHTWAVYSHADE (QUOTE PAINT)
WINDOW])
(GETBROWSERPROMPTWINDOW
[LAMBDA (WINDOW) (* M.Yonke "17-AUG-83 11:51")
(* * create a window which is twice as high as the browser menu window but in the same location * *)
(* * it is expected that everyone who uses it clears it after use so it will be fresh for the next guy * *)
(PROG (PWINDOW)
[SETQ PWINDOW (if (fetch (WINDOWPROP BROWSERPROMPTWINDOW) of WINDOW)
else (CREATEW (create REGION
using (fetch (WINDOWPROP REGION)
of (fetch (WINDOWPROP MENUWINDOW) of WINDOW))
HEIGHT ←(HEIGHTIFWINDOW
(ITIMES 2 (FONTPROP (DEFAULTFONT (QUOTE DISPLAY))
(QUOTE HEIGHT]
(replace (WINDOWPROP BROWSERPROMPTWINDOW) of WINDOW with PWINDOW)
(RETURN PWINDOW])
(MESSAGEDISPLAYER
[LAMBDA (MESSAGEFILE TITLE NEWWINDOWFLG) (* M.Yonke " 1-AUG-83 16:56")
(* * Displayer for individual messages * *)
(PROG (TEDITSTREAM DISPLAYWINDOW OLDMESSAGEFILE NEWTITLE)
(SETQ NEWTITLE (OR TITLE "Message"))
(if (AND (NOT NEWWINDOWFLG)
(WINDOWP PRIMARYDISPLAYWINDOW))
then (replace (WINDOWPROP TITLE) of PRIMARYDISPLAYWINDOW with NEWTITLE)
(CLEARW PRIMARYDISPLAYWINDOW)
(SETQ DISPLAYWINDOW PRIMARYDISPLAYWINDOW)
else (* Create a window to do the editing in.)
(SETQ DISPLAYWINDOW (CREATEW (AND (NOT NEWWINDOWFLG)
(type? REGION LAFITEDISPLAYREGION)
LAFITEDISPLAYREGION)
NEWTITLE))
(DSPFONT LAFITEDISPLAYFONT DISPLAYWINDOW)
(replace (WINDOWPROP CLOSEFN) of DISPLAYWINDOW with (FUNCTION LA.CLOSETEMPFILE))
(push LAFITEDISPLAYWINDOWS DISPLAYWINDOW)
(if (NULL PRIMARYDISPLAYWINDOW)
then (* save the first display window as the primary one *)
(SETQ PRIMARYDISPLAYWINDOW DISPLAYWINDOW)))
(LA.CLOSETEMPFILE DISPLAYWINDOW)
[if (AND (fetch (WINDOWPROP MESSAGEFILE) of DISPLAYWINDOW)
(NEQ (fetch (WINDOWPROP MESSAGEFILE) of DISPLAYWINDOW)
MESSAGEFILE))
then (* I can delete this since it is going to be replaced by
the new message *)
(if (DELFILE (fetch (WINDOWPROP MESSAGEFILE) of DISPLAYWINDOW))
then (WINDOWDELPROP LAFITECOMMANDWINDOW (QUOTE LAFITETEMPFILES)
(fetch (WINDOWPROP MESSAGEFILE) of DISPLAYWINDOW]
(replace (WINDOWPROP MESSAGEFILE) of DISPLAYWINDOW with MESSAGEFILE)
(* Now let TEDIT display it *)
[SETQ TEDITSTREAM (OPENTEXTSTREAM MESSAGEFILE DISPLAYWINDOW NIL NIL
(if LAFITEREADONLYFLG
then (QUOTE (READONLY]
(RETURN DISPLAYWINDOW])
(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])
)
(* Low level printing and message header parsing coms)
(* these vars are used in the ACCESSFNS of MESSAGEDESCRIPTOR and model Laurel mail file format
*)
(DECLARE: EVAL@COMPILE
(RPAQQ LAFITEDELETEPOSITION 20)
(RPAQQ LAFITESEENPOSITION 21)
(RPAQQ LAFITEMARKPOSITION 22)
(CONSTANTS (LAFITEDELETEPOSITION 20)
(LAFITESEENPOSITION 21)
(LAFITEMARKPOSITION 22))
)
(DEFINEQ
(PRINTMESSAGESUMMARY
[LAMBDA (MSGDESCRIPTOR MSGCOUNT FILE WINDOW) (* M.Yonke "18-AUG-83 15:51")
(DECLARE (SPECVARS $$MAXWIDTH$$))
(PROG (FROMSTR DATESTR)
(if (NOT (ZEROP (POSITION WINDOW)))
then (TERPRI WINDOW))
(MARKMESSAGEMARK MSGDESCRIPTOR WINDOW)
(PRINTNUM (QUOTE (FIX 6))
(OR (fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR)
(replace (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR with MSGCOUNT))
WINDOW)
(LA.BROWSERTAB 0 WINDOW 2)
(SETQ DATESTR (GETMESSAGEFIELDFORSUMMARY MSGDESCRIPTOR (QUOTE DATE)
FILE T))
(PRIN1 (OR (SUBSTRING DATESTR 1 6)
DATESTR)
WINDOW)
(LA.BROWSERTAB 18 WINDOW 1)
(SETQ FROMSTR (GETMESSAGEFIELDFORSUMMARY MSGDESCRIPTOR (QUOTE FROM)
FILE))
(if (MESSAGEFROMMEP (MKATOM (U-CASE FROMSTR)))
then (PRIN1 "To: " WINDOW)
(PRIN1 (GETMESSAGEFIELDFORSUMMARY MSGDESCRIPTOR (QUOTE TO)
FILE)
WINDOW)
else (PRIN1 FROMSTR WINDOW))
(LA.BROWSERTAB 40 WINDOW 2)
(PRIN1 (GETMESSAGEFIELDFORSUMMARY MSGDESCRIPTOR (QUOTE SUBJECT)
FILE)
WINDOW)
(printout WINDOW " [" (MKSTRING (fetch (MESSAGEDESCRIPTOR 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.)
(if (ILESSP $$MAXWIDTH$$ (DSPXPOSITION NIL WINDOW))
then (SETQ $$MAXWIDTH$$ (DSPXPOSITION NIL WINDOW)))
(if (fetch (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR)
then (MARKMESSAGESELECTED MSGDESCRIPTOR WINDOW))
(if (fetch (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR)
then (MARKMESSAGEDELETED MSGDESCRIPTOR WINDOW))
(TERPRI WINDOW])
(MESSAGEFROMMEP
[LAMBDA (FROM) (* M.Yonke "27-JUL-83 10:35")
(OR [EQ FROM (MKATOM (U-CASE (FULLUSERNAME]
(EQ FROM (MKATOM (U-CASE (GETSIMPLENAME (FULLUSERNAME])
(LA.BROWSERTAB
[LAMBDA (POS WINDOW MINSPACES) (* M.Yonke "26-JUL-83 15:12")
(* * currently this is in terms of character positions -- someday will change this to pixel positions so we can
have a variable pitch font in the browser window * *)
(TAB (IPLUS (IMAX POS (POSITION WINDOW))
(OR (FIXP MINSPACES)
1))
NIL WINDOW])
(MARKMESSAGESELECTED
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "19-JUL-83 12:20")
(BITBLT LA.SELECTION.BITMAP 0 0 WINDOW 0 (IDIFFERENCE (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of MSGDESCRIPTOR)
2)
NIL NIL (QUOTE INPUT)
(QUOTE REPLACE])
(MARKMESSAGEUNSELECTED
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "19-JUL-83 12:20")
(BITBLT LA.SELECTION.BITMAP 0 0 WINDOW 0 (IDIFFERENCE (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION)
of MSGDESCRIPTOR)
2)
NIL NIL (QUOTE INPUT)
(QUOTE ERASE])
(UNSELECTMESSAGE
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "28-JUN-83 12:39")
(if MSGDESCRIPTOR
then (replace (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR with NIL)
(WINDOWDELPROP WINDOW (QUOTE CURRENTMESSAGENUMBERS)
(fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR))
(MARKMESSAGEUNSELECTED MSGDESCRIPTOR WINDOW])
(SELECTMESSAGE
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "28-JUN-83 12:39")
(if MSGDESCRIPTOR
then (replace (MESSAGEDESCRIPTOR SELECTED?) of MSGDESCRIPTOR with T)
(WINDOWADDPROP WINDOW (QUOTE CURRENTMESSAGENUMBERS)
(fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR))
(MARKMESSAGESELECTED MSGDESCRIPTOR WINDOW])
(MARKMESSAGE
[LAMBDA (MSGDESCRIPTOR WINDOW MAILFILE MARK) (* M.Yonke " 1-AUG-83 16:43")
(* * causes the "seen mark" to be changed to MARK both on the file and in the window * *)
(PROG (FILE ATOMICMARK)
(SETQ ATOMICMARK (NTHCHAR (MKATOM MARK)
1)) (* make sure it's only one character *)
(if (FIXP (fetch (MESSAGEDESCRIPTOR MARKFILEPTR) of MSGDESCRIPTOR))
then (* write it out on the file *)
(WITH.MONITOR (LA.GETFILELOCK MAILFILE)
(SETQ FILE (OPENMAILFOLDER MAILFILE (QUOTE OUTPUT)))
(RESETLST (RESETSAVE (SETFILEPTR FILE
(fetch (MESSAGEDESCRIPTOR
MARKFILEPTR)
of MSGDESCRIPTOR))
(LIST (FUNCTION SETFILEPTR)
FILE
(GETFILEPTR FILE)))
(PRIN3 ATOMICMARK FILE))
(CLOSEMAILFOLDER FILE)))
(replace (MESSAGEDESCRIPTOR MARKCHAR) of MSGDESCRIPTOR with ATOMICMARK)
(MARKMESSAGEMARK MSGDESCRIPTOR WINDOW])
(MARKMESSAGEMARK
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "26-JUL-83 13:16")
(MOVETO BROWSERMARKXPOSITION (OR (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)
(DSPYPOSITION NIL WINDOW))
WINDOW)
(PRIN1 (fetch (MESSAGEDESCRIPTOR MARKCHAR) of MSGDESCRIPTOR)
WINDOW])
(SEENMESSAGE
[LAMBDA (MSGDESCRIPTOR WINDOW MAILFILE) (* M.Yonke "18-AUG-83 13:19")
(* * causes the "seen character" -- as opposed to the "seen mark" -- to be changed to "S" on the file * *)
(PROG (FILE)
(if (AND (FIXP (fetch (MESSAGEDESCRIPTOR MARKFILEPTR) of MSGDESCRIPTOR))
(NULL (fetch (MESSAGEDESCRIPTOR SEEN?) of MSGDESCRIPTOR)))
then (replace (MESSAGEDESCRIPTOR SEEN?) of MSGDESCRIPTOR with T)
(* write it out on the file *)
(WITH.MONITOR (LA.GETFILELOCK MAILFILE)
(SETQ FILE (OPENMAILFOLDER MAILFILE (QUOTE OUTPUT)))
(RESETLST (RESETSAVE (SETFILEPTR FILE
(fetch (MESSAGEDESCRIPTOR
SEENFILEPTR)
of MSGDESCRIPTOR))
(LIST (FUNCTION SETFILEPTR)
FILE
(GETFILEPTR FILE)))
(PRIN3 "S" FILE))
(CLOSEMAILFOLDER FILE)) (* only change the mark if it was ? -- it might already
be something more meaningful like an answer mark *)
(if (EQ (fetch (MESSAGEDESCRIPTOR MARKCHAR) of MSGDESCRIPTOR)
UNSEENMARK)
then (MARKMESSAGE MSGDESCRIPTOR WINDOW MAILFILE SEENMARK])
(MARKMESSAGEDELETED
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "26-JUL-83 13:16")
(BITBLT NIL 0 0 WINDOW (IPLUS BROWSERMARKXPOSITION 2)
(IPLUS (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)
(IQUOTIENT (FONTPROP WINDOW (QUOTE ASCENT))
2)
-1)
NIL 2 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE])
(MARKMESSAGEUNDELETED
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke "26-JUL-83 14:42")
(BITBLT NIL 0 0 WINDOW (IPLUS BROWSERMARKXPOSITION 2)
(IPLUS (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)
(IQUOTIENT (FONTPROP WINDOW (QUOTE ASCENT))
2)
-1)
NIL 2 (QUOTE TEXTURE)
(QUOTE ERASE)
BLACKSHADE) (* undeleted; reprint the header.)
(MOVETO 0 (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR)
WINDOW)
(PROG (($$MAXWIDTH$$ 0))
(DECLARE (SPECVARS $$MAXWIDTH$$))
(PRINTMESSAGESUMMARY MSGDESCRIPTOR (fetch (MESSAGEDESCRIPTOR #) of MSGDESCRIPTOR)
(fetch (MAILFILEDATA FILENAME) of (fetch (WINDOWPROP LAFITEDATA)
of WINDOW))
WINDOW])
(DELETEMESSAGE
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke " 1-AUG-83 16:43")
(PROG (FILE)
(if MSGDESCRIPTOR
then (WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW)))
(SETQ FILE (OPENMAILFOLDER (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA)
of WINDOW))
(QUOTE OUTPUT)))
(RESETLST (RESETSAVE (SETFILEPTR FILE
(fetch (MESSAGEDESCRIPTOR
DELETEFILEPTR)
of MSGDESCRIPTOR))
(LIST (FUNCTION SETFILEPTR)
FILE
(GETFILEPTR FILE)))
(PRIN3 "D" FILE))
(CLOSEMAILFOLDER FILE))
(replace (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR with T)
(MARKMESSAGEDELETED MSGDESCRIPTOR WINDOW])
(UNDELETEMESSAGE
[LAMBDA (MSGDESCRIPTOR WINDOW) (* M.Yonke " 1-AUG-83 16:43")
(if MSGDESCRIPTOR
then (WITH.MONITOR (LA.GETFILELOCK (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW)))
(SETQ FILE (OPENMAILFOLDER (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA)
of WINDOW))
(QUOTE OUTPUT)))
(RESETLST (RESETSAVE (SETFILEPTR FILE
(fetch (MESSAGEDESCRIPTOR DELETEFILEPTR)
of MSGDESCRIPTOR))
(LIST (FUNCTION SETFILEPTR)
FILE
(GETFILEPTR FILE)))
(PRIN3 "U" FILE))
(CLOSEMAILFOLDER FILE))
(replace (MESSAGEDESCRIPTOR DELETED?) of MSGDESCRIPTOR with NIL)
(MARKMESSAGEUNDELETED MSGDESCRIPTOR WINDOW])
(GETMESSAGEFIELDFORSUMMARY
[LAMBDA (MESSAGE FIELDNAME FILE FIRSTONLYFLG) (* M.Yonke "27-JUL-83 11:52")
(* * Gets the field from the message and returns it as a string -- will do this either from an internal message or
one out on a file * *)
(if (GETMESSAGEFIELD MESSAGE FIELDNAME FILE FIRSTONLYFLG)
else UNSUPPLIEDFIELDSTR])
(GETMESSAGEFIELD
[LAMBDA (MESSAGE FIELDNAME FILE FIRSTONLYFLG) (* M.Yonke " 1-AUG-83 16:38")
(* * Gets the field from the message and returns it as a string -- will do this either from an internal message or
one out on a file * *)
(SELECTQ (TYPENAME MESSAGE)
(STRINGP (GETMESSAGEFIELDFROMSTRING MESSAGE FIELDNAME))
(LISTP (* MESSAGE is a message descriptor *)
(GETMESSAGEFIELDFROMFOLDER MESSAGE FIELDNAME FILE FIRSTONLYFLG))
(SHOULDNT])
(GETMESSAGEFIELDFROMSTRING
[LAMBDA (MESSAGE FIELDNAME) (* M.Yonke " 1-AUG-83 16:28")
(PROG (HEADER BEGIN END FIELD)
(SETQ HEADER (SUBSTRING MESSAGE 1 (OR (STRPOS (CONSTANT (CONCAT LAFITEEOL LAFITEEOL))
MESSAGE)
1)))
(SETQ BEGIN (LA.STRPOS (CONCAT LAFITEEOL (SELECTQ FIELDNAME
(FROM "FROM: ")
(SENDER "SENDER: ")
(TO "TO: ")
(CC "CC: ")
(REPLY-TO "REPLY-TO: ")
(SHOULDNT)))
HEADER NIL NIL NIL T))
(if (NULL BEGIN)
then (* no such field -- give up *)
(RETURN NIL))
(SETQ END (IPLUS (OR (STRPOS LAFITEEOL HEADER BEGIN)
0)
-1))
(SETQ FIELD (SUBSTRING HEADER BEGIN END))
(RETURN FIELD])
(GETMESSAGEFIELDFROMFOLDER
[LAMBDA (MSGDESCRIPTOR FIELDNAME FILE FLG) (* M.Yonke " 1-AUG-83 16:43")
(* * The reason for FLG is if it NIL then this will return all occurences of ID, otherwise just the first
occurence of FIELD in the header * *)
(PROG (TEMPFILE FIELD INTERNALFLG)
(if (SETQ FIELD (ASSOC FIELDNAME (fetch (MESSAGEDESCRIPTOR HEADERFIELDS) of MSGDESCRIPTOR)))
then (RETURN (CADR FIELD))
else (if (NOT (OPENP FILE))
then (* have to open it because going to read from it *)
(SETQ INTERNALFLG T)
(SETQ TEMPFILE (OPENMAILFOLDER FILE (QUOTE INPUT)))
else (SETQ TEMPFILE FILE))
(SETQ FIELD
(bind (STR ←(CONCAT LAFITEEOL FIELDNAME ": "))
[END ←(OR (fetch (MESSAGEDESCRIPTOR ENDHEADERFILEPTR) of MSGDESCRIPTOR)
(replace (MESSAGEDESCRIPTOR ENDHEADERFILEPTR) of MSGDESCRIPTOR
with (OR (FFILEPOS (CONSTANT (CONCAT LAFITEEOL LAFITEEOL))
TEMPFILE
(fetch (MESSAGEDESCRIPTOR START)
of MSGDESCRIPTOR)
(fetch (MESSAGEDESCRIPTOR END)
of MSGDESCRIPTOR))
(fetch (MESSAGEDESCRIPTOR END) of MSGDESCRIPTOR]
(FIRSTTIME ← T) first (SETFILEPTR TEMPFILE (fetch (MESSAGEDESCRIPTOR START)
of MSGDESCRIPTOR))
while
[PROGN (* why this "while" isn't just the first FFILEPOS is
Hardy files don't conform to the standard -- code
according to lmm 9-JUN-83 *)
(OR (FFILEPOS STR TEMPFILE NIL END NIL T UPPERTOLOWERCASEARRAY)
(AND FIRSTTIME
(PROGN (SETQ FIRSTTIME NIL)
(FFILEPOS (SUBSTRING STR (ADD1 #EOLCHARS))
TEMPFILE NIL
(IPLUS (fetch (MESSAGEDESCRIPTOR START)
of MSGDESCRIPTOR)
(NCHARS STR)
-1)
NIL T UPPERTOLOWERCASEARRAY]
collect (RSTRING TEMPFILE LINEPARSERRDTBL) repeatuntil FLG))
(if FIELD
then (push (fetch (MESSAGEDESCRIPTOR HEADERFIELDS) of MSGDESCRIPTOR)
(CONS FIELDNAME FIELD)))
(if INTERNALFLG
then (CLOSEMAILFOLDER TEMPFILE))
(RETURN (CAR FIELD])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS WITHOUT.MAILWATCH MACRO (FORMS
(CONS (FUNCTION RESETLST)
(CONS [QUOTE (RESETSAVE (AND LAFITEMAILWATCHPROCESS
(SUSPEND.PROCESS LAFITEMAILWATCHPROCESS))
(LIST (QUOTE AND)
LAFITEMAILWATCHPROCESS
(LIST (FUNCTION WAKE.PROCESS)
LAFITEMAILWATCHPROCESS]
FORMS))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS $$MAXWIDTH$$)
)
(DEFINEQ
(SETUPPARSETABLES
[LAMBDA NIL (* M.Yonke "29-JUN-83 11:31")
(* first make a read table with no breaks and seperators
*)
(SETQ LINEPARSERRDTBL (COPYREADTABLE (QUOTE ORIG)))
(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))
(* * make a readtable whose only sepr char is <c.r.> and no break chars * *)
(SETSYNTAX (CHARCODE CR)
(QUOTE SEPRCHAR)
LINEPARSERRDTBL)
(* * 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)
(* * make a casearray which maps all uppercase chars into lowercase chars * *)
(if (NOT (BOUNDP (QUOTE UPPERTOLOWERCASEARRAY)))
then (SETQ UPPERTOLOWERCASEARRAY (CASEARRAY))
(for I from 0 to 127
do (SETCASEARRAY UPPERTOLOWERCASEARRAY I
(if [AND [NOT (ILESSP I (CONSTANT (CHARCODE A]
(NOT (IGREATERP I (CONSTANT (CHARCODE Z]
then [IPLUS I (CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
else I])
(PARSEMAILFOLDER
[LAMBDA (FILE) (* M.Yonke " 1-AUG-83 16:43")
(bind CHCOUNT STAMPCOUNT END MARK SEEN STARTFLG DELETED MSGDESCRIPTOR (HERE ← 0)
first (SETQ FILE (OPENMAILFOLDER FILE (QUOTE INPUT)
(QUOTE OLD)))
(SETQ END (GETEOFPTR FILE))
for I from 1 while (ILESSP HERE END)
collect (SETFILEPTR FILE 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 * *)
(if (AND (EQ (SETQ STARTFLG (READ FILE))
(QUOTE *start*))
(FIXP (SETQ CHCOUNT (READ FILE)))
(FIXP (SETQ STAMPCOUNT (READ FILE)))
(IGEQ CHCOUNT STAMPCOUNT))
else (ERROR "Bad Mail File Format" FILE))
(* * now read in the status characters and save their pointers * *)
(READC FILE) (* read the <sp> *)
(SETQ DELETED (READC FILE)) (* read the U for Undeleted *)
(SETQ SEEN (READC FILE)) (* read the U for unseen *)
(SETQ MARK (READC FILE)) (* read the mark char *)
(SETQ MSGDESCRIPTOR
(create MESSAGEDESCRIPTOR
# ← I
BEGIN ← HERE
MESSAGELENGTH ← CHCOUNT
MARKCHAR ←(OR (AND (EQ SEEN (QUOTE U))
UNSEENMARK)
MARK)
SEEN? ←(NEQ SEEN (QUOTE U))
DELETED? ←(NEQ DELETED (QUOTE U))
STAMPLENGTH ← STAMPCOUNT))
(add HERE CHCOUNT)
MSGDESCRIPTOR
finally (CLOSEMAILFOLDER FILE])
)
(* Low level file functions)
(DEFINEQ
(MAKEMAILFOLDER
[LAMBDA (MAILFILE) (* M.Yonke "16-AUG-83 16:42")
(PROG (FULLMAILFILENAME)
(if (AND MAILFILE (SETQ FULLMAILFILENAME (LA.LONGFILENAME MAILFILE LAFITEMAIL.EXT)))
then [if (NOT (INFILEP FULLMAILFILENAME))
then (* create it by opening it then closing it *)
(CLOSEF (OPENFILE FULLMAILFILENAME (QUOTE OUTPUT)
(QUOTE NEW] (* just in case there wasn't a version number -- have to
get it *)
(SETQ FULLMAILFILENAME (INFILEP FULLMAILFILENAME))
(* now add it to the list of mail files and to its menu
*)
(if (NOT (MEMB FULLMAILFILENAME LAFITEMAILFOLDERS))
then (push LAFITEMAILFOLDERS FULLMAILFILENAME)
(SETQ LAFAITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU LAFITEMAILFOLDERS)))
(RETURN FULLMAILFILENAME])
(WRITEPROFILEFILE
[LAMBDA NIL (* M.Yonke "10-AUG-83 11:50")
(PROG ((PROFILEFILE (PROFILEFILENAME)))
(WITH.MONITOR (LA.GETFILELOCK PROFILEFILE)
(DELFILE PROFILEFILE)
(SETQ PROFILEFILE (OPENFILE PROFILEFILE (QUOTE OUTPUT)))
(PRIN2 LAFITEMAILFOLDERS PROFILEFILE)
(PRIN1 " " PROFILEFILE)
(PRIN2 LAFITEFORMFILES PROFILEFILE)
(CLOSEF PROFILEFILE])
(READPROFILEFILE
[LAMBDA NIL (* M.Yonke "10-AUG-83 11:50")
(PROG ((PROFILEFILE (PROFILEFILENAME)))
(if (INFILEP PROFILEFILE)
then (* read in the profile file *)
(WITH.MONITOR (LA.GETFILELOCK PROFILEFILE)
(OPENFILE PROFILEFILE (QUOTE INPUT))
(SETQ LAFITEMAILFOLDERS (READ PROFILEFILE))
(SETQ LAFITEFORMFILES (READ PROFILEFILE))
(CLOSEF PROFILEFILE))
else (SETQ LAFITEMAILFOLDERS (SETQ LAFITEFORMFILES NIL])
(DELETEMAILFOLDER
[LAMBDA (MAILFILE) (* M.Yonke " 4-AUG-83 11:04")
(* * deletes the associated files and tells Lafite to forget about that mail file * *)
(PROG (TEMPFILE)
(FORGETMAILFOLDER MAILFILE)
(CLOSEF? MAILFILE)
(DELFILE MAILFILE)
(SETQ TEMPFILE (TOCFILENAME MAILFILE))
(CLOSEF? TEMPFILE)
(DELFILE TEMPFILE])
(FORGETMAILFOLDER
[LAMBDA (MAILFILE) (* M.Yonke " 4-AUG-83 11:04")
(* * removes mail file from the list of mail files and remakes the menu -- this is done when it is decided that
the mail file was not a real mail file or it was empty * *)
(SETQ LAFITEMAILFOLDERS (DREMOVE MAILFILE LAFITEMAILFOLDERS))
(SETQ LAFAITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU LAFITEMAILFOLDERS])
(OPENMAILFOLDER
[LAMBDA (FILE ACCESS RECOG) (* M.Yonke " 2-MAR-83 15:25")
(* * 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 (ACC)
(RETURN (SELECTQ (SYSTEMTYPE)
[(D JERICHO)
(if (OPENP FILE)
then (* check how it's suppose to be opened *)
(SETQ ACC (GETFILEINFO FILE (QUOTE ACCESS)))
(SELECTQ ACCESS
(INPUT (if (OR (EQ ACC (QUOTE INPUT))
(EQ ACC (QUOTE BOTH)))
then FILE
else (CLOSEF FILE)
(OPENFILE FILE ACCESS RECOG)))
((OUTPUT BOTH APPEND)
(if (EQ ACC (QUOTE BOTH))
then FILE
else (CLOSEF FILE)
(* open it for both *)
(OPENFILE FILE (QUOTE BOTH)
RECOG)
(if (EQ ACCESS (QUOTE APPEND))
then (SETFILEPTR FILE -1))
FILE))
(SHOULDNT))
else (SELECTQ ACCESS
(INPUT (OPENFILE FILE ACCESS RECOG))
((OUTPUT BOTH APPEND)
(OPENFILE FILE (QUOTE BOTH)
RECOG)
(if (EQ ACCESS (QUOTE APPEND))
then (SETFILEPTR FILE -1))
FILE)
(SHOULDNT]
(OPENFILE FILE ACCESS RECOG])
(CLOSEMAILFOLDER
[LAMBDA (FILE REALLYP) (* M.Yonke "21-JUN-83 14:31")
(* * This is the companion to OPENMAILFILE -- see it's comment * *)
(if REALLYP
then (if (OPENP FILE)
then (SETFILEPTR FILE -1)
(CLOSEF FILE))
else (SELECTQ (SYSTEMTYPE)
(D (* just flush the dirty pages back to the disk *)
(FLUSHMAP FILE))
(JERICHO (* just flush the dirty pages back to the disk *)
(* Ask Alice what the equivalent function is to
(FLUSHMAP FILE) *)
(HELP))
(PROGN (SETFILEPTR FILE -1)
(CLOSEF? FILE])
(INSUREMESSAGEINBROWSERWINDOW
[LAMBDA (WINDOW MSGDESCRIPTOR) (* M.Yonke "28-JUN-83 12:45")
(PROG (YPOS)
(SETQ YPOS (fetch (MESSAGEDESCRIPTOR BROWSERYPOSITION) of MSGDESCRIPTOR))
(if (AND YPOS (OR (IGREATERP (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL WINDOW))
YPOS)
(ILESSP (fetch (REGION TOP) of (DSPCLIPPINGREGION NIL WINDOW))
YPOS)))
then (SCROLLBYREPAINTFN WINDOW 0 (IPLUS (fetch (REGION BOTTOM)
of (DSPCLIPPINGREGION NIL WINDOW))
(IQUOTIENT (fetch (REGION HEIGHT)
of (DSPCLIPPINGREGION NIL WINDOW))
2)
(IMINUS YPOS)))
(MOVETO 0 (IPLUS YPOS (DSPLINEFEED NIL WINDOW))
WINDOW])
(PROMPTFORFILENAME
[LAMBDA NIL (* M.Yonke "18-AUG-83 12:53")
(* * THE WAY TO FIND OUT WHAT WINDOW IS A TERRIBLE KLUDGE -- FIX THIS * *)
(WITHOUT.MAILWATCH (PROG (WIN POS)
[if (SETQ POS (STKPOS (FUNCTION LAFITE.MOVETO)))
then (* use the prompt window for the browser if called from
LAFITE.MOVETO *)
(SETQ WIN (STKARG (QUOTE WINDOW)
POS))
(if (WINDOWP WIN)
then (SETQ WIN (GETBROWSERPROMPTWINDOW WIN]
(SETQ WIN (OR (WINDOWP WIN)
(WINDOWP LAFITEPROMPTWINDOW)
(WINDOWP PROMPTWINDOW)))
(RETURN (CAR (RESETLST (RESETSAVE (DSPFONT (QUOTE (FACE STANDARD))
WIN)
(LIST (FUNCTION DSPFONT)
(DSPFONT NIL WIN)
WIN))
(CLEARW WIN)
(printout WIN "Type in a filename (NIL to abort)"
T FILENAMEPROMPT)
(PROG1 (PROCESS.READ WIN)
(CLEARW WIN])
(MAILFOLDERBUSY
[LAMBDA (FILENAME) (* M.Yonke "10-AUG-83 11:33")
(RESETFORM (CURSOR LA.CROSSCURSOR)
(printout PROMPTWINDOW T FILENAME " is busy.")
(BLOCK LAFITEBUSYWAITTIME])
(LA.LONGFILENAME
[LAMBDA (FILENAME EXT) (* DECLARATIONS: (PROPRECORD
(HOST DEVICE DIRECTORY EXTENSION VERSION)))
(* M.Yonke "14-JUN-83 11:23")
(* * this is the one place where the FULL name is created -- notice it does not check to see if it exists --
MAKEMAILFILE and SAVEFORM should be the only ones to call this function * *)
(if FILENAME
then (if (FMEMB FILENAME (QUOTE (##ANOTHERFILE## ##ANOTHERFORM##)))
then (* the user didn't specify a real filename but one of
the "another ..." menu items *)
(SETQ FILENAME (PROMPTFORFILENAME)))
(if FILENAME
then (PROG (DEFAULTFIELDS FILEFIELDS)
(SETQ DEFAULTFIELDS (UNPACKFILENAME \LAFITEDEFAULTHOST&DIR))
(SETQ FILEFIELDS (UNPACKFILENAME FILENAME))
[if (AND (fetch HOST of FILEFIELDS)
(NULL (fetch DIRECTORY of FILEFIELDS)))
then (* don't do anything -- default was {h}<d> and he said
{h} *)
else (if (NULL (fetch HOST of FILEFIELDS))
then (replace HOST of FILEFIELDS
with (fetch HOST of DEFAULTFIELDS)))
(if (NULL (fetch DIRECTORY of FILEFIELDS))
then (replace DIRECTORY of FILEFIELDS
with (fetch DIRECTORY of DEFAULTFIELDS]
(if (fetch EXTENSION of FILEFIELDS)
else (replace EXTENSION of FILEFIELDS with EXT))
(if (AND (NOT (fetch VERSION of FILEFIELDS))
(NOT LAFITEUSEHIGHESTVERSIONFLG))
then (* only if there is not a version number or the user
doesn't want to use the highest version number *)
(replace VERSION of FILEFIELDS with 1))
(RETURN (PACKFILENAME FILEFIELDS])
(PROFILEFILENAME
[LAMBDA NIL (* M.Yonke "22-JUN-83 15:31")
(PACKFILENAME (QUOTE NAME)
LAFITEPROFILE.NAME
(QUOTE EXTENSION)
LAFITEPROFILE.EXT
(QUOTE VERSION)
1
(QUOTE BODY)
\LAFITEDEFAULTHOST&DIR])
(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)))
(* M.Yonke "19-JUL-83 17:28")
(* * returns that shortest file name that is compatible with \LAFITEDEFAULTHOST&DIR and EXT and no version number
-- the result is used in menu creation * *)
(PROG (DEFAULTFIELDS FILEFIELDS)
(if FILE
then (SETQ DEFAULTFIELDS (UNPACKFILENAME \LAFITEDEFAULTHOST&DIR))
(SETQ FILEFIELDS (UNPACKFILENAME FILE))
(if (EQ (fetch HOST of DEFAULTFIELDS)
(fetch HOST of FILEFIELDS))
then (replace HOST of FILEFIELDS with NIL))
(if (EQ (fetch DEVICE of DEFAULTFIELDS)
(fetch DEVICE of FILEFIELDS))
then (replace DEVICE of FILEFIELDS with NIL))
(if (EQ (fetch DIRECTORY of DEFAULTFIELDS)
(fetch DIRECTORY of FILEFIELDS))
then (replace DIRECTORY of FILEFIELDS with NIL))
(if (EQ EXT (fetch EXTENSION of FILEFIELDS))
then (replace EXTENSION of FILEFIELDS with NIL))
(if KEEPVERSIONFLG
else (replace VERSION of FILEFIELDS with NIL))
(RETURN (PACKFILENAME FILEFIELDS])
(ADDSENDMAILTOBACKGROUNDMENU
[LAMBDA NIL (* M.Yonke "18-AUG-83 15:38")
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(if (ASSOC (QUOTE SendMail)
BackgroundMenuCommands)
else [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
(LIST (LIST (QUOTE SendMail)
(KWOTE (LIST (FUNCTION SENDMAIL)))
"Bring up a message sending form."]
(SETQ BackgroundMenu NIL])
)
(DEFINEQ
(LA.GETFILELOCK
[LAMBDA (FILE) (* M.Yonke "14-JUN-83 10:38")
(* * gets a monitor lock for FILE -- if one does not exist then it creates one and caches it for later use * *)
(if FILE
then (if (fetch LAFITEMONITOR of FILE)
else (replace LAFITEMONITOR of FILE with (CREATE.MONITORLOCK (PACK* FILE
".MONITOR.LOCK"])
)
(* ICON stuff *)
(RPAQ MSGSENTICON (READBITMAP))
(75 40
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"L@@@@@@@@@@@@@@@@@F@"
"MOOOL@@@@@@@@@@@GOF@"
"MOOOL@@@@@@@FFFFFAF@"
"L@@@@@@@@@@AIIIIMMF@"
"MOOOO@@@@@@@@@@@EEF@"
"MOOOO@@@@@@@FFFFEMF@"
"L@@@@@@@@@@AIIIILIF@"
"MOOOOKOH@@@@@@@@EMF@"
"MOOOOKOH@@@@FFFFFCF@"
"L@@@@@@@@@@AIIIIOOF@"
"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@"
"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))
(150 100
"@OOOOOOOOOOL@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOOON@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"C@@@@@@@@@@C@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"F@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"L@@@@@@@@@@@L@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"L@DA@@@@@@@@L@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"L@FC@@@@@@@@L@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"L@EE@LCI@@@@L@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"L@EEABAA@@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"L@DIBAAA@@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"L@DACOAA@@@@@@@@@@@@@@@@@@@@@@@@@@@@C@@@"
"L@DABACIN@@@@@@@@@@@@@@@@@@@@@@@@@@@C@@@"
"L@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C@@@"
"L@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"LOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"LL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"FL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"CL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@L@@"
"AOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@")
(RPAQ MSGFOLDERMASK (READBITMAP))
(150 100
"@OOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"COOOOOOOOOOOL@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"GOOOOOOOOOOON@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOO@@@@@@@@@@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"GOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"COOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"AOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@")
(FILESLOAD ICONW)
(RPAQ MSGFOLDERTEMPLATE (create TITLEDICON ICON ← MSGFOLDERICON MASK ← MSGFOLDERMASK TITLEREG ←
(create REGION LEFT ← 10 BOTTOM ← 10 WIDTH ← 130 HEIGHT ← 60)))
(RPAQ MSGSENTTEMPLATE (create TITLEDICON ICON ← MSGSENTICON MASK ← MSGSENTMASK TITLEREG ←
(create REGION LEFT ← 0 BOTTOM ← 0 WIDTH ← 75 HEIGHT ← 30)))
(DEFINEQ
(LAFITEBROWSERICONFN
[LAMBDA (WINDOW OLDICON) (* M.Yonke "16-AUG-83 16:53")
(* * the holding place for all the fancy stuff for making an icon for a mail broswer window * *)
(TITLEDICONW MSGFOLDERTEMPLATE (LA.SHORTFILENAME (fetch (MAILFILEDATA FILENAME)
of (fetch (WINDOWPROP LAFITEDATA) of WINDOW))
LAFITEMAIL.EXT)
NIL
(create POSITION
XCOORD ←(fetch (REGION LEFT) of (fetch (WINDOWPROP REGION) of WINDOW))
YCOORD ←(fetch (REGION BOTTOM) of (fetch (WINDOWPROP REGION) of WINDOW)))
T])
)
(* need to do this so you can send a message without "starting" lafite *)
(ADDSENDMAILTOBACKGROUNDMENU)
(SETUPPARSETABLES)
(FILESLOAD MENUEDWINDOW TEDIT MAILCLIENT GRAPEVINE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(FILESLOAD (IMPORT)
MAILCLIENT)
)
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD WINDOWPROP NIL [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))
(NEWREGIONFN (WINDOWPROP DATUM (QUOTE NEWREGIONFN))
(WINDOWPROP DATUM (QUOTE NEWREGIONFN)
NEWVALUE))
(RESHAPEFN (WINDOWPROP DATUM (QUOTE RESHAPEFN))
(WINDOWPROP DATUM (QUOTE RESHAPEFN)
NEWVALUE))
(REPAINTFN (WINDOWPROP DATUM (QUOTE REPAINTFN))
(WINDOWPROP DATUM (QUOTE REPAINTFN)
NEWVALUE))
(MOVEFN (WINDOWPROP DATUM (QUOTE MOVEFN))
(WINDOWPROP DATUM (QUOTE MOVEFN)
NEWVALUE))
(TITLE (WINDOWPROP DATUM (QUOTE TITLE))
(WINDOWPROP DATUM (QUOTE TITLE)
NEWVALUE))
(BORDER (WINDOWPROP DATUM (QUOTE BORDER))
(WINDOWPROP DATUM (QUOTE BORDER)
NEWVALUE))
(EXTENT (WINDOWPROP DATUM (QUOTE EXTENT))
(WINDOWPROP DATUM (QUOTE EXTENT)
NEWVALUE))
(PAGEFULLFN (WINDOWPROP DATUM (QUOTE PAGEFULLFN))
(WINDOWPROP DATUM (QUOTE PAGEFULLFN)
NEWVALUE))
(TOTOPFN (WINDOWPROP DATUM (QUOTE TOTOPFN))
(WINDOWPROP DATUM (QUOTE TOTOPFN)
NEWVALUE))
(ICONWINDOW (WINDOWPROP DATUM (QUOTE ICONWINDOW))
(WINDOWPROP DATUM (QUOTE ICONWINDOW)
NEWVALUE))
(ICONFOR (WINDOWPROP DATUM (QUOTE ICONFOR))
(WINDOWPROP DATUM (QUOTE ICONFOR)
NEWVALUE))
(DSP (WINDOWPROP DATUM (QUOTE DSP)))
(HEIGHT (WINDOWPROP DATUM (QUOTE HEIGHT)))
(WIDTH (WINDOWPROP DATUM (QUOTE WIDTH)))
(REGION (WINDOWPROP DATUM (QUOTE REGION)))
(* Window properties specific to Lafite *)
(LAFITEDATA (WINDOWPROP DATUM (QUOTE LAFITEDATA))
(WINDOWPROP DATUM (QUOTE LAFITEDATA)
NEWVALUE))
(LAFITEBROWSERWINDOWS (WINDOWPROP DATUM
(QUOTE LAFITEBROWSERWINDOWS))
(WINDOWPROP DATUM
(QUOTE LAFITEBROWSERWINDOWS)
NEWVALUE))
(MESSAGEFILE (WINDOWPROP DATUM (QUOTE MESSAGEFILE))
(WINDOWPROP DATUM (QUOTE MESSAGEFILE)
NEWVALUE))
(CURRENTMESSAGENUMBERS (WINDOWPROP DATUM
(QUOTE CURRENTMESSAGENUMBERS))
(WINDOWPROP DATUM
(QUOTE CURRENTMESSAGENUMBERS)
NEWVALUE))
(CURRENTDISPLAYED# (WINDOWPROP DATUM (QUOTE CURRENTDISPLAYED#))
(WINDOWPROP DATUM (QUOTE CURRENTDISPLAYED#)
NEWVALUE))
(BROWSERPROMPTWINDOW (WINDOWPROP DATUM (QUOTE BROWSERPROMPTWINDOW))
(WINDOWPROP DATUM (QUOTE BROWSERPROMPTWINDOW)
NEWVALUE))
(MOVETOFILE (WINDOWPROP DATUM (QUOTE MOVETOFILE))
(WINDOWPROP DATUM (QUOTE MOVETOFILE)
NEWVALUE))
(ORIGINALTITLE (WINDOWPROP DATUM (QUOTE ORIGINALTITLE))
(WINDOWPROP DATUM (QUOTE ORIGINALTITLE)
NEWVALUE))
(* Window properties specific to MENUEDWINDOWs *)
(MENU (WINDOWPROP DATUM (QUOTE MENU))
(WINDOWPROP DATUM (QUOTE MENU)
NEWVALUE))
(MENUWINDOW (WINDOWPROP DATUM (QUOTE MENUWINDOW))
(WINDOWPROP DATUM (QUOTE MENUWINDOW)
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])
(RECORD LAFITEUSERDATA (FULLNAME ENCRYPTEDPASSWORD . MAILSERVERS))
(RECORD MESSAGEDESCRIPTOR (BROWSERYPOSITION # DELETED? SELECTED? SEEN? BEGIN HEADERLENGTH
MESSAGELENGTH MARKCHAR STAMPLENGTH HEADERFIELDS)
BEGIN ← 0 MESSAGELENGTH ← 0 (* BEGIN is the only absolute pointer into the message
file -- all other positions are relative to BEGIN -- see
the ACCESSFNS *)
[ACCESSFNS MESSAGEDESCRIPTOR
((END (IPLUS (fetch (MESSAGEDESCRIPTOR MESSAGELENGTH) of DATUM)
(fetch (MESSAGEDESCRIPTOR BEGIN) of DATUM)))
(START (IPLUS (fetch (MESSAGEDESCRIPTOR BEGIN) of DATUM)
(fetch (MESSAGEDESCRIPTOR STAMPLENGTH) of DATUM)))
[ENDHEADERFILEPTR
(AND (fetch (MESSAGEDESCRIPTOR HEADERLENGTH) of DATUM)
(IPLUS (fetch (MESSAGEDESCRIPTOR BEGIN) of DATUM)
(fetch (MESSAGEDESCRIPTOR HEADERLENGTH)
of DATUM)))
(PROGN (replace HEADERLENGTH of DATUM
with (IDIFFERENCE NEWVALUE
(fetch (MESSAGEDESCRIPTOR BEGIN)
of DATUM)))
(IPLUS (fetch (MESSAGEDESCRIPTOR BEGIN) of DATUM)
(fetch (MESSAGEDESCRIPTOR HEADERLENGTH)
of DATUM]
(SEENFILEPTR (IPLUS (fetch (MESSAGEDESCRIPTOR BEGIN) of DATUM)
LAFITESEENPOSITION))
(MARKFILEPTR (IPLUS (fetch (MESSAGEDESCRIPTOR BEGIN) of DATUM)
LAFITEMARKPOSITION))
(DELETEFILEPTR (IPLUS (fetch (MESSAGEDESCRIPTOR BEGIN)
of DATUM)
LAFITEDELETEPOSITION])
(RECORD MAILFILEDATA (FILENAME LAFITEVERSION# MAILFILEOLDEOFPTR MESSAGEDESCRIPTORS))
(RECORD MAILSERVER (NAME MAILPORT NEWMAILFLG SERVERTYPE)
(SUBRECORD MAILPORT))
(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##])
]
)
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(HASHLINK LAFITEBROWSERLINK (LAFITEBROWSERWINDOW LAFITE.FILE.TO.WINDOW.HARRAY 10))
(HASHLINK LAFITEMONITORLINK (LAFITEMONITOR LAFITE.FILE.TO.MONITOR.HARRAY 10))
]
(DECLARE: EVAL@COMPILE (GLOBALVARS LAFITE.FILE.TO.WINDOW.HARRAY))
(SETUPHASHARRAY (QUOTE LAFITE.FILE.TO.WINDOW.HARRAY)
10)
(DECLARE: EVAL@COMPILE (GLOBALVARS LAFITE.FILE.TO.MONITOR.HARRAY))
(SETUPHASHARRAY (QUOTE LAFITE.FILE.TO.MONITOR.HARRAY)
10)
)
(DECLARE: EVAL@COMPILE (GLOBALVARS LAFITE.FILE.TO.WINDOW.HARRAY))
(SETUPHASHARRAY (QUOTE LAFITE.FILE.TO.WINDOW.HARRAY)
10)
(DECLARE: EVAL@COMPILE (GLOBALVARS LAFITE.FILE.TO.MONITOR.HARRAY))
(SETUPHASHARRAY (QUOTE LAFITE.FILE.TO.MONITOR.HARRAY)
10)
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA LAFITE)
)
(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9145 24638 (LAFITE 9155 . 10419) (LAFITEON 10421 . 10931) (LAFITEINIT 10933 . 12553) (
LAFITEDEFAULTHOST&DIR 12555 . 14359) (MAKELAFITECOMMANDWINDOW 14361 . 15854) (DOLAFITEBROWSERCOMMAND
15856 . 17604) (EXTRACTMENUCOMMAND 17606 . 18016) (DOLAFITESENDINGCOMMAND 18018 . 18859) (
LAFITE.GETMAIL 18861 . 19200) (GETMAIL.PROC 19202 . 20444) (LAFITE.UPDATE 20446 . 20864) (UPDATE.PROC
20866 . 21808) (CHECKLAFITEMAILFOLDERS 21810 . 23455) (HIGHESTVERSIONP 23457 . 24226) (
EMPTYMAILFOLDERP 24228 . 24397) (FILELENGTHMATCHESDATAP 24399 . 24636)) (24689 34349 (
DOMAINLAFITECOMMAND 24699 . 25392) (LAFITE.BROWSE 25394 . 26025) (BROWSE.PROC 26027 . 30981) (
LAFITE.MESSAGEFORM 30983 . 32267) (LAFITE.QUIT 32269 . 34347)) (34350 48892 (
LAFITEBROWSERBUTTONEVENTFN 34360 . 35218) (BROWSERSELECTMESSAGE 35220 . 38975) (GETMAILFOLDER 38977 .
41647) (BUILDBROWSERMAP 41649 . 44129) (LAFITEBROWSERREPAINTFN 44131 . 45777) (LAFITEBROWSERSCROLLFN
45779 . 46404) (LAFITEBROWSERRESHAPEFN 46406 . 47025) (LAFITEBROWSERAFTERMOVEFN 47027 . 47230) (
LAFITEBROWSERCLOSEFN 47232 . 48365) (LAFITEBROWSERCURSORMOVEDFN 48367 . 48736) (
LAFITEBROWSERCURSOROUTFN 48738 . 48890)) (48893 56132 (CLOSEMAILBROWSER 48903 . 50384) (
ADDMESSAGESTOMAILBROWSER 50386 . 51287) (COMPACTMAILFOLDER 51289 . 56130)) (56133 61737 (
LAFITE.DISPLAY 56143 . 58213) (NEXTMESSAGETODISPLAY 58215 . 61735)) (61738 73478 (LAFITE.DELETE 61748
. 62705) (DISPLAYAFTERDELETE 62707 . 63802) (LAFITE.UNDELETE 63804 . 64479) (LAFITE.MOVETO 64481 .
67822) (MOVETO.PROC 67824 . 70669) (LAFITE.HARDCOPY 70671 . 70992) (HARDCOPY.PROC 70994 . 73476)) (
73479 78768 (LAFITE.ANSWER 73489 . 74050) (ANSWER.PROC 74052 . 74552) (MAKEANSWERFORM 74554 . 77036) (
GETANOTHERFORM 77038 . 78038) (MAKELAFITESUPPORTFORM 78040 . 78447) (MAKELISPSUPPORTFORM 78449 . 78766
)) (78769 82525 (LAFITE.FORWARD 78779 . 79170) (FORWARD.PROC 79172 . 80202) (MAKEFORWARDFORM 80204 .
81898) (LA.OPENTEMPFILE 81900 . 82523)) (82526 85063 (MAKENEWMESSAGEFORM 82536 . 82807) (
MAKELAFITEFORMSMENU 82809 . 83196) (MAKELAFITEMAILFOLDERSMENU 83198 . 83671) (GETMESSAGEFORM 83673 .
83876) (SAVEMESSAGEFORM 83878 . 84432) (UPDATECONTENTSFILE 84434 . 85061)) (91163 94020 (
LA.MOUSECONFIRM 91173 . 92922) (LA.STRPOS 92924 . 93251) (LA.REMOVEDUPLICATES 93253 . 93756) (NTHITEM
93758 . 93887) (LASTITEM 93889 . 94018)) (94777 103559 (MAILSERVERLOGIN 94787 . 96755) (MAILSERVERTYPE
96757 . 97219) (USERINFORMATION 97221 . 97414) (FULLUSERNAME 97416 . 97952) (GETREGISTRY 97954 .
98683) (GETSIMPLENAME 98685 . 99414) (LAFITEMAILWATCH 99416 . 99590) (POLLNEWMAIL 99592 . 100527) (
POLLNEWMAIL1 100529 . 101854) (LA.STATUSTIME 101856 . 102456) (LA.DATE 102458 . 103287) (
PRINTLAFITESTATUS 103289 . 103557)) (104079 104242 (LAFITEAFTERLOGOUT 104089 . 104240)) (104290 110466
(GETNEWMAIL 104300 . 108512) (RETRIEVEMESSAGES 108514 . 110464)) (110618 137132 (SENDMAIL 110628 .
111017) (SENDMESSAGE 111019 . 114761) (SENDMESSAGE1 114763 . 116079) (SENDMESSAGE2 116081 . 118681) (
CHECKRECIPIENTS 118683 . 119544) (CHECKRECIPIENT 119546 . 119875) (FIXRECIPIENTS 119877 . 120527) (
SENDRECIPIENTS 120529 . 122522) (PARSERECIPIENTS 122524 . 126706) (DELETETRAILINGSPACES 126708 .
126967) (COLLECTADDRESSES 126969 . 128130) (ADDRESSESTOSTRING 128132 . 128468) (LA.TIMEZONE 128470 .
128862) (LA.CLOSEW! 128864 . 129221) (LA.FLASHWINDOW 129223 . 129487) (MESSAGEEDITOR 129489 . 133555)
(GRAYOUTWINDOW 133557 . 133797) (GETBROWSERPROMPTWINDOW 133799 . 134670) (MESSAGEDISPLAYER 134672 .
136820) (LA.CLOSETEMPFILE 136822 . 137130)) (137531 151727 (PRINTMESSAGESUMMARY 137541 . 139571) (
MESSAGEFROMMEP 139573 . 139808) (LA.BROWSERTAB 139810 . 140207) (MARKMESSAGESELECTED 140209 . 140529)
(MARKMESSAGEUNSELECTED 140531 . 140851) (UNSELECTMESSAGE 140853 . 141259) (SELECTMESSAGE 141261 .
141661) (MARKMESSAGE 141663 . 142781) (MARKMESSAGEMARK 142783 . 143140) (SEENMESSAGE 143142 . 144458)
(MARKMESSAGEDELETED 144460 . 144854) (MARKMESSAGEUNDELETED 144856 . 145737) (DELETEMESSAGE 145739 .
146666) (UNDELETEMESSAGE 146668 . 147558) (GETMESSAGEFIELDFORSUMMARY 147560 . 147953) (GETMESSAGEFIELD
147955 . 148519) (GETMESSAGEFIELDFROMSTRING 148521 . 149377) (GETMESSAGEFIELDFROMFOLDER 149379 .
151725)) (152141 157568 (SETUPPARSETABLES 152151 . 155767) (PARSEMAILFOLDER 155769 . 157566)) (157606
169657 (MAKEMAILFOLDER 157616 . 158629) (WRITEPROFILEFILE 158631 . 159069) (READPROFILEFILE 159071 .
159650) (DELETEMAILFOLDER 159652 . 160105) (FORGETMAILFOLDER 160107 . 160566) (OPENMAILFOLDER 160568
. 162177) (CLOSEMAILFOLDER 162179 . 162972) (INSUREMESSAGEINBROWSERWINDOW 162974 . 163765) (
PROMPTFORFILENAME 163767 . 164817) (MAILFOLDERBUSY 164819 . 165067) (LA.LONGFILENAME 165069 . 167146)
(PROFILEFILENAME 167148 . 167433) (TOCFILENAME 167435 . 167724) (LA.SHORTFILENAME 167726 . 169155) (
ADDSENDMAILTOBACKGROUNDMENU 169157 . 169655)) (169658 170114 (LA.GETFILELOCK 169668 . 170112)) (181104
181756 (LAFITEBROWSERICONFN 181114 . 181754)))))
STOP