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

(FILECREATED "24-Oct-88 18:26:24" {POOH/N}<POOH>LAFITE>SOURCES>LAFITECOMMANDS;7
 74357  

      changes to%:  (FNS \LAFITE.UPDATE.MOVE.MENU)

      previous date%: "13-Sep-88 18:48:59" {POOH/N}<POOH>LAFITE>SOURCES>LAFITECOMMANDS;6)


(* "
Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LAFITECOMMANDSCOMS)

(RPAQQ LAFITECOMMANDSCOMS ((* ;; "Handling of the main Lafite browser commands") (COMS (* ; "DISPLAY") (FNS \LAFITE.DISPLAY \LAFITE.DO.DISPLAY SELECTMESSAGETODISPLAY MESSAGEDISPLAYER LA.COPY.MESSAGE.TEXT \LAFITE.CLOSE.DISPLAYWINDOWS \LAFITE.CLOSE.DISPLAYER) (FNS \LAFITE.UNHIDE.HEADERS \LAFITE.HIDE.HEADERS \LAFITE.REHIDE.HEADERS LAFITE.EAT.UNDESIRABLE.FIELD \LAFITE.SET.LOOKS.FROM.MENU \LAFITE.SET.DEFAULT.LOOKS \LAFITE.SET.FIXED.LOOKS LAFITE.SET.LOOKS \LAFITE.HARDCOPY.FROM.DISPLAY LAFITE.HARDCOPY.TAB.WIDTH LAFITE.SET.TAB.LOOKS) (INITVARS \LAFITE.DISPLAY.COMMANDS) (ADDVARS (LAFITE.EXTRA.DISPLAY.COMMANDS ("Looks" (QUOTE \LAFITE.SET.LOOKS.FROM.MENU) "Change the appearance of the selected text, or whole message if nothing selected") ("Hardcopy" (QUOTE \LAFITE.HARDCOPY.FROM.DISPLAY) "Hardcopy this message in its current appearance") ("Unhide" (QUOTE \LAFITE.UNHIDE.HEADERS) "Display the header fields that are hidden from view." (SUBITEMS ("Hide" (QUOTE \LAFITE.REHIDE.HEADERS) "Hide uninteresting fields from view again")))) (LAFITE.LOOKS.SUBCOMMANDS ("Default" (QUOTE \LAFITE.SET.DEFAULT.LOOKS) "Change selection (or whole text) back to default font") ("Fixed Width" (QUOTE \LAFITE.SET.FIXED.LOOKS) "Change selection (or whole text) to fixed-width font"))) (GLOBALVARS \LAFITE.DISPLAY.COMMANDS)) (COMS (* ; "DELETE") (FNS LAFITE.DELETE.MESSAGES \LAFITE.DELETE DISPLAYAFTERDELETE \LAFITE.SELECT.NEXT \LAFITE.UNDELETE)) (COMS (* ; "MOVE") (FNS LAFITE.MOVE.MESSAGES \COERCE.TO.MSGLST \LAFITE.MOVETO \LAFITE.COPYTO \LAFITE.MOVETO.PROC \LAFITE.MOVE.MESSAGES.INTERNAL \LAFITE.OPEN.DESTINATION) (* ; "Aux move") (FNS \LAFITE.ENABLE.MOVE.MENU \LAFITE.ADD.TO.MOVE.MENU \LAFITE.UPDATE.MOVE.MENU \LAFITE.RESTORE.MOVE.MENU \LAFITE.HANDLE.AUTO.MOVE) (ADDVARS (LAFITEEXTRAMENUITEMS ("Enable MoveTo Menu" (QUOTE \LAFITE.ENABLE.MOVE.MENU) "Attach a menu of folders for accelerated MoveTo (or modify existing one)" (SUBITEMS ("Restore MoveTo Menu" (QUOTE \LAFITE.RESTORE.MOVE.MENU) "Just reopen the attached MoveTo menu if it existed."))) ("Copy To" (QUOTE \LAFITE.COPYTO) "Like MoveTo, but don't delete the message(s).")) (LAFITE.EXTRA.MOVE.ITEMS ("---Display---" (QUOTE \LAFITE.DISPLAY) "Display the next message") ("---Delete---" (QUOTE \LAFITE.DELETE) "Delete the selected message(s)"))) (INITVARS (LAFITE.AUTO.MOVE.MENU))) (COMS (* ; "UPDATE") (FNS \LAFITE.UPDATE \LAFITE.EXPUNGE.PROC \LAFITE.UPDATE.PROC \LAFITE.HARDCOPYONLY.PROC LAB.CHOOSE.UPDATE.MENU LA.CREATE.UPDATE.MENU.ARRAY LAB.UPDATE.NEEDED? \LAFITE.START.UPDATE LAB.START.COMMAND \LAFITE.FINISH.UPDATE \LAFITE.CLOSE.OTHER.FOLDERS) (FNS LAB.FLUSHWINDOW LAB.APPENDMESSAGES \LAFITE.COMPACT.FOLDER \LAFITE.COMPACT.FOLDER1 \LAFITE.UPDATE.FOLDER \LAFITE.UPDATE.CONTENTS \LAFITE.UPDATE.CONTENTS1 WRITETOCENTRY WRITETOCMARKBYTES WRITEFOLDERMARKBYTES LA.OPENTEMPFILE)) (COMS (* ; "HARDCOPY") (FNS LAFITE.HARDCOPY.MESSAGES \LAFITE.HARDCOPY \LAFITE.HARDCOPY.PROC \LAFITE.HARDCOPY.HEADERS \LAFITE.MARK.HARDCOPIED \LAFITE.TRANSMIT.HARDCOPY \LAFITE.HARDCOPY.BODIES \LAFITE.APPEND.MESSAGE.BODY \LAFITE.DO.PENDING.HARDCOPY)) (COMS (INITVARS (LAFITEHARDCOPYBATCHFLG NIL) (LAFITEHARDCOPY.MIN.TOC NIL) (LAFITEDISPLAYAFTERDELETEFLG T) (LAFITEMOVETOCONFIRMFLG (QUOTE ALWAYS)) (LAFITENEWPAGEFLG T) (LAFITEENDOFMESSAGESTR "End of message") (LAFITEENDOFMESSAGEFONT (FONTCREATE (QUOTE (TIMESROMAN 10 ITALIC)))) (LAFITE.DISPLAY.SIZE (QUOTE (500 . 300))) (LAFITE.BROWSER.LAYOUTS NIL) (LAFITE.MIDDLE.UPDATE (QUOTE (:EXPUNGE :SHRINK :CONFIRM))) (LAFITEHARDCOPYBATCHSHADE 1025) (LAFITEHARDCOPYSEPARATOR "
 Next Message 
")) (COMS (* ; "Obsolete") (INITVARS (LAFITEDISPLAYREGION (CREATEREGION 375 25 600 335))))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA LAFITE.HARDCOPY.MESSAGES)))))



(* ;; "Handling of the main Lafite browser commands")





(* ; "DISPLAY")


(DEFINEQ

(\LAFITE.DISPLAY

(LAMBDA (WINDOW MAILFOLDER ITEM MENU KEY) (* ; "Edited 22-Sep-87 14:56 by bvm:") (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) (LET ((MSGDESCRIPTOR (SELECTMESSAGETODISPLAY WINDOW MAILFOLDER)) W) (COND (MSGDESCRIPTOR (\LAFITE.DO.DISPLAY MAILFOLDER MSGDESCRIPTOR (EQ KEY (QUOTE MIDDLE)))) (T (LAB.PROMPTPRINT MAILFOLDER T "No more messages.") (* ; "But return current display window for topping, just in case it was buried") (CAR (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER)))))))))) (* ; "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) (* ; "Edited 13-Oct-87 15:56 by bvm:") (* ;;; "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) (SETQ TEMPMSG (CLOSEF TEMPMSG)) (SETQ DISPLAYWINDOW (MESSAGEDISPLAYER MAILFOLDER (OPENSTREAM TEMPMSG (QUOTE INPUT) NIL (QUOTE ((ENDOFSTREAMOP \LAFITE.EOF)))) (CONCAT "Message " (fetch (LAFITEMSG %#) of MSGDESCRIPTOR) " from " (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER) "   [" (fetch (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR) " chars]") NEWWINDOWFLG)) (SEENMESSAGE MSGDESCRIPTOR MAILFOLDER) (PROGN (* ; "Cache the stream that we copied the message text to, since we might be able to use it to accelerate a Move or Hardcopy.  Unfortunately, we can't take advantage of it now, since NODIRCORE doesn't support multiple streams per file.") (replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of MAILFOLDER with TEMPMSG) (replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER with MSGDESCRIPTOR)) (RETURN DISPLAYWINDOW)))
)

(SELECTMESSAGETODISPLAY

(LAMBDA (WINDOW MAILFOLDER) (* bvm%: " 1-Mar-86 18:19") (* ;;; "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") (LET ((CURRENTDISPLAYEDMSG (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of MAILFOLDER)) (MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (FIRST# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)) (LAST# (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER)) DISPLAYED# 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") (\LAFITE.SELECT.NEXT MAILFOLDER (fetch (LAFITEMSG %#) of CURRENTDISPLAYEDMSG))) (T (* ; "Multiple selections -- Cycle to the next one") (NTHMESSAGE MESSAGES (COND ((EQ (SETQ DISPLAYED# (fetch (LAFITEMSG %#) of CURRENTDISPLAYEDMSG)) LAST#) (* ; "Cycle back to first") FIRST#) (T (LAB.FIND.SELECTED.MSG MAILFOLDER (ADD1 DISPLAYED#) LAST#))))))))
)

(MESSAGEDISPLAYER

(LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG) (* ; "Edited  2-Jun-88 16:27 by bvm") (* ;;; "Displayer for individual messages") (LET ((CURRENTWINDOWS (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER)) (PROPS (BQUOTE (FONT (\, LAFITEDISPLAYFONT) PROMPTWINDOW DON'T))) (EOF (GETEOFPTR TEXTFILE)) TEXTSTREAM DISPLAYWINDOW EOF FILTERED) (if (AND \LAPARSE.DONT.DISPLAY.HEADERS (NEQ EOF 0) (SETQ FILTERED (LAFITE.PARSE.HEADER TEXTFILE \LAPARSE.DONT.DISPLAY.HEADERS 0))) then (* ; "We will filter some headers out, so put * in title to show this") (SETQ TITLE (CONCAT "*" TITLE))) (COND ((AND (NOT NEWWINDOWFLG) (SETQ DISPLAYWINDOW (CAR CURRENTWINDOWS))) (CLEARW DISPLAYWINDOW) (WINDOWPROP DISPLAYWINDOW (QUOTE TITLE) TITLE)) (T (SETQ DISPLAYWINDOW (CREATEW (COND ((AND (NOT NEWWINDOWFLG) (PROGN (* ; "This says where we'd like the primary window to be.") (fetch (MAILFOLDER FOLDERDISPLAYREGION) of MAILFOLDER)))) (LAFITE.DISPLAY.SIZE (* ; "Global default") (GETBOXREGION (CAR LAFITE.DISPLAY.SIZE) (CDR LAFITE.DISPLAY.SIZE) NIL NIL NIL TITLE))) TITLE)) (WINDOWADDPROP DISPLAYWINDOW (QUOTE CLOSEFN) (FUNCTION \LAFITE.CLOSE.DISPLAYER)) (WINDOWPROP DISPLAYWINDOW (QUOTE TEDIT.MENU.COMMANDS) \LAFITE.DISPLAY.COMMANDS) (COND ((NOT CURRENTWINDOWS) (replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER with (if NEWWINDOWFLG then (* ; "not primary, even though no window previously open") (LIST NIL DISPLAYWINDOW) else (LIST DISPLAYWINDOW)))) (NEWWINDOWFLG (RPLACD CURRENTWINDOWS (CONS DISPLAYWINDOW (CDR CURRENTWINDOWS)))) (T (* ; "DIsplaying the primary window for the first time when there are already secondary windows.") (RPLACA CURRENTWINDOWS DISPLAYWINDOW))))) (* ; "Now let TEDIT display it") (COND ((EQ EOF 0) (LAB.PROMPTPRINT MAILFOLDER "Message is empty")) (T (LET (WINDOW) (if (NOT FILTERED) then (* ; "Go ahead and display it right off.  Make it READONLY to start with in order to avoid TEdit's odd temptation to display an ugly caret at the start.") (push PROPS (QUOTE READONLY) T) (SETQ WINDOW DISPLAYWINDOW)) (SETQ TEXTSTREAM (OR (CAR (NLSETQ (OPENTEXTSTREAM TEXTFILE WINDOW NIL NIL PROPS))) (PROGN (LAB.PROMPTPRINT MAILFOLDER T "Problems displaying message, trying unformatted.") (OPENTEXTSTREAM TEXTFILE WINDOW NIL NIL (LIST* (QUOTE CLEARGET) T PROPS)))))) (if FILTERED then (if (NOT (= EOF (GETEOFPTR TEXTSTREAM))) then (* ; "rats, there may have been nschars in the header, so parse it now more carefully") (SETQ FILTERED (LAFITE.PARSE.HEADER TEXTSTREAM \LAPARSE.DONT.DISPLAY.HEADERS 0))) (\LAFITE.HIDE.HEADERS TEXTSTREAM FILTERED) (* ; "Now we can display it without a major glitch") (OPENTEXTSTREAM TEXTSTREAM DISPLAYWINDOW NIL NIL (QUOTE (READONLY T))) (TEXTPROP TEXTSTREAM (QUOTE FILTERED) FILTERED) (* ; "Remember what's invisible, so we can easily undo it")) (COND (LAFITEENDOFMESSAGESTR (* ; "Add %"End of message%" token.  Have to take away READONLY for a moment here...") (TEXTPROP TEXTSTREAM (QUOTE READONLY) NIL) (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) (TEXTPROP TEXTSTREAM (QUOTE READONLY) T) (TEDIT.SETSEL TEXTSTREAM 1 0) (\CARET.DOWN) (* ; "Patch around TEdit bug"))))) DISPLAYWINDOW))
)

(LA.COPY.MESSAGE.TEXT

(LAMBDA (MAILFOLDER OUTPUTSTREAM MSGDESCRIPTOR) (* ; "Edited 23-Sep-87 18:40 by bvm:") (PROG ((INSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT))) (MAYBEVERIFYMSG MSGDESCRIPTOR MAILFOLDER) (COPYBYTES INSTREAM OUTPUTSTREAM (fetch (LAFITEMSG START) of MSGDESCRIPTOR) (fetch (LAFITEMSG END) of MSGDESCRIPTOR))))
)

(\LAFITE.CLOSE.DISPLAYWINDOWS

(LAMBDA (FOLDER) (* ; "Edited 22-Sep-87 15:36 by bvm:") (* ;; "Called when browser closed, to close associated windows.") (PROG ((WINDOWS (fetch (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER)) W) (replace (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of FOLDER with NIL) (replace (MAILFOLDER CURRENTDISPLAYEDSTREAM) of FOLDER with NIL) (COND (WINDOWS (for WINDOW in (CDR WINDOWS) do (* ; "Leave secondary windows open, but disconnect them from browser") (WINDOWDELPROP WINDOW (QUOTE CLOSEFN) (FUNCTION \LAFITE.CLOSE.DISPLAYER))) (COND ((WINDOWP (SETQ W (CAR WINDOWS))) (* ; "Save region for later") (replace (MAILFOLDER FOLDERDISPLAYREGION) of FOLDER with (APPEND (WINDOWPROP W (QUOTE REGION)))) (WINDOWDELPROP W (QUOTE CLOSEFN) (FUNCTION \LAFITE.CLOSE.DISPLAYER)) (CLOSEW W))) (replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER with NIL)))))
)

(\LAFITE.CLOSE.DISPLAYER

(LAMBDA (WINDOW) (* ; "Edited 22-Sep-87 15:37 by bvm:") (* ;; "called via CLOSEFN 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) (if (EQ WINDOW (CAR THESEWINDOWS)) then (* ; "the main window--keep its region") (replace (MAILFOLDER FOLDERDISPLAYREGION) of FOLDER with (APPEND (WINDOWPROP WINDOW (QUOTE REGION)))) (if (CDR THESEWINDOWS) then (RPLACA THESEWINDOWS NIL) else (replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of FOLDER with NIL)) else (* ; "floating window, just remove") (RPLACD THESEWINDOWS (DREMOVE WINDOW (CDR THESEWINDOWS)))) (RETURN)))
)
)
(DEFINEQ

(\LAFITE.UNHIDE.HEADERS

(LAMBDA (TEXTSTREAM) (* ; "Edited 10-Dec-87 19:48 by bvm:") (LET ((FILTERED (TEXTPROP TEXTSTREAM (QUOTE FILTERED))) START W) (if (OR (NULL FILTERED) (TEXTPROP TEXTSTREAM (QUOTE VISIBLE))) then (PROMPTPRINT "The whole message is already displayed") else (TEXTPROP TEXTSTREAM (QUOTE READONLY) NIL) (TEDIT.LOOKS TEXTSTREAM (QUOTE (INVISIBLE OFF)) (ADD1 (SETQ START (CAAR (LAST FILTERED)))) (- (CADAR FILTERED) START)) (TEDIT.SETSEL TEXTSTREAM 1 0) (TEXTPROP TEXTSTREAM (QUOTE VISIBLE) T) (TEXTPROP TEXTSTREAM (QUOTE READONLY) T) (if (SETQ W (LA.WINDOW.FROM.TEXTSTREAM TEXTSTREAM)) then (* ; "Remove the * from the title.") (WINDOWPROP W (QUOTE TITLE) (SUBSTRING (WINDOWPROP W (QUOTE TITLE)) 2))))))
)

(\LAFITE.HIDE.HEADERS

(LAMBDA (TEXTSTREAM FILTERED) (* ; "Edited 10-Dec-87 19:44 by bvm:") (for PAIR in FILTERED do (* ; "Make each filtered field invisible") (TEDIT.LOOKS TEXTSTREAM (QUOTE (INVISIBLE ON)) (+ (CAR PAIR) 1) (- (CADR PAIR) (CAR PAIR)))) (TEDIT.SETSEL TEXTSTREAM 1 0))
)

(\LAFITE.REHIDE.HEADERS

(LAMBDA (TEXTSTREAM) (* ; "Edited 10-Dec-87 19:44 by bvm:") (* ;; "Called from display window menu to hide the headers again after having them unhidden.") (LET ((FILTERED (TEXTPROP TEXTSTREAM (QUOTE FILTERED))) START W) (if (NULL FILTERED) then (PROMPTPRINT "No uninteresting header fields were found") elseif (NOT (TEXTPROP TEXTSTREAM (QUOTE VISIBLE))) then (PROMPTPRINT "Uninteresting headers are already hidden") else (TEXTPROP TEXTSTREAM (QUOTE READONLY) NIL) (\LAFITE.HIDE.HEADERS TEXTSTREAM FILTERED) (TEXTPROP TEXTSTREAM (QUOTE VISIBLE) NIL) (TEXTPROP TEXTSTREAM (QUOTE READONLY) T) (if (SETQ W (LA.WINDOW.FROM.TEXTSTREAM TEXTSTREAM)) then (* ; "Add * back to the title.") (WINDOWPROP W (QUOTE TITLE) (CONCAT "*" (WINDOWPROP W (QUOTE TITLE))))))))
)

(LAFITE.EAT.UNDESIRABLE.FIELD

(LAMBDA (STREAM IGNORE) (* ; "Edited 23-Sep-87 13:12 by bvm:") (* ;; "Parser function called when a field to be filtered is found--skip over the field, and push onto the result a pair giving (start stop) of the whole field.") (DECLARE (USEDFREE PARSERESULT PARSEBEGIN)) (* ; "bound in parser") (LA.SKIP.TO.EOL STREAM) (if (AND PARSERESULT (= PARSEBEGIN (CADR (CAR PARSERESULT)))) then (* ; "two in a row--combine them") (CL:SETF (CADR (CAR PARSERESULT)) (GETFILEPTR STREAM)) else (push PARSERESULT (LIST PARSEBEGIN (GETFILEPTR STREAM)))))
)

(\LAFITE.SET.LOOKS.FROM.MENU

(LAMBDA (TEXTSTREAM) (* ; "Edited 22-Sep-87 12:43 by bvm:") (LAFITE.SET.LOOKS TEXTSTREAM T)))

(\LAFITE.SET.DEFAULT.LOOKS

(LAMBDA (TEXTSTREAM) (* ; "Edited 22-Sep-87 12:33 by bvm:") (LAFITE.SET.LOOKS TEXTSTREAM LAFITEDISPLAYFONT))
)

(\LAFITE.SET.FIXED.LOOKS

(LAMBDA (TEXTSTREAM) (* ; "Edited 22-Sep-87 12:43 by bvm:") (LAFITE.SET.LOOKS TEXTSTREAM LAFITEFIXEDWIDTHFONT))
)

(LAFITE.SET.LOOKS

(LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS) (* ; "Edited 13-Jun-88 12:59 by bvm") (* ;; "Called from Looks (sub)commands of Lafite display window.  Change the looks of the current selection (if there is an interesting one) or the whole message to be NEWLOOKS.  If NEWLOOKS is T, we use TEdit's menu interface.") (RESETLST (RESETSAVE NIL (LIST (QUOTE TEXTPROP) TEXTSTREAM (QUOTE READONLY) T)) (TEXTPROP TEXTSTREAM (QUOTE READONLY) NIL) (LET ((SEL (TEDIT.GETSEL TEXTSTREAM)) LEN WIDTH FIXEDLOOKS) (if (AND (NOT PARALOOKS) (FONTP NEWLOOKS) (EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i") NEWLOOKS)) (CHARWIDTH (CHARCODE "W") NEWLOOKS))) then (* ; "If font is fixed-width, let's make the tab the right width.  Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.") (SETQ FIXEDLOOKS (SETQ PARALOOKS (BQUOTE (TABS ((\, (TIMES WIDTH 8)))))))) (if (> (SETQ LEN (fetch (SELECTION DCH) of SEL)) 1) then (* ; "User has already selected something.  Assume any selection greater than a single character is not accidental.") (if (EQ NEWLOOKS T) then (* ; "use menu.  This may be our only dependence on TEdit internals.") (\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM)) else (TEDIT.LOOKS TEXTSTREAM NEWLOOKS SEL)) (AND PARALOOKS (TEDIT.PARALOOKS TEXTSTREAM PARALOOKS)) (if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM (QUOTE LAFITEFIXEDLOOKS))) T)) then (* ; "Record the portions we have so marked, so hardcopy can work right--T means everything.  If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code") (TEXTPROP TEXTSTREAM (QUOTE LAFITEFIXEDLOOKS) (CONS (CONS (fetch (SELECTION CH#) of SEL) LEN) FIXEDLOOKS))) else (SETQ LEN (- (GETEOFPTR TEXTSTREAM) (if LAFITEENDOFMESSAGESTR then (NCHARS LAFITEENDOFMESSAGESTR) else 0))) (if (EQ NEWLOOKS T) then (* ; "Use menu--have to explicitly set selection to cover whole text") (TEDIT.SETSEL TEXTSTREAM 1 LEN (QUOTE RIGHT)) (\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM)) else (TEDIT.LOOKS TEXTSTREAM NEWLOOKS 1 LEN)) (AND PARALOOKS (TEDIT.PARALOOKS TEXTSTREAM PARALOOKS 1 LEN)) (if FIXEDLOOKS then (* ; "The whole thing is fixed now") (TEXTPROP TEXTSTREAM (QUOTE LAFITEFIXEDLOOKS) T)) (* ; "Either way, set selection back to where it was.") (TEDIT.SETSEL TEXTSTREAM SEL)))))
)

(\LAFITE.HARDCOPY.FROM.DISPLAY

(LAMBDA (TEXTSTREAM) (* ; "Edited 10-Jun-88 18:36 by bvm") (* ;; "Hardcopy command on title bar of message display -- like window hardcopy, but gets the title right and omits the end of message string.") (RESETLST (if LAFITEENDOFMESSAGESTR then (* ; "Hide end of message") (LET ((LEN (GETEOFPTR TEXTSTREAM)) (NC (NCHARS LAFITEENDOFMESSAGESTR)) (FIXEDLOOKS (TEXTPROP TEXTSTREAM (QUOTE LAFITEFIXEDLOOKS)))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (TEXTSTREAM LEN NC FIXEDLOOKS) (LET ((W (LA.WINDOW.FROM.TEXTSTREAM TEXTSTREAM))) (if (AND W (OPENWP W) (EQ (WINDOWPROP W (QUOTE TEXTSTREAM)) TEXTSTREAM)) then (* ; "Don't screw around if the message isn't in the window anymore") (TEDIT.LOOKS TEXTSTREAM (QUOTE (INVISIBLE OFF)) (ADD1 (- LEN NC)) NC) (TEDIT.SETSEL TEXTSTREAM 1 0) (TEXTPROP TEXTSTREAM (QUOTE READONLY) T) (if FIXEDLOOKS then (LAFITE.SET.TAB.LOOKS TEXTSTREAM FIXEDLOOKS (TIMES 8 (CHARWIDTH (CHARCODE X) LAFITEFIXEDWIDTHFONT)))))))) TEXTSTREAM LEN NC FIXEDLOOKS)) (TEXTPROP TEXTSTREAM (QUOTE READONLY) NIL) (TEDIT.LOOKS TEXTSTREAM (QUOTE (INVISIBLE ON)) (ADD1 (- LEN NC)) NC) (if FIXEDLOOKS then (* ; "Change to the hardcopy tab width") (LAFITE.SET.TAB.LOOKS TEXTSTREAM FIXEDLOOKS (LAFITE.HARDCOPY.TAB.WIDTH))))) (TEDIT.HARDCOPY TEXTSTREAM NIL NIL (LET ((TMP (LA.WINDOW.FROM.TEXTSTREAM TEXTSTREAM))) (AND TMP (SETQ TMP (WINDOWPROP TMP (QUOTE TITLE))) (if (EQ (CHCON1 TMP) (CHARCODE *)) then (* ; "Remove the * that says filtered") (SUBSTRING TMP 2) else TMP))))))
)

(LAFITE.HARDCOPY.TAB.WIDTH

(LAMBDA NIL (* ; "Edited 10-Jun-88 18:27 by bvm") (FIXR (TIMES (FQUOTIENT (CHARWIDTH (CHARCODE X) (FONTCOPY LAFITEFIXEDWIDTHFONT (QUOTE DEVICE) (QUOTE INTERPRESS))) (CONSTANT (FQUOTIENT 2540 72))) 8)))
)

(LAFITE.SET.TAB.LOOKS

(LAMBDA (TEXTSTREAM FIXEDLOOKS TABWIDTH) (* ; "Edited 11-Jun-88 17:07 by bvm") (LET ((LOOKS (BQUOTE (TABS ((\, TABWIDTH))))) (SEL (TEDIT.GETSEL TEXTSTREAM))) (if (EQ FIXEDLOOKS T) then (TEDIT.PARALOOKS TEXTSTREAM LOOKS 1 (GETEOFPTR TEXTSTREAM)) else (for PAIR in FIXEDLOOKS do (TEDIT.PARALOOKS TEXTSTREAM LOOKS (CAR PAIR) (CDR PAIR)))) (* ; "Finally, restore selection") (TEDIT.SETSEL TEXTSTREAM SEL)))
)
)

(RPAQ? \LAFITE.DISPLAY.COMMANDS NIL)

(ADDTOVAR LAFITE.EXTRA.DISPLAY.COMMANDS ("Looks" (QUOTE \LAFITE.SET.LOOKS.FROM.MENU) "Change the appearance of the selected text, or whole message if nothing selected") ("Hardcopy" (QUOTE \LAFITE.HARDCOPY.FROM.DISPLAY) "Hardcopy this message in its current appearance") ("Unhide" (QUOTE \LAFITE.UNHIDE.HEADERS) "Display the header fields that are hidden from view." (SUBITEMS ("Hide" (QUOTE \LAFITE.REHIDE.HEADERS) "Hide uninteresting fields from view again"))))

(ADDTOVAR LAFITE.LOOKS.SUBCOMMANDS ("Default" (QUOTE \LAFITE.SET.DEFAULT.LOOKS) "Change selection (or whole text) back to default font") ("Fixed Width" (QUOTE \LAFITE.SET.FIXED.LOOKS) "Change selection (or whole text) to fixed-width font"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \LAFITE.DISPLAY.COMMANDS)
)



(* ; "DELETE")


(DEFINEQ

(LAFITE.DELETE.MESSAGES

(LAMBDA (FOLDER MESSAGES) (* ; "Edited 31-Aug-88 12:47 by bvm") (* ;; "Programmatic entrypoint to delete a single MSG (# or msg object) from FOLDER.  FOLDER must have a browser.") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (for MSG inside MESSAGES do (DELETEMESSAGE (if (type? LAFITEMSG MSG) then MSG else (NTHMESSAGE (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) MSG)) FOLDER))))
)

(\LAFITE.DELETE

(LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* ; "Edited 30-Aug-88 11:42 by bvm") (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (OR (LAB.ASSURE.SELECTIONS MAILFOLDER) (for MSGDESCRIPTOR selectedin MAILFOLDER when (NOT (fetch (LAFITEMSG DELETED?) of MSGDESCRIPTOR)) do (* ; "delete all the currrently selected messages that aren't already deleted") (DELETEMESSAGE MSGDESCRIPTOR MAILFOLDER) finally (SHADEITEM ITEM MENU WHITESHADE) (DISPLAYAFTERDELETE MAILFOLDER WINDOW)))))
)

(DISPLAYAFTERDELETE

(LAMBDA (FOLDER WINDOW) (* ; "Edited 29-Aug-88 15:34 by bvm") (* ;;; "Maybe select and maybe display the next message after a deletion, according to setting of LAFITEDISPLAYAFTERDELETEFLG --- T means display next if the deleted one is the one currently displayed and the next message is undeleted and unseen --- ALWAYS means display the next undeleted message if the deleted one is the one currently displayed;  if it's not currently displayed, merely select the next undeleted message --- MULTIPLE means ALWAYS plus when the selection is multiple, still advance to next undeleted msg.") (COND (LAFITEDISPLAYAFTERDELETEFLG (LET ((FIRST# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER)) CURRENT LASTMSG# MESSAGES MENU) (COND ((NEQ FIRST# (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER)) (* ;; "More than one message was selected.  Only do something if flag says MULTIPLE -- select but don't display next message") (COND ((EQ LAFITEDISPLAYAFTERDELETEFLG (QUOTE MULTIPLE)) (\LAFITE.SELECT.NEXT FOLDER FIRST#)))) ((OR (NOT (SETQ CURRENT (fetch (MAILFOLDER CURRENTDISPLAYEDMESSAGE) of FOLDER))) (NEQ FIRST# (fetch (LAFITEMSG %#) of CURRENT))) (* ; "Deleted message is not the one currently displayed") (SELECTQ LAFITEDISPLAYAFTERDELETEFLG ((ALWAYS MULTIPLE) (* ; "select but don't display next message") (\LAFITE.SELECT.NEXT FOLDER FIRST#)) NIL)) ((SELECTQ LAFITEDISPLAYAFTERDELETEFLG ((ALWAYS MULTIPLE) (* ; "Always do it, assuming there's a next message") (\LAFITE.SELECT.NEXT FOLDER FIRST#)) (AND (NEQ FIRST# (SETQ LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER))) (NOT (fetch (LAFITEMSG DELETED?) of (NTHMESSAGE (SETQ MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER)) (ADD1 FIRST#)))) (for I from (ADD1 FIRST#) to LASTMSG# bind NEXTMSG do (* ;; "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") (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)))))) (\LAFITE.DISPLAY WINDOW FOLDER (LA.MENU.ITEM (FUNCTION \LAFITE.DISPLAY) (SETQ MENU (fetch (MAILFOLDER BROWSERMENU) of FOLDER))) MENU)))))))
)

(\LAFITE.SELECT.NEXT

(LAMBDA (MAILFOLDER AFTER#) (* ; "Edited 23-Aug-88 18:35 by bvm") (* ;;; "Select the next undeleted message in MAILFOLDER following AFTER# and return the msg, or NIL if there are no more") (for N from (ADD1 AFTER#) to (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) bind (MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) MSG unless (fetch (LAFITEMSG DELETED?) of (SETQ MSG (NTHMESSAGE MESSAGES N))) do (RETURN (LAB.GO.TO.MESSAGE MAILFOLDER MSG))))
)

(\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))))))
)
)



(* ; "MOVE")


(DEFINEQ

(LAFITE.MOVE.MESSAGES

(LAMBDA (SOURCEFOLDER DESTINATIONFOLDER MESSAGES COPYFLG) (* ; "Edited 13-Sep-88 18:38 by bvm") (* ;; "Programmatic entry to move (or copy if COPYFLG true) specified MESSAGES from SOURCEFOLDER to DESTINATIONFOLDER.  Returns T on success.") (AND MESSAGES (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of SOURCEFOLDER) (\LAFITE.MOVE.MESSAGES.INTERNAL SOURCEFOLDER DESTINATIONFOLDER (\COERCE.TO.MSGLST MESSAGES SOURCEFOLDER) NIL NIL COPYFLG))))
)

(\COERCE.TO.MSGLST

(LAMBDA (MSGLST FOLDER) (* ; "Edited 30-Aug-88 14:11 by bvm") (* ;; "Accepts a singleton or list of LAFITEMSG objects or numbers relative to FOLDER and returns a list of LAFITEMSG objects") (if (AND (CL:LISTP MSGLST) (for M in MSGLST always (type? LAFITEMSG M))) then MSGLST else (LET ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER))) (for M inside MSGLST collect (if (type? LAFITEMSG M) then M else (NTHMESSAGE MESSAGES M))))))
)

(\LAFITE.MOVETO

(LAMBDA (WINDOW MAILFOLDER ITEM MENU KEY COPYFLG) (* ; "Edited 13-Sep-88 18:33 by bvm") (PROG ((BROWSERPROMPTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)) LONGFORMP TOFILE OUTPUTFILE DESTINATIONFOLDER MIDDLESELECTED) (CLEARW BROWSERPROMPTWINDOW) (COND ((LAB.ASSURE.SELECTIONS MAILFOLDER) (* ; "Nothing to move") (RETURN))) (COND ((AND (EQ KEY (QUOTE MIDDLE)) (SETQ DESTINATIONFOLDER (fetch (MAILFOLDER DEFAULTMOVETOFILE) of MAILFOLDER))) (* ; "Accelerator: don't use menu.  We will still re-obtain the destination folder below, since the pointer sitting in the folder may be to a long-closed folder.") (SETQ MIDDLESELECTED T) (SETQ OUTPUTFILE (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of DESTINATIONFOLDER))) (T (CL:MULTIPLE-VALUE-SETQ (TOFILE LONGFORMP) (\LAFITE.PROMPTFORFOLDER BROWSERPROMPTWINDOW)) (if (NULL TOFILE) then (RETURN NIL)) (SETQ OUTPUTFILE (LA.LONGFILENAME TOFILE LAFITEMAIL.EXT)) (COND ((STRING-EQUAL OUTPUTFILE (fetch (MAILFOLDER VERSIONLESSFOLDERNAME) of MAILFOLDER)) (LAB.PROMPTPRINT MAILFOLDER T "This IS " TOFILE ", can't move to there.") (RETURN NIL))))) (AND ITEM (SHADEITEM ITEM MENU LAFITEITEMBUSYSHADE)) (COND (LONGFORMP (* ; "if user had to type file longhand, don't confirm now (but there may be a confirmation for creation later on)")) ((SELECTQ LAFITEMOVETOCONFIRMFLG (NIL (* ; "never confirm") T) (LEFT (* ; "don't confirm when middle selected") MIDDLESELECTED) (MIDDLE (* ; "confirm ONLY when middle selected") (NOT MIDDLESELECTED)) NIL)) ((LAB.MOUSECONFIRM MAILFOLDER "Click LEFT to confirm ~A ~@[of ~D msgs ~]to ~A" (if COPYFLG then "copy" else "move") (AND (< (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER) (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER)) (for MSG selectedin MAILFOLDER sum (* ; "Count how many selected") 1)) (if DESTINATIONFOLDER then (fetch (MAILFOLDER SHORTFOLDERNAME) of DESTINATIONFOLDER) else (LA.SHORTFILENAME OUTPUTFILE LAFITEMAIL.EXT)))) (T (* ; "abort") (AND ITEM (SHADEITEM ITEM MENU WHITESHADE)) (RETURN NIL))) (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION \LAFITE.MOVETO.PROC)) (QUOTE (\, WINDOW)) (QUOTE (\, MAILFOLDER)) (QUOTE (\, OUTPUTFILE)) (QUOTE (\, ITEM)) (QUOTE (\, MENU)) NIL (QUOTE (\, COPYFLG)))) (QUOTE LAFITEMOVE))))
)

(\LAFITE.COPYTO

(LAMBDA (FOLDER ITEM MENU KEY) (* ; "Edited 13-Sep-88 18:37 by bvm") (LET ((MENU (fetch (MAILFOLDER BROWSERMENU) of FOLDER))) (\LAFITE.MOVETO (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of FOLDER) FOLDER (LA.MENU.ITEM (FUNCTION \LAFITE.MOVETO) MENU) MENU NIL T)))
)

(\LAFITE.MOVETO.PROC

(LAMBDA (WINDOW SOURCEFOLDER DESTINATIONFULLNAME ITEM MENU FROM.AUTO.MENU COPYFLG) (* ; "Edited 13-Sep-88 18:24 by bvm") (* ;; "Move selected messages from SOURCEFOLDER to the folder named by OUTPUTFILE.  If FROM.AUTO.MENU is true, it came from the auxiliary moveto menu.  Note that MENU is thus not necessarily SOURCEFOLDER's menu.") (if (RESETLST (LA.RESETSHADE ITEM MENU) (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of SOURCEFOLDER) NIL T) (LET ((DESTINATIONFOLDER (LAFITE.OBTAIN.FOLDER DESTINATIONFULLNAME (QUOTE BOTH) SOURCEFOLDER :CONFIRM))) (if DESTINATIONFOLDER then (\LAFITE.MOVE.MESSAGES.INTERNAL SOURCEFOLDER DESTINATIONFOLDER (LAB.SELECTED.MESSAGES SOURCEFOLDER) FROM.AUTO.MENU T COPYFLG)))) then (if COPYFLG then (LAB.PROMPTPRINT SOURCEFOLDER "Copy completed.") else (DISPLAYAFTERDELETE SOURCEFOLDER WINDOW))))
)

(\LAFITE.MOVE.MESSAGES.INTERNAL

(LAMBDA (SOURCEFOLDER DESTINATIONFOLDER MSGLST FROM.AUTO.MENU INTERACTIVE COPYFLG) (* ; "Edited 13-Sep-88 18:22 by bvm") (* ;; "Move the messages in MSGLST from SOURCEFOLDER to DESTINATIONFOLDER.  Caller must have acquired the lock on SOURCEFOLDER.  FROM.AUTO.MENU means the call was from the auxiliary move menu; INTERACTIVE means it was interactive call vs. programmatic.") (PROG (OUTPUTSTREAM MSGDESCRIPTORS OLDMOVETO) (COND ((NOT (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of DESTINATIONFOLDER) T T)) (LAB.PROMPTPRINT SOURCEFOLDER T "Waiting for " (fetch (MAILFOLDER SHORTFOLDERNAME) of DESTINATIONFOLDER) " to become available...") (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of DESTINATIONFOLDER) NIL T) (LAB.PROMPTPRINT SOURCEFOLDER T))) (COND ((NOT (AND (\LAFITE.OPEN.FOLDER SOURCEFOLDER (QUOTE INPUT) NIL) (SETQ OUTPUTSTREAM (\LAFITE.OPEN.DESTINATION DESTINATIONFOLDER T SOURCEFOLDER)))) (* ; "Failed to open source") (RETURN NIL))) (COND ((NEQ (SETQ OLDMOVETO (fetch (MAILFOLDER DEFAULTMOVETOFILE) of SOURCEFOLDER)) DESTINATIONFOLDER) (LET ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of SOURCEFOLDER))) (replace (MAILFOLDER DEFAULTMOVETOFILE) of SOURCEFOLDER with DESTINATIONFOLDER) (WINDOWPROP WINDOW (QUOTE TITLE) (LAB.TITLE.STRING SOURCEFOLDER)) (if (AND OLDMOVETO (NOT FROM.AUTO.MENU) (OR LAFITE.AUTO.MOVE.MENU (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES)))) then (\LAFITE.ADD.TO.MOVE.MENU SOURCEFOLDER DESTINATIONFOLDER OLDMOVETO))))) (SETQ MSGDESCRIPTORS (for MSGDESCRIPTOR in MSGLST bind NEWMSGDESCRIPTOR NEWLENGTH MARK collect (MAYBEVERIFYMSG MSGDESCRIPTOR SOURCEFOLDER) (SETFILEPTR OUTPUTSTREAM -1) (SETQ NEWLENGTH (+ (- (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 SOURCEFOLDER OUTPUTSTREAM MSGDESCRIPTOR) (if (NOT COPYFLG) then (MARKMESSAGE MSGDESCRIPTOR SOURCEFOLDER MOVETOMARK) (* ; "delete it") (DELETEMESSAGE MSGDESCRIPTOR SOURCEFOLDER)) 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))) (RETURN T)))
)

(\LAFITE.OPEN.DESTINATION

(LAMBDA (DESTINATIONFOLDER CHECKOLDFILEP SOURCEFOLDER) (* ; "Edited 23-Aug-88 16:00 by bvm") (* ;; "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") (LET ((OUTPUTSTREAM (fetch (MAILFOLDER FOLDERSTREAM) of DESTINATIONFOLDER))) (COND (OUTPUTSTREAM (* ; "Folder is already open, just make sure the access is right") (COND ((OPENP OUTPUTSTREAM (QUOTE OUTPUT)) OUTPUTSTREAM) (T (\LAFITE.OPEN.FOLDER DESTINATIONFOLDER (QUOTE BOTH) :OK)))) (T (\LAFITE.MAYBE.OPEN.FOLDER DESTINATIONFOLDER (QUOTE BOTH) SOURCEFOLDER (AND CHECKOLDFILEP :CONFIRM))))))
)
)



(* ; "Aux move")


(DEFINEQ

(\LAFITE.ENABLE.MOVE.MENU

(LAMBDA (FOLDER) (* ; "Edited 31-Aug-88 12:39 by bvm") (* ;; "Bring up a menu of folders attached to FOLDER's browser for accelerated MoveTo") (LET* ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (ITEMS (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES))) (OLDDEFAULT (fetch (MAILFOLDER DEFAULTMOVETOFILE) of FOLDER))) (LAB.PROMPTPRINT FOLDER T "Specify which folders to include in the accelerated menu.") (if OLDDEFAULT then (CL:PUSHNEW (fetch (MAILFOLDER SHORTFOLDERNAME) of OLDDEFAULT) ITEMS :TEST (QUOTE STRING-EQUAL))) (if (SETQ ITEMS (LAFITE.SELECT.FOLDERS ITEMS)) then (* ; "Didn't abort") (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES) ITEMS) (\LAFITE.UPDATE.MOVE.MENU FOLDER T)) (LAB.PROMPTPRINT FOLDER T)))
)

(\LAFITE.ADD.TO.MOVE.MENU

(LAMBDA (FOLDER NEWFOLDER OLDFOLDER) (* ; "Edited 31-Aug-88 12:43 by bvm") (* ;; "Add NEWFOLDER to FOLDER's auto move menu, creating it if necessary, in which case also include OLDFOLDER") (PROG* ((NEWNAME (fetch (MAILFOLDER SHORTFOLDERNAME) of NEWFOLDER)) (WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (OLDITEMS (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES))) (ITEMS OLDITEMS)) (COND ((NULL ITEMS) (SETQ ITEMS (LIST NEWNAME)) (if OLDFOLDER then (push ITEMS (fetch (MAILFOLDER SHORTFOLDERNAME) of OLDFOLDER)))) ((CL:MEMBER NEWNAME ITEMS :TEST (QUOTE STRING-EQUAL)) (* ; "Nothing new to do") (RETURN)) (T (push ITEMS NEWNAME))) (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES) ITEMS) (\LAFITE.UPDATE.MOVE.MENU FOLDER (NULL OLDITEMS))))
)

(\LAFITE.UPDATE.MOVE.MENU

(LAMBDA (FOLDER FORCE) (* ; "Edited 24-Oct-88 18:20 by bvm") (* ;; "Called when someone has changed the set of folder names in FOLDER's auto move menu.  This function creates a new menu.  If the menu is not currently open, we don't open one unless FORCE is true.") (PROG* ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (MENUW (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.MENU))) HOW POSITION) (if (NOT (OPENWP WINDOW)) then (* ; "Maybe the browser is shrunk.  The system doesn't know how to attach to shrunken windows, so just punt it") (RETURN) elseif MENUW then (* ; "Remove the old window and make a new") (DETACHWINDOW MENUW WINDOW) (CLOSEW MENUW) elseif (NULL FORCE) then (RETURN)) (SETQ POSITION (SELECTQ (SETQ HOW LAFITE.AUTO.MOVE.MENU) ((LEFT RIGHT) (QUOTE TOP)) ((BOTTOM TOP) (QUOTE LEFT)) (PROGN (SETQ HOW (QUOTE RIGHT)) (QUOTE TOP)))) (CL:MULTIPLE-VALUE-BIND (NCOLUMNS ITEMS) (\LAFITE.ARRANGE.MENU (APPEND (SORT (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES)) (FUNCTION UALPHORDER)) (AND LAFITE.EXTRA.MOVE.ITEMS (CONS (QUOTE ("" (QUOTE NILL) "")) LAFITE.EXTRA.MOVE.ITEMS))) LAFITE.FOLDER.MENU.FONT (- (LET ((BROWSERHEIGHT (fetch (REGION HEIGHT) of (WINDOWREGION WINDOW)))) (if (EQ POSITION (QUOTE TOP)) then (* ; "Don't make the menu taller than the window") BROWSERHEIGHT else (* ; "Don't make it taller than the screen") (- SCREENHEIGHT BROWSERHEIGHT))) (FONTPROP WINDOWTITLEFONT (QUOTE HEIGHT)))) (SETQ MENUW (MENUWINDOW (create MENU ITEMS ← ITEMS MENUCOLUMNS ← NCOLUMNS CENTERFLG ← T TITLE ← "Move To:" WHENHELDFN ← (FUNCTION (LAMBDA (ITEM) (PROMPTPRINT (if (LISTP ITEM) then (CADDR ITEM) else "Move the selected message(s) to this folder")))) WHENSELECTEDFN ← (FUNCTION \LAFITE.HANDLE.AUTO.MOVE) MENUFONT ← LAFITE.FOLDER.MENU.FONT MENUTITLEFONT ← WINDOWTITLEFONT)))) (ATTACHWINDOW MENUW WINDOW HOW POSITION (QUOTE LOCALCLOSE)) (WINDOWADDPROP MENUW (QUOTE CLOSEFN) (FUNCTION (LAMBDA (W) (* ;; "Remove pointer to me") (AND (SETQ W (MAINWINDOW W)) (WINDOWPROP W (QUOTE LAFITE.AUTO.MOVE.MENU) NIL))))) (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.MENU) MENUW)))
)

