(FILECREATED "30-Dec-85 10:11:40" {DSK19}CCACHE.;2 11964
changes to: (FNS CacheFiles)
previous date: " 9-Apr-85 08:36:15" {DSK19}CCACHE.;1)
(* Copyright (c) 1985 by Speech Input Project, Univ. of Edinburgh. All rights reserved.)
(PRETTYCOMPRINT CCACHECOMS)
(RPAQQ CCACHECOMS [(INITVARS (CCacheSafeHomes)
(NotSavedFiles (LIST NIL))
(CCacheStackPtr (RELSTK (STKNTH 1)))
(CCachePrintMoves T)
(CCacheSaveAll NIL)
(CCachePreviousHome NIL))
(ADDVARS (CCacheUnsafeHomes DSK)
(CCacheFellowTravellers DCOM DATABASE)
(MAKEFILEOPTIONS SAVE))
(GLOBALVARS NotSavedFiles CCacheStackPtr CCacheFellowTravellers
CCacheUnsafeHomes CCacheSafeHomes CCachePrintMoves CCacheSaveAll
CCachePreviousHome)
(FNS CacheFiles SaveFile SaveFiles \NeedSaved \SaveFile)
(PROP FILEHOME REM.CM EMPRESS.SCRATCH)
(ADVISE CLEANUP FILES?)
(* * What follows is compiled in advice, as these all get called a lot)
(FNS CCaching-MAKEFILE CCaching-OPENSTREAM)
(P (pushnew CCacheUnsafeHomes (FILENAMEFIELD (DIRECTORYNAME '{DSK})
'HOST))
(for f in '(MAKEFILE OPENSTREAM)
do
(MOVD? f (PACK* 'BeforeCCache-
f))
(MOVD (PACK* 'CCaching-
f)
f)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA SaveFiles CacheFiles)
(NLAML)
(LAMA])
(RPAQ? CCacheSafeHomes )
(RPAQ? NotSavedFiles (LIST NIL))
(RPAQ? CCacheStackPtr (RELSTK (STKNTH 1)))
(RPAQ? CCachePrintMoves T)
(RPAQ? CCacheSaveAll NIL)
(RPAQ? CCachePreviousHome NIL)
(ADDTOVAR CCacheUnsafeHomes DSK)
(ADDTOVAR CCacheFellowTravellers DCOM DATABASE)
(ADDTOVAR MAKEFILEOPTIONS SAVE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NotSavedFiles CCacheStackPtr CCacheFellowTravellers CCacheUnsafeHomes CCacheSafeHomes
CCachePrintMoves CCacheSaveAll CCachePreviousHome)
)
(DEFINEQ
(CacheFiles
[NLAMBDA files (* ht: "30-Dec-85 10:07")
(bind (toHost ←(FILENAMEFIELD (DIRECTORYNAME T)
'HOST))
(toDir ←(FILENAMEFIELD (DIRECTORYNAME T)
'DIRECTORY))
(fromHost ←(CAR CCacheSafeHomes))
volume onlyFlg fromDir found dest
first [volume←(if (AND (MACHINETYPE)= 'DANDELION
toHost=
'DSK)
then (FILENAMEFIELD (DIRECTORYNAME '{DSK})
'DIRECTORY]
(fromDir←(if (AND volume (STREQUAL (SUBSTRING toDir 1 (NCHARS volume))
(MKSTRING volume)))
then (SUBSTRING toDir 2+(NCHARS volume)
-1)
else toDir))
for f in files unless (if (LISTP f)
then (SELECTQ f:1
(TO toHost← (OR (FILENAMEFIELD
f:2
'HOST)
toHost)
toDir←
(FILENAMEFIELD f:2 'DIRECTORY))
(FROM fromHost← (OR (FILENAMEFIELD
f:2
'HOST)
fromHost)
fromDir←
(FILENAMEFIELD f:2 'DIRECTORY))
(ONLY onlyFlg←T)
(printout T T
"Option not TO, FROM or ONLY - ignoring "
f))
T)
join (if found←(OR (INFILEP (PACKFILENAME 'HOST
fromHost
'DIRECTORY
fromDir
'BODY
f))
(SPELLFILE f))
then (/PUT (ROOTFILENAME f)
'FILEHOME
(PACKFILENAME 'NAME
NIL
'EXTENSION
NIL
'VERSION
NIL
'BODY
found))
(dest←(COPYFILE found (PACKFILENAME 'HOST
toHost
'DIRECTORY
toDir
'VERSION
NIL
'BODY
f)))
(if CCachePrintMoves
then (printout T found " -> " dest T))
(CONS dest (AND onlyFlg=NIL (FILENAMEFIELD f 'EXTENSION)=NIL
(bind efnd edst for ext in CCacheFellowTravellers
when efnd←(OR (INFILEP (PACKFILENAME
'HOST
fromHost
'DIRECTORY
fromDir
'EXTENSION
ext
'BODY
f))
(SPELLFILE (PACKFILENAME
'EXTENSION
ext
'BODY
f)))
collect (edst←(COPYFILE efnd (PACKFILENAME
'HOST
toHost
'DIRECTORY
toDir
'VERSION
NIL
'EXTENSION
ext
'BODY
f)))
(if CCachePrintMoves
then (printout T efnd " -> " edst T))
edst)))
else (LIST 'not-found])
(SaveFile
[LAMBDA (file) (* ht: "22-Mar-85 10:17")
(let ((rfn (ROOTFILENAME file))
(candidateHomes (LIST '**other**
'NONE))
home val name mResult)
(if home←[OR (GETP rfn 'FILEHOME)
(AND (MEMB (FILENAMEFIELD rfn 'EXTENSION)
CCacheFellowTravellers)
(GETP name←(FILENAMEFIELD rfn 'NAME)
'FILEHOME]=NIL
then (printout T "Please choose a home directory for " (OR name rfn))
(pushnew candidateHomes (PACKFILENAME 'HOST
CCacheSafeHomes:1
'DIRECTORY
USERNAME))
(for d in (GETP (OR name rfn)
'FILEDATES)
when (MEMB (FILENAMEFIELD d::1 'HOST)
CCacheSafeHomes)
do (pushnew candidateHomes (PACKFILENAME 'NAME
NIL
'EXTENSION
NIL
'VERSION
NIL
'BODY
d::1)))
(if (MEMB (FILENAMEFIELD (DIRECTORYNAME T)
'HOST)
CCacheSafeHomes)
then (pushnew candidateHomes (DIRECTORYNAME T)))
(if CCachePreviousHome
then (pushnew candidateHomes CCachePreviousHome))
(home←(NLSETQ (SELECTQ (mResult←(MENU (create MENU
TITLE ←(PACK* "FILEHOME for "
(OR name rfn))
ITEMS ← candidateHomes)))
(NIL 'NONE)
(**other** (printout T ": ")
(READ))
mResult)))
(/PUT (OR name rfn)
'FILEHOME
home←(if home
then home:1
else 'NONE))
(TERPRI T))
(if (AND home home~= 'NONE)
then (val←(\SaveFile rfn file home))
(CCachePreviousHome←home)
(if (FILENAMEFIELD rfn 'EXTENSION)=NIL
then (bind friend for ext in CCacheFellowTravellers
when (AND friend←(ASSOC (PACKFILENAME 'EXTENSION
ext
'BODY
rfn)
NotSavedFiles::1)
friend::1)
collect (\SaveFile friend:1 friend::1 home)
finally (RETURN (if $$VAL
then (CONS val $$VAL)
else val)))
else val])
(SaveFiles
[NLAMBDA files (* ht: "20-Mar-85 11:24")
(if files
then (bind entry for f in files when (if entry←(ASSOC f NotSavedFiles::1)
then (\NeedSaved entry)
else (/PUTASSOC (FILENAMEFIELD f 'NAME)
(INFILEP f)
NotSavedFiles)
(\NeedSaved entry←(ASSOC f NotSavedFiles::1)))
collect (SaveFile entry::1))
else (for f in NotSavedFiles::1 when (\NeedSaved f) collect (SaveFile f::1])
(\NeedSaved
[LAMBDA (entry) (* ht: "22-Mar-85 10:08")
(AND entry::1 (GETP entry:1 'FILEHOME)
~=
'NONE
(if (MEMB (FILENAMEFIELD entry:1 'EXTENSION)
CCacheFellowTravellers)
then (GETP (FILENAMEFIELD entry:1 'NAME)
'FILEHOME)
~=
'NONE
else T)
(OR CCacheSaveAll (CDR (GETP (if (MEMB (FILENAMEFIELD entry:1 'EXTENSION)
CCacheFellowTravellers)
then (FILENAMEFIELD entry:1 'NAME)
else entry:1)
'FILE))=NIL])
(\SaveFile
[LAMBDA (rootName fullName home) (* ht: "22-Mar-85 09:28")
(let [(dest (COPYFILE fullName (PACKFILENAME 'HOST
(FILENAMEFIELD home 'HOST)
'DIRECTORY
(FILENAMEFIELD home 'DIRECTORY)
'VERSION
NIL
'BODY
fullName]
(if (CDR (ASSOC rootName NotSavedFiles))
then (printout T T "Note - " (FILENAMEFIELD home 'HOST)
" is not known to be a safe home -" T
"You should add it to CCacheSafeHomes if you wish it to be considered as such."
T)
(/PUTASSOC rootName NIL NotSavedFiles))
(if CCachePrintMoves
then (printout T fullName " -> " dest T))
dest])
)
(PUTPROPS REM.CM FILEHOME NONE)
(PUTPROPS EMPRESS.SCRATCH FILEHOME NONE)
(PUTPROPS CLEANUP READVICE [NIL (AFTER NIL (COND ((MEMB 'SAVE
(OR (LISTP (CAR (NLAMBDA.ARGS FILES)))
CLEANUPOPTIONS))
(bind (fileListOrNIL
←
(if (LISTP (CAR (NLAMBDA.ARGS FILES)))
then
(CDR (NLAMBDA.ARGS FILES))
else
(NLAMBDA.ARGS FILES)))
for f in (CDR NotSavedFiles)
when
(AND (OR (NULL fileListOrNIL)
(FMEMB (CAR f)
fileListOrNIL))
(\NeedSaved f))
do
(SaveFile (CDR f])
(PUTPROPS FILES? READVICE [NIL (AFTER NIL (bind fl for f on (CDR NotSavedFiles)
when
(\NeedSaved (CAR f))
do
(SETQ fl T)
(PRIN1 (CAAR f))
(if (for ff in (CDR f)
thereis
(\NeedSaved ff))
then
(PRIN1 ',))
finally
(if fl then (PRIN1 "...to be saved.")
(TERPRI])
(READVISE CLEANUP FILES?)
(* * What follows is compiled in advice, as these all get called a lot)
(DEFINEQ
(CCaching-MAKEFILE
[LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ht: " 8-Mar-85 21:43")
(PROG1 (BeforeCCache-MAKEFILE FILE OPTIONS REPRINTFNS SOURCEFILE)
(if (MEMB 'SAVE
OPTIONS)
then (SaveFile FILE])
(CCaching-OPENSTREAM
[LAMBDA (FILE ACCESS RECOG BYTESIZE PARAMETERS) (* ht: "22-Mar-85 10:55")
(let ((stream (BeforeCCache-OPENSTREAM FILE ACCESS RECOG BYTESIZE PARAMETERS))
fullName home)
(if (AND (FMEMB ACCESS '(OUTPUT BOTH APPEND))
(LITATOM fullName←(FULLNAME stream)))
then (if (AND (MEMB home←(FILENAMEFIELD fullName 'HOST)
CCacheUnsafeHomes)
(PROG1 (OR (STKNAME (STKNTH 1 'OPENSTREAM
CCacheStackPtr))
~=
'\COPYOPENFILE
(NOT (MEMB (FILENAMEFIELD (FULLNAME (STKARG 1 CCacheStackPtr))
'HOST)
CCacheSafeHomes)))
(RELSTK CCacheStackPtr)))
then (/PUTASSOC (ROOTFILENAME fullName)
fullName NotSavedFiles)
elseif (MEMB home CCacheSafeHomes)
then (/PUTASSOC (ROOTFILENAME fullName)
NIL NotSavedFiles)))
stream])
)
(pushnew CCacheUnsafeHomes (FILENAMEFIELD (DIRECTORYNAME '{DSK})
'HOST))
(for f in '(MAKEFILE OPENSTREAM)
do
(MOVD? f (PACK* 'BeforeCCache-
f))
(MOVD (PACK* 'CCaching-
f)
f))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA SaveFiles CacheFiles)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS CCACHE COPYRIGHT ("Speech Input Project, Univ. of Edinburgh" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2000 9101 (CacheFiles 2010 . 4885) (SaveFile 4887 . 7162) (SaveFiles 7164 . 7767) (
\NeedSaved 7769 . 8360) (\SaveFile 8362 . 9099)) (10218 11500 (CCaching-MAKEFILE 10228 . 10505) (
CCaching-OPENSTREAM 10507 . 11498)))))
STOP