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

(FILECREATED "15-Jun-90 18:25:37" {DSK}<usr>local>lde>lispcore>internal>library>MAILSCAVENGE.;2
 21651  

      changes to%:  (VARS MAILSCAVENGECOMS)

      previous date%: " 7-Nov-89 19:34:02" 
{DSK}<usr>local>lde>lispcore>internal>library>MAILSCAVENGE.;1)


(* ; "
Copyright (c) 1985, 1989, 1990 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT MAILSCAVENGECOMS)

(RPAQQ MAILSCAVENGECOMS

       [(FNS LAFITE.SCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH 
             \MAILSCAVENGE.LENGTHWIDTH \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP 
             \MAILSCAVENGE.DUPLICATE? \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW 
             \MAILSCAVENGE.ASKUSER \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (*START*LENGTH 8))
               (SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
               (LOCALVARS . T))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA 
                                                                                 \MAILSCAVENGE.FORMAT
                                                                                   ])
(DEFINEQ

(LAFITE.SCAVENGE

(LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?) (* ; "Edited 18-Apr-89 18:19 by bvm") (* ;; "User entry to the scavenger.  If FORGET?, we won't add folder to the list of known folders.") (LET ((FOLDER (LAFITE.OBTAIN.FOLDER (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT) (QUOTE INPUT) T (AND FORGET? :FORGET)))) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (\MAILSCAVENGE.INTERNAL FOLDER ERRORMSGSTREAM))))
)

