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

(FILECREATED " 1-May-92 16:49:39" {DSK}<project>lfg>parser>THINFILES.;5
 8005   

      changes to%:  (FNS FB.THINP)

      previous date%: "28-Sep-89 16:38:11" {DSK}<project>lfg>parser>THINFILES.;2)


(* ; "
Copyright (c) 1987, 1988, 1989, 1992 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT THINFILESCOMS)

(RPAQQ THINFILESCOMS
 [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
                                                                  FILEBROWSER))
                          (FNS FB.THINCOMMAND FB.THINP)
                          (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND 
                     "Delvers non-source files and removes all but the last source file of each day."
                                                           ])
(DECLARE%: EVAL@COMPILE DONTCOPY 

(FILESLOAD (LOADCOMP)
       FILEBROWSER)
)
(DEFINEQ

(FB.THINCOMMAND

  [LAMBDA (FBROWSER)                                         (* ; "Edited 10-Oct-88 10:06 by jtm:")

                                                             (* ; "Edited 10-Oct-88 10:05 by jtm:")

                                                             (* bvm%: "13-Oct-85 16:52")


         (* * FB.THINCOMMAND interfaces between the user and the file browser.

       It calls FB.THINP on each file to determine if the file should be deleted.

       Any changes to the heuristic should be made to FB.THINP.)


    (LET (TBROWSER NDELETED FILES NOW ONEDAY SORT#)

         (* * collect the files into a list.)


         (SETQ FILES (TB.COLLECT.ITEMS (SETQ TBROWSER (fetch
 (FILEBROWSER TABLEBROWSER)
                                                         of
 FBROWSER))
                            (FUNCTION FB.IS.NOT.SUBDIRECTORY.ITEM)))

         (* * sort the files in descending order.)


         [SETQ FILES (SELECTQ (fetch
 (FILEBROWSER SORTBY) of
 FBROWSER)
                         (FB.NAMES.DECREASING.VERSION        (* Just right)

                              FILES)
                         (FB.NAMES.INCREASING.VERSION        (* Close, but no cigar)

                              (FB.SORT.VERSIONS FILES (FUNCTION FB.DECREASING.VERSION)))
                         (SORT FILES (FUNCTION FB.NAMES.DECREASING.VERSION]

         (* * delete the files that satisfy FB.THINP.)


         (SETQ NOW (IDATE (DATE)))
         (SETQ ONEDAY (IDIFFERENCE (IDATE "31-Aug-87 09:06:06")
                             (IDATE "30-Aug-87 09:06:06")))

         (* * get the position of CREATIONDATE. (code borrowed from FB.SORTCOMMAND))


         [SETQ SORT# (OR (CL:POSITION 'CREATIONDATE (fetch
 (FILEBROWSER INFODISPLAYED)
                                                       of
 FBROWSER)
                                :KEY
                                (FUNCTION CAR))
                         (HELP "Couldn't find sort attribute" 'CREATIONDATE]
         (SETQ NDELETED (for
 TAIL FILE DATA on
 FILES bind
 (%#DELETED _ 0)
                                                                   THISNAME LASTNAME CREATIONDATE 
                                                                   TIMESTAMP LASTTIMESTAMP
                           do
 (SETQ FILE (CAR TAIL))
                                 (SETQ DATA (fetch
 TIDATA of
 FILE))
                                 (SETQ TIMESTAMP (AND (SETQ CREATIONDATE (CL:NTH SORT#
                                                                                (fetch

                                                                                 (FBFILEDATA FILEINFO
                                                                                        )
                                                                                   of
 DATA)))
                                                      (IDATE CREATIONDATE)))
                                 (OR TIMESTAMP (FB.PROMPTWPRINT FBROWSER T "No creation date for " 
                                                      THISNAME))
                                 (SETQ THISNAME (fetch
 (FBFILEDATA VERSIONLESSNAME) of
 DATA))
                                 (COND
                                    [(STRING-EQUAL THISNAME LASTNAME)
                                     (COND
                                        ((OR (NULL LASTTIMESTAMP)
                                             (NULL TIMESTAMP))
                                                             (* no creation date was given.)

                                         NIL)
                                        ((ILESSP LASTTIMESTAMP TIMESTAMP)
                                         (HELP THISNAME "is out of order."))
                                        ((FB.THINP

                                          THISNAME
                                          (IDIFFERENCE NOW TIMESTAMP)
                                          (IDIFFERENCE LASTTIMESTAMP TIMESTAMP)
                                          [OR (NULL (CDR TAIL))
                                              (NOT (STRING-EQUAL THISNAME (fetch
 (FBFILEDATA
                                                                                      VERSIONLESSNAME
                                                                                      )
                                                                             of

                                                                             (fetch
 TIDATA
                                                                                of
 (CADR TAIL]
                                          ONEDAY)            (* FB.THINP determines whether or 

                                                           not the file should be deleted.)

                                         (COND
                                            ((FB.DELETE.FILE TBROWSER FILE)
                                             (add
 %#DELETED 1]
                                    (T (SETQ LASTNAME THISNAME)))
                                 (SETQ LASTTIMESTAMP TIMESTAMP) finally
 (RETURN %#DELETED)))
         (FB.UPDATE.COUNTERS FBROWSER 'DELETED)
         (FB.PROMPTWPRINT FBROWSER T "Done, " NDELETED " files marked for deletion."])

(FB.THINP

  [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)

                                                             (* ; "Edited  1-May-92 16:49 by rmk:")

    (LET [(EXT (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION]
         (COND
            ((OR (FMEMB EXT '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL))
                 (FMEMB EXT *COMPILED-EXTENSIONS*))          (* ; 

                                   "always delver files that can be reconstructed from the source.")

             T)
            (OLDESTVERSION?                                  (* ; 

                                                 "don't delete the oldest version of source files.")

                   NIL)
            ((ILESSP AGE ONEDAY)                             (* ; 

                                                   "don't delete anything written within 24 hours.")

             NIL)
            ((ILESSP (ITIMES DELTATIMESTAMP 3)
                    ONEDAY)                                  (* ; 

         "delete anything that occurs on the same day as something else (except for the first day)")

             T)
            ((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30))

             (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")


             T])
)

(APPENDTOVAR FB.MENU.ITEMS
 (Thin FB.THINCOMMAND 
                     "Delvers non-source files and removes all but the last source file of each day."
                                     ))
(PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (925 7713 (FB.THINCOMMAND 935 . 6343) (FB.THINP 6345 . 7711)))))
STOP