initial checkin for lispusers
This commit is contained in:
Larry Masinter
143
lispusers/THINFILES
Normal file
143
lispusers/THINFILES
Normal file
@@ -0,0 +1,143 @@
|
||||
(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
|
||||
Reference in New Issue
Block a user