(\LAFITE.RESTORE.MOVE.MENU

(LAMBDA (FOLDER) (* ; "Edited 31-Aug-88 15:19 by bvm") (LET* ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (ITEMS (WINDOWPROP WINDOW (QUOTE LAFITE.AUTO.MOVE.NAMES)))) (if ITEMS then (* ; "Yes, there was a menu, so bring it up") (\LAFITE.UPDATE.MOVE.MENU FOLDER T) else (* ; "Start from scratch") (\LAFITE.ENABLE.MOVE.MENU FOLDER))))
)

(\LAFITE.HANDLE.AUTO.MOVE

(LAMBDA (ITEM MENU KEY) (* ; "Edited 29-Aug-88 15:06 by bvm") (* ;; "Handle the selection of an item from Lafite's auto moveto menu.  Just do the specified move") (LET ((MENUW (WFROMMENU MENU)) WINDOW FOLDER) (AND MENUW (SETQ WINDOW (MAINWINDOW MENUW)) (SETQ FOLDER (WINDOWPROP WINDOW (QUOTE MAILFOLDER))) (fetch (MAILFOLDER BROWSERREADY) of FOLDER) (if (LISTP ITEM) then (* ; "Handle other commands") (CL:FUNCALL (EXTRACTMENUCOMMAND ITEM) WINDOW FOLDER ITEM MENU KEY) else (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION \LAFITE.MOVETO.PROC)) (QUOTE (\, WINDOW)) (QUOTE (\, FOLDER)) (QUOTE (\, (LA.LONGFILENAME ITEM LAFITEMAIL.EXT))) (QUOTE (\, ITEM)) (QUOTE (\, MENU)) T)) (QUOTE LAFITEMOVE))))))
)
)

