Rename.st
changeset 1585 91ec771207a2
child 1588 6dde5ad32643
--- /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$'
+! !