(FILECREATED "12-Mar-85 00:52:59" {ERIS}<LAFITE>LAFITEBROWSE.;16 131040
changes to: (FNS MESSAGEDISPLAYER \LAFITE.MOVETO \LAFITE.BROWSE.PROC \LAFITE.PREPARE.BROWSER)
(VARS LAFITESUBBROWSEMENUITEMS)
previous date: " 5-Jan-85 15:55:32" {ERIS}<LAFITE>LAFITEBROWSE.;14)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LAFITEBROWSECOMS)
(RPAQQ LAFITEBROWSECOMS [(COMS (* BROWSE)
(FNS \LAFITE.BROWSE \LAFITE.SUBBROWSE \LAFITE.BROWSE.PROC
\LAFITE.PREPARE.BROWSER LAB.LOADFOLDER LAB.DISPLAYFOLDER
LAB.MAKE.INITIAL.SELECTION LAB.CREATEWINDOW LAB.COMMANDFN
LAB.ASSURE.SELECTIONS))
(COMS (* Browser operations)
(FNS LAB.SETUP LAB.BUTTONEVENTFN LAB.DO.UNLESS.BUSY LOADMAILFOLDER
\LAFITE.GETMAILFOLDER LAB.REPAINTFN LAB.SCROLLFN LAB.RESHAPEFN LAB.CLOSEFN
LAB.SHRINKFN LAB.CLOSE/SHRINK LAB.EXPANDFN))
(COMS (* Browser selection)
(FNS LAB.SELECTMESSAGE LAB.CHANGEMARK LA.READ.NEW.MARK YPOS.TO.MESSAGE#
MESSAGE#.TO.YPOS)
(FNS LA.CONSIDERRANGE LA.DECONSIDERRANGE LA.RECONSIDERRANGE LA.SELECTRANGE
LA.DESELECTRANGE LAB.FIND.SELECTED.MSG LAB.REV.FIND.SELECTED.MSG LA.UNDOSELECTION
LA.VERIFY.SELECTION))
(COMS (* Browser display)
(FNS LAB.PROMPTPRINT \LAFITE.MAYBE.CLEAR.PROMPT)
(FNS PRINTMESSAGESUMMARY FIRSTVISIBLEMESSAGE LASTVISIBLEMESSAGE LAB.DISPLAYLINES
LAB.EXPOSEMESSAGE UNSELECTALLMESSAGES SELECTMESSAGE MARKMESSAGE CHANGEFLAGINFOLDER
LA.SHOW.MARK LA.INVERT.MARK.BOX LA.BLT.MARK.BOX LA.SHOW.DELETION LA.SHOW.SELECTION
SEENMESSAGE DELETEMESSAGE UNDELETEMESSAGE))
(COMS (* ICON stuff *)
(BITMAPS MSGFOLDERICON MSGFOLDERMASK)
(FILES ICONW)
(FNS LAB.ICONFN)
(INITVARS MSGFOLDERTEMPLATE))
(COMS (* UPDATE)
(FNS \LAFITE.UPDATE \LAFITE.EXPUNGE.PROC \LAFITE.UPDATE.PROC \LAFITE.HARDCOPYONLY.PROC
LAB.CHOOSE.UPDATE.MENU \LAFITE.START.UPDATE \LAFITE.FINISH.UPDATE
\LAFITE.CLOSE.OTHER.FOLDERS)
(FNS LAB.FLUSHWINDOW LAB.APPENDMESSAGES COMPACTMAILFOLDER COMPACTMAILFOLDER1
UPDATEMAILFOLDER UPDATECONTENTSFILE WRITETOCENTRY WRITETOCMARKBYTES
WRITEFOLDERMARKBYTES LA.OPENTEMPFILE))
(COMS (* DISPLAY)
(FNS \LAFITE.DISPLAY \LAFITE.DO.DISPLAY SELECTMESSAGETODISPLAY MESSAGEDISPLAYER
LA.COPY.MESSAGE.TEXT \LAFITE.CLOSE.DISPLAYWINDOWS \LAFITE.CLOSE.DISPLAYER))
(COMS (* DELETE & MOVE)
(FNS \LAFITE.DELETE DISPLAYAFTERDELETE \LAFITE.UNDELETE \LAFITE.MOVETO
\LAFITE.MOVETO.PROC \LAFITE.OPEN.DESTINATION))
(COMS (* HARDCOPY)
(FNS \LAFITE.HARDCOPY \LAFITE.HARDCOPY.PROC \LAFITE.HARDCOPY.HEADERS
\LAFITE.MARK.HARDCOPIED \LAFITE.TRANSMIT.HARDCOPY \LAFITE.HARDCOPY.BODIES
\LAFITE.DO.PENDING.HARDCOPY))
(COMS [INITVARS (LAFITEEXTRAMENUFLG)
(LAFITEHARDCOPYBATCHFLG)
(LAFITEHARDCOPY.MIN.TOC)
(LAFITEFROMFRACTION .3)
(LAFITEMINFROMCHARS 15)
(LAFITEIMMEDIATECHANGESFLG)
(LAFITEVERIFYFLG T)
(LAFITEDISPLAYAFTERDELETEFLG T)
(LAFITEMOVETOCONFIRMFLG (QUOTE ALWAYS))
(LAFITEREADONLYFLG T)
(LAFITEDELETEDLINEHEIGHT 1)
(LAFITENEWPAGEFLG T)
(LAFITEBROWSERREGION (create REGION LEFT ← 30 BOTTOM ← 30 WIDTH ← 575 HEIGHT
← 210))
(LAFITEDISPLAYREGION (create REGION LEFT ← 375 BOTTOM ← 25 WIDTH ← 600 HEIGHT
← 335))
(LAFITEENDOFMESSAGESTR "End of message")
(LAFITEENDOFMESSAGEFONT (FONTCREATE (QUOTE (TIMESROMAN 10 ITALIC]
(INITVARS (LAFITETEMPFILEHOSTNAME (QUOTE CORE))
(LAFITEHARDCOPYBATCHSHADE 1025)
(LAFITEHARDCOPYSEPARATOR "
Next Message
"))
(VARS LAFITEBROWSERMENUITEMS LAFITESUBBROWSEMENUITEMS)
(INITVARS (LAFITESUBBROWSEMENU))
(VARS (BROWSERMARKXPOSITION 8))
(BITMAPS LA.SELECTION.BITMAP))
(DECLARE: DOEVAL@COMPILE DONTCOPY (CONSTANTS * TOCSTATES))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA LAB.PROMPTPRINT])
(* BROWSE)
(DEFINEQ
(\LAFITE.BROWSE
[LAMBDA (ITEM MENU BUTTON FILE OPTIONS) (* bvm: "30-Oct-84 17:03")
(* * Function called by the Browse button on main Lafite window. Can also be called programmatically, in which case
FILE and/or OPTIONS may be set)
(COND
((EQ BUTTON (QUOTE MIDDLE))
(\LAFITE.SUBBROWSE ITEM MENU))
((OR FILE (SETQ FILE (\LAFITE.PROMPTFORFOLDER)))
(\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.BROWSE.PROC)
(KWOTE (LA.LONGFILENAME (U-CASE FILE)
LAFITEMAIL.EXT))
(KWOTE ITEM)
(KWOTE MENU)
(KWOTE OPTIONS))
(QUOTE LAFITEBROWSE])
(\LAFITE.SUBBROWSE
[LAMBDA (ITEM MENU) (* bvm: " 5-Mar-84 15:36")
(PROG [(COMMAND (MENU (.LAFITEMENU. LAFITESUBBROWSEMENU LAFITESUBBROWSEMENUITEMS
"Browse subcommands"]
(COND
(COMMAND (APPLY* COMMAND ITEM MENU])
(\LAFITE.BROWSE.PROC
[LAMBDA (FOLDERNAME ITEM MENU OPTIONS) (* bvm: "12-Mar-85 00:12")
(PROG (MAILFOLDER)
(RETURN (COND
((SETQ MAILFOLDER (RESETLST (AND ITEM (LA.RESETSHADE ITEM MENU))
(\LAFITE.PREPARE.BROWSER FOLDERNAME OPTIONS)))
[WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(COND
((EQMEMB (QUOTE LAUREL)
OPTIONS)
(\LAFITE.FIX.LAUREL.FOLDER MAILFOLDER)))
(LAB.LOADFOLDER MAILFOLDER)
(COND
((EQMEMB (QUOTE SHRINK)
OPTIONS)
(SHRINKW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER]
MAILFOLDER])
(\LAFITE.PREPARE.BROWSER
[LAMBDA (FOLDERNAME OPTIONS) (* bvm: "12-Mar-85 00:12")
(WITH.MONITOR
\LAFITE.BROWSELOCK
(PROG (MAILFOLDER BROWSERWINDOW)
(RETURN (COND
((NULL (SETQ MAILFOLDER (\LAFITE.GETMAILFOLDER FOLDERNAME)))
(* Error occurred)
NIL)
((SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(COND
((OPENWP BROWSERWINDOW)
(TOTOPW BROWSERWINDOW))
(T (* Make sure the EXPANDFN runs)
(EXPANDW BROWSERWINDOW)))
NIL)
(T (PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER))
ERRN)
(COND
(STREAM (* Already have folder open, e.g., from MOVETO, but no
browser yet)
(SETFILEINFO STREAM (QUOTE BUFFERS)
LAFITEBUFFERSIZE))
(T [COND
([NULL (SETQ STREAM (CAR (NLSETQ (\LAFITE.OPENSTREAM
FOLDERNAME
(QUOTE INPUT)
(QUOTE OLD)
T]
(COND
((OR (NEQ (CAR (SETQ ERRN (ERRORN)))
(PROG1 23
(* File not found)))
(NEQ (CADR ERRN)
FOLDERNAME))
(printout PROMPTWINDOW T "Could not open " FOLDERNAME)
(RETURN))
((OR (EQMEMB (QUOTE NOCONFIRM)
OPTIONS)
(MOUSECONFIRM (CONCAT
"Click LEFT to confirm creating "
FOLDERNAME)
T))
(SETQ STREAM (\LAFITE.OPENSTREAM FOLDERNAME (QUOTE BOTH)
(QUOTE NEW)
T)))
(T (FORGETMAILFILE FOLDERNAME)
(RETURN]
(replace (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER
with (FULLNAME STREAM))
(replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER with STREAM)))
(SETQ BROWSERWINDOW (LAB.CREATEWINDOW MAILFOLDER))
(RETURN MAILFOLDER])
(LAB.LOADFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "28-Mar-84 14:37")
(COND
((LOADMAILFOLDER MAILFOLDER)
(LAB.DISPLAYFOLDER MAILFOLDER])
(LAB.DISPLAYFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "28-Mar-84 14:45")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
CLIPREGION MSGDESCRIPTOR)
(CLEARW WINDOW)
(LAB.SETUP MAILFOLDER)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with NIL)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of MAILFOLDER with NIL)
(replace (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER with 1)
(replace (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER with 0)
(COND
([AND (SETQ MSGDESCRIPTOR (LAB.MAKE.INITIAL.SELECTION MAILFOLDER))
(ILESSP (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)
(fetch (REGION BOTTOM) of (SETQ CLIPREGION (DSPCLIPPINGREGION NIL WINDOW]
(* Quietly scroll so that selected message is in window)
(WYOFFSET (ITIMES [IDIFFERENCE (fetch (LAFITEMSG #) of MSGDESCRIPTOR)
(IQUOTIENT (fetch (REGION HEIGHT) of CLIPREGION)
(ITIMES 2 (fetch (MAILFOLDER
BROWSERFONTHEIGHT)
of MAILFOLDER]
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))
WINDOW)))
(COND
((ZEROP (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(LAB.PROMPTPRINT MAILFOLDER "Folder is empty."))
(T (LAB.DISPLAYLINES MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER CLIPREGION)
(LASTVISIBLEMESSAGE MAILFOLDER CLIPREGION])
(LAB.MAKE.INITIAL.SELECTION
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 12:10")
(PROG ((LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
MSGDESCRIPTOR MESSAGES)
(COND
((EQ LASTMSG# 0)
(RETURN)))
(SETQ MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(for I from 1 to LASTMSG# when (AND [NOT (fetch (LAFITEMSG SEEN?)
of (SETQ MSGDESCRIPTOR (NTHMESSAGE MESSAGES I]
(NOT (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR)))
do (* Found an unseen, undeleted message.
If we don't find one, the last MSGDESCRIPTOR is the one
to select)
(RETURN))
(SELECTMESSAGE MSGDESCRIPTOR MAILFOLDER)
(RETURN MSGDESCRIPTOR])
(LAB.CREATEWINDOW
[LAMBDA (MAILFOLDER) (* bvm: " 5-Jan-85 15:47")
(* * Build a browser window, which consists of three attached windows: the main BROWSERWINDOW, the BROWSERMENUWINDOW
containing the menu, and a BROWSERPROMPTWINDOW for displaying random info)
(PROG ((TITLE (CONCAT "Mail browser for " (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER)))
BROWSERPROMPTWINDOW BROWSERMENUWINDOW BROWSERMENU BROWSERWINDOW WIDTH HEIGHT MENUREGION
WHOLEREGION)
(SETQ BROWSERMENU (create MENU
ITEMS ← LAFITEBROWSERMENUITEMS
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION LAB.COMMANDFN)
MENUFONT ← LAFITEMENUFONT))
(SETQ MENUREGION (WINDOWPROP (SETQ BROWSERMENUWINDOW (MENUWINDOW BROWSERMENU))
(QUOTE REGION)))
(SETQ WIDTH (fetch (REGION WIDTH) of MENUREGION))
[SETQ HEIGHT (HEIGHTIFWINDOW (FONTPROP LAFITEBROWSERFONT (QUOTE HEIGHT]
(* * Now figure out where to put it all)
[SETQ WHOLEREGION (COND
((AND (for FOLDER in \ACTIVELAFITEFOLDERS never (fetch (MAILFOLDER BROWSERWINDOW)
of FOLDER))
(type? REGION LAFITEBROWSERREGION))
(COPY LAFITEBROWSERREGION))
(T (PROMPTPRINT "Specify region for " TITLE)
(PROG1 (GETREGION WIDTH (ITIMES HEIGHT 6)
NIL NIL NIL NIL)
(CLRPROMPT]
(SETQ WIDTH (fetch (REGION WIDTH) of WHOLEREGION))
[replace (REGION HEIGHT) of WHOLEREGION with (IDIFFERENCE (fetch (REGION HEIGHT)
of WHOLEREGION)
(IPLUS HEIGHT
(fetch (REGION HEIGHT)
of MENUREGION]
(* Shrink user-supplied region by the combined heights
of the menu and prompt window)
(SETQ BROWSERPROMPTWINDOW
(CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
NIL NIL T))
(WINDOWPROP BROWSERPROMPTWINDOW (QUOTE MINSIZE)
(CONS 0 HEIGHT))
(WINDOWPROP BROWSERPROMPTWINDOW (QUOTE MAXSIZE)
(CONS MAX.SMALLP HEIGHT))
(DSPSCROLL T BROWSERPROMPTWINDOW)
(DSPFONT LAFITEBROWSERFONT BROWSERPROMPTWINDOW)
(SETQ BROWSERWINDOW (CREATEW WHOLEREGION TITLE))
(ATTACHWINDOW BROWSERMENUWINDOW BROWSERWINDOW (QUOTE TOP)
(QUOTE JUSTIFY))
(ATTACHWINDOW BROWSERPROMPTWINDOW BROWSERWINDOW (QUOTE TOP)
(QUOTE JUSTIFY))
(CLEARW BROWSERPROMPTWINDOW) (* Get the xy set correctly for the actual font being
used)
(LINELENGTH (IQUOTIENT WIDTH (CHARWIDTH (CHARCODE a)
LAFITEBROWSERFONT))
BROWSERPROMPTWINDOW) (* Kludge to get LINELENGTH set closer to what it
should be for a variable width font)
(replace (MAILFOLDER ORIGINALBROWSERTITLE) of MAILFOLDER with TITLE)
(WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER)
MAILFOLDER)
(WINDOWPROP BROWSERWINDOW (QUOTE SCROLLFN)
(FUNCTION LAB.SCROLLFN))
(replace (MAILFOLDER BROWSERWINDOW) of MAILFOLDER with BROWSERWINDOW)
(replace (MAILFOLDER BROWSERMENUWINDOW) of MAILFOLDER with BROWSERMENUWINDOW)
(replace (MAILFOLDER BROWSERMENU) of MAILFOLDER with BROWSERMENU)
(replace (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER with BROWSERPROMPTWINDOW)
(WINDOWPROP BROWSERWINDOW (QUOTE REPAINTFN)
(FUNCTION LAB.REPAINTFN))
(WINDOWPROP BROWSERWINDOW (QUOTE ICONFN)
(FUNCTION LAB.ICONFN))
(WINDOWPROP BROWSERWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION LAB.BUTTONEVENTFN))
(WINDOWPROP BROWSERWINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION LAB.BUTTONEVENTFN)) (* make sure Lafite has the first CLOSEFN and SHRINKFN
*)
(WINDOWADDPROP BROWSERWINDOW (QUOTE CLOSEFN)
(FUNCTION LAB.CLOSEFN)
T)
(WINDOWADDPROP BROWSERWINDOW (QUOTE SHRINKFN)
(FUNCTION LAB.SHRINKFN)
T)
(WINDOWADDPROP BROWSERWINDOW (QUOTE RESHAPEFN)
(FUNCTION LAB.RESHAPEFN))
(RETURN BROWSERWINDOW])
(LAB.COMMANDFN
[LAMBDA (ITEM MENU KEY) (* bvm: "31-Jul-84 14:45")
(ASSURE.LAFITE.READY)
(PROG ((WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
MAILFOLDER)
(SETQ MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))
(COND
((NULL (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER))
(RETURN)))
(APPLY* (EXTRACTMENUCOMMAND ITEM)
WINDOW MAILFOLDER ITEM MENU KEY])
(LAB.ASSURE.SELECTIONS
[LAMBDA (MAILFOLDER) (* bvm: "28-Mar-84 14:43")
(COND
((IGREATERP (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)
(fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER))
(LAB.PROMPTPRINT MAILFOLDER "No messages selected.")
T])
)
(* Browser operations)
(DEFINEQ
(LAB.SETUP
[LAMBDA (MAILFOLDER) (* bvm: "31-Jul-84 14:39")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
WIDTH HEIGHT TOTALHEIGHT ASCENT DIGITWIDTH SPACEWIDTH XPOS)
(CLEARW WINDOW)
(SETQ LAFITEBROWSERFONT (FONTCREATE LAFITEBROWSERFONT))
(DSPFONT LAFITEBROWSERFONT WINDOW)
(DSPRIGHTMARGIN MAX.SMALLP WINDOW)
(LINELENGTH 10000 WINDOW)
[replace (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER with (SETQ HEIGHT
(FONTPROP LAFITEBROWSERFONT
(QUOTE HEIGHT]
[replace (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER with (SETQ ASCENT
(FONTPROP LAFITEBROWSERFONT
(QUOTE ASCENT]
(replace (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER with (FONTPROP LAFITEBROWSERFONT
(QUOTE DESCENT)))
(replace (MAILFOLDER BROWSERORIGIN) of MAILFOLDER with (IPLUS (DSPYPOSITION NIL WINDOW)
ASCENT))
[replace (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER with (SETQ WIDTH (WINDOWPROP
WINDOW
(QUOTE WIDTH]
(SETQ TOTALHEIGHT (ITIMES (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
HEIGHT))
(WINDOWPROP WINDOW (QUOTE EXTENT)
(replace (MAILFOLDER BROWSEREXTENT) of MAILFOLDER
with (create REGION
LEFT ← 0
BOTTOM ←(IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN)
of MAILFOLDER)
TOTALHEIGHT)
WIDTH ← WIDTH
HEIGHT ← TOTALHEIGHT)))
(* * Now figure out columns for printing toc entries)
(SETQ DIGITWIDTH (CHARWIDTH (CHARCODE 9)
LAFITEBROWSERFONT))
(SETQ SPACEWIDTH (CHARWIDTH (CHARCODE r)
LAFITEBROWSERFONT))
[replace (MAILFOLDER ORDINALXPOS) of MAILFOLDER with (SETQ XPOS (IPLUS BROWSERMARKXPOSITION
(CHARWIDTH
(CHARCODE m)
LAFITEBROWSERFONT)
(LRSH DIGITWIDTH 1]
(* Message # starts here)
[replace (MAILFOLDER DATEXPOS) of MAILFOLDER with (add XPOS (IPLUS (TIMES 2 SPACEWIDTH)
(TIMES 4 DIGITWIDTH]
(* Date starts here. Allow 4 columns of digits plus some
space)
[replace (MAILFOLDER FROMXPOS) of MAILFOLDER with (add XPOS (IPLUS (TIMES 2 DIGITWIDTH)
(TIMES 2 SPACEWIDTH)
(CHARWIDTH (CHARCODE
-)
LAFITEBROWSERFONT)
(STRINGWIDTH
(QUOTE MAY)
LAFITEBROWSERFONT]
(* From field starts here. Allow 3 columns of digits, a
month, and some space)
[replace (MAILFOLDER SUBJECTXPOS) of MAILFOLDER
with (add XPOS (IMAX (TIMES LAFITEMINFROMCHARS (CHARWIDTH (CHARCODE A)
LAFITEBROWSERFONT))
(FIXR (FTIMES LAFITEFROMFRACTION (IDIFFERENCE WIDTH XPOS]
(* Subject field starts here. Space is divided up between From and Subject so that From field gets
LAFITEFROMFRACTION of the available space, but at least LAFITEMINFROMCHARS wide)
(replace (MAILFOLDER FROMMAXXPOS) of MAILFOLDER with (IDIFFERENCE XPOS (TIMES 2 SPACEWIDTH))
) (* From field gets truncated beyond this position)
(replace (MAILFOLDER BROWSERDIGITWIDTH) of MAILFOLDER with DIGITWIDTH])
(LAB.BUTTONEVENTFN
[LAMBDA (WINDOW) (* bvm: "28-Mar-84 14:54")
(TOTOPW WINDOW)
(COND
((INSIDEP (DSPCLIPPINGREGION NIL WINDOW)
(LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(LAB.DO.UNLESS.BUSY WINDOW (FUNCTION LAB.SELECTMESSAGE)))
((LASTMOUSESTATE (ONLY RIGHT))
(DOWINDOWCOM WINDOW))
((AND LAFITEEXTRAMENUFLG (LASTMOUSESTATE (ONLY MIDDLE)))
(LAB.DO.UNLESS.BUSY WINDOW (FUNCTION LAFITEEXTRABROWSERCOMMANDFN])
(LAB.DO.UNLESS.BUSY
[LAMBDA (WINDOW FN ARGUMENT) (* bvm: " 4-Mar-84 23:32")
(RESETLST (PROG [(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(COND
((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T))
(APPLY* FN WINDOW MAILFOLDER ARGUMENT])
(LOADMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "12-Jan-84 15:07")
(* LAFITEVERSION# is used to keep track of changed in internal datastructures that get written out to Lafite TOC
files. If the datastructures change, then just change the version number to LAFITEVERSION#+1 and the rest of
Lafite should adjust appropriately. *)
(PROG ((MAILFILE (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER))
CONTENTSFILE)
(RETURN (COND
((OR (AND (INFILEP (SETQ CONTENTSFILE (TOCFILENAME MAILFILE)))
(READTOCFILE MAILFOLDER CONTENTSFILE))
(PARSEMAILFOLDER MAILFOLDER))
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
" done.")
[replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER
with (for I from 1 to (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
bind (MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)
)
thereis (fetch (LAFITEMSG DELETED?) of (NTHMESSAGE MESSAGES I]
MAILFOLDER)
(T (printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Failed.")
NIL])
(\LAFITE.GETMAILFOLDER
[LAMBDA (FOLDERNAME) (* bvm: "12-Jan-84 15:08")
(* * Locates a MAILFOLDER on FOLDERNAME, or creates one if there is none. The newly created folder does not have a
full name unless FOLDERNAME itself has a version)
(OR (for FOLDER in \ACTIVELAFITEFOLDERS when (OR (EQ (fetch (MAILFOLDER VERSIONLESSFOLDERNAME)
of FOLDER)
FOLDERNAME)
(EQ (fetch (MAILFOLDER FULLFOLDERNAME)
of FOLDER)
FOLDERNAME))
do (RETURN FOLDER))
(PROG ((UNPACKEDNAME (UNPACKFILENAME FOLDERNAME))
VERSIONLESSNAME SHORTNAME NEWFOLDER)
(LISTPUT UNPACKEDNAME (QUOTE VERSION)
NIL)
(SETQ VERSIONLESSNAME (PACKFILENAME UNPACKEDNAME))
[COND
[(AND (NEQ VERSIONLESSNAME FOLDERNAME)
(find old NEWFOLDER in \ACTIVELAFITEFOLDERS suchthat
(EQ (fetch (MAILFOLDER
VERSIONLESSFOLDERNAME)
of NEWFOLDER)
VERSIONLESSNAME)))
(* Found a folder describing a different version)
(COND
((fetch (MAILFOLDER BROWSERWINDOW) of NEWFOLDER)
(printout PROMPTWINDOW T "A different version of " FOLDERNAME
" is already being browsed."
"Multiple versions may not be manipulated at once.")
(RETURN NIL))
(T (* Not being browsed, so just smash the full name)
(replace (MAILFOLDER FULLFOLDERNAME) of NEWFOLDER with FOLDERNAME]
(T (SETQ SHORTNAME (LA.SHORTFILENAME UNPACKEDNAME LAFITEMAIL.EXT))
(SETQ NEWFOLDER (create MAILFOLDER
FULLFOLDERNAME ←(AND (NEQ FOLDERNAME VERSIONLESSNAME)
FOLDERNAME)
VERSIONLESSFOLDERNAME ← VERSIONLESSNAME
SHORTFOLDERNAME ← SHORTNAME
FOLDERLOCK ←(CREATE.MONITORLOCK VERSIONLESSNAME)))
(push \ACTIVELAFITEFOLDERS NEWFOLDER)
(COND
((NOT (FMEMB SHORTNAME (CDR LAFITEMAILFOLDERS)))
(push (CDR LAFITEMAILFOLDERS)
SHORTNAME)
(SETQ \LAFITEPROFILECHANGED T)
(SETQ LAFITEFOLDERSMENU]
(RETURN NEWFOLDER])
(LAB.REPAINTFN
[LAMBDA (WINDOW REGION) (* bvm: "28-Mar-84 14:22")
(PROG [(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(AND (NOT (ZEROP (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)))
(fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(RESETLST (COND
((OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T)
(LAB.DISPLAYLINES MAILFOLDER (FIRSTVISIBLEMESSAGE MAILFOLDER REGION)
(LASTVISIBLEMESSAGE MAILFOLDER REGION)))
(T (MAILFOLDERBUSY MAILFOLDER])
(LAB.SCROLLFN
[LAMBDA (WINDOW DX DY CONTINUOUSFLG) (* bvm: " 3-Jan-84 14:53")
(* * only scroll if can get the monitor lock * *)
(RESETLST (PROG [(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(COND
((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T))
(SCROLLBYREPAINTFN WINDOW DX DY CONTINUOUSFLG))
(T (MAILFOLDERBUSY MAILFOLDER])
(LAB.RESHAPEFN
[LAMBDA (WINDOW OLDIMAGEBM OLDREGION) (* bvm: "28-Mar-84 14:22")
(RESETLST (PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))
(REGION (DSPCLIPPINGREGION NIL WINDOW))
MSG#)
[COND
((NOT (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T)) (* Folder is busy, have to wait until it is ready.
But don't tie up mouse!)
(ALLOW.BUTTON.EVENTS)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T))
((NOT (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER))
(* Browser not functional)
(RETURN (RESHAPEBYREPAINTFN WINDOW OLDIMAGEBM OLDREGION]
(SETQ MSG# (FIRSTVISIBLEMESSAGE MAILFOLDER REGION))
(LAB.SETUP MAILFOLDER)
(WYOFFSET (ITIMES (SUB1 MSG#)
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER))
WINDOW)
(LAB.DISPLAYLINES MAILFOLDER MSG# (LASTVISIBLEMESSAGE MAILFOLDER REGION])
(LAB.CLOSEFN
[LAMBDA (BROWSERWINDOW) (* bvm: "28-Mar-84 15:05")
(LAB.CLOSE/SHRINK BROWSERWINDOW (QUOTE CLOSE])
(LAB.SHRINKFN
[LAMBDA (WINDOW) (* bvm: "28-Mar-84 15:05")
(LAB.CLOSE/SHRINK WINDOW (QUOTE SHRINK])
(LAB.CLOSE/SHRINK
[LAMBDA (BROWSERWINDOW FLG) (* bvm: "22-Dec-84 00:50")
(RESETLST (PROG ((MAILFOLDER (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER)))
HOW?)
(RETURN (COND
[(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
T T)
(AND (OPENWP BROWSERWINDOW)
(CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)))
(SELECTQ [SETQ HOW? (COND
((AND (fetch (MAILFOLDER BROWSERREADY) of MAILFOLDER)
(SETQ HOW? (LAB.CHOOSE.UPDATE.MENU MAILFOLDER T)))
(MENU HOW?))
(T (FUNCTION \LAFITE.FINISH.UPDATE]
(NIL (QUOTE DON'T))
(PROGN (\LAFITE.PROCESS (LIST HOW? (KWOTE BROWSERWINDOW)
(KWOTE MAILFOLDER)
(KWOTE FLG))
(QUOTE LAFITEUPDATE))
(* Return DON'T now, for UPDATE.PROC will do it later)
(QUOTE DON'T]
(T (printout PROMPTWINDOW T "Browser is busy, can't close")
(QUOTE DON'T])
(LAB.EXPANDFN
[LAMBDA (BROWSERWINDOW) (* bvm: "31-Jul-84 14:58")
(PROG [(MAILFOLDER (WINDOWPROP BROWSERWINDOW (QUOTE MAILFOLDER]
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG ((FIRSTCHANGEDMSG# (fetch (MAILFOLDER BROWSERUPDATEFROMHERE)
of MAILFOLDER))
REGION) (* Restore SHRINKFN prop if necessary)
(WINDOWADDPROP BROWSERWINDOW (QUOTE SHRINKFN)
(FUNCTION LAB.SHRINKFN)
T)
(COND
(FIRSTCHANGEDMSG# (* Browser has changed since shrinking)
[COND
((ZEROP FIRSTCHANGEDMSG#)
(* After expunge)
(LAB.DISPLAYFOLDER MAILFOLDER))
(T (LAB.DISPLAYLINES
MAILFOLDER
[IMAX FIRSTCHANGEDMSG#
(FIRSTVISIBLEMESSAGE MAILFOLDER
(SETQ REGION
(
DSPCLIPPINGREGION NIL BROWSERWINDOW]
(LASTVISIBLEMESSAGE MAILFOLDER REGION]
(replace (MAILFOLDER BROWSERUPDATEFROMHERE)
of MAILFOLDER with NIL])
)
(* Browser selection)
(DEFINEQ
(LAB.SELECTMESSAGE
[LAMBDA (WINDOW) (* bvm: "31-Jul-84 16:08")
(DECLARE (GLOBALVARS LASTMOUSEBUTTONS)
(SPECVARS TOCSTATE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(PROG ((MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER)))
MESSAGES SELECTIONREGION FIRST# LAST# FIRSTVISIBLE# LASTVISIBLE# TOCSTATE SEL# OLDSEL#
CTRLDOWN OLDLASTMOUSEBUTTONS MSG LASTX LASTY MARKRIGHT)
(COND
((ZEROP (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(* Nothing to select)
(RETURN)))
(SETQ SELECTIONREGION (DSPCLIPPINGREGION NIL WINDOW))
(SETQ LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(SETQ FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(SETQ FIRSTVISIBLE# (FIRSTVISIBLEMESSAGE MAILFOLDER SELECTIONREGION))
(SETQ LASTVISIBLE# (LASTVISIBLEMESSAGE MAILFOLDER SELECTIONREGION))
(SETQ MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(SETQ MARKRIGHT (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER))
(* * keep looping until all mouse buttons are up * *)
[do (GETMOUSESTATE)
(COND
[[NOT (INSIDEP SELECTIONREGION (SETQ LASTX (LASTMOUSEX WINDOW))
(SETQ LASTY (LASTMOUSEY WINDOW]
(* I would like to just return here and let the next window take over, but current mouse arrangement means I'll
never get control back unless user lets up on mouse)
(COND
((NEQ TOCSTATE TS.IDLE)
(LA.UNDOSELECTION)
(SETQ OLDSEL#)))
(COND
((LASTMOUSESTATE UP)
(RETURN))
(T (BLOCK]
((LASTMOUSESTATE UP) (* Make selection permanent)
(SELECTC TOCSTATE
(TS.REPLACING (for MSG selectedin MAILFOLDER
do (replace SELECTED? of MSG with NIL))
(replace SELECTED? of (NTHMESSAGE MESSAGES OLDSEL#)
with T)
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER
with (replace LASTSELECTEDMESSAGE of MAILFOLDER
with OLDSEL#)))
(TS.ADDING (LA.SELECTRANGE MAILFOLDER OLDSEL# OLDSEL# T))
(TS.REMOVING (LA.DESELECTRANGE MAILFOLDER OLDSEL# OLDSEL#))
(TS.EXTENDING.HI (LA.SELECTRANGE MAILFOLDER (ADD1 LAST#)
OLDSEL# CTRLDOWN))
(TS.EXTENDING.LO (LA.SELECTRANGE MAILFOLDER OLDSEL# (SUB1 FIRST#)
CTRLDOWN))
(TS.SHRINKING.HI (LA.DESELECTRANGE MAILFOLDER (ADD1 OLDSEL#)
LAST#))
(TS.SHRINKING.LO (LA.DESELECTRANGE MAILFOLDER FIRST# (SUB1 OLDSEL#)))
NIL)
(RETURN))
((AND (IGEQ LASTX BROWSERMARKXPOSITION)
(ILESSP LASTX MARKRIGHT)) (* Inside mark region)
(COND
((NEQ TOCSTATE TS.IDLE)
(LA.UNDOSELECTION)
(SETQ OLDSEL#)))
(LAB.CHANGEMARK MAILFOLDER))
((OR (NEQ (SETQ SEL# (YPOS.TO.MESSAGE# (LASTMOUSEY WINDOW)
MAILFOLDER))
OLDSEL#)
(NEQ LASTMOUSEBUTTONS OLDLASTMOUSEBUTTONS))
[COND
[(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))) (* Deselect this message)
(SELECTC TOCSTATE
(TS.REMOVING (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES
OLDSEL#)
(QUOTE REPLACE)))
(TS.IDLE)
(LA.UNDOSELECTION))
(SETQ TOCSTATE (COND
((fetch SELECTED? of (SETQ MSG (NTHMESSAGE MESSAGES SEL#)))
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE ERASE))
TS.REMOVING)
(T TS.IDLE]
((LASTMOUSESTATE LEFT) (* Set (change) the selection to this single message)
(COND
((EQ TOCSTATE TS.REPLACING)
(LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES OLDSEL#)
(QUOTE ERASE)))
(T (LA.DECONSIDERRANGE FIRSTVISIBLE# LASTVISIBLE#)
(SETQ TOCSTATE TS.REPLACING)))
(LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES SEL#)
(QUOTE REPLACE)))
[(LASTMOUSESTATE MIDDLE) (* Add this message to the selection)
(SELECTC TOCSTATE
(TS.ADDING (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES OLDSEL#)
(QUOTE ERASE)))
(TS.IDLE)
(LA.UNDOSELECTION))
(SETQ TOCSTATE (COND
([NOT (fetch SELECTED? of (SETQ MSG (NTHMESSAGE MESSAGES SEL#]
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE))
TS.ADDING)
(T TS.IDLE]
((LASTMOUSESTATE RIGHT) (* Extend: either up or down, or shrink a selection.
This is messy)
(SELECTC TOCSTATE
[TS.EXTENDING.HI (COND
((IGREATERP SEL# OLDSEL#)
(* Extend further)
(LA.CONSIDERRANGE (ADD1 OLDSEL#)
SEL# CTRLDOWN))
(T (* Shrinking back)
(LA.RECONSIDERRANGE (ADD1 (COND
((IGREATERP SEL#
LAST#)
SEL#)
(T (SETQ TOCSTATE
TS.IDLE)
LAST#)))
OLDSEL#]
[TS.EXTENDING.LO (COND
((ILESSP SEL# OLDSEL#)
(* Extend further)
(LA.CONSIDERRANGE SEL# (SUB1 OLDSEL#)
CTRLDOWN))
(T (* Shrinking back)
(LA.RECONSIDERRANGE OLDSEL#
(SUB1 (COND
((ILESSP SEL# FIRST#)
SEL#)
(T (SETQ TOCSTATE
TS.IDLE)
FIRST#]
[TS.SHRINKING.HI (COND
[(IGEQ SEL# OLDSEL#)
(* Shrinking less)
(LA.RECONSIDERRANGE (ADD1 OLDSEL#)
(COND
((ILESSP SEL# LAST#)
SEL#)
(T (SETQ TOCSTATE TS.IDLE)
LAST#]
((IGEQ SEL# FIRST#)
(* Shrinking further)
(LA.DECONSIDERRANGE (ADD1 SEL#)
OLDSEL#))
(T (* Too far to shrink)
(LA.RECONSIDERRANGE FIRST# LAST#)
(SETQ TOCSTATE TS.IDLE]
[TS.SHRINKING.LO (COND
((ILEQ SEL# OLDSEL#)
(* Shrinking less)
(LA.RECONSIDERRANGE (COND
((IGREATERP SEL# FIRST#)
SEL#)
(T (SETQ TOCSTATE TS.IDLE)
FIRST#))
(SUB1 OLDSEL#)))
((ILEQ SEL# LAST#)
(* Shrinking further)
(LA.DECONSIDERRANGE OLDSEL# (SUB1 SEL#)))
(T (* Too far to shrink)
(LA.RECONSIDERRANGE FIRST# LAST#)
(SETQ TOCSTATE TS.IDLE]
(COND
((NOT (IGREATERP FIRST# LAST#))
(COND
((NEQ TOCSTATE TS.IDLE)
(LA.UNDOSELECTION)))
(SETQ CTRLDOWN (KEYDOWNP (QUOTE CTRL)))
(SETQ TOCSTATE (COND
((IGREATERP SEL# LAST#)
(LA.CONSIDERRANGE (ADD1 LAST#)
SEL# CTRLDOWN)
TS.EXTENDING.HI)
((ILESSP SEL# FIRST#)
(LA.CONSIDERRANGE SEL# (SUB1 FIRST#)
CTRLDOWN)
TS.EXTENDING.LO)
((IGREATERP SEL# (LRSH (IPLUS LAST# FIRST#)
1))
(LA.DECONSIDERRANGE (ADD1 SEL#)
LAST#)
TS.SHRINKING.HI)
(T (LA.DECONSIDERRANGE FIRST# (SUB1 SEL#))
TS.SHRINKING.LO]
(SETQ OLDLASTMOUSEBUTTONS LASTMOUSEBUTTONS)
(SETQ OLDSEL# (AND (NEQ TOCSTATE TS.IDLE)
SEL#]
(COND
((EQ LAFITEVERIFYFLG (QUOTE TOC))
(LA.VERIFY.SELECTION MAILFOLDER])
(LAB.CHANGEMARK
[LAMBDA (MAILFOLDER) (* bvm: "17-Feb-84 15:46")
(* Called when mouse is inside the "mark" region of a
browser. Tracks mouse while in that region and does
whatever is appropriate)
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(RIGHT (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER))
SEL# OLDSEL# COCKED REGION X Y TOP BOTTOM)
[SETQ BOTTOM (fetch (REGION BOTTOM) of (SETQ REGION (DSPCLIPPINGREGION NIL WINDOW]
(SETQ TOP (fetch (REGION TOP) of REGION))
(do (GETMOUSESTATE)
(COND
((OR (ILESSP (SETQ X (LASTMOUSEX WINDOW))
BROWSERMARKXPOSITION)
(IGREATERP X RIGHT)
(ILESSP (SETQ Y (LASTMOUSEY WINDOW))
BOTTOM)
(IGREATERP Y TOP))
(COND
(COCKED (LA.INVERT.MARK.BOX MAILFOLDER OLDSEL#)))
(RETURN))
((LASTMOUSESTATE UP)
(COND
(COCKED (LA.READ.NEW.MARK MAILFOLDER OLDSEL#)))
(RETURN))
((NEQ (SETQ SEL# (YPOS.TO.MESSAGE# Y MAILFOLDER))
OLDSEL#)
(COND
(COCKED (LA.INVERT.MARK.BOX MAILFOLDER OLDSEL#))
(T (SETQ COCKED T)))
(LA.INVERT.MARK.BOX MAILFOLDER (SETQ OLDSEL# SEL#])
(LA.READ.NEW.MARK
[LAMBDA (MAILFOLDER MSG#) (* bvm: "13-Nov-84 11:01")
(PROG ((MSG (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)
MSG#))
(WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
YPOS MARK)
(RESETSAVE NIL (LIST (QUOTE CLEARW)
(fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)))
(RESETSAVE NIL (LIST (FUNCTION LA.SHOW.MARK)
MSG MAILFOLDER)) (* Display correct mark on exit no matter what happens)
(RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (* So caret flashes in the right place)
(RESETSAVE NIL (LIST (QUOTE WINDOWPROP)
WINDOW
(QUOTE PROCESS)
NIL))
(* PROCESS prop put there by TTYDISPLAYSTREAM -- don't want it to linger, else MOUSE proc will get tty in future
when we bug browser)
(LA.BLT.MARK.BOX MAILFOLDER WINDOW (SETQ YPOS (MESSAGE#.TO.YPOS MSG MAILFOLDER))
(QUOTE REPLACE)
WHITESHADE) (* Erase whatever's there)
(LAB.PROMPTPRINT MAILFOLDER "Type single character mark, or ESC to abort")
(MOVETO BROWSERMARKXPOSITION YPOS WINDOW)
(COND
((AND (IGEQ (SETQ MARK (\GETKEY))
(CHARCODE SPACE))
(ILEQ MARK (CHARCODE DEL)))
(replace (LAFITEMSG MARKSCHANGED?) of MSG with T)
(replace (LAFITEMSG SEEN?) of MSG with (NEQ MARK UNSEENMARK))
(replace (LAFITEMSG MARKCHAR) of MSG with MARK)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T])
(YPOS.TO.MESSAGE#
[LAMBDA (YPOS MAILFOLDER) (* bvm: "24-Dec-83 17:45")
(PROG [(N (IQUOTIENT (IPLUS (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
YPOS)
(fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER))
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER]
(RETURN (COND
((ILEQ N 0)
1)
(T (IMIN N (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER])
(MESSAGE#.TO.YPOS
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "24-Dec-83 16:37")
(IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
(ITIMES (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)
(fetch (LAFITEMSG #) of MSGDESCRIPTOR])
)
(DEFINEQ
(LA.CONSIDERRANGE
[LAMBDA (FIRST# LAST# EVENIFDELETED) (* bvm: "14-Feb-84 17:25")
(* * Change display so that messages from FIRST# to LAST# are marked as selected. Deleted messages are not
selected unless EVENIFDELETED is true)
(DECLARE (USEDFREE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(for I from (IMAX FIRST# FIRSTVISIBLE#) to (IMIN LAST# LASTVISIBLE#) bind MSG
do (SETQ MSG (NTHMESSAGE MESSAGES I))
(COND
((OR EVENIFDELETED (NOT (fetch DELETED? of MSG)))
(LA.SHOW.SELECTION MAILFOLDER MSG (QUOTE REPLACE])
(LA.DECONSIDERRANGE
[LAMBDA (FIRST# LAST#) (* bvm: "14-Feb-84 17:26")
(* * Change display so that messages from FIRST# to LAST# are marked as unselected.)
(DECLARE (USEDFREE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(for I from (IMAX FIRST# FIRSTVISIBLE#) to (IMIN LAST# LASTVISIBLE#)
do (LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES I)
(QUOTE ERASE])
(LA.RECONSIDERRANGE
[LAMBDA (FIRST# LAST#) (* bvm: "14-Feb-84 17:41")
(* * Change display so that messages from FIRST# to LAST# are marked as selected or unselected according to the
truth of the matter.)
(DECLARE (USEDFREE MAILFOLDER MESSAGES FIRSTVISIBLE# LASTVISIBLE#))
(for I from (IMAX FIRST# FIRSTVISIBLE#) to (IMIN LAST# LASTVISIBLE#) bind MSG
do (LA.SHOW.SELECTION MAILFOLDER (SETQ MSG (NTHMESSAGE MESSAGES I))
(COND
((fetch SELECTED? of MSG)
(QUOTE REPLACE))
(T (QUOTE ERASE])
(LA.SELECTRANGE
[LAMBDA (MAILFOLDER FIRST# LAST# EVENIFDELETED) (* bvm: "15-Feb-84 15:39")
(* * Mark internally messages FIRST# thru LAST# as selected. Do not select deleted messages unless EVENIFDELETED
is true. Keeps MAILFOLDER:LASTSELECTEDMESSAGE and MAILFOLDER:FIRSTSELECTEDMESSAGE up to date.
Assumes display has already been appropriately modified)
(PROG ((MESSAGES (fetch MESSAGEDESCRIPTORS of MAILFOLDER))
(FIRSTSEL (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(LASTSEL (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
MSG)
[for I from FIRST# to LAST#
do (SETQ MSG (NTHMESSAGE MESSAGES I))
(COND
((OR EVENIFDELETED (NOT (fetch DELETED? of MSG)))
(replace SELECTED? of MSG with T]
(COND
((OR (IGREATERP FIRSTSEL LASTSEL)
(ILESSP FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER)))
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER with FIRST#)))
(COND
((OR (IGREATERP FIRSTSEL LASTSEL)
(IGREATERP LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER)))
(replace LASTSELECTEDMESSAGE of MAILFOLDER with LAST#])
(LA.DESELECTRANGE
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: "28-Mar-84 14:52")
(* * Mark internally messages FIRST# thru LAST# as unselected. Keeps MAILFOLDER:LASTSELECTEDMESSAGE and
MAILFOLDER:FIRSTSELECTEDMESSAGE up to date. Assumes display has already been appropriately modified)
(COND
((ILEQ FIRST# LAST#)
(PROG ((MESSAGES (fetch MESSAGEDESCRIPTORS of MAILFOLDER)))
(for I from FIRST# to LAST# do (replace SELECTED? of (NTHMESSAGE MESSAGES I)
with NIL))
(COND
[(EQ FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER
with (COND
((LAB.FIND.SELECTED.MSG MAILFOLDER (ADD1 LAST#)
(fetch LASTSELECTEDMESSAGE of MAILFOLDER)))
(T (replace LASTSELECTEDMESSAGE of MAILFOLDER with 0)
(* Null selection indicated by first GT last.)
(ADD1 (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER]
((EQ LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(replace LASTSELECTEDMESSAGE of MAILFOLDER
with (OR (LAB.REV.FIND.SELECTED.MSG MAILFOLDER (fetch FIRSTSELECTEDMESSAGE
of MAILFOLDER)
(SUB1 FIRST#))
1])
(LAB.FIND.SELECTED.MSG
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: "15-Feb-84 12:22")
(find I from FIRST# to LAST# bind (MESSAGES ←(fetch MESSAGEDESCRIPTORS of MAILFOLDER))
suchthat (fetch SELECTED? of (NTHMESSAGE MESSAGES I])
(LAB.REV.FIND.SELECTED.MSG
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: " 2-Mar-84 18:02")
(find I from LAST# to FIRST# by -1 bind (MESSAGES ←(fetch MESSAGEDESCRIPTORS of MAILFOLDER))
suchthat (fetch SELECTED? of (NTHMESSAGE MESSAGES I])
(LA.UNDOSELECTION
[LAMBDA NIL (* bvm: "14-Feb-84 17:43")
(* * Restore browser to state before any selections were attempted)
(DECLARE (USEDFREE FIRSTVISIBLE# LASTVISIBLE# TOCSTATE))
(LA.RECONSIDERRANGE FIRSTVISIBLE# LASTVISIBLE#)
(SETQ TOCSTATE TS.IDLE])
(LA.VERIFY.SELECTION
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 11:53")
(PROG ((FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
(MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(#OFMESSAGES (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
SEL)
(COND
[(IGREATERP FIRST# LAST#)
(COND
([SETQ SEL (for I from 1 to #OFMESSAGES collect I when (fetch SELECTED?
of (NTHMESSAGE MESSAGES I]
(HELP "First > Last, but these msgs selected" SEL]
(T [for I from 1 to #OFMESSAGES do (COND
((fetch SELECTED? of (NTHMESSAGE MESSAGES I))
(COND
((ILESSP I FIRST#)
(HELP "First is too high" FIRST#))
((IGREATERP I LAST#)
(HELP "Last is too low" LAST#]
(COND
((AND (EQ FIRST# 1)
(EQ LAST# 1)) (* The only time it is okay for them not to be selected)
)
((NOT (fetch SELECTED? of (NTHMESSAGE MESSAGES FIRST#)))
(HELP "First not selected" FIRST#))
((NOT (fetch SELECTED? of (NTHMESSAGE MESSAGES LAST#)))
(HELP "Last not selected" LAST#])
)
(* Browser display)
(DEFINEQ
(LAB.PROMPTPRINT
[LAMBDA FOLDER&ARGS (* bvm: " 7-Apr-84 18:20")
(PROG ((MAILFOLDER (\DTEST (ARG FOLDER&ARGS 1)
(QUOTE MAILFOLDER)))
WINDOW)
(SETQ WINDOW (ffetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(CLEARW WINDOW)
(for I from 2 to FOLDER&ARGS do (PRIN3 (ARG FOLDER&ARGS I)
WINDOW))
(freplace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T])
(\LAFITE.MAYBE.CLEAR.PROMPT
[LAMBDA (MAILFOLDER) (* bvm: " 1-Feb-84 14:53")
(COND
((fetch (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER)
(CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with NIL])
)
(DEFINEQ
(PRINTMESSAGESUMMARY
[LAMBDA (MSGDESCRIPTOR MAILFOLDER WINDOW) (* bvm: " 2-Feb-84 12:08")
(PROG (FROMSTR HERE THERE EXTENT MSG#)
(OR (fetch (LAFITEMSG PARSED?) of MSGDESCRIPTOR)
(LAFITE.PARSE.MSG.FOR.TOC MSGDESCRIPTOR MAILFOLDER))
(MOVETO 0 (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)
WINDOW)
(POSITION WINDOW 0)
(LA.SHOW.MARK MSGDESCRIPTOR MAILFOLDER)
(DSPXPOSITION [IPLUS (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER)
(TIMES (fetch (MAILFOLDER BROWSERDIGITWIDTH) of MAILFOLDER)
(COND
((ILESSP (SETQ MSG# (fetch (LAFITEMSG #) of MSGDESCRIPTOR))
10)
3)
((ILESSP MSG# 100)
2)
((ILESSP MSG# 1000)
1)
(T 0]
WINDOW) (* Ugh. Manually right-justify message # given that font
may be variable width)
(PRINTNUM (QUOTE (FIX 1))
MSG# WINDOW)
(DSPXPOSITION (fetch (MAILFOLDER DATEXPOS) of MAILFOLDER)
WINDOW)
(PRIN1 (OR (fetch (LAFITEMSG DATE) of MSGDESCRIPTOR)
UNSUPPLIEDFIELDSTR)
WINDOW)
(DSPXPOSITION (fetch (MAILFOLDER FROMXPOS) of MAILFOLDER)
WINDOW)
[COND
[(fetch (LAFITEMSG MSGFROMMEP) of MSGDESCRIPTOR)
(PRIN1 "To: " WINDOW)
(SETQ FROMSTR (OR (fetch (LAFITEMSG TO) of MSGDESCRIPTOR)
(LAFITE.FETCH.TO.FIELD MSGDESCRIPTOR MAILFOLDER]
(T (SETQ FROMSTR (OR (fetch (LAFITEMSG FROM) of MSGDESCRIPTOR)
UNSUPPLIEDFIELDSTR]
(PRIN1 FROMSTR WINDOW)
(COND
((IGREATERP (SETQ HERE (DSPXPOSITION NIL WINDOW))
(SETQ THERE (fetch (MAILFOLDER FROMMAXXPOS) of MAILFOLDER)))
(* Erase the overflow)
(DSPBACKUP (IDIFFERENCE HERE THERE)
WINDOW)))
(DSPXPOSITION (fetch (MAILFOLDER SUBJECTXPOS) of MAILFOLDER)
WINDOW)
(PRIN1 (OR (fetch (LAFITEMSG SUBJECT) of MSGDESCRIPTOR)
UNSUPPLIEDFIELDSTR)
WINDOW)
(printout WINDOW " [" .I1 (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR)
" chars]")
(* keep track of maximum width printed to. If header is allowed to print on two lines, $$MAXWIDTH$$ was set to
right margin by BUILDBROWSERMAP so this should not reset it.)
(COND
((ILESSP (fetch (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER)
(SETQ HERE (DSPXPOSITION NIL WINDOW)))
(replace (MAILFOLDER BROWSERMAXXPOS) of MAILFOLDER with HERE)
(replace (REGION WIDTH) of (SETQ EXTENT (fetch (MAILFOLDER BROWSEREXTENT) of MAILFOLDER)
)
with HERE)
(WINDOWPROP WINDOW (QUOTE EXTENT)
EXTENT)))
[COND
((fetch (LAFITEMSG SELECTED?) of MSGDESCRIPTOR)
(LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE]
(COND
((fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR)
(LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR WINDOW (QUOTE REPLACE])
(FIRSTVISIBLEMESSAGE
[LAMBDA (MAILFOLDER REGION) (* bvm: "22-Dec-83 12:15")
(* Computes number of the first message in MAILFOLDER
that is visible in REGION)
(IMAX 1 (IQUOTIENT (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
(IPLUS (fetch (REGION TOP) of REGION)
(fetch (MAILFOLDER BROWSERFONTDESCENT) of MAILFOLDER)))
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER])
(LASTVISIBLEMESSAGE
[LAMBDA (MAILFOLDER REGION) (* bvm: "22-Dec-83 12:15")
(* Computes number of the last message in MAILFOLDER
that is visible in REGION)
(IMIN (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
(IQUOTIENT (IPLUS (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN) of MAILFOLDER)
(IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
(fetch (MAILFOLDER BROWSERFONTASCENT)
of MAILFOLDER)))
(SUB1 (fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)))
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER])
(LAB.DISPLAYLINES
[LAMBDA (MAILFOLDER FIRST# LAST#) (* bvm: "22-Dec-83 12:23")
(for MSG# from FIRST# to LAST#
bind (WINDOW ←(fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
do (PRINTMESSAGESUMMARY (NTHMESSAGE MESSAGES MSG#)
MAILFOLDER WINDOW])
(LAB.EXPOSEMESSAGE
[LAMBDA (MAILFOLDER MSGDESCRIPTOR) (* bvm: "24-Dec-83 19:00")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(YPOS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER))
CLIPREGION)
(COND
((OR (IGREATERP (fetch (REGION BOTTOM) of (SETQ CLIPREGION (DSPCLIPPINGREGION NIL WINDOW))
)
YPOS)
(ILESSP (fetch (REGION TOP) of CLIPREGION)
YPOS))
(SCROLLBYREPAINTFN WINDOW 0 (IPLUS (fetch (REGION BOTTOM) of CLIPREGION)
(IQUOTIENT (fetch (REGION HEIGHT) of CLIPREGION)
2)
(IMINUS YPOS])
(UNSELECTALLMESSAGES
[LAMBDA (MAILFOLDER) (* bvm: "15-Feb-84 16:21")
(for N from (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER) to (fetch LASTSELECTEDMESSAGE
of MAILFOLDER)
bind (MESSAGES ←(fetch MESSAGEDESCRIPTORS of MAILFOLDER))
do (LA.DESELECTRANGE MAILFOLDER N N)
(LA.SHOW.SELECTION MAILFOLDER (NTHMESSAGE MESSAGES N)
(QUOTE ERASE])
(SELECTMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "15-Feb-84 12:34")
(PROG ((N (fetch (LAFITEMSG #) of MSGDESCRIPTOR)))
(LA.SELECTRANGE MAILFOLDER N N T)
(LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE])
(MARKMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER MARK) (* bvm: "15-Apr-84 17:36")
(* * Changes the mark byte of MSGDESCRIPTOR to be MARK. This may also imply something about SEEN?)
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG MARKFILEPTR)
of MSGDESCRIPTOR)
MARK))
(replace (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR with MARK)
(replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with (NEQ MARK UNSEENMARK))
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(COND
((OPENWP (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(LA.SHOW.MARK MSGDESCRIPTOR MAILFOLDER))
(T (* Wait until browser expanded before showing mark
update)
(PROG ((N (fetch (LAFITEMSG #) of MSGDESCRIPTOR))
(OLDU (fetch (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER)))
(COND
((OR (NULL OLDU)
(IGREATERP OLDU N))
(replace (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER with N])
(CHANGEFLAGINFOLDER
[LAMBDA (MAILFOLDER PTR FLAG) (* bvm: "31-Jul-84 15:10")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG [(STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE OUTPUT]
(SETFILEPTR STREAM PTR)
(BOUT STREAM FLAG])
(LA.SHOW.MARK
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "17-Feb-84 15:34")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))
(YPOS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER))
(MARK (fetch (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR)))
(LA.BLT.MARK.BOX MAILFOLDER WINDOW YPOS (QUOTE REPLACE)
WHITESHADE) (* Erase whatever's there)
(COND
((NEQ MARK (CHARCODE SPACE))
(MOVETO BROWSERMARKXPOSITION YPOS WINDOW)
(BOUT WINDOW MARK])
(LA.INVERT.MARK.BOX
[LAMBDA (MAILFOLDER MSG#) (* bvm: "17-Feb-84 14:44")
(LA.BLT.MARK.BOX MAILFOLDER (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)
(MESSAGE#.TO.YPOS (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of MAILFOLDER)
MSG#)
MAILFOLDER)
(QUOTE INVERT)
BLACKSHADE])
(LA.BLT.MARK.BOX
[LAMBDA (MAILFOLDER WINDOW YPOS OPERATION TEXTURE) (* bvm: "17-Feb-84 14:21")
(BITBLT NIL NIL NIL WINDOW BROWSERMARKXPOSITION (IDIFFERENCE YPOS (fetch (MAILFOLDER
BROWSERFONTDESCENT)
of MAILFOLDER))
(IDIFFERENCE (fetch (MAILFOLDER ORDINALXPOS) of MAILFOLDER)
BROWSERMARKXPOSITION)
(fetch (MAILFOLDER BROWSERFONTHEIGHT) of MAILFOLDER)
(QUOTE TEXTURE)
OPERATION TEXTURE])
(LA.SHOW.DELETION
[LAMBDA (MAILFOLDER MSGDESCRIPTOR WINDOW OPERATION) (* bvm: " 2-Feb-84 12:40")
(* * Draws or erases, for OPERATION = REPLACE or ERASE, the line indicating that MSGDESCRIPTOR is deleted)
(BITBLT NIL 0 0 WINDOW BROWSERMARKXPOSITION (IDIFFERENCE (IPLUS (MESSAGE#.TO.YPOS MSGDESCRIPTOR
MAILFOLDER)
(LRSH (fetch (MAILFOLDER
BROWSERFONTASCENT)
of MAILFOLDER)
1))
(LRSH LAFITEDELETEDLINEHEIGHT 1))
NIL LAFITEDELETEDLINEHEIGHT (QUOTE TEXTURE)
OPERATION BLACKSHADE])
(LA.SHOW.SELECTION
[LAMBDA (MAILFOLDER MSGDESCRIPTOR OPERATION) (* bvm: " 2-Feb-84 12:37")
(* * Displays or erases, per OPERATION = REPLACE or ERASE, the mark indicating that MSGDESCRIPTOR is selected)
(BITBLT LA.SELECTION.BITMAP 0 0 (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)
0
(IPLUS (MESSAGE#.TO.YPOS MSGDESCRIPTOR MAILFOLDER)
(LRSH (fetch (MAILFOLDER BROWSERFONTASCENT) of MAILFOLDER)
1)
-5)
NIL NIL (QUOTE INPUT)
OPERATION])
(SEENMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: " 3-Jan-84 17:10")
(* * causes the "seen character" -- as opposed to the "seen mark" -- to be changed to "S" on the file * *)
(COND
((NULL (fetch (LAFITEMSG SEEN?) of MSGDESCRIPTOR))
(replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with T)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(* write it out on the file *)
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG SEENFILEPTR)
of MSGDESCRIPTOR)
SEENFLAG))
(* only change the mark if it was ? -- it might already
be something more meaningful like an answer mark *)
(COND
((EQ (fetch (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR)
UNSEENMARK)
(MARKMESSAGE MSGDESCRIPTOR MAILFOLDER SEENMARK])
(DELETEMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "26-Jan-84 16:02")
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG DELETEFILEPTR)
of MSGDESCRIPTOR)
DELETEDFLAG))
(replace (LAFITEMSG DELETED?) of MSGDESCRIPTOR with T)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER with T)
(LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)
(QUOTE REPLACE])
(UNDELETEMESSAGE
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "26-Jan-84 16:00")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)))
(AND LAFITEIMMEDIATECHANGESFLG (CHANGEFLAGINFOLDER MAILFOLDER (fetch (LAFITEMSG
DELETEFILEPTR)
of MSGDESCRIPTOR)
UNDELETEDFLAG))
(replace (LAFITEMSG DELETED?) of MSGDESCRIPTOR with NIL)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)
(LA.SHOW.DELETION MAILFOLDER MSGDESCRIPTOR WINDOW (QUOTE ERASE))
(* undeleted; reprint the header.)
(PRINTMESSAGESUMMARY MSGDESCRIPTOR MAILFOLDER WINDOW])
)
(* ICON stuff *)
(RPAQ MSGFOLDERICON (READBITMAP))
(100 72
"@OOOOOOOO@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOH@@@@@@@@@@@@@@@@@@"
"C@@@@@@@@L@@@@@@@@@@@@@@@@@@"
"F@@@@@@@@F@@@@@@@@@@@@@@@@@@"
"L@DA@@@@@C@@@@@@@@@@@@@@@@@@"
"L@FC@@@@@C@@@@@@@@@@@@@@@@@@"
"L@EE@HGB@C@@@@@@@@@@@@@@@@@@"
"L@EEADBB@C@@@@@@@@@@@@@@@@@@"
"L@DIBBBB@COOOOOOOOOOOOOOL@@@"
"L@DACNBB@COOOOOOOOOOOOOOL@@@"
"L@DABBGCL@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@@@@@L@@@"
"L@@@@@@@@@@@@@@@@@@@@@@@L@@@"
"LOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"LOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"LL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"FL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"CL@@@@@@@@@@@@@@@@@@@@@@C@@@"
"AOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"@OOOOOOOOOOOOOOOOOOOOOOOO@@@")
(RPAQ MSGFOLDERMASK (READBITMAP))
(100 72
"@OOOOOOOO@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOH@@@@@@@@@@@@@@@@@@"
"COOOOOOOOL@@@@@@@@@@@@@@@@@@"
"GOOOOOOOON@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOO@@@@@@@@@@@@@@@@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOL@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOOOOOOOOOOO@@@"
"AOOOOOOOOOOOOOOOOOOOOOOOO@@@"
"@OOOOOOOOOOOOOOOOOOOOOOOO@@@")
(FILESLOAD ICONW)
(DEFINEQ
(LAB.ICONFN
[LAMBDA (WINDOW OLDICON) (* bvm: "31-Jul-84 14:55")
(* * the holding place for all the fancy stuff for making an icon for a mail broswer window * *)
(OR (WINDOWP (WINDOWPROP WINDOW (QUOTE ICONWINDOW)))
(PROG [(BROWSERREGION (WINDOWPROP WINDOW (QUOTE REGION)))
(MAILFOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER]
(RETURN (TITLEDICONW [OR MSGFOLDERTEMPLATE
(SETQ MSGFOLDERTEMPLATE
(create TITLEDICON
ICON ← MSGFOLDERICON
MASK ← MSGFOLDERMASK
TITLEREG ←(create REGION
LEFT ← 8
BOTTOM ← 4
WIDTH ← 88
HEIGHT ← 51]
(COND
(MAILFOLDER (LA.SHORTFILENAME (fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)
LAFITEMAIL.EXT))
(T "??"))
NIL
(create POSITION
XCOORD ←(fetch (REGION LEFT) of BROWSERREGION)
YCOORD ←(fetch (REGION BOTTOM) of BROWSERREGION))
T])
)
(RPAQ? MSGFOLDERTEMPLATE NIL)
(* UPDATE)
(DEFINEQ
(\LAFITE.UPDATE
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: " 7-Nov-84 11:24")
(PROG ((HOW? (LAB.CHOOSE.UPDATE.MENU MAILFOLDER)))
(COND
((NOT HOW?)
(LAB.PROMPTPRINT MAILFOLDER "No changes since the last Update"))
((SETQ HOW? (MENU HOW?))
(\LAFITE.PROCESS (LIST HOW? (KWOTE WINDOW)
(KWOTE MAILFOLDER)
NIL
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE LAFITEUPDATE])
(\LAFITE.EXPUNGE.PROC
[LAMBDA (WINDOW MAILFOLDER CLOSEFLG ITEM MENU) (* bvm: " 7-Nov-84 11:22")
[RESETLST (\LAFITE.START.UPDATE MAILFOLDER ITEM MENU)
(\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER)
(CLEARW WINDOW)
(UPDATECONTENTSFILE MAILFOLDER (COMPACTMAILFOLDER MAILFOLDER))
(COND
(CLOSEFLG (\LAFITE.CLOSE.FOLDER MAILFOLDER T)
(replace (MAILFOLDER BROWSERUPDATEFROMHERE) of MAILFOLDER with 0))
(T (LAB.DISPLAYFOLDER MAILFOLDER] (* Do the following outside RESETLST so that Update
gets unshaded)
(\LAFITE.FINISH.UPDATE WINDOW MAILFOLDER CLOSEFLG])
(\LAFITE.UPDATE.PROC
[LAMBDA (WINDOW MAILFOLDER CLOSEFLG ITEM MENU) (* bvm: " 7-Nov-84 11:22")
[RESETLST (\LAFITE.START.UPDATE MAILFOLDER ITEM MENU)
(COND
((OR (COND
((fetch (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER)
(UPDATEMAILFOLDER MAILFOLDER)
T))
(NEQ (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
(fetch (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER)))
(UPDATECONTENTSFILE MAILFOLDER (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)))
(T (LAB.PROMPTPRINT MAILFOLDER "No changes since last update")))
(COND
(CLOSEFLG (\LAFITE.CLOSE.FOLDER MAILFOLDER T]
(* Do the following outside RESETLST so that Update
gets unshaded)
(\LAFITE.FINISH.UPDATE WINDOW MAILFOLDER CLOSEFLG])
(\LAFITE.HARDCOPYONLY.PROC
[LAMBDA (WINDOW MAILFOLDER CLOSEFLG ITEM MENU) (* bvm: " 7-Nov-84 11:22")
(* Called by Update or Close to just do pending
hardcopy, nothing else)
(RESETLST (LA.RESETSHADE [OR ITEM (ASSOC (QUOTE Update)
(fetch (MENU ITEMS) of (SETQ MENU (fetch (MAILFOLDER
BROWSERMENU)
of MAILFOLDER]
MENU)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(\LAFITE.DO.PENDING.HARDCOPY MAILFOLDER MENU))
(\LAFITE.FINISH.UPDATE WINDOW MAILFOLDER CLOSEFLG])
(LAB.CHOOSE.UPDATE.MENU
[LAMBDA (MAILFOLDER CLOSEFLG) (* bvm: "29-May-84 15:00")
(* Returns a menu for prompting the user about what to do with MAILFOLDER when Update is requested, or if CLOSEFLG
is true, if Close/Shrink is requested. Returns NIL if there is no interesting choice)
(PROG [(CHOICES (COND
(CLOSEFLG (CDR LAFITEUPDATEMENUS))
(T (CAR LAFITEUPDATEMENUS]
(RETURN (COND
((fetch (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER)
(CAR CHOICES))
((fetch (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER)
(CADR CHOICES))
((fetch (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER)
(CADDR CHOICES))
((NEQ (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
(fetch (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER))
(CADDDR CHOICES])
(\LAFITE.START.UPDATE
[LAMBDA (MAILFOLDER ITEM MENU) (* bvm: "28-Mar-84 14:43")
(* Called under a RESETLST to start an UPDATE or
EXPUNGE)
(LA.RESETSHADE [OR ITEM (ASSOC (QUOTE Update)
(fetch (MENU ITEMS) of (SETQ MENU (fetch (MAILFOLDER BROWSERMENU)
of MAILFOLDER]
MENU)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T) (* Mark folder being updated for benefit of LOGOUT
check)
(replace (MAILFOLDER FOLDERBEINGUPDATED) of MAILFOLDER with T)
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (MAILFOLDER)
(replace (MAILFOLDER FOLDERBEINGUPDATED) of MAILFOLDER with NIL])
MAILFOLDER)) (* Close all other folders, so MoveTo's are up to date)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(\LAFITE.CLOSE.OTHER.FOLDERS MAILFOLDER)
(PROG ((TEXTSTREAM (fetch (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER)))
(COND
(TEXTSTREAM (LAB.PROMPTPRINT MAILFOLDER "Hardcopying... ")
(\LAFITE.TRANSMIT.HARDCOPY MAILFOLDER TEXTSTREAM (fetch (MAILFOLDER
HARDCOPYMESSAGES)
of MAILFOLDER))
(replace (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER
with (replace (MAILFOLDER HARDCOPYMESSAGES) of MAILFOLDER with NIL))
(SHADEITEM (ASSOC (QUOTE Hardcopy)
(fetch (MENU ITEMS) of MENU))
MENU WHITESHADE) (* Take the speckle off the menu)
])
(\LAFITE.FINISH.UPDATE
[LAMBDA (WINDOW MAILFOLDER CLOSEFLG DONTCLOSE) (* bvm: "21-Dec-84 22:33")
(* * Takes care of closing/shrinking WINDOW after an update or expunge. DONTCLOSE is true if neither occurred, in
which case we are being called directly from the CLOSEFN and should not close/shrink the window ourselves)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(SELECTQ CLOSEFLG
[CLOSE (WITH.MONITOR \LAFITE.BROWSELOCK (\LAFITE.CLOSE.FOLDER MAILFOLDER T)
(SETQ WINDOW (LAB.FLUSHWINDOW WINDOW MAILFOLDER))
(OR DONTCLOSE (CLOSEW WINDOW))
(COND
([AND (OR (NOT (fetch (MAILFOLDER FOLDEREOFPTR)
of MAILFOLDER))
(IEQP (fetch (MAILFOLDER FOLDEREOFPTR)
of MAILFOLDER)
0))
(ZEROP (GETFILEINFO (fetch (MAILFOLDER
FULLFOLDERNAME)
of MAILFOLDER)
(QUOTE LENGTH]
(* FOLDEREOFPTR should always be right, but
double-check with the file itself before deleting)
(DELETEMAILFOLDER MAILFOLDER]
(SHRINK (\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER)
(\LAFITE.CLOSE.FOLDER MAILFOLDER T)
(WINDOWADDPROP WINDOW (QUOTE EXPANDFN)
(FUNCTION LAB.EXPANDFN))
(WINDOWDELPROP WINDOW (QUOTE SHRINKFN)
(FUNCTION LAB.SHRINKFN))
(OR DONTCLOSE (SHRINKW WINDOW)))
NIL))
(COND
(\LAFITEPROFILECHANGED (\LAFITE.WRITE.PROFILE])
(\LAFITE.CLOSE.OTHER.FOLDERS
[LAMBDA (THISFOLDER) (* bvm: "31-Jul-84 15:17")
(* Closes or flushes output of all Lafite folders except THISFOLDER. If a folder does not have an open browser,
the file is closed; else output is flushed)
(WITH.MONITOR \LAFITE.MAINLOCK (for FOLDER in \ACTIVELAFITEFOLDERS
when (AND (NEQ FOLDER THISFOLDER)
(fetch (MAILFOLDER FOLDERSTREAM) of FOLDER))
do (RESETLST (COND
((OBTAIN.MONITORLOCK (fetch (MAILFOLDER
FOLDERLOCK)
of FOLDER)
T T)
(\LAFITE.CLOSE.FOLDER
FOLDER
(NULL (OPENWP (fetch (MAILFOLDER
BROWSERWINDOW)
of FOLDER])
)
(DEFINEQ
(LAB.FLUSHWINDOW
[LAMBDA (WINDOW MAILFOLDER) (* bvm: "31-Jul-84 14:55")
(\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER)
(WINDOWDELPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION LAB.CLOSEFN))
[replace (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER
with (replace (MAILFOLDER BROWSERREADY) of MAILFOLDER
with (replace (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER
with (replace (MAILFOLDER BROWSERMENUWINDOW) of MAILFOLDER
with (replace (MAILFOLDER BROWSERWINDOW) of MAILFOLDER
with (replace (MAILFOLDER BROWSERMENU) of MAILFOLDER
with (replace (MAILFOLDER BROWSERPROMPTWINDOW)
of MAILFOLDER with NIL]
(WINDOWPROP WINDOW (QUOTE MAILFOLDER)
NIL)
(SETQ \ACTIVELAFITEFOLDERS (DREMOVE MAILFOLDER \ACTIVELAFITEFOLDERS))
(OR (OPENWP WINDOW)
(OPENWP (WINDOWPROP WINDOW (QUOTE ICONWINDOW])
(LAB.APPENDMESSAGES
[LAMBDA (FOLDERDATA NEWMESSAGEDESCRIPTORS) (* bvm: "31-Jul-84 15:10")
(* get the new file length *)
(PROG ((LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of FOLDERDATA))
FIRSTMSG#)
(SETQ FIRSTMSG# (ADD1 LASTMSG#))
[replace (MAILFOLDER FOLDEREOFPTR) of FOLDERDATA with (GETEOFPTR (\LAFITE.OPEN.FOLDER
FOLDERDATA
(QUOTE INPUT]
(for MSGDESCRIPTOR in NEWMESSAGEDESCRIPTORS
do (replace (LAFITEMSG #) of MSGDESCRIPTOR with (add LASTMSG# 1))
(LAFITE.PARSE.MSG.FOR.TOC MSGDESCRIPTOR FOLDERDATA))
(replace (MAILFOLDER #OFMESSAGES) of FOLDERDATA with LASTMSG#)
(replace (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDERDATA with (\LAFITE.ADDMESSAGES.TO.ARRAY
(fetch (MAILFOLDER
MESSAGEDESCRIPTORS)
of FOLDERDATA)
NEWMESSAGEDESCRIPTORS
FIRSTMSG# LASTMSG#))
(PROG ((REGION (DSPCLIPPINGREGION NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDERDATA)))
(EXTENT (fetch (MAILFOLDER BROWSEREXTENT) of FOLDERDATA))
(HEIGHT (ITIMES LASTMSG# (fetch (MAILFOLDER BROWSERFONTHEIGHT) of FOLDERDATA)))
WINDOW)
(replace (REGION HEIGHT) of EXTENT with HEIGHT)
(replace (REGION BOTTOM) of EXTENT with (IDIFFERENCE (fetch (MAILFOLDER BROWSERORIGIN)
of FOLDERDATA)
HEIGHT))
(WINDOWPROP (SETQ WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDERDATA))
(QUOTE EXTENT)
EXTENT)
(COND
((OPENWP WINDOW) (* If window is visible, update it now)
(LAB.DISPLAYLINES FOLDERDATA (IMAX FIRSTMSG# (FIRSTVISIBLEMESSAGE FOLDERDATA
REGION))
(LASTVISIBLEMESSAGE FOLDERDATA REGION)))
((NULL (fetch (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDERDATA))
(* Mark browser for display update after being unshrunk)
(replace (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDERDATA with FIRSTMSG#])
(COMPACTMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "31-Jul-84 15:10")
(* * Expunge deleted messages from MAILFOLDER -
Copy undeleted messages after the first deleted one into a scratch file and copy the scratch file back into the
main file -
Returns the msg # of the last message before the compacted section)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
(LASTGOODMSG# 0)
FOLDERSTREAM MSG)
(* * first see if there are any messages to delete and while doing so collect information for rapidly compacting
the file just in case we have to)
(for MSG# from 1 to LASTMSG# until (fetch (LAFITEMSG DELETED?) of (SETQ MSG
(NTHMESSAGE MESSAGES
MSG#)))
do [COND
((fetch (LAFITEMSG MARKSCHANGED?) of MSG)
(WRITEFOLDERMARKBYTES MSG MAILFOLDER (OR FOLDERSTREAM (SETQ FOLDERSTREAM
(\LAFITE.OPEN.FOLDER MAILFOLDER
(QUOTE BOTH]
(replace (LAFITEMSG SELECTED?) of MSG with NIL)
(SETQ LASTGOODMSG# MSG#))
(COND
((NEQ LASTGOODMSG# LASTMSG#)
(COMPACTMAILFOLDER1 MAILFOLDER (OR FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER
(QUOTE BOTH)))
LASTGOODMSG#)))
(replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER with NIL)
(RETURN LASTGOODMSG#])
(COMPACTMAILFOLDER1
[LAMBDA (MAILFOLDER FOLDERSTREAM LASTGOODMSG#) (* bvm: "31-Jul-84 15:17")
(* * LASTGOODMSG# is the number of the last good message before the region to be compacted.
-
GOODMSGSPTR will be a pointer into the mail file to the end of the last consecutive good message)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(OLDLASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
GOODMSGSPTR MSGDESCRIPTOR NEXTFILEPTR SCRATCHFILE MESSAGELENGTH COMPACTLENGTH START)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Compacting folder... ")
[SETQ GOODMSGSPTR (SETQ NEXTFILEPTR (COND
((ZEROP LASTGOODMSG#)
0)
(T (fetch (LAFITEMSG END) of (NTHMESSAGE MESSAGES LASTGOODMSG#]
(SETQ COMPACTLENGTH (for I from (ADD1 LASTGOODMSG#) to OLDLASTMSG#
unless (fetch (LAFITEMSG DELETED?) of (SETQ MSGDESCRIPTOR
(NTHMESSAGE MESSAGES I)))
sum (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR)))
[COND
((NEQ COMPACTLENGTH 0) (* have to copy the scratch file to the end of the good
messages left in the original file *)
(SETQ SCRATCHFILE (LA.OPENTEMPFILE (QUOTE SCRATCH)
(QUOTE BOTH)
(QUOTE NEW)
COMPACTLENGTH))
(* * now map down the rest of the messages moving the not deleted ones into the scratch file * *)
(for I from (ADD1 LASTGOODMSG#) to OLDLASTMSG# unless (fetch (LAFITEMSG DELETED?)
of (SETQ MSGDESCRIPTOR
(NTHMESSAGE MESSAGES I)))
do (MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER)
(LA.PRINTSTAMP SCRATCHFILE) (* *start*)
(SETQ MESSAGELENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR))
(SETQ START (fetch (LAFITEMSG START) of MSGDESCRIPTOR))
(* Compute this before we possibly alter the
STAMPLENGTH)
(COND
((NEQ (fetch (LAFITEMSG STAMPLENGTH) of MSGDESCRIPTOR)
LAFITESTAMPLENGTH) (* As we compact file, convert all messages to Lafite
format)
(SETQ MESSAGELENGTH (IPLUS (IDIFFERENCE MESSAGELENGTH (fetch (LAFITEMSG
STAMPLENGTH)
of MSGDESCRIPTOR))
LAFITESTAMPLENGTH))
(replace (LAFITEMSG STAMPLENGTH) of MSGDESCRIPTOR with LAFITESTAMPLENGTH)))
(POSITION SCRATCHFILE 0) (* So that LA.PRINTCOUNT doesn't screw up)
(LA.PRINTCOUNT MESSAGELENGTH SCRATCHFILE)
(* total message length)
(LA.PRINTCOUNT LAFITESTAMPLENGTH SCRATCHFILE)
(* length of this header)
(WRITEFOLDERMARKBYTES MSGDESCRIPTOR NIL SCRATCHFILE)
(BOUT SCRATCHFILE (CHARCODE CR))
(COPYBYTES FOLDERSTREAM SCRATCHFILE START (fetch (LAFITEMSG END) of MSGDESCRIPTOR)
)
(replace (LAFITEMSG #) of MSGDESCRIPTOR with (add LASTGOODMSG# 1))
(replace (LAFITEMSG SELECTED?) of MSGDESCRIPTOR with NIL)
(replace (LAFITEMSG BEGIN) of MSGDESCRIPTOR with NEXTFILEPTR)
(add NEXTFILEPTR MESSAGELENGTH)
(SETA MESSAGES LASTGOODMSG# MSGDESCRIPTOR))
(* * set the pointer to the end of the good messages * *)
(SETFILEPTR FOLDERSTREAM GOODMSGSPTR)
(COPYBYTES SCRATCHFILE FOLDERSTREAM 0 -1)
(SETQ SCRATCHFILE (CLOSEF SCRATCHFILE))
(OR (IEQP NEXTFILEPTR (GETFILEPTR FOLDERSTREAM))
(HELP "Miscalculation in COMPACTMAILFOLDER" (LIST NEXTFILEPTR (QUOTE NEQ)
(GETFILEPTR FOLDERSTREAM]
(replace (MAILFOLDER #OFMESSAGES) of MAILFOLDER with LASTGOODMSG#)
(for I from (ADD1 LASTGOODMSG#) to OLDLASTMSG#
do (* Erase entries beyond the new end of messages)
(SETA MESSAGES I NIL))
(SETFILEPTR FOLDERSTREAM NEXTFILEPTR)
(replace (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER with NEXTFILEPTR)
(SETFILEINFO FOLDERSTREAM (QUOTE LENGTH)
NEXTFILEPTR)
(\LAFITE.CLOSE.FOLDER MAILFOLDER T)
(COND
((EQ LAFITEVERIFYFLG (QUOTE ALL))
(VERIFYMAILFOLDER MAILFOLDER)))
(AND SCRATCHFILE (DELFILE SCRATCHFILE])
(UPDATEMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "31-Jul-84 15:17")
(* * Write out any changed marks in MAILFOLDER, but don't expunge deleted messages)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(BROWSERPROMPTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
OUTSTREAM MSG)
(printout BROWSERPROMPTWINDOW "Writing out changes...")
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
[for MSG# from 1 to (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
do (COND
((fetch (LAFITEMSG MARKSCHANGED?) of (SETQ MSG (NTHMESSAGE MESSAGES MSG#)))
(WRITEFOLDERMARKBYTES MSG MAILFOLDER (OR OUTSTREAM (SETQ OUTSTREAM
(\LAFITE.OPEN.FOLDER MAILFOLDER
(QUOTE OUTPUT]
(\LAFITE.CLOSE.FOLDER MAILFOLDER)
(printout BROWSERPROMPTWINDOW (COND
(OUTSTREAM " done.")
(T "nothing changed."))
,])
(UPDATECONTENTSFILE
[LAMBDA (MAILFOLDER LASTUNCHANGEDMESSAGE#) (* bvm: "20-Feb-84 12:53")
(* Update the TOC file for MAILFOLDER, assuming that
entries up to LASTUNCHANGEDMESSAGE# are okay.)
(RESETLST (PROG ((TOCFILE (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER)))
(MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(TOCSTART LAFITETOCHEADERLENGTH)
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
FIRSTMSG# TOCSTREAM MSG)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Writing table of contents...")
(COND
((IGREATERP LASTMSG# 0)
[RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(SETQ STREAM (CLOSEF STREAM))
(AND RESETSTATE (DELFILE STREAM]
(SETQ TOCSTREAM (OPENSTREAM TOCFILE (QUOTE BOTH)
(QUOTE OLD/NEW)
NIL
(QUOTE ((TYPE BINARY]
(WHENCLOSE TOCSTREAM (QUOTE CLOSEALL)
(QUOTE NO))
(SETQ LASTUNCHANGEDMESSAGE# (IMIN LASTUNCHANGEDMESSAGE# (fetch (MAILFOLDER
TOCLASTMESSAGE#)
of MAILFOLDER)))
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with 0)
[COND
((ZEROP (GETEOFPTR TOCSTREAM))
(SETQ LASTUNCHANGEDMESSAGE# 0))
((AND (ZEROP LASTUNCHANGEDMESSAGE#)
(NEQ (PROGN (SETFILEPTR TOCSTREAM BYTESPERWORD)
(WORDIN TOCSTREAM))
LAFITEVERSION#)) (* A version number change, rewrite entire toc)
)
(T (* TOC already existed, just update it)
(for MSG# from 1 to LASTUNCHANGEDMESSAGE#
do (COND
((fetch (LAFITEMSG MARKSCHANGED?) of (SETQ MSG (NTHMESSAGE
MESSAGES MSG#)))
(* Message not compacted out, but its mark bytes have
changed)
(SETFILEPTR TOCSTREAM (IPLUS TOCSTART LAFITETOCMARKBYTEOFFSET))
(WRITETOCMARKBYTES MSG TOCSTREAM)
(replace (LAFITEMSG MARKSCHANGED?) of MSG with NIL)))
(add TOCSTART (fetch (LAFITEMSG TOCLENGTH) of MSG]
(SETFILEPTR TOCSTREAM TOCSTART)
(for MSG# from (ADD1 LASTUNCHANGEDMESSAGE#) to LASTMSG#
do (WRITETOCENTRY (NTHMESSAGE MESSAGES MSG#)
TOCSTREAM))
(SETFILEINFO TOCSTREAM (QUOTE LENGTH)
(GETFILEPTR TOCSTREAM))
(SETFILEPTR TOCSTREAM 0) (* Now write the header info)
(WORDOUT TOCSTREAM LAFITETOCPASSWORD)
(WORDOUT TOCSTREAM LAFITEVERSION#)
(FIXPOUT TOCSTREAM (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER))
(WORDOUT TOCSTREAM LASTMSG#))
((SETQ TOCFILE (INFILEP TOCFILE))
(DELFILE TOCFILE)))
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with LASTMSG#)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
" done.")
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with NIL])
(WRITETOCENTRY
[LAMBDA (MSG STREAM) (* bvm: " 4-Jan-84 16:12")
(* * Dumps TOC entry for MSG on STREAM)
(PROG ((LENGTH LAFITETOCOVERHEADPERENTRY)
(MESSAGELENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSG))
DAT NC)
(COND
((IGREATERP MESSAGELENGTH MAX.SMALLP) (* Ugh, length greater than fits in one word.
Would be surprised if this ever happens, but file format
permits it)
(BOUT STREAM (LRSH MESSAGELENGTH BITSPERWORD))
(WORDOUT STREAM (LOGAND MESSAGELENGTH MAX.SMALLP)))
(T (* Normal case, a small length)
(BOUT STREAM 0)
(WORDOUT STREAM MESSAGELENGTH)))
(BOUT STREAM (fetch (LAFITEMSG STAMPLENGTH) of MSG))
(WRITETOCMARKBYTES MSG STREAM)
(PRIN3 [COND
((EQ [SETQ NC (NCHARS (SETQ DAT (fetch (LAFITEMSG DATE) of MSG]
6) (* The usual case)
DAT)
(T (OR (SUBSTRING DAT 1 6)
(CONCAT DAT (ALLOCSTRING (IDIFFERENCE 6 NC)
(CHARCODE SPACE]
STREAM)
(add LENGTH (LA.PRINTSHORTSTRING STREAM (fetch (LAFITEMSG SUBJECT) of MSG)))
(add LENGTH (LA.PRINTSHORTSTRING STREAM (fetch (LAFITEMSG FROM) of MSG)))
(add LENGTH (LA.PRINTSHORTSTRING STREAM (fetch (LAFITEMSG TO) of MSG)))
(replace (LAFITEMSG TOCLENGTH) of MSG with LENGTH)
(replace (LAFITEMSG MARKSCHANGED?) of MSG with NIL])
(WRITETOCMARKBYTES
[LAMBDA (MSG STREAM) (* bvm: "20-Feb-84 12:53")
(BOUT STREAM (fetch (LAFITEMSG MSGFLAGBITS) of MSG))
(BOUT STREAM (fetch (LAFITEMSG MARKCHAR) of MSG])
(WRITEFOLDERMARKBYTES
[LAMBDA (MSG MAILFOLDER OUTSTREAM) (* bvm: "12-Jan-84 17:25")
(* * Write the three magic flag bytes for MSG in MAILFOLDER onto the file itself, given by OUTSTREAM)
[COND
(MAILFOLDER (MAYBEVERIFYMSG MSG MAILFOLDER)
(COND
((fetch (LAFITEMSG MESSAGELENGTHCHANGED?) of MSG)
(* Length is different in core and on file.
This is for scavenging purposes)
(SETFILEPTR OUTSTREAM (fetch (LAFITEMSG BEGIN) of MSG))
(OR (LA.READSTAMP OUTSTREAM)
(HELP))
(LA.PRINTCOUNT (fetch (LAFITEMSG MESSAGELENGTH) of MSG)
OUTSTREAM)
(replace (LAFITEMSG MESSAGELENGTHCHANGED?) of MSG with NIL)))
(SETFILEPTR OUTSTREAM (fetch (LAFITEMSG DELETEFILEPTR) of MSG]
(BOUT OUTSTREAM (COND
((fetch (LAFITEMSG DELETED?) of MSG)
DELETEDFLAG)
(T UNDELETEDFLAG)))
(BOUT OUTSTREAM (COND
((fetch (LAFITEMSG SEEN?) of MSG)
SEENFLAG)
(T UNSEENFLAG)))
(BOUT OUTSTREAM (fetch (LAFITEMSG MARKCHAR) of MSG])
(LA.OPENTEMPFILE
[LAMBDA (EXTENSION ACCESS RECOG LENGTH) (* bvm: "13-Jan-84 11:04")
(PROG [(STREAM (OPENSTREAM (PACKFILENAME (QUOTE HOST)
(COND
((AND LENGTH (IGREATERP LENGTH (UNFOLD 30 BYTESPERPAGE)
))
(QUOTE DSK))
(T LAFITETEMPFILEHOSTNAME))
(QUOTE NAME)
(QUOTE LAFITETEMPORARY)
(QUOTE EXTENSION)
EXTENSION)
(OR ACCESS (QUOTE OUTPUT))
(OR RECOG (QUOTE NEW))
NIL
(AND LENGTH (LIST (LIST (QUOTE LENGTH)
LENGTH]
(RETURN (COND
(STREAM (* save them so they can be deleted by LAFITE.QUIT *)
(WHENCLOSE STREAM (QUOTE CLOSEALL)
(QUOTE NO))
(LINELENGTH MAX.SMALLP STREAM)
(push \LAFITE.TEMPFILES (FULLNAME STREAM))
STREAM])
)
(* DISPLAY)
(DEFINEQ
(\LAFITE.DISPLAY
[LAMBDA (WINDOW MAILFOLDER ITEM MENU KEY) (* bvm: "28-Mar-84 14:48")
(PROG (DISPLAYWINDOW)
(COND
([WINDOWP (SETQ DISPLAYWINDOW
(RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR
(fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OR (LAB.ASSURE.SELECTIONS MAILFOLDER)
(PROG ((MSGDESCRIPTOR (SELECTMESSAGETODISPLAY WINDOW
MAILFOLDER)))
(RETURN (COND
[MSGDESCRIPTOR (\LAFITE.DO.DISPLAY
MAILFOLDER MSGDESCRIPTOR
(EQ KEY (QUOTE MIDDLE]
(T (LAB.PROMPTPRINT MAILFOLDER
"No more messages.")
NIL]
(* make sure the display window is on top in case
SHADEITEM put the browser back on top *)
(TOTOPW DISPLAYWINDOW])
(\LAFITE.DO.DISPLAY
[LAMBDA (MAILFOLDER MSGDESCRIPTOR NEWWINDOWFLG) (* bvm: "15-Apr-84 17:18")
(* * Display MSGDESCRIPTOR from MAILFOLDER, using a new window if NEWWINDOWFLG is true, else reusing if possible
the primary window. Returns the window)
(PROG (TEMPMSG DISPLAYWINDOW)
(LAB.EXPOSEMESSAGE MAILFOLDER MSGDESCRIPTOR)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with NIL)
(* Clear it here in case of abort)
(LA.COPY.MESSAGE.TEXT MAILFOLDER (SETQ TEMPMSG (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
MSGDESCRIPTOR)
(* (replace (MAILFOLDER CURRENTEOMLENGTH) of MAILFOLDER with (COND ((AND LAFITEENDOFMESSAGESTR
(NOT (fetch (LAFITEMSG FORMATTED?) of MSGDESCRIPTOR))) (* Append end of message token here.
MESSAGEDISPLAYER will change its font later) (IPLUS (COND ((EQ (PROGN (SETFILEPTR TEMPMSG
(SUB1 (GETFILEPTR TEMPMSG))) (BIN TEMPMSG)) (CHARCODE CR)) 0) (T (\BOUT TEMPMSG (CHARCODE CR)) 1))
(PROGN (PRIN1 LAFITEENDOFMESSAGESTR TEMPMSG) (NCHARS LAFITEENDOFMESSAGESTR)))) (T 0))))
(CLOSEF TEMPMSG)
(SETQ DISPLAYWINDOW (MESSAGEDISPLAYER MAILFOLDER (OPENSTREAM TEMPMSG (QUOTE INPUT))
(CONCAT "Message " (fetch (LAFITEMSG #) of
MSGDESCRIPTOR)
" from "
(fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)
" ["
(fetch (LAFITEMSG MESSAGELENGTH)
of MSGDESCRIPTOR)
" chars]")
NEWWINDOWFLG))
(SEENMESSAGE MSGDESCRIPTOR MAILFOLDER)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of MAILFOLDER with TEMPMSG)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with MSGDESCRIPTOR)
(RETURN DISPLAYWINDOW])
(SELECTMESSAGETODISPLAY
[LAMBDA (WINDOW MAILFOLDER) (* bvm: "28-Mar-84 14:52")
(* * Laurel acts differently if there is currently only one message selected or many about whether it unselects
the one that was displayed before. Lafite will follow the same model * *)
(PROG ((CURRENTDISPLAYEDMSG (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER))
(MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(FIRST# (fetch FIRSTSELECTEDMESSAGE of MAILFOLDER))
(LAST# (fetch LASTSELECTEDMESSAGE of MAILFOLDER))
DISPLAYED# MSGDESCRIPTOR)
[COND
((SETQ MSGDESCRIPTOR (COND
((IGREATERP FIRST# LAST#) (* Nothing selected, so nothing to display)
NIL)
((OR (NULL CURRENTDISPLAYEDMSG)
(NOT (fetch (LAFITEMSG SELECTED?) of CURRENTDISPLAYEDMSG)))
(* haven't displayed any yet, or displayed one is not
part of the selection)
(NTHMESSAGE MESSAGES FIRST#))
[(EQ FIRST# LAST#) (* Only one msg selected and it is displayed, so move on
to next undeleted msg)
(for N from (ADD1 (fetch (LAFITEMSG #) of CURRENTDISPLAYEDMSG))
to (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)
do (COND
([NOT (fetch (LAFITEMSG DELETED?) of (SETQ MSGDESCRIPTOR
(NTHMESSAGE MESSAGES N]
(* only unselect if there is another message *)
(LA.SHOW.SELECTION MAILFOLDER CURRENTDISPLAYEDMSG (QUOTE ERASE))
(LA.SHOW.SELECTION MAILFOLDER MSGDESCRIPTOR (QUOTE REPLACE))
(replace (LAFITEMSG SELECTED?) of CURRENTDISPLAYEDMSG with NIL)
(replace (LAFITEMSG SELECTED?) of MSGDESCRIPTOR with T)
(replace FIRSTSELECTEDMESSAGE of MAILFOLDER
with (replace LASTSELECTEDMESSAGE of MAILFOLDER with N))
(RETURN MSGDESCRIPTOR]
(T (* Multiple selections -- Cycle to the next one)
(NTHMESSAGE MESSAGES (OR (LAB.FIND.SELECTED.MSG MAILFOLDER
(ADD1 (SETQ DISPLAYED#
(fetch (LAFITEMSG #)
of
CURRENTDISPLAYEDMSG)))
LAST#)
(LAB.FIND.SELECTED.MSG MAILFOLDER FIRST# DISPLAYED#]
(RETURN MSGDESCRIPTOR])
(MESSAGEDISPLAYER
[LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG) (* bvm: "12-Mar-85 00:43")
(* * Displayer for individual messages * *)
(PROG ((CURRENTWINDOWS (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER))
[PROPS (CONS (QUOTE FONT)
(CONS LAFITEDISPLAYFONT (AND LAFITEREADONLYFLG (QUOTE (READONLY T]
TEXTSTREAM DISPLAYWINDOW REGION EOF W)
(COND
(NEWWINDOWFLG)
[(SETQ DISPLAYWINDOW (WINDOWP (CAR CURRENTWINDOWS]
((SETQ DISPLAYWINDOW LAFITEPRIMARYDISPLAYWINDOW)
(SETQ LAFITEPRIMARYDISPLAYWINDOW NIL)
(WINDOWADDPROP DISPLAYWINDOW (QUOTE CLOSEFN)
(FUNCTION \LAFITE.CLOSE.DISPLAYER)))
([AND (SETQ REGION CURRENTWINDOWS)
(for FOLDER in \ACTIVELAFITEFOLDERS never (AND (SETQ W (fetch (MAILFOLDER
FOLDERDISPLAYWINDOWS)
of FOLDER))
(WINDOWP (SETQ W (CAR W)))
(EQUAL REGION (WINDOWPROP
W
(QUOTE REGION]
(* Remember region from last time this browser ran, and
use it unless there's already a display window there)
)
([AND (type? REGION LAFITEDISPLAYREGION)
(for FOLDER in \ACTIVELAFITEFOLDERS never (WINDOWP (CAR (fetch (MAILFOLDER
FOLDERDISPLAYWINDOWS)
of FOLDER]
(* Global default)
(SETQ REGION LAFITEDISPLAYREGION)))
[COND
(DISPLAYWINDOW (WINDOWPROP DISPLAYWINDOW (QUOTE TITLE)
TITLE)
(CLEARW DISPLAYWINDOW))
(T (SETQ DISPLAYWINDOW (CREATEW REGION TITLE))
(WINDOWADDPROP DISPLAYWINDOW (QUOTE CLOSEFN)
(FUNCTION \LAFITE.CLOSE.DISPLAYER]
[COND
([OR (NOT CURRENTWINDOWS)
(NOT (WINDOWP (CAR CURRENTWINDOWS]
(replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER with (LIST DISPLAYWINDOW)))
((NEQ DISPLAYWINDOW (CAR CURRENTWINDOWS))
(RPLACD CURRENTWINDOWS (CONS DISPLAYWINDOW (CDR CURRENTWINDOWS]
(* Now let TEDIT display it *)
[SETQ TEXTSTREAM (OR (CAR (NLSETQ (OPENTEXTSTREAM TEXTFILE DISPLAYWINDOW NIL NIL PROPS)))
(PROGN (LAB.PROMPTPRINT MAILFOLDER
"Problems displaying message, trying unformatted.")
(OPENTEXTSTREAM TEXTFILE DISPLAYWINDOW NIL NIL
(APPEND PROPS (LIST (QUOTE CLEARGET)
T]
(COND
(LAFITEENDOFMESSAGESTR [SETFILEPTR TEXTSTREAM (SUB1 (SETQ EOF (GETEOFPTR TEXTSTREAM]
(COND
((NEQ (BIN TEXTSTREAM)
(CHARCODE CR)) (* Message doesn't end in CR, so add one before
inserting end of message str)
(TEDIT.INSERT TEXTSTREAM LAFITEEOL (ADD1 (add EOF 1))
NIL T)))
(TEDIT.INSERT TEXTSTREAM LAFITEENDOFMESSAGESTR (ADD1 EOF)
LAFITEENDOFMESSAGEFONT T)
(TEDIT.SETSEL TEXTSTREAM 1 0)))
(RETURN DISPLAYWINDOW])
(LA.COPY.MESSAGE.TEXT
[LAMBDA (MAILFOLDER OUTPUTSTREAM MSGDESCRIPTOR) (* bvm: "31-Jul-84 15:10")
(PROG [(INSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT]
(MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER)
(COPYBYTES INSTREAM OUTPUTSTREAM (fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR])
(\LAFITE.CLOSE.DISPLAYWINDOWS
[LAMBDA (FOLDER) (* bvm: "31-Jul-84 14:55")
(PROG ((WINDOWS (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER))
REG)
(COND
((AND WINDOWS (WINDOWP (CAR WINDOWS)))
(replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER
with (PROG1 [APPEND (SETQ REG (WINDOWPROP (CAR WINDOWS)
(QUOTE REGION]
[COND
((OR (NULL LAFITEPRIMARYDISPLAYWINDOW)
(EQUAL REG LAFITEDISPLAYREGION))
(* Retain one actual window for speed.
Prefer to retain the one that's in the profile-specified
position)
(SETQ LAFITEPRIMARYDISPLAYWINDOW (CAR WINDOWS]
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of FOLDER with NIL)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of FOLDER with NIL)
(for WINDOW in WINDOWS
do (WINDOWDELPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION \LAFITE.CLOSE.DISPLAYER))
(CLOSEW (OR (OPENWP WINDOW)
(OPENWP (WINDOWPROP WINDOW (QUOTE ICONWINDOW])
(\LAFITE.CLOSE.DISPLAYER
[LAMBDA (WINDOW) (* bvm: "24-Mar-84 17:21")
(* called when a display window is explicitly closed)
(for FOLDER in \ACTIVELAFITEFOLDERS bind THESEWINDOWS when (MEMB WINDOW (SETQ THESEWINDOWS
(fetch (MAILFOLDER
FOLDERDISPLAYWINDOWS)
of FOLDER)))
do (* Do we need a monitorlock here?)
(replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of FOLDER with NIL)
(replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of FOLDER with NIL)
[replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER
with (OR (DREMOVE WINDOW THESEWINDOWS)
(PROGN (* No windows left; remember the region of the last one)
(APPEND (WINDOWPROP WINDOW (QUOTE REGION]
(RETURN])
)
(* DELETE & MOVE)
(DEFINEQ
(\LAFITE.DELETE
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: "31-May-84 12:22")
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(LAB.ASSURE.SELECTIONS MAILFOLDER)
(for MSGDESCRIPTOR selectedin MAILFOLDER bind I ONEDELETE DELETEDMESSAGE
when (NOT (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR))
do (* delete all the currrently selected messages that
aren't already deleted *)
(DELETEMESSAGE MSGDESCRIPTOR MAILFOLDER)
(COND
((NULL DELETEDMESSAGE)
(SETQ DELETEDMESSAGE MSGDESCRIPTOR)
(SETQ ONEDELETE T))
(ONEDELETE (SETQ ONEDELETE NIL)))
finally (SHADEITEM ITEM MENU WHITESHADE)
(COND
((AND ONEDELETE DELETEDMESSAGE (EQ (fetch (MAILFOLDER
FIRSTSELECTEDMESSAGE)
of MAILFOLDER)
(fetch (MAILFOLDER
LASTSELECTEDMESSAGE)
of MAILFOLDER)))
(* Exactly one message was selected and deleted)
(DISPLAYAFTERDELETE DELETEDMESSAGE MAILFOLDER WINDOW MENU])
(DISPLAYAFTERDELETE
[LAMBDA (MSG MAILFOLDER WINDOW MENU) (* bvm: " 5-Mar-84 16:26")
(COND
((AND LAFITEDISPLAYAFTERDELETEFLG (EQ MSG (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE)
of MAILFOLDER)))
(* this is the semantics of LAFITEDISPLAYAFTERDELETEFLG
*)
(PROG ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(LASTMSG# (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER))
NEXTMSG)
(COND
([for N from (ADD1 (fetch (LAFITEMSG #) of MSG)) to LASTMSG#
do (COND
[(NOT (fetch (LAFITEMSG DELETED?) of (NTHMESSAGE MESSAGES N)))
(* Next message undeleted, so maybe display it. LAFITEDISPLAYAFTERDELETEFLG = T means only do so if it is
unexamined. However, messages from us are usually already examined, so pretend the message is unexamined if there
is some unexamined message immediately after any from me)
(RETURN (OR (EQ LAFITEDISPLAYAFTERDELETEFLG (QUOTE ALWAYS))
(for I from N to LASTMSG#
do (COND
([NOT (fetch (LAFITEMSG SEEN?)
of (SETQ NEXTMSG (NTHMESSAGE MESSAGES I]
(* An unexamined message, ok)
(RETURN T))
((NOT (fetch (LAFITEMSG MSGFROMMEP) of NEXTMSG))
(* Not from me, but examined, so must not be in the
stream of new mail)
(RETURN NIL]
((NEQ LAFITEDISPLAYAFTERDELETEFLG (QUOTE ALWAYS))
(RETURN NIL]
(\LAFITE.DISPLAY WINDOW MAILFOLDER (ASSOC (QUOTE Display)
(fetch (MENU ITEMS) of MENU))
MENU])
(\LAFITE.UNDELETE
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: "28-Mar-84 14:48")
(RESETLST (LA.RESETSHADE ITEM MENU)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OR (LAB.ASSURE.SELECTIONS MAILFOLDER)
(for MSGDESCRIPTOR selectedin MAILFOLDER when (fetch (LAFITEMSG
DELETED?)
of MSGDESCRIPTOR)
do (UNDELETEMESSAGE MSGDESCRIPTOR MAILFOLDER])
(\LAFITE.MOVETO
[LAMBDA (WINDOW MAILFOLDER ITEM MENU KEY) (* bvm: "11-Mar-85 23:32")
(PROG ((BROWSERPROMPTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
TOFILE OUTPUTFILE DESTINATIONFOLDER SHORTOUTPUT OLDFILEP MIDDLESELECTED)
(CLEARW BROWSERPROMPTWINDOW)
(COND
((LAB.ASSURE.SELECTIONS MAILFOLDER)
(RETURN)))
[SETQ TOFILE (COND
((AND (EQ KEY (QUOTE MIDDLE))
(fetch (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER))
(SETQ MIDDLESELECTED T) (* Accelerator: don't confirm)
(fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of (fetch (MAILFOLDER DEFAULTMOVETOFILE)
of MAILFOLDER)))
(T (MENU (OR LAFITEFOLDERSMENU (MAKELAFITEMAILFOLDERSMENU]
(SELECTQ TOFILE
(NIL (RETURN))
[##ANOTHERFILE## (COND
((NULL (SETQ TOFILE (PROMPTFORFILENAME BROWSERPROMPTWINDOW)))
(* User aborted)
(CLEARW BROWSERPROMPTWINDOW)
(RETURN]
(SETQ OLDFILEP T))
(SETQ OUTPUTFILE (LA.LONGFILENAME (U-CASE TOFILE)
LAFITEMAIL.EXT))
(SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)
(COND
((EQ (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of MAILFOLDER)
OUTPUTFILE)
(LAB.PROMPTPRINT MAILFOLDER "This IS " TOFILE ", can't move to there.")
(SHADEITEM ITEM MENU WHITESHADE)
(RETURN)))
(SETQ SHORTOUTPUT (LA.SHORTFILENAME OUTPUTFILE LAFITEMAIL.EXT))
(COND
((SELECTQ LAFITEMOVETOCONFIRMFLG
(NIL T)
(LEFT (* Accelerator: don't confirm)
MIDDLESELECTED)
(MIDDLE (NOT MIDDLESELECTED))
NIL))
((MOUSECONFIRM (CONCAT "Click LEFT to confirm move to " SHORTOUTPUT (COND
(OLDFILEP "")
((INFILEP OUTPUTFILE)
" [Old File].")
(T " [New File].")))
T BROWSERPROMPTWINDOW))
(T (* abort *)
(SHADEITEM ITEM MENU WHITESHADE)
(RETURN)))
(COND
((SETQ DESTINATIONFOLDER (WITH.MONITOR \LAFITE.BROWSELOCK (\LAFITE.GETMAILFOLDER
OUTPUTFILE)))
(* save the last file moved-to for the accelerator *)
(\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.MOVETO.PROC)
(KWOTE WINDOW)
(KWOTE MAILFOLDER)
(KWOTE DESTINATIONFOLDER)
(KWOTE ITEM)
(KWOTE MENU)
(KWOTE SHORTOUTPUT)
(KWOTE OLDFILEP))
(QUOTE LAFITEMOVE])
(\LAFITE.MOVETO.PROC
[LAMBDA (WINDOW MAILFOLDER DESTINATIONFOLDER ITEM MENU SHORTOUTPUT OLDFILEP)
(* bvm: " 7-Nov-84 12:07")
(PROG (LASTMSGDESCRIPTOR)
[RESETLST (LA.RESETSHADE ITEM MENU)
(PROG (INPUTFILE OUTPUTSTREAM MSGDESCRIPTORS)
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
NIL T)
[COND
((NOT (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of
DESTINATIONFOLDER)
T T))
(LAB.PROMPTPRINT MAILFOLDER "Waiting for " SHORTOUTPUT
" to become available...")
(OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of DESTINATIONFOLDER)
NIL T)
(CLEARW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER]
(\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT))
(OR (SETQ OUTPUTSTREAM (\LAFITE.OPEN.DESTINATION DESTINATIONFOLDER OLDFILEP
MAILFOLDER))
(RETURN))
[COND
((NEQ (fetch (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER)
DESTINATIONFOLDER)
(replace (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER with
DESTINATIONFOLDER)
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (fetch (MAILFOLDER ORIGINALBROWSERTITLE)
of MAILFOLDER)
" -- Default 'Move To': " SHORTOUTPUT]
(SETQ MSGDESCRIPTORS (for MSGDESCRIPTOR selectedin MAILFOLDER
bind NEWMSGDESCRIPTOR NEWLENGTH MARK
collect (SETQ LASTMSGDESCRIPTOR
(AND (NOT NEWMSGDESCRIPTOR)
MSGDESCRIPTOR))
(* Save this for Display After Delete, if there is only
one such message)
(MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER)
(SETFILEPTR OUTPUTSTREAM -1)
(SETQ NEWLENGTH
(IPLUS (IDIFFERENCE (fetch (LAFITEMSG
MESSAGELENGTH)
of MSGDESCRIPTOR)
(fetch (LAFITEMSG
STAMPLENGTH)
of MSGDESCRIPTOR))
LAFITESTAMPLENGTH))
(* As we copy the message, we turn it into Lafite
format, independent of what format it started in)
(SETQ NEWMSGDESCRIPTOR
(create LAFITEMSG
BEGIN ←(GETFILEPTR OUTPUTSTREAM)
SEEN? ←(fetch (LAFITEMSG SEEN?)
of MSGDESCRIPTOR)
MESSAGELENGTH ← NEWLENGTH
MARKCHAR ←(SETQ MARK
(fetch (LAFITEMSG MARKCHAR)
of MSGDESCRIPTOR))
STAMPLENGTH ← LAFITESTAMPLENGTH
PARSED? ←(fetch (LAFITEMSG
PARSED?)
of MSGDESCRIPTOR)
DATE ←(fetch (LAFITEMSG DATE)
of MSGDESCRIPTOR)
FROM ←(fetch (LAFITEMSG FROM)
of MSGDESCRIPTOR)
SUBJECT ←(fetch (LAFITEMSG
SUBJECT)
of MSGDESCRIPTOR)
TO ←(fetch (LAFITEMSG TO)
of MSGDESCRIPTOR)))
(LA.PRINTSTAMP OUTPUTSTREAM)
(* *start*)
(LA.PRINTCOUNT NEWLENGTH OUTPUTSTREAM)
(* total message length)
(LA.PRINTCOUNT LAFITESTAMPLENGTH
OUTPUTSTREAM)
(* length of this header)
(PROGN
(* Now the 3 flag bytes)
(BOUT OUTPUTSTREAM UNDELETEDFLAG)
(BOUT OUTPUTSTREAM
(COND
((fetch (LAFITEMSG SEEN?)
of MSGDESCRIPTOR)
SEENFLAG)
(T UNSEENFLAG)))
(BOUT OUTPUTSTREAM MARK)
(BOUT OUTPUTSTREAM (CHARCODE CR)))
(LA.COPY.MESSAGE.TEXT MAILFOLDER
OUTPUTSTREAM
MSGDESCRIPTOR)
(MARKMESSAGE MSGDESCRIPTOR MAILFOLDER
MOVETOMARK)
(* delete it *)
(DELETEMESSAGE MSGDESCRIPTOR MAILFOLDER)
NEWMSGDESCRIPTOR))
(* delete them from FROMFILE *)
(COND
((AND (fetch (MAILFOLDER BROWSERWINDOW) of DESTINATIONFOLDER)
(fetch (MAILFOLDER BROWSERREADY) of DESTINATIONFOLDER))
(* now print them in the other window, if up *)
(LAB.APPENDMESSAGES DESTINATIONFOLDER MSGDESCRIPTORS]
(COND
(LASTMSGDESCRIPTOR (DISPLAYAFTERDELETE LASTMSGDESCRIPTOR MAILFOLDER WINDOW MENU])
(\LAFITE.OPEN.DESTINATION
[LAMBDA (DESTINATIONFOLDER CHECKOLDFILEP SOURCEFOLDER) (* bvm: "31-Jul-84 15:17")
(* Open DESTINATIONFOLDER for output. Folder may be new, so this is messy. Returns stream on the destination, or
NIL on failure. If CHECKOLDFILEP is true, verifies that file already exists, or interacts with SOURCEFOLDER's
prompt window to confirm)
(PROG ((OUTPUTSTREAM (fetch (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER))
OUTPUTFULLNAME)
[COND
(OUTPUTSTREAM (* Folder is already open, just make sure the access is
right)
(RETURN (COND
((OPENP OUTPUTSTREAM (QUOTE OUTPUT))
OUTPUTSTREAM)
(T (\LAFITE.OPEN.FOLDER DESTINATIONFOLDER (QUOTE BOTH]
(SETQ OUTPUTSTREAM (OR (fetch (MAILFOLDER FULLFOLDERNAME) of DESTINATIONFOLDER)
(fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of DESTINATIONFOLDER)))
(COND
((AND CHECKOLDFILEP (INFILEP OUTPUTSTREAM)) (* We assume files in the Mail Folder menu already
exist, so we have not tested INFILEP until now)
(SETQ CHECKOLDFILEP NIL)))
(SETQ OUTPUTSTREAM (\LAFITE.OPENSTREAM OUTPUTSTREAM (QUOTE BOTH)))
(replace (MAILFOLDER FULLFOLDERNAME) of DESTINATIONFOLDER with (SETQ OUTPUTFULLNAME
(FULLNAME OUTPUTSTREAM)))
(replace (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER with OUTPUTSTREAM)
(RETURN (COND
([AND CHECKOLDFILEP (EQ (GETEOFPTR OUTPUTSTREAM)
0)
(NOT (MOUSECONFIRM (CONCAT "CLick LEFT to confirm creating " OUTPUTFULLNAME
" [New File]")
T
(fetch (MAILFOLDER BROWSERPROMPTWINDOW) of SOURCEFOLDER]
(* The reason we didn't complain until we actually opened the folder is because INFILEP can fail if the file is
busy, in which case we don't want to get a spurious "New File" warning)
(\LAFITE.CLOSE.FOLDER DESTINATIONFOLDER T)
(DELETEMAILFOLDER DESTINATIONFOLDER))
(T (fetch (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER])
)
(* HARDCOPY)
(DEFINEQ
(\LAFITE.HARDCOPY
[LAMBDA (WINDOW FOLDERDATA ITEM MENU) (* bvm: "25-Mar-84 17:20")
(\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.HARDCOPY.PROC)
(KWOTE FOLDERDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE MESSAGEHARDCOPIER])
(\LAFITE.HARDCOPY.PROC
[LAMBDA (MAILFOLDER ITEM MENU) (* bvm: "28-Mar-84 14:48")
(PROG (LCASEFILENAME TEXTSTREAM CONTINUEFLG MSGLST)
[RESETLST (LA.RESETSHADE ITEM MENU (AND LAFITEHARDCOPYBATCHFLG LAFITEHARDCOPYBATCHSHADE))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(COND
((NOT (LAB.ASSURE.SELECTIONS MAILFOLDER))
(SETQ MSGLST (for MSGDESCRIPTOR selectedin MAILFOLDER
collect MSGDESCRIPTOR))
(SETQ LCASEFILENAME (L-CASE (fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)))
[SETQ TEXTSTREAM (COND
((AND (NOT LAFITEHARDCOPYBATCHFLG)
LAFITEHARDCOPY.MIN.TOC
(IGEQ (LENGTH MSGLST)
LAFITEHARDCOPY.MIN.TOC))
(\LAFITE.HARDCOPY.HEADERS MAILFOLDER LCASEFILENAME MSGLST)
)
(T (OR (SETQ CONTINUEFLG (fetch (MAILFOLDER HARDCOPYSTREAM)
of MAILFOLDER))
(OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEHARDCOPYFONT]
(\LAFITE.HARDCOPY.BODIES MAILFOLDER TEXTSTREAM MSGLST
CONTINUEFLG)
(COND
(LAFITEHARDCOPYBATCHFLG (\LAFITE.MARK.HARDCOPIED MAILFOLDER
MSGLST
HARDCOPYBATCHMARK)
(replace (MAILFOLDER HARDCOPYSTREAM)
of MAILFOLDER with TEXTSTREAM)
(replace (MAILFOLDER HARDCOPYMESSAGES)
of MAILFOLDER
with (NCONC (fetch (MAILFOLDER
HARDCOPYMESSAGES)
of MAILFOLDER)
MSGLST))
(SETQ TEXTSTREAM]
(COND
(TEXTSTREAM (\LAFITE.TRANSMIT.HARDCOPY MAILFOLDER TEXTSTREAM MSGLST LCASEFILENAME])
(\LAFITE.HARDCOPY.HEADERS
[LAMBDA (MAILFOLDER LCASEFILENAME MESSAGES INCLUDE# TEXTSTREAM)
(* bvm: " 2-Mar-84 15:08")
(PROG ((OUTPUTFILE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
ENDOFTITLE FROMSTR SUBJLEFT DATELEFT TABSTOPS)
(LINELENGTH MAX.SMALLP OUTPUTFILE)
(printout OUTPUTFILE "Messages from " LCASEFILENAME T "Listed on " (DATE)
T)
(SETQ ENDOFTITLE (ADD1 (GETFILEPTR OUTPUTFILE)))
(for MSG in MESSAGES as N from 1
do (OR (fetch (LAFITEMSG PARSED?) of MSG)
(LAFITE.PARSE.MSG.FOR.TOC MSG MAILFOLDER))
(POSITION OUTPUTFILE 0)
(COND
(INCLUDE# (\BOUT OUTPUTFILE (CHARCODE TAB))
(printout OUTPUTFILE .I1 N ".")))
(\BOUT OUTPUTFILE (CHARCODE TAB))
(PRIN1 (OR (fetch (LAFITEMSG DATE) of MSG)
UNSUPPLIEDFIELDSTR)
OUTPUTFILE)
(\BOUT OUTPUTFILE (CHARCODE TAB))
[COND
[(fetch (LAFITEMSG MSGFROMMEP) of MSG)
(PRIN1 "To: " OUTPUTFILE)
(SETQ FROMSTR (OR (fetch (LAFITEMSG TO) of MSG)
(LAFITE.FETCH.TO.FIELD MSG MAILFOLDER]
(T (SETQ FROMSTR (OR (fetch (LAFITEMSG FROM) of MSG)
UNSUPPLIEDFIELDSTR]
(PRIN1 FROMSTR OUTPUTFILE)
(\BOUT OUTPUTFILE (CHARCODE TAB))
(PRIN1 (OR (fetch (LAFITEMSG SUBJECT) of MSG)
UNSUPPLIEDFIELDSTR)
OUTPUTFILE)
(TERPRI OUTPUTFILE))
(\BOUT OUTPUTFILE (CHARCODE FF))
(OPENSTREAM (CLOSEF OUTPUTFILE)
(QUOTE INPUT))
[COND
(TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM 1 0 (QUOTE LEFT))
(TEDIT.INCLUDE TEXTSTREAM OUTPUTFILE))
(T (SETQ TEXTSTREAM (OPENTEXTSTREAM OUTPUTFILE (AND NIL (CREATEW NIL "Lafite headers"))
NIL NIL (LIST (QUOTE FONT)
LAFITEHARDCOPYFONT]
(TEDIT.PARALOOKS TEXTSTREAM (QUOTE (QUAD CENTER))
1
(SUB1 ENDOFTITLE))
(TEDIT.PARALOOKS TEXTSTREAM (QUOTE (PARALEADING 40))
(ADD1 ENDOFTITLE)
1) (* Make title centered)
(SETQ DATELEFT (COND
(INCLUDE# 30)
(T 0)))
[SETQ TABSTOPS (LIST (CONS (IPLUS DATELEFT 50)
(QUOTE LEFT))
(CONS (SETQ SUBJLEFT (IPLUS DATELEFT 170))
(QUOTE LEFT]
[COND
(INCLUDE# (push TABSTOPS (QUOTE (20 . RIGHT))
(CONS DATELEFT (QUOTE LEFT]
(TEDIT.PARALOOKS TEXTSTREAM (BQUOTE (TABS (NIL ,@ TABSTOPS)
LEFTMARGIN , (IPLUS SUBJLEFT 30)))
(ADD1 ENDOFTITLE)
(IDIFFERENCE (GETEOFPTR TEXTSTREAM)
(ADD1 ENDOFTITLE)))
(RETURN TEXTSTREAM])
(\LAFITE.MARK.HARDCOPIED
[LAMBDA (MAILFOLDER MSGS MARK) (* bvm: "22-Feb-84 12:02")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(for MSG in MSGS bind (MESSAGES ←(fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of MAILFOLDER))
when (AND (EQ MSG (NTHMESSAGE MESSAGES (fetch (LAFITEMSG #) of MSG)))
(SELCHARQ (fetch (LAFITEMSG MARKCHAR) of MSG)
((? SPACE H)
T)
NIL))
do (* If message doesn't already have a more interesting
mark, set the hardcopy mark)
(MARKMESSAGE MSG MAILFOLDER MARK])
(\LAFITE.TRANSMIT.HARDCOPY
[LAMBDA (MAILFOLDER TEXTSTREAM MSGLST LCASEFILENAME) (* bvm: " 2-Mar-84 13:32")
(* * Sends TEXTSTREAM off to be hardcopied, then deletes it)
[WITH.MONITOR \LAFITE.HARDCOPYLOCK (* Because press isn't reentrant yet)
(TEDIT.HARDCOPY TEXTSTREAM NIL NIL (CONCAT [COND
((CDR MSGLST)
(CONCAT (LENGTH MSGLST)
" messages"))
(T (CONCAT "Message #"
(fetch (LAFITEMSG #)
of (CAR MSGLST]
" from "
(OR LCASEFILENAME
(L-CASE (fetch (MAILFOLDER
FULLFOLDERNAME)
of MAILFOLDER]
(CLOSEF TEXTSTREAM)
(DELFILE TEXTSTREAM)
(\LAFITE.MARK.HARDCOPIED MAILFOLDER MSGLST HARDCOPYMARK])
(\LAFITE.HARDCOPY.BODIES
[LAMBDA (MAILFOLDER TEXTSTREAM MESSAGES CONTINUEFLG NEXTMSG#)
(* bvm: "31-Jul-84 15:10")
(for MSGDESCRIPTOR in MESSAGES
bind (NTHTIME ← CONTINUEFLG)
(INPUTFILE ←(\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT)))
do [COND
((NULL NTHTIME)
(SETQ NTHTIME T))
((OR LAFITENEWPAGEFLG CONTINUEFLG)
(\BOUT TEXTSTREAM (CHARCODE FF))
(SETQ CONTINUEFLG))
(T (TERPRI TEXTSTREAM)
(COND
((NOT NEXTMSG#)
(printout TEXTSTREAM LAFITEHARDCOPYSEPARATOR T]
(COND
(NEXTMSG# (printout TEXTSTREAM "Message " NEXTMSG# T T)
(add NEXTMSG# 1)))
(TEDIT.SETSEL TEXTSTREAM (ADD1 (GETEOFPTR TEXTSTREAM))
0
(QUOTE LEFT)) (* Get selection right for TEDIT.INCLUDE)
(TEDIT.INCLUDE TEXTSTREAM INPUTFILE (fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR))
(SETFILEPTR TEXTSTREAM -1])
(\LAFITE.DO.PENDING.HARDCOPY
[LAMBDA (MAILFOLDER MENU) (* bvm: " 7-Nov-84 11:21")
(PROG ((TEXTSTREAM (fetch (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER)))
(COND
(TEXTSTREAM (LAB.PROMPTPRINT MAILFOLDER "Hardcopying... ")
(\LAFITE.TRANSMIT.HARDCOPY MAILFOLDER TEXTSTREAM (fetch (MAILFOLDER
HARDCOPYMESSAGES)
of MAILFOLDER))
(replace (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER
with (replace (MAILFOLDER HARDCOPYMESSAGES) of MAILFOLDER with NIL))
(SHADEITEM (ASSOC (QUOTE Hardcopy)
(fetch (MENU ITEMS) of MENU))
MENU WHITESHADE) (* Take the speckle off the menu)
(printout (fetch BROWSERPROMPTWINDOW of MAILFOLDER)
"done."])
)
(RPAQ? LAFITEEXTRAMENUFLG )
(RPAQ? LAFITEHARDCOPYBATCHFLG )
(RPAQ? LAFITEHARDCOPY.MIN.TOC )
(RPAQ? LAFITEFROMFRACTION .3)
(RPAQ? LAFITEMINFROMCHARS 15)
(RPAQ? LAFITEIMMEDIATECHANGESFLG )
(RPAQ? LAFITEVERIFYFLG T)
(RPAQ? LAFITEDISPLAYAFTERDELETEFLG T)
(RPAQ? LAFITEMOVETOCONFIRMFLG (QUOTE ALWAYS))
(RPAQ? LAFITEREADONLYFLG T)
(RPAQ? LAFITEDELETEDLINEHEIGHT 1)
(RPAQ? LAFITENEWPAGEFLG T)
(RPAQ? LAFITEBROWSERREGION (create REGION LEFT ← 30 BOTTOM ← 30 WIDTH ← 575 HEIGHT ← 210))
(RPAQ? LAFITEDISPLAYREGION (create REGION LEFT ← 375 BOTTOM ← 25 WIDTH ← 600 HEIGHT ← 335))
(RPAQ? LAFITEENDOFMESSAGESTR "End of message")
(RPAQ? LAFITEENDOFMESSAGEFONT (FONTCREATE (QUOTE (TIMESROMAN 10 ITALIC))))
(RPAQ? LAFITETEMPFILEHOSTNAME (QUOTE CORE))
(RPAQ? LAFITEHARDCOPYBATCHSHADE 1025)
(RPAQ? LAFITEHARDCOPYSEPARATOR "
Next Message
")
(RPAQQ LAFITEBROWSERMENUITEMS ((Display (QUOTE \LAFITE.DISPLAY)
"Displays the selected message in the display window.")
(Delete (QUOTE \LAFITE.DELETE)
"Deletes the selected messages.")
(Undelete (QUOTE \LAFITE.UNDELETE)
"Undeletes the selected messages.")
(Answer (QUOTE \LAFITE.ANSWER)
"Prepares a delivery form to reply to the selected message.")
(Forward (QUOTE \LAFITE.FORWARD)
"Prepares a delivery form to forward the selected message(s).")
(Hardcopy (QUOTE \LAFITE.HARDCOPY)
"Sends hardcopy of the selected message(s) to the default printer")
("Move To" (QUOTE \LAFITE.MOVETO)
"Moves the selected message(s) to another mail folder.")
(Update (QUOTE \LAFITE.UPDATE)
"Write out browser changes to the physical mail file.
Option to expunge all deleted messages.")
("Get Mail" (QUOTE \LAFITE.GETMAIL)
"Retrieves new messages and puts them into this mail folder.")))
(RPAQQ LAFITESUBBROWSEMENUITEMS (("Browse" (FUNCTION \LAFITE.BROWSE)
"Browse a mail file")
("Browse Laurel File" (FUNCTION \LAFITE.BROWSE.LAURELFILE)
"Massages Laurel File before browsing with Lafite")
["Forget Folder" (FUNCTION \LAFITE.UNCACHE.FOLDER)
"Remove a folder from list of known folders"
(SUBITEMS ("Forget Folders" (QUOTE
\LAFITE.UNCACHE.FOLDER.MULTIPLE]
("Forget Message Form" (FUNCTION \LAFITE.UNCACHE.MESSAGEFORM)
"Remove a form from list of known message forms")))
(RPAQ? LAFITESUBBROWSEMENU )
(RPAQQ BROWSERMARKXPOSITION 8)
(RPAQ LA.SELECTION.BITMAP (READBITMAP))
(8 10
"L@@@"
"N@@@"
"O@@@"
"OH@@"
"OL@@"
"OH@@"
"O@@@"
"N@@@"
"L@@@"
"@@@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(RPAQQ TOCSTATES ((TS.IDLE 0)
(TS.REPLACING 1)
(TS.ADDING 2)
(TS.REMOVING 3)
(TS.EXTENDING.HI 4)
(TS.EXTENDING.LO 5)
(TS.SHRINKING.HI 6)
(TS.SHRINKING.LO 7)))
(DECLARE: EVAL@COMPILE
(RPAQQ TS.IDLE 0)
(RPAQQ TS.REPLACING 1)
(RPAQQ TS.ADDING 2)
(RPAQQ TS.REMOVING 3)
(RPAQQ TS.EXTENDING.HI 4)
(RPAQQ TS.EXTENDING.LO 5)
(RPAQQ TS.SHRINKING.HI 6)
(RPAQQ TS.SHRINKING.LO 7)
(CONSTANTS (TS.IDLE 0)
(TS.REPLACING 1)
(TS.ADDING 2)
(TS.REMOVING 3)
(TS.EXTENDING.HI 4)
(TS.EXTENDING.LO 5)
(TS.SHRINKING.HI 6)
(TS.SHRINKING.LO 7))
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA LAB.PROMPTPRINT)
)
(PUTPROPS LAFITEBROWSE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4001 16238 (\LAFITE.BROWSE 4011 . 4726) (\LAFITE.SUBBROWSE 4728 . 5013) (
\LAFITE.BROWSE.PROC 5015 . 5758) (\LAFITE.PREPARE.BROWSER 5760 . 7998) (LAB.LOADFOLDER 8000 . 8197) (
LAB.DISPLAYFOLDER 8199 . 9820) (LAB.MAKE.INITIAL.SELECTION 9822 . 10727) (LAB.CREATEWINDOW 10729 .
15408) (LAB.COMMANDFN 15410 . 15893) (LAB.ASSURE.SELECTIONS 15895 . 16236)) (16270 29418 (LAB.SETUP
16280 . 20040) (LAB.BUTTONEVENTFN 20042 . 20536) (LAB.DO.UNLESS.BUSY 20538 . 20942) (LOADMAILFOLDER
20944 . 22201) (\LAFITE.GETMAILFOLDER 22203 . 24462) (LAB.REPAINTFN 24464 . 25079) (LAB.SCROLLFN 25081
. 25594) (LAB.RESHAPEFN 25596 . 26704) (LAB.CLOSEFN 26706 . 26869) (LAB.SHRINKFN 26871 . 27029) (
LAB.CLOSE/SHRINK 27031 . 28229) (LAB.EXPANDFN 28231 . 29416)) (29449 41300 (LAB.SELECTMESSAGE 29459 .
37351) (LAB.CHANGEMARK 37353 . 38698) (LA.READ.NEW.MARK 38700 . 40495) (YPOS.TO.MESSAGE# 40497 . 40985
) (MESSAGE#.TO.YPOS 40987 . 41298)) (41301 48016 (LA.CONSIDERRANGE 41311 . 41952) (LA.DECONSIDERRANGE
41954 . 42427) (LA.RECONSIDERRANGE 42429 . 43068) (LA.SELECTRANGE 43070 . 44313) (LA.DESELECTRANGE
44315 . 45710) (LAB.FIND.SELECTED.MSG 45712 . 46018) (LAB.REV.FIND.SELECTED.MSG 46020 . 46340) (
LA.UNDOSELECTION 46342 . 46690) (LA.VERIFY.SELECTION 46692 . 48014)) (48045 48921 (LAB.PROMPTPRINT
48055 . 48563) (\LAFITE.MAYBE.CLEAR.PROMPT 48565 . 48919)) (48922 62143 (PRINTMESSAGESUMMARY 48932 .
52098) (FIRSTVISIBLEMESSAGE 52100 . 52669) (LASTVISIBLEMESSAGE 52671 . 53393) (LAB.DISPLAYLINES 53395
. 53813) (LAB.EXPOSEMESSAGE 53815 . 54476) (UNSELECTALLMESSAGES 54478 . 54948) (SELECTMESSAGE 54950
. 55246) (MARKMESSAGE 55248 . 56499) (CHANGEFLAGINFOLDER 56501 . 56818) (LA.SHOW.MARK 56820 . 57398)
(LA.INVERT.MARK.BOX 57400 . 57803) (LA.BLT.MARK.BOX 57805 . 58288) (LA.SHOW.DELETION 58290 . 58902) (
LA.SHOW.SELECTION 58904 . 59438) (SEENMESSAGE 59440 . 60548) (DELETEMESSAGE 60550 . 61266) (
UNDELETEMESSAGE 61268 . 62141)) (66739 67790 (LAB.ICONFN 66749 . 67788)) (67845 75839 (\LAFITE.UPDATE
67855 . 68380) (\LAFITE.EXPUNGE.PROC 68382 . 69075) (\LAFITE.UPDATE.PROC 69077 . 69996) (
\LAFITE.HARDCOPYONLY.PROC 69998 . 70773) (LAB.CHOOSE.UPDATE.MENU 70775 . 71679) (\LAFITE.START.UPDATE
71681 . 73349) (\LAFITE.FINISH.UPDATE 73351 . 75029) (\LAFITE.CLOSE.OTHER.FOLDERS 75031 . 75837)) (
75840 93660 (LAB.FLUSHWINDOW 75850 . 76842) (LAB.APPENDMESSAGES 76844 . 79126) (COMPACTMAILFOLDER
79128 . 80688) (COMPACTMAILFOLDER1 80690 . 85329) (UPDATEMAILFOLDER 85331 . 86413) (UPDATECONTENTSFILE
86415 . 89689) (WRITETOCENTRY 89691 . 91320) (WRITETOCMARKBYTES 91322 . 91563) (WRITEFOLDERMARKBYTES
91565 . 92762) (LA.OPENTEMPFILE 92764 . 93658)) (93681 105138 (\LAFITE.DISPLAY 93691 . 94632) (
\LAFITE.DO.DISPLAY 94634 . 96580) (SELECTMESSAGETODISPLAY 96582 . 99161) (MESSAGEDISPLAYER 99163 .
102554) (LA.COPY.MESSAGE.TEXT 102556 . 102943) (\LAFITE.CLOSE.DISPLAYWINDOWS 102945 . 104132) (
\LAFITE.CLOSE.DISPLAYER 104134 . 105136)) (105165 119110 (\LAFITE.DELETE 105175 . 106494) (
DISPLAYAFTERDELETE 106496 . 108354) (\LAFITE.UNDELETE 108356 . 108891) (\LAFITE.MOVETO 108893 . 111790
) (\LAFITE.MOVETO.PROC 111792 . 116905) (\LAFITE.OPEN.DESTINATION 116907 . 119108)) (119132 127393 (
\LAFITE.HARDCOPY 119142 . 119413) (\LAFITE.HARDCOPY.PROC 119415 . 121261) (\LAFITE.HARDCOPY.HEADERS
121263 . 123952) (\LAFITE.MARK.HARDCOPIED 123954 . 124662) (\LAFITE.TRANSMIT.HARDCOPY 124664 . 125480)
(\LAFITE.HARDCOPY.BODIES 125482 . 126534) (\LAFITE.DO.PENDING.HARDCOPY 126536 . 127391)))))
STOP