(ADDTOVAR LAFITEEXTRAMENUITEMS ("Enable MoveTo Menu" (QUOTE \LAFITE.ENABLE.MOVE.MENU) "Attach a menu of folders for accelerated MoveTo (or modify existing one)" (SUBITEMS ("Restore MoveTo Menu" (QUOTE \LAFITE.RESTORE.MOVE.MENU) "Just reopen the attached MoveTo menu if it existed."))) ("Copy To" (QUOTE \LAFITE.COPYTO) "Like MoveTo, but don't delete the message(s)."))

(ADDTOVAR LAFITE.EXTRA.MOVE.ITEMS ("---Display---" (QUOTE \LAFITE.DISPLAY) "Display the next message") ("---Delete---" (QUOTE \LAFITE.DELETE) "Delete the selected message(s)"))

(RPAQ? LAFITE.AUTO.MOVE.MENU)



(* ; "UPDATE")


(DEFINEQ

(\LAFITE.UPDATE

(LAMBDA (WINDOW FOLDER ITEM MENU BUTTONS) (* ; "Edited  7-Jun-88 15:36 by bvm") (LET ((HOWINDEX (LAB.UPDATE.NEEDED? FOLDER)) HOW? HOWSTRING CLOSEFLG CONFIRMFLG) (\LAFITE.MAYBE.CLEAR.PROMPT FOLDER) (if (AND (EQ BUTTONS (QUOTE MIDDLE)) LAFITE.MIDDLE.UPDATE) then (* ; "Accelerator: do what this flag says, asking only for confirmation first") (for OP inside LAFITE.MIDDLE.UPDATE do (CASE OP ((:CLOSE :SHRINK) (SETQ CLOSEFLG OP)) ((:UPDATE :EXPUNGE) (SETQ HOWSTRING (if (AND (EQ OP :EXPUNGE) (BITTEST HOWINDEX \EXPUNGE.MENU.BIT)) then (* ; "Expunge is needed and requested") (SETQ HOW? (FUNCTION \LAFITE.EXPUNGE.PROC)) "Expunge" elseif (BITTEST HOWINDEX \TOC.MENU.BIT) then (* ; "Some sort of update needed, so either :UPDATE or :EXPUNGE will do it") (SETQ HOW? (FUNCTION \LAFITE.UPDATE.PROC)) (if (BITTEST HOWINDEX \UPDATE.MENU.BIT) then "Write out changes" else "Update table of contents"))) (if (BITTEST HOWINDEX \HARDCOPY.MENU.BIT) then (* ; "Also might want to hardcopy") (SETQ HOWSTRING (if (NULL HOW?) then (SETQ HOW? (FUNCTION \LAFITE.HARDCOPYONLY.PROC)) "Hardcopy" else (CONCAT "Hardcopy, " HOWSTRING))) elseif (NULL HOW?) then (* ; "Pretend no update is needed, even if left-update would have said Expunge") (SETQ HOWINDEX 0))) (:CONFIRM (SETQ CONFIRMFLG T))))) (if (AND (NULL CLOSEFLG) (EQ 0 HOWINDEX)) then (* ; "We weren't asked to close it, and nothing changed.") (LAB.PROMPTPRINT FOLDER T "No changes since the last Update") elseif (SETQ HOW? (if (OR HOWSTRING CLOSEFLG) then (if (AND (NULL HOWSTRING) (EQ CLOSEFLG :SHRINK)) then (* ; "Accelerator says Shrink, and there is nothing else to do, so just shrink") (FUNCTION \LAFITE.FINISH.UPDATE) elseif (OR (NULL CONFIRMFLG) (LAB.MOUSECONFIRM FOLDER (CONCATLIST (CONS "Click LEFT to confirm " (LET ((CF (AND CLOSEFLG (LIST (L-CASE CLOSEFLG T))))) (if HOWSTRING then (LIST* HOWSTRING (AND CF (CONS " and " CF))) else CF)))))) then (OR HOW? (FUNCTION \LAFITE.FINISH.UPDATE))) else (MENU (LAB.CHOOSE.UPDATE.MENU HOWINDEX)))) then (\LAFITE.PROCESS (LIST HOW? (KWOTE WINDOW) (KWOTE FOLDER) CLOSEFLG (KWOTE ITEM) (KWOTE MENU)) (QUOTE LAFITEUPDATE)))))
)

(\LAFITE.EXPUNGE.PROC

(LAMBDA (WINDOW MAILFOLDER CLOSEFLG ITEM MENU) (* ; "Edited 14-Oct-87 20:00 by bvm:") (RESETLST (\LAFITE.START.UPDATE MAILFOLDER ITEM MENU) (\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER) (CLEARW WINDOW) (\LAFITE.UPDATE.CONTENTS MAILFOLDER (\LAFITE.COMPACT.FOLDER MAILFOLDER)) (\LAFITE.CLOSE.FOLDER MAILFOLDER T) (COND (CLOSEFLG (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) (* ; "Edited 14-Oct-87 20:00 by bvm:") (RESETLST (\LAFITE.START.UPDATE MAILFOLDER ITEM MENU) (COND ((OR (COND ((fetch (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER) (\LAFITE.UPDATE.FOLDER MAILFOLDER) T)) (NEQ (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) (fetch (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER))) (\LAFITE.UPDATE.CONTENTS MAILFOLDER (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER))) (T (LAB.PROMPTPRINT MAILFOLDER T "No changes since last update"))) (\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) (* ; "Edited 29-Aug-88 17:49 by bvm") (* ;; "Called by Update or Close to just do pending hardcopy, nothing else") (RESETLST (LAB.START.COMMAND MAILFOLDER (FUNCTION \LAFITE.UPDATE) ITEM MENU) (\LAFITE.DO.PENDING.HARDCOPY MAILFOLDER)) (\LAFITE.FINISH.UPDATE WINDOW MAILFOLDER CLOSEFLG))
)

(LAB.CHOOSE.UPDATE.MENU

(LAMBDA (FOLDER CLOSEFLG) (* ; "Edited  7-Jun-88 14:39 by bvm") (* ;; "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") (LET ((INDEX (OR (FIXP FOLDER) (LAB.UPDATE.NEEDED? FOLDER))) MENU) (if (NEQ INDEX 0) then (CASE CLOSEFLG (:CLOSE (add INDEX \CLOSE.MENU.BIT)) (:SHRINK (add INDEX \SHRINK.MENU.BIT))) (SETQ MENU (CL:AREF LAFITE.UPDATE.MENU.ARRAY INDEX)) (if (NOT (TYPENAMEP MENU (QUOTE MENU))) then (CL:SETF (CL:AREF LAFITE.UPDATE.MENU.ARRAY INDEX) (SETQ MENU (\LAFITE.CREATE.MENU MENU (CASE CLOSEFLG (:CLOSE "Close Options") (:SHRINK "Shrink Options") (T "Update Options")))))) MENU)))
)

(LA.CREATE.UPDATE.MENU.ARRAY

(LAMBDA NIL (* ; "Edited  7-Jun-88 18:37 by bvm") (* ;; "Create the array from which we obtain the menus used to ask about updating.  There is a bit for each possible thing you might want to do to update a folder -- Update, Expunge, Update TOC, Hardcopy.  Not all bit combinations are possible; in particular, Update implies Update TOC.  The Update TOC item appears in the menu only when Update (Write out Changes) doesn't.  Other combinations are unlikely but possible, e.g., Hardcopy + Update TOC.  In addition, there are %"bits%" for %"close%" and %"shrink%" (00 => Update), to specify the use for the menu (the Update and Shrink menus have an additional item %"just Close%").  To obtain the menu, OR together the bits and fetch out the value from this array.  If the value is a list, it is a list of items, and we then create the menu and stick the menu back.") (LET ((ARR (CL:MAKE-ARRAY (+ \SHRINK.MENU.BIT \CLOSE.MENU.BIT))) (CLOSEITEM (LIST (QUOTE ("Just close" (FUNCTION \LAFITE.FINISH.UPDATE) "Just close the window - don't touch the mail file.")))) (SHRINKITEM (LIST (QUOTE ("Just shrink" (FUNCTION \LAFITE.FINISH.UPDATE) "Just shrink the window - don't touch the mail file.")))) ITEMS) (for I from 1 to (SUB1 \CLOSE.MENU.BIT) unless (AND (NOT (BITTEST I \TOC.MENU.BIT)) (BITTEST I \UPDATE.MENU.BIT)) do (* ; "We skip the entries that say both %"Update toc%" and %"Update%"") (SETQ ITEMS (for ITEM in LAFITEUPDATEMENUITEMS as (BIT ← 1) by (LLSH BIT 1) when (AND (BITTEST I BIT) (NOT (AND (EQ BIT \TOC.MENU.BIT) (BITTEST I \UPDATE.MENU.BIT)))) collect ITEM)) (* ; "%"Update toc%" only appears when %"update%" doesn't") (LET ((LASTTAIL (LAST ITEMS))) (if (STRPOS "Only" (CAAR LASTTAIL) -4 NIL T NIL UPPERCASEARRAY) then (* ; "Sounds funny if last item says %"Only%"") (RPLACA LASTTAIL (CONS (SUBSTRING (CAAR LASTTAIL) 1 -6) (CDAR LASTTAIL))))) (CL:SETF (CL:AREF ARR I) ITEMS) (CL:SETF (CL:AREF ARR (LOGOR I \CLOSE.MENU.BIT)) (APPEND ITEMS CLOSEITEM)) (CL:SETF (CL:AREF ARR (LOGOR I \SHRINK.MENU.BIT)) (APPEND ITEMS SHRINKITEM))) (SETQ LAFITE.UPDATE.MENU.ARRAY ARR)))
)

(LAB.UPDATE.NEEDED?

(LAMBDA (FOLDER) (* ; "Edited  7-Jun-88 14:52 by bvm") (* ;; "Returns an integer whose bits indicate the type of updating needed by FOLDER; zero if it needs none.") (LOGOR (COND ((fetch (MAILFOLDER HARDCOPYSTREAM) of FOLDER) \HARDCOPY.MENU.BIT) (T 0)) (if (fetch (MAILFOLDER FOLDERNEEDSUPDATE) of FOLDER) then (LOGOR \UPDATE.MENU.BIT \TOC.MENU.BIT) elseif (NEQ (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER) (fetch (MAILFOLDER TOCLASTMESSAGE#) of FOLDER)) then (* ; "If Update needed, so is toc update.  Also update toc if messages have been appended") \TOC.MENU.BIT else 0) (if (fetch (MAILFOLDER FOLDERNEEDSEXPUNGE) of FOLDER) then \EXPUNGE.MENU.BIT else 0)))
)

(\LAFITE.START.UPDATE

(LAMBDA (MAILFOLDER ITEM MENU) (* ; "Edited 18-Jul-88 11:56 by bvm") (* ;; "Called under a RESETLST to start an UPDATE or EXPUNGE") (LAB.START.COMMAND MAILFOLDER (FUNCTION \LAFITE.UPDATE) ITEM MENU) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (MAILFOLDER) (replace (MAILFOLDER FOLDERBEINGUPDATED) of MAILFOLDER with NIL))) MAILFOLDER)) (* ; "Mark folder being updated for benefit of LOGOUT check") (replace (MAILFOLDER FOLDERBEINGUPDATED) of MAILFOLDER with T) (* ; "Close all other folders, so MoveTo's are up to date") (\LAFITE.CLOSE.OTHER.FOLDERS MAILFOLDER) (\LAFITE.DO.PENDING.HARDCOPY MAILFOLDER MENU))
)

(LAB.START.COMMAND

(LAMBDA (MAILFOLDER CMD ITEM MENU) (* ; "Edited 18-Jul-88 11:56 by bvm") (* ;; "Shades MAILFOLDER's command implemented by CMD, or ITEM of MENU if supplied and obtains the folder lock.  Opens browser window if it is shrunk.  Must be called under RESETLST surrounding command execution.") (LET ((WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER))) (if (AND WINDOW (NOT (OPENWP WINDOW))) then (EXPANDW WINDOW))) (LA.RESETSHADE (OR ITEM (LA.MENU.ITEM CMD (SETQ MENU (fetch (MAILFOLDER BROWSERMENU) of MAILFOLDER)))) MENU) (OBTAIN.MONITORLOCK (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) NIL T) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER))
)

(\LAFITE.FINISH.UPDATE

(LAMBDA (WINDOW MAILFOLDER CLOSEFLG) (* ; "Edited  7-Jun-88 14:28 by bvm") (* ;;; "Takes care of closing/shrinking WINDOW after an update or expunge.") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (CASE CLOSEFLG ((:CLOSE :EXIT) (WITH.MONITOR \LAFITE.BROWSELOCK (\LAFITE.CLOSE.FOLDER MAILFOLDER T) (SETQ WINDOW (LAB.FLUSHWINDOW WINDOW MAILFOLDER)) (CLOSEW WINDOW) (COND ((AND (NEQ CLOSEFLG :EXIT) (OR (NOT (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER)) (= (fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER) 0)) (EQ (GETFILEINFO (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER) (QUOTE LENGTH)) 0)) (* ;; "Folder is empty, and we are explicitly closing it (as opposed to indirectly via the Quit command), so delete underlying file, etc.  FOLDEREOFPTR should always be right, but be paranoid and 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)) (SHRINKW WINDOW)))) (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) (* ; "Edited 18-Jul-88 11:37 by bvm") (\LAFITE.CLOSE.DISPLAYWINDOWS MAILFOLDER) (WINDOWDELPROP WINDOW (QUOTE CLOSEFN) (FUNCTION LAB.CLOSEFN)) (replace (MAILFOLDER BROWSERREADY) of MAILFOLDER with (replace (MAILFOLDER MESSAGEDESCRIPTORS) 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 (FOLDER NEWMESSAGEDESCRIPTORS) (* ; "Edited 23-Sep-87 18:38 by bvm:") (* ; "get the new file length") (PROG ((LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)) FIRSTMSG#) (SETQ FIRSTMSG# (ADD1 LASTMSG#)) (replace (MAILFOLDER FOLDEREOFPTR) of FOLDER with (GETEOFPTR (fetch (MAILFOLDER FOLDERSTREAM) of FOLDER))) (for MSGDESCRIPTOR in NEWMESSAGEDESCRIPTORS do (replace (LAFITEMSG %#) of MSGDESCRIPTOR with (add LASTMSG# 1)) (LAFITE.PARSE.MSG.FOR.TOC MSGDESCRIPTOR FOLDER)) (replace (MAILFOLDER %#OFMESSAGES) of FOLDER with LASTMSG#) (replace (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER with (\LAFITE.ADDMESSAGES.TO.ARRAY (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER) NEWMESSAGEDESCRIPTORS FIRSTMSG# LASTMSG#)) (PROG ((REGION (DSPCLIPPINGREGION NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (EXTENT (fetch (MAILFOLDER BROWSEREXTENT) of FOLDER)) (HEIGHT (TIMES LASTMSG# (fetch (MAILFOLDER BROWSERFONTHEIGHT) of FOLDER))) WINDOW) (replace (REGION HEIGHT) of EXTENT with HEIGHT) (replace (REGION BOTTOM) of EXTENT with (- (fetch (MAILFOLDER BROWSERORIGIN) of FOLDER) HEIGHT)) (WINDOWPROP (SETQ WINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) (QUOTE EXTENT) EXTENT) (COND ((OPENWP WINDOW) (* ; "If window is visible, update it now") (LAB.DISPLAYLINES FOLDER (MAX FIRSTMSG# (FIRSTVISIBLEMESSAGE FOLDER REGION)) (LASTVISIBLEMESSAGE FOLDER REGION))) ((NULL (fetch (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDER)) (* ; "Mark browser for display update after being unshrunk") (replace (MAILFOLDER BROWSERUPDATEFROMHERE) of FOLDER with FIRSTMSG#))))))
)

(\LAFITE.COMPACT.FOLDER

(LAMBDA (MAILFOLDER) (* ; "Edited 23-Sep-87 18:40 by bvm:") (* ;;; "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 MARKSCHANGEDINFILE?) of MSG) (WRITEFOLDERMARKBYTES MSG MAILFOLDER (OR FOLDERSTREAM (SETQ FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE BOTH) :ABORT)))))) (SETQ LASTGOODMSG# MSG#)) (COND ((NEQ LASTGOODMSG# LASTMSG#) (\LAFITE.COMPACT.FOLDER1 MAILFOLDER (OR FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE BOTH) :ABORT)) LASTGOODMSG#))) (replace (MAILFOLDER FOLDERNEEDSEXPUNGE) of MAILFOLDER with NIL) (RETURN LASTGOODMSG#)))
)

(\LAFITE.COMPACT.FOLDER1

(LAMBDA (MAILFOLDER FOLDERSTREAM LASTGOODMSG#) (* bvm%: "24-Feb-86 17:56") (* ;;; "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)) (FIRSTSELECTED (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER)) (LASTSELECTED (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER)) NEXTFILEPTR SCRATCHFILE MESSAGELENGTH COMPACTLENGTH START END GOODMSGSPTR MSGDESCRIPTOR) (LAB.PROMPTPRINT MAILFOLDER "Compacting folder... ") (COND ((> LASTSELECTED LASTGOODMSG#) (* ; "There are selections in the compacting region") (COND ((> FIRSTSELECTED LASTGOODMSG#) (* ; "All selections are there, so recompute completely") (SETQ LASTSELECTED (SETQ FIRSTSELECTED NIL))) (T (* ; "Some selections before it, so only Last changes") (SETQ LASTSELECTED (LAB.REV.FIND.SELECTED.MSG MAILFOLDER FIRSTSELECTED LASTGOODMSG#)))))) (SETQ GOODMSGSPTR (SETQ NEXTFILEPTR (COND ((EQ LASTGOODMSG# 0) 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)) (SETQ END (fetch (LAFITEMSG END) 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 (+ (- END START) LAFITESTAMPLENGTH)) (replace (LAFITEMSG STAMPLENGTH) of MSGDESCRIPTOR with LAFITESTAMPLENGTH) (replace (LAFITEMSG MESSAGELENGTH) of MSGDESCRIPTOR with MESSAGELENGTH))) (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 END) (replace (LAFITEMSG %#) of MSGDESCRIPTOR with (add LASTGOODMSG# 1)) (COND ((fetch (LAFITEMSG SELECTED?) of MSGDESCRIPTOR) (COND ((NOT FIRSTSELECTED) (SETQ FIRSTSELECTED LASTGOODMSG#))) (SETQ LASTSELECTED LASTGOODMSG#))) (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#) (replace (MAILFOLDER FIRSTSELECTEDMESSAGE) of MAILFOLDER with (OR FIRSTSELECTED 1)) (replace (MAILFOLDER LASTSELECTEDMESSAGE) of MAILFOLDER with (OR LASTSELECTED 0)) (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))))
)

(\LAFITE.UPDATE.FOLDER

(LAMBDA (MAILFOLDER) (* ; "Edited 15-Oct-87 17:45 by bvm:") (* ;;; "Write out any changed marks in MAILFOLDER, but don't expunge deleted messages") (LET ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) OUTSTREAM MSG) (LAB.PROMPTPRINT MAILFOLDER "Writing out changes...") (for MSG# from 1 to (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER) when (fetch (LAFITEMSG MARKSCHANGEDINFILE?) of (SETQ MSG (NTHMESSAGE MESSAGES MSG#))) do (WRITEFOLDERMARKBYTES MSG MAILFOLDER (OR OUTSTREAM (SETQ OUTSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE OUTPUT) :ABORT))))) (\LAFITE.CLOSE.FOLDER MAILFOLDER) (LAB.PROMPTPRINT MAILFOLDER (COND (OUTSTREAM " done. ") (T "nothing changed. "))) (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with NIL)))
)

(\LAFITE.UPDATE.CONTENTS

(LAMBDA (MAILFOLDER LASTUNCHANGEDMESSAGE#) (* bvm%: "28-Feb-86 18:54") (* ;;; "Update the TOC file for MAILFOLDER, assuming that entries up to LASTUNCHANGEDMESSAGE# are okay.") (COND ((NLSETQ (\LAFITE.UPDATE.CONTENTS1 MAILFOLDER LASTUNCHANGEDMESSAGE#)) (LAB.PROMPTPRINT MAILFOLDER " done.")) (T (LAB.PROMPTPRINT MAILFOLDER " failed."))) (* ;; "FOLDERNEEDSUPDATE set to NIL now either because toc was completely written or because toc was deleted on error, in which case 'Update Table of Contents' is still needed") (replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with NIL))
)

(\LAFITE.UPDATE.CONTENTS1

(LAMBDA (MAILFOLDER LASTUNCHANGEDMESSAGE#) (* ; "Edited  9-Sep-87 17:06 by bvm:") (RESETLST (LET ((*UPPER-CASE-FILE-NAMES* NIL) (TOCFILE (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER))) (LASTMSG# (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) (MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (TOCSTART LAFITETOCHEADERLENGTH) FIRSTMSG# TOCSTREAM MSG) (COND ((IGREATERP LASTMSG# 0) (LAB.PROMPTPRINT MAILFOLDER "Writing table of contents...") (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM MAILFOLDER) (SETQ STREAM (CLOSEF STREAM)) (COND (RESETSTATE (* ; "If we aborted out, assume toc is garbage") (replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with 0) (DELFILE (FULLNAME STREAM)))))) (SETQ TOCSTREAM (OPENSTREAM TOCFILE (QUOTE BOTH) (QUOTE OLD/NEW) (QUOTE ((TYPE BINARY))))) MAILFOLDER)) (SETQ LASTUNCHANGEDMESSAGE# (IMIN LASTUNCHANGEDMESSAGE# (fetch (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER))) (COND ((EQ (GETEOFPTR TOCSTREAM) 0) (SETQ LASTUNCHANGEDMESSAGE# 0)) ((AND (EQ LASTUNCHANGEDMESSAGE# 0) (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 MARKSCHANGEDINTOC?) of (SETQ MSG (NTHMESSAGE MESSAGES MSG#))) (* ; "Message not compacted out, but its mark bytes have changed") (SETFILEPTR TOCSTREAM (+ TOCSTART LAFITETOCMARKBYTEOFFSET)) (WRITETOCMARKBYTES MSG TOCSTREAM) (replace (LAFITEMSG MARKSCHANGEDINTOC?) 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)) (LAB.PROMPTPRINT MAILFOLDER "Deleting table of contents...") (DELFILE TOCFILE))) (replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with LASTMSG#))))
)

(WRITETOCENTRY

(LAMBDA (MSG STREAM) (* bvm%: "28-Feb-86 14:44") (* ;;; "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 MARKSCHANGEDINTOC?) 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%: "28-Feb-86 14:46") (* ;;; "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)) (replace (LAFITEMSG MARKSCHANGEDINFILE?) of MSG with NIL))
)

(LA.OPENTEMPFILE

(LAMBDA (EXTENSION ACCESS RECOG LENGTH) (* ; "Edited  3-Sep-87 16:29 by bvm:") (LET ((STREAM (OPENSTREAM (PACKFILENAME.STRING (QUOTE HOST) (QUOTE SCRATCH) (QUOTE NAME) (QUOTE LAFITETEMPORARY) (QUOTE EXTENSION) EXTENSION) (OR ACCESS (QUOTE OUTPUT)) (OR RECOG (QUOTE NEW)) NIL (AND LENGTH (LIST (LIST (QUOTE LENGTH) LENGTH)))))) (COND (STREAM (WHENCLOSE STREAM (QUOTE CLOSEALL) (QUOTE NO)) (LINELENGTH MAX.SMALLP STREAM) (if NIL then (* ; "save them so they can be deleted by LAFITE.QUIT") (* ;; "no need to keep list--they vanish via gc") (push \LAFITE.TEMPFILES (FULLNAME STREAM))) STREAM))))
)
)



(* ; "HARDCOPY")


(DEFINEQ

(LAFITE.HARDCOPY.MESSAGES

(CL:LAMBDA (FOLDER MESSAGES &OPTIONAL (BATCHFLG NIL BATCHP)) (* ; "Edited 30-Aug-88 14:13 by bvm") (AND MESSAGES (\LAFITE.HARDCOPY.PROC FOLDER NIL NIL (\COERCE.TO.MSGLST MESSAGES) (if BATCHP then BATCHFLG else LAFITEHARDCOPYBATCHFLG))))
)

(\LAFITE.HARDCOPY

(LAMBDA (WINDOW FOLDER ITEM MENU) (* ; "Edited 23-Aug-88 15:45 by bvm") (\LAFITE.PROCESS (BQUOTE ((\, (FUNCTION \LAFITE.HARDCOPY.PROC)) (QUOTE (\, FOLDER)) (QUOTE (\, ITEM)) (QUOTE (\, MENU)) NIL (QUOTE (\, LAFITEHARDCOPYBATCHFLG)))) (QUOTE MESSAGEHARDCOPIER)))
)

(\LAFITE.HARDCOPY.PROC

(LAMBDA (MAILFOLDER ITEM MENU MSGLST BATCHFLG) (* ; "Edited 23-Aug-88 15:37 by bvm") (PROG (LCASEFILENAME TEXTSTREAM) (RESETLST (LA.RESETSHADE ITEM MENU (AND BATCHFLG LAFITEHARDCOPYBATCHSHADE)) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER) (COND ((OR MSGLST (NOT (LAB.ASSURE.SELECTIONS MAILFOLDER))) (LET (CONTINUEFLG) (OR MSGLST (SETQ MSGLST (LAB.SELECTED.MESSAGES MAILFOLDER))) (SETQ LCASEFILENAME (L-CASE (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER))) (SETQ TEXTSTREAM (COND ((AND BATCHFLG (SETQ CONTINUEFLG (fetch (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER)))) ((AND (NOT BATCHFLG) LAFITEHARDCOPY.MIN.TOC (>= (LENGTH MSGLST) LAFITEHARDCOPY.MIN.TOC)) (\LAFITE.HARDCOPY.HEADERS MAILFOLDER LCASEFILENAME MSGLST)) (T (* ; "Start fresh") (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT) LAFITEHARDCOPYFONT))))) (\LAFITE.HARDCOPY.BODIES MAILFOLDER TEXTSTREAM MSGLST CONTINUEFLG) (COND (BATCHFLG (\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 (* ; "Send to printer now...") (\LAFITE.TRANSMIT.HARDCOPY MAILFOLDER TEXTSTREAM MSGLST LCASEFILENAME)))))
)

(\LAFITE.HARDCOPY.HEADERS

(LAMBDA (MAILFOLDER LCASEFILENAME MESSAGES INCLUDE# TEXTSTREAM) (* ; "Edited  3-Jun-88 17:50 by bvm") (PROG ((OUTPUTFILE (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH) (QUOTE NEW))) TITLELEN TITLE TOCSTART TOCLEN FROMSTR SUBJLEFT DATELEFT TABSTOPS) (LINELENGTH MAX.SMALLP OUTPUTFILE) (for MSG in MESSAGES as N from 1 do (* ;; "Each line consists of [<tab>#.<tab>]date<tab>from<tab>subject<cr>") (OR (fetch (LAFITEMSG PARSED?) of MSG) (LAFITE.PARSE.MSG.FOR.TOC MSG MAILFOLDER)) (POSITION OUTPUTFILE 0) (COND (INCLUDE# (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) (CL:FORMAT OUTPUTFILE "~D." N) (\OUTCHAR OUTPUTFILE (CHARCODE TAB)))) (PRIN3 (OR (fetch (LAFITEMSG DATE) of MSG) UNSUPPLIEDFIELDSTR) OUTPUTFILE) (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) (PRIN3 (OR (COND ((fetch (LAFITEMSG MSGFROMMEP) of MSG) (PRIN3 "To: " OUTPUTFILE) (OR (fetch (LAFITEMSG TO) of MSG) (LAFITE.FETCH.TO.FIELD MSG MAILFOLDER))) (T (fetch (LAFITEMSG FROM) of MSG))) UNSUPPLIEDFIELDSTR) OUTPUTFILE) (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) (PRIN3 (OR (fetch (LAFITEMSG SUBJECT) of MSG) UNSUPPLIEDFIELDSTR) OUTPUTFILE) (TERPRI OUTPUTFILE)) (SETQ OUTPUTFILE (OPENSTREAM (CLOSEF OUTPUTFILE) (QUOTE INPUT))) (SETQ TITLE (CL:FORMAT NIL "Messages from ~A~%%Listed on ~A~%%~%%" LCASEFILENAME (DATE))) (SETQ TITLELEN (NCHARS TITLE)) (COND (TEXTSTREAM (* ; "Need to insert all this stuff at beginning of textstream") (TEDIT.INSERT TEXTSTREAM TITLE 1)) (T (SETQ TEXTSTREAM (OPENTEXTSTREAM TITLE (AND NIL (CREATEW NIL "Lafite headers")) NIL NIL (LIST (QUOTE FONT) LAFITEHARDCOPYFONT))))) (PROGN (* ; "Make title centered") (TEDIT.PARALOOKS TEXTSTREAM (QUOTE (QUAD CENTERED)) 1 (SUB1 TITLELEN)) (TEDIT.PARALOOKS TEXTSTREAM (QUOTE (POSTPARALEADING 30)) (- TITLELEN 4) 1)) (PROGN (* ; "Insert toc lines. ") (SETQ TOCLEN (LA.TEDIT.INCLUDE TEXTSTREAM OUTPUTFILE (SETQ TOCSTART (ADD1 TITLELEN)))) (TEDIT.INSERT TEXTSTREAM (CONSTANT (CONCATCODES (CHARCODE (FF)))) (+ TOCSTART TOCLEN))) (* ; "Formfeed after the insertion") (PROGN (* ; "Now give the toc lines the appropriate tab settings.") (SETQ DATELEFT (COND (INCLUDE# 30) (T 0))) (SETQ TABSTOPS (LIST (CONS (+ DATELEFT 50) (QUOTE LEFT)) (CONS (SETQ SUBJLEFT (+ DATELEFT 170)) (QUOTE LEFT)))) (COND (INCLUDE# (push TABSTOPS (QUOTE (20 . RIGHT)) (CONS DATELEFT (QUOTE LEFT))))) (TEDIT.PARALOOKS TEXTSTREAM (BQUOTE (TABS (NIL (\,@ TABSTOPS)) LEFTMARGIN (\, (+ SUBJLEFT 20)))) TOCSTART (SUB1 TOCLEN))) (RETURN TEXTSTREAM)))
)

(\LAFITE.MARK.HARDCOPIED

(LAMBDA (MAILFOLDER MSGS MARK) (* bvm%: "26-Feb-86 12:34") (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER) (LET ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER)) (LASTMSG (fetch (MAILFOLDER %#OFMESSAGES) of MAILFOLDER)) N) (COND (MESSAGES (* ; "If not, folder has been closed") (for MSG in MSGS when (AND (ILEQ (SETQ N (fetch (LAFITEMSG %#) of MSG)) LASTMSG) (EQ MSG (NTHMESSAGE MESSAGES N)) (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#) (* ; "Edited 23-Aug-88 12:50 by bvm") (for MSGDESCRIPTOR in MESSAGES bind (NTHTIME ← CONTINUEFLG) (INPUTFILE ← (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT) :ABORT)) do (COND ((NULL NTHTIME) (SETQ NTHTIME T)) ((OR LAFITENEWPAGEFLG CONTINUEFLG) (\OUTCHAR TEXTSTREAM (CHARCODE FF)) (SETQ CONTINUEFLG)) (T (TERPRI TEXTSTREAM) (COND ((NOT NEXTMSG#) (PRIN3 LAFITEHARDCOPYSEPARATOR TEXTSTREAM) (TERPRI TEXTSTREAM))))) (COND (NEXTMSG# (CL:FORMAT TEXTSTREAM "Message ~D~%%~%%" NEXTMSG#) (add NEXTMSG# 1))) (\LAFITE.APPEND.MESSAGE.BODY TEXTSTREAM INPUTFILE MSGDESCRIPTOR \LAPARSE.DONT.HARDCOPY.HEADERS) (TEDIT.CARETLOOKS TEXTSTREAM LAFITEHARDCOPYFONT)))
)

(\LAFITE.APPEND.MESSAGE.BODY

(LAMBDA (TEXTSTREAM MSGSTREAM MSGDESCRIPTOR FILTERS) (* ; "Edited 29-Sep-87 17:51 by bvm:") (* ;; "Appends the text of the indicated message to TEXTSTREAM, filtering out any header fields found in FILTERS") (LET ((START (fetch (LAFITEMSG START) of MSGDESCRIPTOR)) (END (fetch (LAFITEMSG END) of MSGDESCRIPTOR)) (EOF (GETEOFPTR TEXTSTREAM)) FILTERED) (if FILTERS then (SETQ FILTERED (LAFITE.PARSE.HEADER MSGSTREAM FILTERS START END))) (TEDIT.SETSEL TEXTSTREAM (ADD1 EOF) 0 (QUOTE LEFT)) (* ; "Get selection right for TEDIT.INCLUDE") (TEDIT.INCLUDE TEXTSTREAM MSGSTREAM START END) (if FILTERED then (if (NOT (= (GETEOFPTR TEXTSTREAM) (+ EOF (- END START)))) then (* ; "Rats, we have to recalculate more slowly now, since there could be ns chars in header.  TEdit counts them differently than the plain text file does") (SETQ FILTERED (LAFITE.PARSE.HEADER TEXTSTREAM FILTERS EOF))) (for PAIR in FILTERED do (* ; "Note: we are depending on the pairs being in reverse order from the parse, so that the deletions do not affect the char count") (TEDIT.DELETE TEXTSTREAM (+ EOF (- (CAR PAIR) START) 1) (- (CADR PAIR) (CAR PAIR))))) (TEDIT.SETSEL TEXTSTREAM (ADD1 (GETEOFPTR TEXTSTREAM)) 0) (SETFILEPTR TEXTSTREAM -1)))
)

(\LAFITE.DO.PENDING.HARDCOPY

(LAMBDA (FOLDER) (* ; "Edited 29-Aug-88 15:35 by bvm") (LET ((TEXTSTREAM (fetch (MAILFOLDER HARDCOPYSTREAM) of FOLDER)) (MSGLST (fetch (MAILFOLDER HARDCOPYMESSAGES) of FOLDER))) (COND (TEXTSTREAM (LAB.PROMPTPRINT FOLDER T "Hardcopying... ") (COND ((AND LAFITEHARDCOPY.MIN.TOC (>= (LENGTH MSGLST) LAFITEHARDCOPY.MIN.TOC)) (\LAFITE.HARDCOPY.HEADERS FOLDER (L-CASE (fetch (MAILFOLDER FULLFOLDERNAME) of FOLDER)) MSGLST NIL TEXTSTREAM))) (\LAFITE.TRANSMIT.HARDCOPY FOLDER TEXTSTREAM MSGLST) (replace (MAILFOLDER HARDCOPYSTREAM) of FOLDER with (replace (MAILFOLDER HARDCOPYMESSAGES) of FOLDER with NIL)) (LET ((MENU (fetch (MAILFOLDER BROWSERMENU) of FOLDER))) (* ; "Take the speckle off the menu") (SHADEITEM (LA.MENU.ITEM (FUNCTION \LAFITE.HARDCOPY) MENU) MENU WHITESHADE)) (LAB.PROMPTPRINT FOLDER "done. ")))))
)
)

(RPAQ? LAFITEHARDCOPYBATCHFLG NIL)

(RPAQ? LAFITEHARDCOPY.MIN.TOC NIL)

(RPAQ? LAFITEDISPLAYAFTERDELETEFLG T)

(RPAQ? LAFITEMOVETOCONFIRMFLG (QUOTE ALWAYS))

(RPAQ? LAFITENEWPAGEFLG T)

(RPAQ? LAFITEENDOFMESSAGESTR "End of message")

(RPAQ? LAFITEENDOFMESSAGEFONT (FONTCREATE (QUOTE (TIMESROMAN 10 ITALIC))))

(RPAQ? LAFITE.DISPLAY.SIZE (QUOTE (500 . 300)))

(RPAQ? LAFITE.BROWSER.LAYOUTS NIL)

(RPAQ? LAFITE.MIDDLE.UPDATE (QUOTE (:EXPUNGE :SHRINK :CONFIRM)))

(RPAQ? LAFITEHARDCOPYBATCHSHADE 1025)

(RPAQ? LAFITEHARDCOPYSEPARATOR "
 Next Message 
")



(* ; "Obsolete")



(RPAQ? LAFITEDISPLAYREGION (CREATEREGION 375 25 600 335))
(DECLARE%: DOEVAL@COMPILE DONTCOPY 

(FILESLOAD (SOURCE) LAFITEDECLS)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA)

(ADDTOVAR NLAML)

(ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
)
(PUTPROPS LAFITECOMMANDS COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (4350 13445 (\LAFITE.DISPLAY 4360 . 5182) (\LAFITE.DO.DISPLAY 5184 . 6570) (
SELECTMESSAGETODISPLAY 6572 . 7885) (MESSAGEDISPLAYER 7887 . 11326) (LA.COPY.MESSAGE.TEXT 11328 . 
11677) (\LAFITE.CLOSE.DISPLAYWINDOWS 11679 . 12548) (\LAFITE.CLOSE.DISPLAYER 12550 . 13443)) (13446 
20735 (\LAFITE.UNHIDE.HEADERS 13456 . 14181) (\LAFITE.HIDE.HEADERS 14183 . 14471) (
\LAFITE.REHIDE.HEADERS 14473 . 15257) (LAFITE.EAT.UNDESIRABLE.FIELD 15259 . 15833) (
\LAFITE.SET.LOOKS.FROM.MENU 15835 . 15961) (\LAFITE.SET.DEFAULT.LOOKS 15963 . 16104) (
\LAFITE.SET.FIXED.LOOKS 16106 . 16248) (LAFITE.SET.LOOKS 16250 . 18556) (\LAFITE.HARDCOPY.FROM.DISPLAY
 18558 . 20065) (LAFITE.HARDCOPY.TAB.WIDTH 20067 . 20301) (LAFITE.SET.TAB.LOOKS 20303 . 20733)) (21579
 25988 (LAFITE.DELETE.MESSAGES 21589 . 22016) (\LAFITE.DELETE 22018 . 22602) (DISPLAYAFTERDELETE 22604
 . 25084) (\LAFITE.SELECT.NEXT 25086 . 25577) (\LAFITE.UNDELETE 25579 . 25986)) (26010 34466 (
LAFITE.MOVE.MESSAGES 26020 . 26488) (\COERCE.TO.MSGLST 26490 . 26956) (\LAFITE.MOVETO 26958 . 29204) (
\LAFITE.COPYTO 29206 . 29487) (\LAFITE.MOVETO.PROC 29489 . 30346) (\LAFITE.MOVE.MESSAGES.INTERNAL 
30348 . 33689) (\LAFITE.OPEN.DESTINATION 33691 . 34464)) (34492 39257 (\LAFITE.ENABLE.MOVE.MENU 34502
 . 35260) (\LAFITE.ADD.TO.MOVE.MENU 35262 . 36041) (\LAFITE.UPDATE.MOVE.MENU 36043 . 38155) (
\LAFITE.RESTORE.MOVE.MENU 38157 . 38531) (\LAFITE.HANDLE.AUTO.MOVE 38533 . 39255)) (39860 50299 (
\LAFITE.UPDATE 39870 . 41997) (\LAFITE.EXPUNGE.PROC 41999 . 42576) (\LAFITE.UPDATE.PROC 42578 . 43273)
 (\LAFITE.HARDCOPYONLY.PROC 43275 . 43640) (LAB.CHOOSE.UPDATE.MENU 43642 . 44410) (
LA.CREATE.UPDATE.MENU.ARRAY 44412 . 46521) (LAB.UPDATE.NEEDED? 46523 . 47207) (\LAFITE.START.UPDATE 
47209 . 47840) (LAB.START.COMMAND 47842 . 48505) (\LAFITE.FINISH.UPDATE 48507 . 49719) (
\LAFITE.CLOSE.OTHER.FOLDERS 49721 . 50297)) (50300 64834 (LAB.FLUSHWINDOW 50310 . 51097) (
LAB.APPENDMESSAGES 51099 . 52685) (\LAFITE.COMPACT.FOLDER 52687 . 53906) (\LAFITE.COMPACT.FOLDER1 
53908 . 58192) (\LAFITE.UPDATE.FOLDER 58194 . 58975) (\LAFITE.UPDATE.CONTENTS 58977 . 59587) (
\LAFITE.UPDATE.CONTENTS1 59589 . 61872) (WRITETOCENTRY 61874 . 63075) (WRITETOCMARKBYTES 63077 . 63254
) (WRITEFOLDERMARKBYTES 63256 . 64215) (LA.OPENTEMPFILE 64217 . 64832)) (64860 73353 (
LAFITE.HARDCOPY.MESSAGES 64870 . 65138) (\LAFITE.HARDCOPY 65140 . 65425) (\LAFITE.HARDCOPY.PROC 65427
 . 66812) (\LAFITE.HARDCOPY.HEADERS 66814 . 69258) (\LAFITE.MARK.HARDCOPIED 69260 . 69908) (
\LAFITE.TRANSMIT.HARDCOPY 69910 . 70520) (\LAFITE.HARDCOPY.BODIES 70522 . 71259) (
\LAFITE.APPEND.MESSAGE.BODY 71261 . 72506) (\LAFITE.DO.PENDING.HARDCOPY 72508 . 73351)))))
STOP