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

(FILECREATED "15-Jun-90 15:57:17" {ERINYES}<LISP>MEDLEY>LISPUSERS>TRICKLE.;3
 7876   

      changes to%:  (VARS TRICKLECOMS)

      previous date%: " 4-Jun-90 17:10:08" {ERINYES}<LISP>MEDLEY>LISPUSERS>TRICKLE.;2)


(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1990 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT TRICKLECOMS)

(RPAQQ TRICKLECOMS
 ((FILES (SYSLOAD)
                               PROMPTREMINDERS COPYFILES)
                        (FNS Trickle TrickleProcessLogfile)))

(FILESLOAD (SYSLOAD)
       PROMPTREMINDERS COPYFILES)
(DEFINEQ

(Trickle

  [LAMBDA (Source Destination RootLogfileName MailAddress ScheduleAnotherOne DontReplaceOldVersions 
                 DontCopyExtensions)
                     (* ; "Edited  4-Jun-90 16:05 by jds")

    (LET* [(DateString (DATE (DATEFORMAT SPACES NUMBER.OF.MONTH NO.TIME)))
           (LogfileName (PACK* (OR RootLogfileName '{qv}<briggs>lispusers-)
                               (SUBSTRING DateString 7 8)
                               (SUBSTRING DateString 4 5)
                               (SUBSTRING DateString 1 2)
                               '.COPYLOG]

          (* ;; "fix up the file name for the case where the day is less than 10")


          [if
 (EQ '%  (NTHCHAR LogfileName -10))
              then
 (SETQ LogfileName (MKATOM (RPLSTRING LogfileName -10 "0"]

          (* ;; "ensure that the logfile has one line per file operated on")


          [RESETVAR FILELINELENGTH 1000 (COPYFILES Source Destination
                                               (APPEND (LIST '>A (LIST 'OUTPUT LogfileName))
                                                      (if
 (NULL DontReplaceOldVersions)
                                                          then
 (LIST 'REPLACE))
                                                      (if
 DontCopyExtensions
                                                          then
 `((DONTCOPY ,@DontCopyExtensions]
          (TrickleProcessLogfile
 LogfileName MailAddress Source Destination)
          (if
 (EQ ScheduleAnotherOne T)
              then
 (SETREMINDER (MKATOM (CONCAT "Trickle-" (GENSYM)
                                                   "-" Source))
                              NIL
                              `(Trickle
 ',Source ',Destination ,RootLogfileName ,MailAddress
                                      ,ScheduleAnotherOne
                                      ,DontReplaceOldVersions)
                              (CONCAT (SUBSTRING [GDATE (PLUS (IDATE)
                                                              (CONSTANT (TIMES 60 60 24]
                                             1 10)
                                     (RAND 1 5)
                                     ":"
                                     (RAND 0 59)))
            elseif
 (AND ScheduleAnotherOne (IDATE (CONCAT "1-jan-87 " ScheduleAnotherOne)))
              then
 (SETREMINDER (MKATOM (CONCAT "Trickle-" (GENSYM)
                                                   "-" Source))
                              NIL
                              `(Trickle
 ',Source ',Destination ,RootLogfileName ,MailAddress
                                      ,ScheduleAnotherOne
                                      ,DontReplaceOldVersions)
                              (CONCAT (SUBSTRING [GDATE (PLUS (IDATE)
                                                              (CONSTANT (TIMES 60 60 24]
                                             1 10)
                                     ScheduleAnotherOne])

(TrickleProcessLogfile

  [LAMBDA (LogfileName MailAddress Source Destination)
       (* N.H.Briggs " 1-Oct-87 11:29")

    (PROG (LogfileStream EndsOfLines (EOLCharacter (CHARACTER (CHARCODE EOL)))
                 EndOfLine Deletions)
          (SETQ LogfileStream (OPENTEXTSTREAM LogfileName))
          (if
 (ZEROP (GETEOFPTR LogfileStream))
              then
 
          
          (* * probably errored -

          people don't usually Trickle empty directories)


                   (if
 MailAddress
                       then
 (TEDIT.INSERT LogfileStream
                                   (PACK* "Subject: (Error?) Trickle:" Source " to " Destination 
                                          EOLCharacter "To: " MailAddress EOLCharacter EOLCharacter)
                                   1)
                            (LAFITE.SENDMESSAGE LogfileStream)
                            (CLOSEF LogfileStream)
                            (RETURN)))
          (TEDIT.SETSEL LogfileStream 1 1 'LEFT)
          (SETQ EndsOfLines (CONS 0 (while
 (SETQ EndOfLine (TEDIT.FIND LogfileStream EOLCharacter))
                                       collect
 (TEDIT.SETSEL LogfileStream EndOfLine 1 'RIGHT)
                                             EndOfLine)))
          
          (* * find lines with "skipped" and collect for deletion)

          
          (* * TEDIT.FIND is very poor on long files, see AR# 4220)


          [for
 EndOfPreviousLine on
 EndsOfLines bind
 StartOfLine EndOfLine
             eachtime
 [SETQ StartOfLine (AND EndOfPreviousLine (ADD1 (CAR EndOfPreviousLine]
                   (SETQ EndOfLine (CADR EndOfPreviousLine))
             when
 [AND EndOfLine (STRPOS "skipped" (TEDIT.SEL.AS.STRING LogfileStream
                                                          (TEDIT.SETSEL LogfileStream StartOfLine
                                                                 (ADD1 (IDIFFERENCE EndOfLine 
                                                                              StartOfLine]
             do
 
          
          (* * if this deletion is an extension of the previous one, then extend the 

          previous one, otherwise add this to the collection.

          This collapsing makes the actual deletion much more efficient, since we expect 

          to have few of the lines kept.)


                (if
 (AND Deletions (EQUAL (PLUS (CAAR Deletions)
                                                (CDAR Deletions))
                                          StartOfLine))
                    then
 [RPLACD (CAR Deletions)
                                (PLUS (CDAR Deletions)
                                      (DIFFERENCE EndOfLine (CAR EndOfPreviousLine]
                  else
 (push
 Deletions (CONS StartOfLine (DIFFERENCE EndOfLine (CAR EndOfPreviousLine
                                                                                    ]
          
          (* * do collected deletions)


          (for
 Deletion in
 Deletions do
 (TEDIT.DELETE LogfileStream (CAR Deletion)
                                               (CDR Deletion)))
          
          (* * KLUDGE! TEDIT.PUT bombs after putting the file if the stream doesn't have 

          a window associated)


          (NLSETQ (TEDIT.PUT LogfileStream LogfileName T T))
          
          (* * construct a mail message and send it)


          (if
 MailAddress
              then
 (TEDIT.INSERT LogfileStream (PACK* (if
 (NOT (ZEROP (GETEOFPTR LogfileStream)))
                                                          then
 "Subject: Trickle: "
                                                        else
 "Subject: (Empty) Trickle:")
                                                      Source " to " Destination EOLCharacter "To: " 
                                                      MailAddress EOLCharacter EOLCharacter)
                          1)
                   (LAFITE.SENDMESSAGE LogfileStream))
          (CLOSEF LogfileStream])
)
(PUTPROPS TRICKLE COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (638 7777 (Trickle 648 . 3673) (TrickleProcessLogfile 3675 . 7775)))))
STOP