--- a/Rename.st Wed Sep 04 17:37:44 2002 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,193 +0,0 @@
-"{ Package: 'stx:libtool2' }"
-
-FileOperations subclass:#Rename
- instanceVariableNames:'renamedFiles'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support'
-!
-
-
-!Rename class methodsFor:'actions'!
-
-renameFile:oldFile to:newName
- "move from to
- "
-
- |instance|
-
- instance := self new.
- instance renameFile:oldFile to:newName.
- ^ instance
-!
-
-renameFiles:aColOfFiles
- "move from to
- "
-
- |instance|
-
- instance := self new.
- instance renameFiles:aColOfFiles.
- ^ 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'!
-
-renameFile: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.
-!
-
-renameFiles: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:[
- initialText := self class
- goodRenameDefaultFor:oldName
- lastOld:lastOldName
- lastNew:lastNewName
- ].
- initialText notNil ifTrue:[
- queryBox initialText:initialText
- ] ifFalse:[
- queryBox initialText:oldName
- ].
- queryBox
- action:[:newName |
- (self renameFile:oldFile to:newName asString) ifTrue:[
- result := true
- ].
- lastOldName := oldName.
- lastNewName := newName
- ].
- queryBox showAtPointer
- ]
-! !
-
-!Rename class methodsFor:'documentation'!
-
-version
- ^ '$Header$'
-! !