# HG changeset patch # User penk # Date 1031066602 -7200 # Node ID 91ec771207a24f3b370e0e380c8c95399e7f0773 # Parent 51c53d6656f4672f09ac3c478a8b289784239593 initial checkin diff -r 51c53d6656f4 -r 91ec771207a2 Copy.st --- /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$' +! ! diff -r 51c53d6656f4 -r 91ec771207a2 Create.st --- /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$' +! ! diff -r 51c53d6656f4 -r 91ec771207a2 Delete.st --- /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$' +! ! diff -r 51c53d6656f4 -r 91ec771207a2 FileOperations.st --- /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$' +! ! diff -r 51c53d6656f4 -r 91ec771207a2 Move.st --- /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$' +! ! diff -r 51c53d6656f4 -r 91ec771207a2 Rename.st --- /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$' +! !