(\MAILSCAVENGE.INTERNAL

(LAMBDA (*FOLDER* *ERRORMSGSTREAM* GOODPTR MSGNO) (* ; "Edited  3-May-89 13:05 by bvm") (* ;; "Scavenge FOLDER, which can be a mail folder, mail file name, or open stream on a mail file.  Commentary goes to *ERRORMSGSTREAM*, which for folders defaults to its browser window.  If GOODPTR is supplied, it is a file pointer that we assert points to the *START* corresponding to msg # MSGNO, and we guarantee we will not touch anything earlier in the file.") (LET (SCRATCHSTREAM FOLDERSTRM) (CL:UNWIND-PROTECT (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (*PRINT-BASE* 10) (BADCOUNT 0) (*START* "*start*
") (*EOL* (CHARCODE CR)) (COPYFN (FUNCTION COPYBYTES)) TRYPTR LFP PWINDOW XPOS DUPSCRATCH FOLDERNAME EOFPTR BODYSTART BADHEADER NOMOREP STAMPLENGTH MSGLENGTH ENDPTR FIELDWIDTH LENGTHFIXUPS TRUNCATEPTR TSTREAM SUCCESS CH) (DECLARE (CL:SPECIAL *FOLDER* *ERRORMSGSTREAM* *EOL*)) (* ; "Used by \mailscavenge.askuser") (if (TYPENAMEP *FOLDER* (QUOTE MAILFOLDER)) then (* ; "It's a mail folder, so play by the rules") (SETQ FOLDERSTRM (\LAFITE.OPEN.FOLDER *FOLDER* (QUOTE INPUT) :OK)) (SETQ PWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of *FOLDER*)) elseif (TYPENAMEP *FOLDER* (QUOTE STREAM)) then (SETQ FOLDERSTRM *FOLDER*) else (SETQ FOLDERSTRM (\LAFITE.OPENSTREAM *FOLDER* (QUOTE INPUT) (QUOTE OLD) (FUNCTION \LAFITE.EOF) NIL (QUOTE LAFITE)))) (SETQ FOLDERNAME (FULLNAME FOLDERSTRM)) (SETFILEINFO FOLDERSTRM (QUOTE BUFFERS) 30) (SETQ EOFPTR (GETEOFPTR FOLDERSTRM)) (SETFILEPTR FOLDERSTRM 0) (if PWINDOW then (LAB.PROMPTPRINT *FOLDER* " Scavenging... ") (SETQ XPOS (DSPXPOSITION NIL PWINDOW))) (if (NOT *ERRORMSGSTREAM*) then (SETQ *ERRORMSGSTREAM* (if (AND (TYPENAMEP *FOLDER* (QUOTE MAILFOLDER)) (SETQ TSTREAM (\MAILSCAVENGE.MAKEWINDOW *FOLDER*))) then (* ; "We waited til here to make the window in case printing %"Scavenging... %" up there grew the window.") (TEXTSTREAM TSTREAM) else (GETSTREAM NIL (QUOTE OUTPUT))))) (\MAILSCAVENGE.FORMAT "Scavenging ~A..." FOLDERNAME) (if GOODPTR then (* ; "Somebody has already gotten us started") (GO LP) else (SETQ GOODPTR 0) (SETQ MSGNO 1) (if (LA.READSTAMP FOLDERSTRM) then (* ; "Good start") (GO PARSEMSG) elseif (PROGN (SETFILEPTR FOLDERSTRM (SUB1 *START*LENGTH)) (AND (EQ (BIN FOLDERSTRM) (CHARCODE LF)) (FILEPOS "*start*" FOLDERSTRM 0 7))) then (* ; "LF woes") (if (\MAILSCAVENGE.ASKUSER "File was apparently written with end of line convention LF.  Convert to CR (Note: TEdit formatting may be corrupted by this action, or could already have been corrupted by copying the file into LF format)? ") then (SETQ *START* "*start*") (SETQ COPYFN (FUNCTION \MAILSCAVENGE.LFCOPYBYTES)) (SETQ *EOL* (CHARCODE LF)) (SETQ LFP T) (SETQ SCRATCHSTREAM (\MAILSCAVENGE.OPEN.SCRATCH FOLDERNAME)) (SETFILEINFO FOLDERSTRM (QUOTE EOL) (QUOTE LF))) elseif (\MAILSCAVENGE.ASKUSER (CL:FORMAT NIL "Alleged mail folder ~A doesn't begin with a Lafite header -- proceed anyway? " FOLDERNAME)) then (SETQ BODYSTART 0) (GO FINDSTART) else (RETURN NIL))) LP (* ;; "GOODPTR is believed to point at *start*") (SETFILEPTR FOLDERSTRM GOODPTR) (if (NOT (\MAILSCAVENGE.READSTAMP FOLDERSTRM)) then (* ; "This shouldn't happen") (CL:ERROR "Scavenger is confused at message ~D, byte ~D" MSGNO GOODPTR)) PARSEMSG (if PWINDOW then (* ; "Tell which message we're on") (DSPXPOSITION XPOS PWINDOW) (PRIN3 MSGNO PWINDOW)) (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) (if (NOT (AND (SETQ MSGLENGTH (LA.READCOUNT FOLDERSTRM)) (> MSGLENGTH 0))) then (* ; "Malformed header--not even the length exists.  Will need to build a new header.  Take all the stuff from BODYSTART as potential message") (SETQ BADHEADER T) (GO FINDSTART)) (SETQ BADHEADER (NOT (AND (PROGN (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) (SETQ STAMPLENGTH (LA.READCOUNT FOLDERSTRM))) (PROGN (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) (BIN FOLDERSTRM) (BIN FOLDERSTRM) (BIN FOLDERSTRM) (* ; "Read 3 status bytes") (OR (EQ (SETQ CH (BIN FOLDERSTRM)) *EOL*) (AND LFP (EQ CH (CHARCODE CR))))) (<= (- (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) GOODPTR) STAMPLENGTH)))) (* ;; "We have a plausible length.  BADHEADER true means the rest of header does not parse because (a) no header length, (b) no CR after the the 3 mark bytes, or (c) header length is too short.  Wait to see whether the length appears correct before deciding whether to rebuild the header or just smash it.") (* ; "Take all the stuff from BODYSTART as potential message") (if (OR (<= (SETQ ENDPTR (+ GOODPTR MSGLENGTH)) (GETFILEPTR FOLDERSTRM)) (> ENDPTR EOFPTR)) then (* ; "Length too short or points past eof.") (GO FINDSTART) elseif (AND (< ENDPTR EOFPTR) (PROGN (SETFILEPTR FOLDERSTRM ENDPTR) (NOT (\MAILSCAVENGE.READSTAMP FOLDERSTRM)))) then (* ; "Length doesn't point at next *start*, have to search for a boundary") (SETFILEPTR FOLDERSTRM ENDPTR) (if (AND (EQ (BIN FOLDERSTRM) 0) (to (- EOFPTR ENDPTR 1) always (EQ (BIN FOLDERSTRM) 0))) then (* ; "File is well-formed except for ending in a bunch of nulls.  This seems to happen every once in a fhile when a file server spazzes.  Throw them away.") (\MAILSCAVENGE.FORMAT "~%%Starting at byte ~D (after message #~D):~%%    File ends in ~D null bytes.  Will discard." ENDPTR MSGNO (- EOFPTR ENDPTR)) (if SCRATCHSTREAM then (* ; "Copy last message verbatim to scratch file") (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM GOODPTR ENDPTR) else (* ; "Note truncation here") (SETQ TRUNCATEPTR ENDPTR)) (add BADCOUNT 1) (GO DONE)) (GO FINDSTART) elseif BADHEADER then (* ; "Length ok, but header was malformed.  It is likely to be safe to just overwrite the header") (add BADCOUNT 1) (\MAILSCAVENGE.FORMAT "~%%Message #~D at byte ~D: length ok, but header garbled." MSGNO GOODPTR) (SETQ FIELDWIDTH (\MAILSCAVENGE.LENGTHWIDTH FOLDERSTRM GOODPTR)) (if SCRATCHSTREAM then (* ; "Have to copy") (SETQ BODYSTART (+ GOODPTR FIELDWIDTH LAFITEBASICSTAMPLENGTH)) (SETQ MSGLENGTH (- ENDPTR BODYSTART)) (GO COPYMSG) else (* ; "Remember fixup") (push LENGTHFIXUPS (LIST GOODPTR MSGLENGTH FIELDWIDTH T)) (GO NEXT)) else (* ; "Well-formed message") (if (AND (< (- BODYSTART GOODPTR) STAMPLENGTH) (EQ (PROGN (SETFILEPTR FOLDERSTRM BODYSTART) (BIN FOLDERSTRM)) (CHARCODE *))) then (* ; "May be a funny one") (LET ((INFO (CL:READ-LINE FOLDERSTRM)) ISDUP) (if (AND (STRPOS "duplicate*" INFO 1 NIL T) (FIXP (SETQ INFO (SUBATOM INFO 11)))) then (* ; "This message claims to be a duplicate of the one at INFO") (SETQ ISDUP (\MAILSCAVENGE.DUPLICATE? FOLDERSTRM INFO GOODPTR STAMPLENGTH MSGLENGTH (OR DUPSCRATCH (SETQ DUPSCRATCH (OPENSTREAM "{nodircore}" (QUOTE BOTH)))))) (\MAILSCAVENGE.FORMAT "~%%Message #~D at byte ~D is marked as a duplicate of the one at byte~D from an aborted Expunge~A." MSGNO GOODPTR INFO (if (NOT ISDUP) then "; however, the original is not there" elseif SCRATCHSTREAM then " (not copied)" else "")) (if ISDUP then (* ; "Nothing to do.") (GO NEXT) elseif SCRATCHSTREAM then (SETQ BADHEADER T) (* ; "so that message gets undeleted") (GO COPYGOOD) else (* ; "Want to rewrite the flags") (push LENGTHFIXUPS (LIST GOODPTR NIL NIL T)) (GO NEXT))))) (if SCRATCHSTREAM then (* ; "Copy verbatim to scratch file") (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM GOODPTR ENDPTR)) (GO NEXT)) FINDSTART (* ;; "At this point, we have a malformed message starting at GOODPTR.  Look for its end.  If the header is also malformed, BADHEADER is true.  BODYSTART points at what could be the start of text..") (SETQ TRYPTR BODYSTART) FINDSTARTLP (SETQ ENDPTR (FFILEPOS *START* FOLDERSTRM TRYPTR)) (if (NULL ENDPTR) then (* ; "Can't find next message.  Maybe this is the last one") (if (AND (EQ MSGNO 1) BADHEADER) then (* ; "Never saw a single *start*") (if (NULL (\MAILSCAVENGE.ASKUSER (CL:FORMAT NIL "There are no message boundaries in this file.  Do you want to turn the file into a single message of length ~D?" (- EOFPTR GOODPTR)))) then (RETURN NIL))) (SETQ ENDPTR EOFPTR) elseif (AND LFP (PROGN (* ; "Have to check that an eol follows, since we're not sure which kind.") (SETFILEPTR FOLDERSTRM (+ ENDPTR (SUB1 *START*LENGTH))) (SELCHARQ (BIN FOLDERSTRM) ((CR LF) NIL) T))) then (SETQ TRYPTR (+ ENDPTR (- *START*LENGTH 2))) (GO FINDSTARTLP)) (\MAILSCAVENGE.FORMAT "~%%Message #~D at byte ~D: length ~:[missing~%%    (~;incorrect~%%    (file says ~:*~D, ~]apparent length is ~D)" MSGNO GOODPTR MSGLENGTH (if BADHEADER then (* ; "Estimate based on standard header size.  We'll be exact later") (+ LAFITESTAMPLENGTH (SETQ MSGLENGTH (- ENDPTR BODYSTART))) else (SETQ MSGLENGTH (- ENDPTR GOODPTR)))) (add BADCOUNT 1) (if BADHEADER then (\MAILSCAVENGE.FORMAT "~%%    Need to rebuild internal header.  Message body may be malformed.") (GO COPYMSG)) (* ; "Header ok, just the length was wrong") (if (NULL SCRATCHSTREAM) then (* ; "Should suffice just to change length in place") (if (<= (NCHARS MSGLENGTH) (SETQ FIELDWIDTH (\MAILSCAVENGE.LENGTHWIDTH FOLDERSTRM GOODPTR))) then (* ; "Good, the correct length fits in the available space.  Save for confirmation later") (push LENGTHFIXUPS (LIST GOODPTR MSGLENGTH FIELDWIDTH)) (GO NEXT)) (* ;; "Arrrgh, the length is too big.  Fall thru to copy message to scratch file.") (\MAILSCAVENGE.FORMAT "~%%New length does not fit into old header, will have to rebuild.")) COPYGOOD (* ;; "Bring MSGLENGTH down to just the body length so we compute the new header correctly") (SETQ MSGLENGTH (- MSGLENGTH STAMPLENGTH)) COPYMSG (* ;; "At this point, we want to write the current message on scratch file.  MSGLENGTH is the length of the body, sans header, starting at BODYSTART.  If BADHEADER is true, we rebuild whole header.  Otherwise, message is believed well-formed, so we can copy flag bytes from old message.") (if (NULL SCRATCHSTREAM) then (* ; "Have to set up scratch file") (\MAILSCAVENGE.FORMAT "~%%Opening scratch file to handle rebuilt header.") (SETQ SCRATCHSTREAM (\MAILSCAVENGE.OPEN.SCRATCH FOLDERNAME)) (if (> GOODPTR 0) then (\MAILSCAVENGE.FORMAT "~%%Copying ~D previous message~:P to scratch file..." (SUB1 MSGNO)) (COPYBYTES FOLDERSTRM SCRATCHSTREAM 0 GOODPTR) (\MAILSCAVENGE.FORMAT "done."))) (LA.PRINTHEADER SCRATCHSTREAM MSGLENGTH) (if BADHEADER then (* ; "Have to create afresh, so use primordial flags") (PRIN3 "UU 
" SCRATCHSTREAM) else (* ; "Original header was ok, except for length info, so copy flags and mark byte from it.") (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM (- BODYSTART 4) BODYSTART) (SETQ BODYSTART (+ GOODPTR STAMPLENGTH))) (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM BODYSTART ENDPTR) NEXT (COND ((< (SETQ GOODPTR ENDPTR) EOFPTR) (* ; "Go process some more") (add MSGNO 1) (GO LP))) DONE (* ;; "All finished--shall we confirm it?") (if SCRATCHSTREAM then (* ; "Close this now (could be slow) before saying done.") (SETQ SCRATCHSTREAM (CLOSEF SCRATCHSTREAM))) (if PWINDOW then (DSPXPOSITION XPOS PWINDOW) (PRIN1 "done. " PWINDOW)) (SETQ SUCCESS (if SCRATCHSTREAM then (* ; "We had to use a scratch file.") (if LENGTHFIXUPS then (* ; "Had some length fixups before we got to a really bad spot, so go back and do them now") (SETQ SCRATCHSTREAM (OPENSTREAM SCRATCHSTREAM (QUOTE BOTH) (QUOTE OLD) (QUOTE ((TYPE LAFITE))))) (CL:UNWIND-PROTECT (\MAILSCAVENGE.FIX.LENGTHS LENGTHFIXUPS SCRATCHSTREAM) (SETQ SCRATCHSTREAM (CLOSEF SCRATCHSTREAM)))) (if (AND (\MAILSCAVENGE.CONFIRM BADCOUNT MSGNO "Replace damaged mail file with scavenged file? ") (PROGN (if *FOLDER* then (\LAFITE.CLOSE.FOLDER *FOLDER* T) else (CLOSEF FOLDERSTRM)) (CL:MULTIPLE-VALUE-BIND (RESULT CONDITION) (\LAFITE.RENAMEFILE SCRATCHSTREAM FOLDERNAME) (if RESULT then T else (\MAILSCAVENGE.FORMAT "~%%RenameFile failed~@[ because ~A~]." CONDITION) NIL)))) then T else (* ; "File not renamed, either because of error or user choice.  Tell where the scavenged file is.") (\MAILSCAVENGE.FORMAT "~%%Scavenged file stored as ~A." SCRATCHSTREAM MSGNO) NIL) elseif (AND (NULL LENGTHFIXUPS) (NULL TRUNCATEPTR)) then (\MAILSCAVENGE.FORMAT "~%%~A is a well-formed message file of ~D messages." FOLDERNAME MSGNO) NIL elseif (\MAILSCAVENGE.CONFIRM BADCOUNT MSGNO "Shall I correct these messages in the file? ") then (* ; "Do fixups in place") (if *FOLDER* then (SETQ FOLDERSTRM (\LAFITE.OPEN.FOLDER *FOLDER* (QUOTE BOTH))) elseif (NOT (OPENP FOLDERSTRM (QUOTE OUTPUT))) then (SETQ FOLDERSTRM (OPENSTREAM (CLOSEF FOLDERSTRM) (QUOTE BOTH) NIL (QUOTE ((TYPE LAFITE)))))) (\MAILSCAVENGE.FIX.LENGTHS LENGTHFIXUPS FOLDERSTRM) (if TRUNCATEPTR then (* ; "Truncate file to drop nulls off end") (SETFILEINFO FOLDERSTRM (QUOTE LENGTH) TRUNCATEPTR)) (* ; "Return success") T)) (if SUCCESS then (\MAILSCAVENGE.FORMAT "done.~2%%You may want to examine the messages listed above for duplications or concatenated messages.~%%")) (if TSTREAM then (DETACHWINDOW TSTREAM) (\MAILSCAVENGE.FORMAT "
(This report window is now detached from its browser.
 You may close it at your convenience.)")) (RETURN (AND SUCCESS FOLDERNAME))) (* ;; "Cleanup time") (if (type? MAILFOLDER *FOLDER*) then (\LAFITE.CLOSE.FOLDER *FOLDER* T) elseif (AND (STREAMP FOLDERSTRM) (OPENP FOLDERSTRM)) then (CLOSEF FOLDERSTRM)) (if (STREAMP SCRATCHSTREAM) then (* ; "Must have aborted.") (DELFILE (CLOSEF SCRATCHSTREAM))))))
)

(\MAILSCAVENGE.OPEN.SCRATCH

(LAMBDA (FOLDERNAME) (* ; "Edited  3-May-89 13:03 by bvm") (OPENSTREAM (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE EXTENSION) (CONCAT (UNPACKFILENAME.STRING FOLDERNAME (QUOTE EXTENSION)) "-scavenged") (QUOTE BODY) FOLDERNAME) (QUOTE OUTPUT) (QUOTE NEW) (QUOTE ((TYPE LAFITE) (SEQUENTIAL T)))))
)

(\MAILSCAVENGE.LENGTHWIDTH

(LAMBDA (FOLDERSTRM STARTPTR) (* ; "Edited  3-May-89 12:42 by bvm") (* ;; "Return the actual width of the %"message length%" field in this message") (LET ((LENSTART (+ STARTPTR *START*LENGTH))) (SETFILEPTR FOLDERSTRM LENSTART) (LA.READCOUNT FOLDERSTRM T) (- (GETFILEPTR FOLDERSTRM) LENSTART 1)))
)

(\MAILSCAVENGE.LFCOPYBYTES

(LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited  3-May-89 13:07 by bvm") (* ;; "A COPYBYTES that turns LF into CR as it goes.") (SETFILEPTR SRCFIL START) (to (- END START) bind CH do (\BOUT DSTFIL (if (EQ (SETQ CH (BIN SRCFIL)) (CHARCODE LF)) then (CHARCODE CR) else CH))))
)

(\MAILSCAVENGE.READSTAMP

(LAMBDA (STREAM) (* ; "Edited  3-May-89 12:20 by bvm") (* ;; "Like LA.READSTAMP, but also succeeds if the stamp ends in LF when we're processing a LF file.") (AND (EQ (BIN STREAM) (CHARCODE *)) (EQ (BIN STREAM) (CHARCODE s)) (EQ (BIN STREAM) (CHARCODE t)) (EQ (BIN STREAM) (CHARCODE a)) (EQ (BIN STREAM) (CHARCODE r)) (EQ (BIN STREAM) (CHARCODE t)) (EQ (BIN STREAM) (CHARCODE *)) (SELCHARQ (BIN STREAM) (CR T) (LF (EQ *EOL* (CHARCODE LF))) NIL)))
)

(\MAILSCAVENGE.DUPLICATE?

(LAMBDA (FOLDERSTRM OLDPTR GOODPTR STAMPLENGTH MSGLENGTH SCRATCH) (* ; "Edited  2-May-89 12:06 by bvm") (* ;; "True if the message at pointer OLDPTR is a duplicate of the one starting at GOODPTR with lengths STAMPLENGTH & MSGLENGTH.") (SETFILEPTR FOLDERSTRM OLDPTR) (LET (OLDLENGTH OLDSTAMP) (AND (LA.READSTAMP FOLDERSTRM) (SETQ OLDLENGTH (LA.READCOUNT FOLDERSTRM)) (SETQ OLDSTAMP (LA.READCOUNT FOLDERSTRM)) (\LAFITE.CHECK.DUPLICATE FOLDERSTRM SCRATCH GOODPTR STAMPLENGTH MSGLENGTH OLDPTR OLDSTAMP OLDLENGTH))))
)

(\MAILSCAVENGE.FORMAT

(CL:LAMBDA (&REST ARGS) (* ; "Edited 21-Apr-89 15:25 by bvm") (if (TEXTSTREAMP *ERRORMSGSTREAM*) then (* ;; "It is MUCH faster to cons the string and hand it to tedit than to print a character at a time.  One difference: unless we set the %"dontscroll%" flag, the window will scroll when we run off the bottom.  This is probably desirable, as it means we look like we're doing something.") (TEDIT.INSERT *ERRORMSGSTREAM* (CL:APPLY (FUNCTION CL:FORMAT) NIL ARGS) (ADD1 (GETEOFPTR *ERRORMSGSTREAM*))) else (CL:APPLY (FUNCTION CL:FORMAT) *ERRORMSGSTREAM* ARGS)))
)

(\MAILSCAVENGE.MAKEWINDOW

(LAMBDA (FOLDER) (* ; "Edited 21-Apr-89 15:34 by bvm") (* ;; "Return a tedit window to use for Scavenger report, or NIL if FOLDER doesn't have a browser") (LET ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (if BROWSERWINDOW then (LET* ((FONT (DSPFONT NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (ERRHEIGHT (HEIGHTIFWINDOW (TIMES 10 (FONTPROP FONT (QUOTE HEIGHT))) T)) (ERRW (CREATEW (CREATEREGION 0 0 10 ERRHEIGHT) (CONCAT "Mail Scavenger Report for " (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER)) T))) (ATTACHWINDOW ERRW BROWSERWINDOW (if (< (fetch (REGION BOTTOM) of (WINDOWPROP BROWSERWINDOW (QUOTE REGION))) ERRHEIGHT) then (* ; "Won't fit below") (QUOTE TOP) else (QUOTE BOTTOM)) (QUOTE JUSTIFY) (QUOTE LOCALCLOSE)) (OPENTEXTSTREAM "" ERRW NIL NIL (BQUOTE (FONT (\, FONT) PROMPTWINDOW DON'T))) ERRW))))
)

(\MAILSCAVENGE.ASKUSER

(LAMBDA (PROMPT) (DECLARE (CL:SPECIAL *FOLDER*)) (* ; "Edited  2-May-89 11:42 by bvm") (LET (BROWSERWINDOW) (if (AND *FOLDER* (SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of *FOLDER*))) then (* ; "Use the browser for interaction") (CLEARW BROWSERWINDOW) (FLASHWINDOW BROWSERWINDOW) (if (> (STRINGWIDTH PROMPT BROWSERWINDOW) (WINDOWPROP BROWSERWINDOW (QUOTE WIDTH))) then (* ; "Sigh, too wide to centerprint.  I wish we had better text layout...") (RELMOVETO 0 (- (IQUOTIENT (WINDOWPROP BROWSERWINDOW (QUOTE HEIGHT)) 2)) BROWSERWINDOW) (PRIN3 PROMPT BROWSERWINDOW) else (* ; "Nicely center the prompt") (CENTERPRINTINREGION PROMPT NIL BROWSERWINDOW)) (LET* ((MENUW (fetch (MAILFOLDER BROWSERMENUWINDOW) of *FOLDER*)) (MENUWREG (WINDOWPROP MENUW (QUOTE REGION))) (MENUWIDTH (fetch (REGION WIDTH) of MENUWREG)) (ITEMS (QUOTE (("Proceed" T "Continue the scavenge as asked") ("Abort" NIL "Abort the mail scavenge operation")))) (MENU (create MENU ITEMS _ ITEMS CENTERFLG _ T MENUFONT _ LAFITEMENUFONT MENUROWS _ 1 ITEMWIDTH _ (MAX (STRINGWIDTH (CAAR ITEMS) LAFITEMENUFONT) (IQUOTIENT MENUWIDTH 4)) MENUOUTLINESIZE _ 0 MENUBORDERSIZE _ 0))) (* ; "Position the menu in the middle of the browser's menu window") (PROG1 (MENU MENU (LA.POSITION.FROM.REGION MENUWREG (IQUOTIENT (- MENUWIDTH (fetch (MENU IMAGEWIDTH) of MENU)) 2) (WINDOWPROP MENUW (QUOTE BORDER))) T) (CLEARW BROWSERWINDOW))) else (EQ (ASKUSER NIL NIL PROMPT) (QUOTE Y)))))
)

(\MAILSCAVENGE.FIX.LENGTHS

(LAMBDA (FIXUPS STREAM) (* ; "Edited  3-May-89 12:42 by bvm") (* ;; "Perform length fixups.  FIXUPS has entries of the form (startptr length fieldwidth fixheader)") (for ENTRY in FIXUPS do (DESTRUCTURING-BIND (START LENGTH FIELDWIDTH FIXHEADER) ENTRY (SETFILEPTR STREAM (+ START *START*LENGTH)) (if LENGTH then (LA.PRINTCOUNT LENGTH STREAM (BQUOTE (FIX (\, FIELDWIDTH) 10 T))) else (LA.READCOUNT STREAM)) (if FIXHEADER then (* ; "Write the rest of the header, too") (if LENGTH then (LA.PRINTCOUNT (+ FIELDWIDTH LAFITEBASICSTAMPLENGTH) STREAM) else (LA.READCOUNT STREAM)) (PRIN3 "UU 
" STREAM))))))

(\MAILSCAVENGE.CONFIRM

(LAMBDA (BADNO TOTALNO PROMPT) (* ; "Edited 21-Apr-89 15:27 by bvm") (DECLARE (CL:SPECIAL *FOLDER* *ERRORMSGSTREAM*)) (* ;; "Called at end of scavenge to report results.  Return T/NIL response to PROMPT") (LET ((FORMATSTRING "~2%%Finished, found ~D bad messages out of ~D total messages.~%%")) (\MAILSCAVENGE.FORMAT FORMATSTRING BADNO TOTALNO) (if (\MAILSCAVENGE.ASKUSER PROMPT) then (if *FOLDER* then (* ; "Make sure to delete any toc that might be hanging around") (DELFILE (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of *FOLDER*)))) (\MAILSCAVENGE.FORMAT "Working... ") (* ; "Show some response") T)))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ *START*LENGTH
 8)


(CONSTANTS (*START*LENGTH 8))
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

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

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 \MAILSCAVENGE.FORMAT)
)
(PUTPROPS MAILSCAVENGE COPYRIGHT ("Venue & Xerox Corporation" 1985 1989 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1429 21135 (LAFITE.SCAVENGE 1439 . 1871) (\MAILSCAVENGE.INTERNAL 1873 . 14946) (
\MAILSCAVENGE.OPEN.SCRATCH 14948 . 15279) (\MAILSCAVENGE.LENGTHWIDTH 15281 . 15609) (
\MAILSCAVENGE.LFCOPYBYTES 15611 . 15916) (\MAILSCAVENGE.READSTAMP 15918 . 16395) (
\MAILSCAVENGE.DUPLICATE? 16397 . 16940) (\MAILSCAVENGE.FORMAT 16942 . 17529) (\MAILSCAVENGE.MAKEWINDOW
 17531 . 18396) (\MAILSCAVENGE.ASKUSER 18398 . 19864) (\MAILSCAVENGE.FIX.LENGTHS 19866 . 20494) (
\MAILSCAVENGE.CONFIRM 20496 . 21133)))))
STOP