--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Copy.st Tue Sep 03 17:23:22 2002 +0200
@@ -0,0 +1,114 @@
+"{ Package: 'stx:libtool2' }"
+
+FileOperations subclass:#Copy
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+
+!Copy class methodsFor:'actions'!
+
+copyFile:aSourceFile to:aDestFile
+ "delete current selected files/directories
+ "
+
+ |instance|
+
+ instance := self new.
+ instance copyFile:aSourceFile to:aDestFile.
+ ^ instance
+!
+
+copyFile:aSourceFile to:aDestFile withOverWriteWarning:overWriteWarning
+ "delete current selected files/directories
+ "
+
+ |instance|
+
+ instance := self new.
+ instance copyFile:aSourceFile to:aDestFile withOverWriteWarning:overWriteWarning.
+ ^ instance
+!
+
+copyFile:aSourceFile to:aDestFile withOverWriteWarning:overWriteWarning copyFileIfSame:copy
+ "delete current selected files/directories
+ "
+
+ |instance|
+
+ instance := self new.
+ instance copyFile:aSourceFile to:aDestFile withOverWriteWarning:overWriteWarning copyFileIfSame:copy.
+ ^ instance
+! !
+
+!Copy methodsFor:'actions'!
+
+copyFile:aSourceFile to:aDestFile
+ "defete current selected files/directories
+ "
+
+ self copyFile:aSourceFile to:aDestFile withOverWriteWarning:true
+!
+
+copyFile:aSourceFile to:aDestFile withOverWriteWarning:overWriteWarning
+ "copy to
+ "
+
+ self copyFile:aSourceFile to:aDestFile withOverWriteWarning:true copyFileIfSame:false
+!
+
+copyFile:aSourceFile to:aDestFile withOverWriteWarning:overWriteWarning copyFileIfSame:copy
+ "copy to
+ "
+
+ |newFile fileString|
+
+ aDestFile exists not ifTrue:[
+ DialogBox warn:'cant copy to:', aDestFile asString.
+ result := false.
+ ^ self
+ ].
+ newFile := (aDestFile pathName asFilename) construct:(aSourceFile baseName).
+ (newFile exists) ifTrue:[
+ ((newFile asString = aSourceFile asString) and:[copy]) ifTrue:[
+ [newFile exists] whileTrue:[
+ fileString := newFile baseName.
+ fileString := 'CopyOf', fileString.
+ newFile := (aDestFile pathName asFilename) construct:fileString.
+ ].
+ ] ifFalse:[
+ overWriteWarning ifTrue:[
+ (self fileExistDialogFor:newFile) ifFalse:[
+ result := false.
+ ^ self.
+ ]
+ ] ifFalse:[
+ result := false.
+ ^ self.
+ ]
+ ].
+ ].
+ Error handle:[:ex|
+ "was not able to copy it"
+ WarningBox warn:'on copy file - ', ex errorString.
+ self errorString:('on copy file - ', ex description asString).
+ result := false.
+ ] do:[
+ aSourceFile isDirectory ifFalse:[
+ aSourceFile copyTo:newFile.
+ ] ifTrue:[
+ OperatingSystem recursiveCopyDirectory:(aSourceFile pathName)
+ to:newFile.
+ ].
+ DirectoryContents flushCachedDirectory:(aSourceFile directory).
+ result := true.
+ ].
+! !
+
+!Copy class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Create.st Tue Sep 03 17:23:22 2002 +0200
@@ -0,0 +1,86 @@
+"{ Package: 'stx:libtool2' }"
+
+FileOperations subclass:#Create
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+
+!Create class methodsFor:'actions'!
+
+createDirectory:newName
+
+ |instance|
+
+ instance := self new.
+ instance createDirectory:newName.
+ ^ instance
+!
+
+createFile:newName
+
+ |instance|
+
+ instance := self new.
+ instance createFile:newName.
+ ^ instance
+! !
+
+!Create methodsFor:'actions'!
+
+createDirectory:newName
+ |msg|
+
+ newName exists ifTrue:[
+ DialogBox warn:(newName, ' already exists.').
+ result := false.
+ ^ self
+ ].
+
+ newName makeDirectory ifFalse:[
+ msg := errorString := ('cannot create directory '', newName,'' !!') , '\\(' , (OperatingSystem lastErrorString) , ')'.
+ errorString := msg withCRs.
+ DialogBox warn:errorString.
+ result := false.
+ ^ self
+ ].
+ result := true.
+!
+
+createFile:file
+ "create an empty file"
+
+ |aStream newName msg|
+
+ newName := file baseName.
+ file exists ifTrue:[
+ (Dialog
+ confirm:(newName, ' already exists\\truncate ?') withCRs
+ yesLabel:('Truncate')
+ noLabel:('Cancel'))
+ ifFalse:[^ self].
+ ].
+
+ FileStream openErrorSignal handle:[:ex|
+ msg := ('Cannot create file '', newName,'' !!') , '\\(' , (FileStream lastErrorString) , ')'.
+ errorString := msg withCRs.
+ ^ DialogBox warn:errorString
+ ] do:[
+ aStream := file newReadWriteStream.
+ ].
+ aStream notNil ifTrue:[
+ aStream close.
+ ] ifFalse:[
+ msg := ('Cannot create file '', newName, '' !!') , '\\(' , (FileStream lastErrorString) , ')'.
+ errorString := msg withCRs.
+ ^ DialogBox warn:errorString
+ ].
+! !
+
+!Create class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Delete.st Tue Sep 03 17:23:22 2002 +0200
@@ -0,0 +1,104 @@
+"{ Package: 'stx:libtool2' }"
+
+FileOperations subclass:#Delete
+ instanceVariableNames:'fileName errorString'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+
+!Delete class methodsFor:'actions'!
+
+deleteFile:aFileOrDirectory
+ "delete current selected files/directories
+ "
+
+ |instance|
+
+ instance := self new.
+ instance deleteFile:aFileOrDirectory.
+ ^ instance
+!
+
+deleteFiles:aColOfFiles
+ "delete current selected files/directories
+ "
+
+ |instance|
+
+ instance := self new.
+ instance deleteFiles:aColOfFiles.
+ ^ instance
+! !
+
+!Delete methodsFor:'actions'!
+
+deleteFile:aFileOrDirectory
+
+ | file isDirectory |
+
+ aFileOrDirectory notNil ifTrue:[
+ file := aFileOrDirectory asFilename.
+
+ file exists ifTrue:[
+ isDirectory := file isDirectory.
+
+ Error handle:[:ex|
+ "was not able to remove it"
+ Smalltalk beep.
+ self errorString:((ex description, '\', ex signal notifierString) withCRs).
+ result := false.
+ ] do:[
+ isDirectory ifTrue:[file recursiveRemove] ifFalse:[file remove].
+
+ "/ flush parent directory or directory
+ DirectoryContents flushCachedDirectory:(file directory).
+ ]
+ ]
+ ].
+ result := true.
+!
+
+deleteFiles:colOfFiles
+ "delete current selected files/directories
+ "
+ | retVal ask size|
+
+ ask := true.
+ size := colOfFiles size.
+ colOfFiles do:[: filename |
+ ask ifTrue:[
+ size = 1 ifTrue:[
+ retVal := Dialog
+ confirmWithCancel:('really delete ', filename asString , ' ?')
+ labels:#('Yes' 'No' 'Cancel')
+ values:#(#yes #no #cancel)
+ default:1.
+ ] ifFalse:[
+ retVal := Dialog
+ confirmWithCancel:('really delete ', filename asString , ' ?')
+ labels:#('Yes' 'No' 'Yes to All' 'Cancel')
+ values:#(#yes #no #yesToAll #cancel)
+ default:1.
+ ]
+ ].
+ retVal == #cancel ifTrue:[
+ ^ self.
+ ].
+ retVal == #yes ifTrue:[
+ self deleteFile:filename.
+ ].
+ retVal == #yesToAll ifTrue:[
+ self deleteFile:filename.
+ ask := false.
+ retVal := #yes.
+ ].
+ ].
+! !
+
+!Delete class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/FileOperations.st Tue Sep 03 17:23:22 2002 +0200
@@ -0,0 +1,68 @@
+"{ Package: 'stx:libtool2' }"
+
+Object subclass:#FileOperations
+ instanceVariableNames:'errorString result'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+
+!FileOperations methodsFor:'accessing'!
+
+errorString
+ "return the value of the static variable 'ErrorString' (automatically generated)"
+
+ ^ errorString
+!
+
+errorString:something
+ "set the value of the static variable 'ErrorString' (automatically generated)"
+
+ errorString := something.
+!
+
+result
+ "return the value of the instance variable 'result' (automatically generated)"
+
+ ^ result
+!
+
+result:something
+ "set the value of the instance variable 'result' (automatically generated)"
+
+ result := something.
+! !
+
+!FileOperations methodsFor:'dialogs'!
+
+fileExistDialogFor:aFile
+ | stream string|
+
+ aFile exists ifTrue:[
+ stream := WriteStream on:''.
+ stream nextPutAll:'overwrite '.
+ stream nextPutAll:(aFile asString).
+ stream nextPutAll:' from '.
+ (aFile modificationTime) printOn:stream format:'%(Day)-%(mon)-%(year) %h:%m:%s'.
+ stream nextPutAll:' with size of '.
+ stream nextPutAll:aFile fileSize asString.
+ stream cr.
+ stream nextPutAll:' with '.
+ stream nextPutAll:aFile asString.
+ stream nextPutAll:' from '.
+ (aFile modificationTime) printOn:stream format:'%(Day)-%(mon)-%(year) %h:%m:%s'.
+ stream nextPutAll:' with size of '.
+ stream nextPutAll:aFile fileSize asString.
+ string := stream contents.
+ stream close.
+ ^ (Dialog confirm:(string)).
+ ].
+ ^ true
+! !
+
+!FileOperations class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Move.st Tue Sep 03 17:23:22 2002 +0200
@@ -0,0 +1,55 @@
+"{ Package: 'stx:libtool2' }"
+
+FileOperations subclass:#Move
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+
+!Move class methodsFor:'actions'!
+
+moveFile:aSourceFile to:aDestFile
+ "move from to
+ "
+
+ |instance|
+
+ instance := self new.
+ instance moveFile:aSourceFile to:aDestFile.
+ ^ instance
+! !
+
+!Move methodsFor:'actions'!
+
+moveFile:aSourceFile to:aDestFile
+ "defete current selected files/directories
+ "
+
+ |newFile|
+
+ aDestFile exists not ifTrue:[
+ DialogBox warn:'cant move to:', aDestFile asString.
+ result := false.
+ ^ self
+ ].
+ newFile := (aDestFile pathName asFilename) construct:(aSourceFile baseName).
+ (self fileExistDialogFor:newFile) ifFalse:[
+ result := false.
+ ^ self.
+ ].
+ Error handle:[:ex|
+ DialogBox warn:ex errorString.
+ result := false.
+ ] do:[
+ aSourceFile renameTo:(aDestFile construct:(aSourceFile baseName)).
+ result := true.
+ ].
+! !
+
+!Move class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Rename.st Tue Sep 03 17:23:22 2002 +0200
@@ -0,0 +1,193 @@
+"{ Package: 'stx:libtool2' }"
+
+FileOperations subclass:#Rename
+ instanceVariableNames:'renamedFiles'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
+!
+
+
+!Rename class methodsFor:'actions'!
+
+filesRename:aColOfFiles
+ "move from to
+ "
+
+ |instance|
+
+ instance := self new.
+ instance filesRename:aColOfFiles.
+ ^ instance
+!
+
+renameFrom:oldFile to:newName
+ "move from to
+ "
+
+ |instance|
+
+ instance := self new.
+ instance renameFrom:oldFile to:newName.
+ ^ instance
+! !
+
+!Rename class methodsFor:'defaults'!
+
+goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName
+ |prefix suffix lastNewSize lastOldSize t
+ lastOldWOSuffix lastNewWOSuffix oldWOSuffix lastOldRest oldRest lastNewRest
+ lastRemoved lastInserted|
+
+ lastNewName isNil ifTrue:[ ^ nil].
+
+ lastNewSize := lastNewName size.
+ lastOldSize := lastOldName size.
+
+ "/ intelligent default ...
+ (lastNewName endsWith:lastOldName) ifTrue:[
+ prefix := lastNewName copyTo:(lastNewSize - lastOldSize).
+ ^ (prefix , oldName).
+ ].
+ (lastOldName endsWith:lastNewName) ifTrue:[
+ prefix := lastOldName copyTo:(lastOldSize - lastNewSize).
+ ^ (oldName copyFrom:prefix size+1).
+ ].
+ (lastOldName withoutSeparators = lastNewName) ifTrue:[
+ "/ intelligent default ...
+ ^ oldName withoutSeparators.
+ ].
+ (lastNewName startsWith:lastOldName) ifTrue:[
+ "/ intelligent default ...
+ suffix := lastNewName copyLast:(lastNewSize - lastOldSize).
+ ^ (oldName , suffix).
+ ].
+ (lastOldName startsWith:lastNewName) ifTrue:[
+ suffix := lastOldName copyLast:(lastOldSize - lastNewSize).
+ (oldName endsWith:suffix) ifTrue:[
+ ^ (oldName copyWithoutLast:suffix size).
+ ]
+ ].
+
+ lastOldWOSuffix := lastOldName asFilename withoutSuffix name.
+ lastNewWOSuffix := lastNewName asFilename withoutSuffix name.
+ oldWOSuffix := oldName asFilename withoutSuffix name.
+
+ prefix := lastOldWOSuffix commonPrefixWith:oldWOSuffix.
+ (lastNewWOSuffix startsWith:prefix) ifTrue:[
+ lastOldRest := lastOldWOSuffix copyFrom:prefix size + 1.
+ lastNewRest := lastNewWOSuffix copyFrom:prefix size + 1.
+ oldRest := oldWOSuffix copyFrom:prefix size + 1.
+
+ (lastNewRest endsWith:lastOldRest) ifTrue:[
+ t := lastNewRest copyWithoutLast:lastOldRest size.
+ ^ ((prefix , t , oldRest) asFilename withSuffix:oldName asFilename suffix) name
+ ].
+ ].
+
+ suffix := lastOldWOSuffix commonSuffixWith:lastNewWOSuffix.
+ suffix size > 0 ifTrue:[
+ "/ last change changed something at the beginning
+ prefix := oldWOSuffix commonPrefixWith:lastOldWOSuffix.
+ prefix size > 0 ifTrue:[
+ "/ this name starts with the same characters
+ lastRemoved := lastOldWOSuffix copyWithoutLast:suffix size.
+ lastInserted := lastNewWOSuffix copyWithoutLast:suffix size.
+ ^ lastInserted , (oldName copyFrom:lastRemoved size + 1)
+ ].
+ ].
+
+ ^ nil
+! !
+
+!Rename methodsFor:'accessing'!
+
+renamedFiles
+ "return the value of the instance variable 'lastRenamedFile' (automatically generated)"
+
+ renamedFiles isNil ifTrue:[
+ renamedFiles := OrderedCollection new.
+ ].
+ ^ renamedFiles
+! !
+
+!Rename methodsFor:'actions'!
+
+filesRename:aColOfFiles
+ "rename the selected file(s)"
+
+ |queryBox b lastNewName lastOldName initialText oldName|
+
+ queryBox := FilenameEnterBox new.
+ queryBox okText:'Rename'.
+ aColOfFiles size > 1 ifTrue:[
+ b := queryBox addAbortButtonLabelled:'Cancel All'.
+ b action:[^ self ].
+ ].
+
+ aColOfFiles do:[:oldFile |
+ oldName := oldFile baseName asString.
+ queryBox title:('Rename ', oldName, ' to:').
+
+ lastNewName notNil ifTrue:[
+ "/ intelligent default ...
+ initialText := self class goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName
+ ].
+ initialText notNil ifTrue:[
+ queryBox initialText:initialText.
+ ] ifFalse:[
+ queryBox initialText:oldName.
+ ].
+ queryBox action:[:newName |
+ (self renameFrom:oldFile to:newName asString) ifTrue:[
+ result := true.
+ ].
+ lastOldName := oldName.
+ lastNewName := newName.
+ ].
+
+ queryBox showAtPointer
+ ].
+!
+
+renameFrom:oldFile to:newName
+ "rename a file (or directory)"
+
+ |old new msg|
+
+ (oldFile isNil or:[newName isNil]) ifTrue:[
+ result := false
+ ].
+ (oldFile asString isBlank or:[newName isBlank]) ifTrue:[
+ result := false
+ ].
+ (oldFile baseName = newName) ifTrue:[
+ result := false
+ ].
+
+ old := oldFile.
+ new := oldFile directory construct:newName.
+
+ OperatingSystem errorSignal handle:[:ex|
+ msg := ('Cannot rename file ', old baseName,' to ', newName,' !!'), '\\(' ,(OperatingSystem lastErrorString) , ')'.
+ DialogBox warn:msg withCRs.
+ result := false
+ ] do:[
+ new exists ifTrue:[
+ (DialogBox confirm:(new baseName allBold, ' already exists - rename (i.e. overwrite) anyway ?'))
+ ifFalse:[
+ result := false.
+ ^ self.
+ ]
+ ].
+ old renameTo:new.
+ self renamedFiles add:new.
+ ].
+ result := true.
+! !
+
+!Rename class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !