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


(FILECREATED " 9-Oct-2021 00:35:17" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;11
 8621   

      changes to%:  (FNS FB.THINP)

      previous date%: " 7-Oct-2021 12:40:24" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;8)


(* ; "
Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
")

(PRETTYCOMPRINT THINFILESCOMS)

(RPAQQ THINFILESCOMS

       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
                                                FILEBROWSER))
        (FNS FB.THINCOMMAND FB.THINP)
        (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
                                         '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE]
               (THINNAMES NIL))
        (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 18-Aug-2021 20:46 by rmk:")


                                                             (* ; "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 (fetch
 (FBFILEDATA FILENAME) of
 DATA)
                                               "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  9-Oct-2021 00:35 by rmk:")

    (SETQ FILENAME (U-CASE FILENAME))
    (COND
       [(OR (EQMEMB (FILENAMEFIELD FILENAME 'EXTENSION)
                   THINEXTENSIONS)
            (FIND
 TN (FN _ (FILENAMEFIELD FILENAME 'NAME))
                   (FE _ (FILENAMEFIELD FILENAME 'EXTENSION)) INSIDE
 THINNAMES
               SUCHTHAT
 

                     (* ;; "Separate extractions because period for null extension is confusing")


                     (AND (EQ FN (FILENAMEFIELD TN 'NAME))
                          (EQ FE (FILENAMEFIELD TN 'EXTENSION]
       (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])
)

(RPAQ? THINEXTENSIONS
 (UNION *COMPILED-EXTENSIONS*
                                 '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE)))

(RPAQ? THINNAMES
 NIL)

(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 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1106 8152 (FB.THINCOMMAND 1116 . 6617) (FB.THINP 6619 . 8150)))))
STOP