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


(FILECREATED "26-Feb-2024 20:13:24" {WMEDLEY}<library>lafite>LAFITE-MAILSCAVENGE.;2
 39927  

      :EDIT-BY rmk

      :CHANGES-TO (VARS LAFITE-MAILSCAVENGECOMS)
                  (FNS MAILSCAVENGE)

      :PREVIOUS-DATE "24-Feb-2024 11:28:52" {WMEDLEY}<library>lafite>LAFITE-SCAVENGE.;1)


(PRETTYCOMPRINT LAFITE-MAILSCAVENGECOMS)

(RPAQQ LAFITE-MAILSCAVENGECOMS

       [(FNS MAILSCAVENGE \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

(MAILSCAVENGE

  [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)
                         '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* 'MAILFOLDER)
                   then
                                  (* ; 

                                                         "It's a mail folder, so play by the rules")

                         (SETQ FOLDERSTRM (\LAFITE.OPEN.FOLDER *FOLDER* 'INPUT :OK))
                         (SETQ PWINDOW (fetch
 (MAILFOLDER BROWSERPROMPTWINDOW) of
 *FOLDER*))
                 elseif
 (TYPENAMEP *FOLDER* 'STREAM)
                   then
 (SETQ FOLDERSTRM *FOLDER*)
                 else
 (SETQ FOLDERSTRM (\LAFITE.OPENSTREAM *FOLDER* 'INPUT 'OLD
                                                  (FUNCTION \LAFITE.EOF)
                                                  NIL
                                                  'LAFITE]
               (SETQ FOLDERNAME (FULLNAME FOLDERSTRM))
               (SETFILEINFO FOLDERSTRM '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* '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 '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 'EOL '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}"
                                                                                   '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 'BOTH 'OLD
                                                               '((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* 'BOTH))
                            elseif
 (NOT (OPENP FOLDERSTRM 'OUTPUT))
                              then
 (SETQ FOLDERSTRM (OPENSTREAM (CLOSEF FOLDERSTRM)
                                                               'BOTH NIL '((TYPE LAFITE]
                          (\MAILSCAVENGE.FIX.LENGTHS
 LENGTHFIXUPS FOLDERSTRM)
                          (if
 TRUNCATEPTR
                              then
                       (* ; 

                                                           "Truncate file to drop nulls off end")

                                    (SETFILEINFO FOLDERSTRM '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 'VERSION NIL 'EXTENSION (CONCAT (UNPACKFILENAME.STRING
                                                                      FOLDERNAME
                                                                      'EXTENSION)
                                                                    "-scavenged")
                       'BODY FOLDERNAME)
           'OUTPUT
           'NEW
           '((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  7-Feb-2022 11:51 by rmk")


                                                             (* ; "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 '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
                                                                       'REGION))
                                      ERRHEIGHT)
                                   then
                      (* ; "Won't fit below")

                                        'TOP
                                 else
 'BOTTOM)
                               'JUSTIFY
                               'LOCALCLOSE)
                        (OPENTEXTSTREAM NIL ERRW NIL NIL `(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 'WIDTH))
                       then
                              (* ; 

                              "Sigh, too wide to centerprint.  I wish we had better text layout...")

                             (RELMOVETO 0 (- (IQUOTIENT (WINDOWPROP BROWSERWINDOW '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 'REGION))
                          (MENUWIDTH (fetch
 (REGION WIDTH) of
 MENUWREG))
                          [ITEMS '(("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 'BORDER))
                                      T)
                                (CLEARW BROWSERWINDOW)))
           else
 (EQ (ASKUSER NIL NIL PROMPT)
                        '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 `(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)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1387 39490 (MAILSCAVENGE 1397 . 1922) (\MAILSCAVENGE.INTERNAL 1924 . 28435) (
\MAILSCAVENGE.OPEN.SCRATCH 28437 . 29040) (\MAILSCAVENGE.LENGTHWIDTH 29042 . 29455) (
\MAILSCAVENGE.LFCOPYBYTES 29457 . 30026) (\MAILSCAVENGE.READSTAMP 30028 . 30775) (
\MAILSCAVENGE.DUPLICATE? 30777 . 31478) (\MAILSCAVENGE.FORMAT 31480 . 32307) (\MAILSCAVENGE.MAKEWINDOW
 32309 . 34206) (\MAILSCAVENGE.ASKUSER 34208 . 37338) (\MAILSCAVENGE.FIX.LENGTHS 37340 . 38498) (
\MAILSCAVENGE.CONFIRM 38500 . 39488)))))
STOP