Rename.st
changeset 1585 91ec771207a2
child 1588 6dde5ad32643
equal deleted inserted replaced
1584:51c53d6656f4 1585:91ec771207a2
       
     1 "{ Package: 'stx:libtool2' }"
       
     2 
       
     3 FileOperations subclass:#Rename
       
     4 	instanceVariableNames:'renamedFiles'
       
     5 	classVariableNames:''
       
     6 	poolDictionaries:''
       
     7 	category:'Interface-Support'
       
     8 !
       
     9 
       
    10 
       
    11 !Rename class methodsFor:'actions'!
       
    12 
       
    13 filesRename:aColOfFiles
       
    14     "move from to
       
    15     "
       
    16 
       
    17     |instance|
       
    18 
       
    19     instance := self new.
       
    20     instance filesRename:aColOfFiles.
       
    21     ^ instance
       
    22 !
       
    23 
       
    24 renameFrom:oldFile to:newName
       
    25     "move from to
       
    26     "
       
    27 
       
    28     |instance|
       
    29 
       
    30     instance := self new.
       
    31     instance renameFrom:oldFile to:newName.
       
    32     ^ instance
       
    33 ! !
       
    34 
       
    35 !Rename class methodsFor:'defaults'!
       
    36 
       
    37 goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName
       
    38     |prefix suffix lastNewSize lastOldSize t
       
    39      lastOldWOSuffix lastNewWOSuffix oldWOSuffix lastOldRest oldRest lastNewRest
       
    40      lastRemoved lastInserted|
       
    41 
       
    42     lastNewName isNil ifTrue:[ ^ nil].
       
    43 
       
    44     lastNewSize := lastNewName size.
       
    45     lastOldSize := lastOldName size.
       
    46 
       
    47     "/ intelligent default ...
       
    48     (lastNewName endsWith:lastOldName) ifTrue:[
       
    49         prefix := lastNewName copyTo:(lastNewSize - lastOldSize).
       
    50         ^ (prefix , oldName).
       
    51     ].
       
    52     (lastOldName endsWith:lastNewName) ifTrue:[
       
    53         prefix := lastOldName copyTo:(lastOldSize - lastNewSize).
       
    54         ^ (oldName copyFrom:prefix size+1).
       
    55     ].
       
    56     (lastOldName withoutSeparators = lastNewName) ifTrue:[
       
    57         "/ intelligent default ...
       
    58         ^ oldName withoutSeparators.
       
    59     ].
       
    60     (lastNewName startsWith:lastOldName) ifTrue:[
       
    61         "/ intelligent default ...
       
    62         suffix := lastNewName copyLast:(lastNewSize - lastOldSize).
       
    63         ^ (oldName , suffix).
       
    64     ].
       
    65     (lastOldName startsWith:lastNewName) ifTrue:[
       
    66         suffix := lastOldName copyLast:(lastOldSize - lastNewSize).
       
    67         (oldName endsWith:suffix) ifTrue:[
       
    68             ^ (oldName copyWithoutLast:suffix size).
       
    69         ]
       
    70     ].
       
    71 
       
    72     lastOldWOSuffix := lastOldName asFilename withoutSuffix name.
       
    73     lastNewWOSuffix := lastNewName asFilename withoutSuffix name.
       
    74     oldWOSuffix := oldName asFilename withoutSuffix name.
       
    75 
       
    76     prefix := lastOldWOSuffix commonPrefixWith:oldWOSuffix.
       
    77     (lastNewWOSuffix startsWith:prefix) ifTrue:[
       
    78         lastOldRest := lastOldWOSuffix copyFrom:prefix size + 1.
       
    79         lastNewRest := lastNewWOSuffix copyFrom:prefix size + 1.
       
    80         oldRest := oldWOSuffix copyFrom:prefix size + 1.
       
    81 
       
    82         (lastNewRest endsWith:lastOldRest) ifTrue:[
       
    83             t := lastNewRest copyWithoutLast:lastOldRest size.
       
    84             ^ ((prefix , t , oldRest) asFilename withSuffix:oldName asFilename suffix) name
       
    85         ].
       
    86     ].
       
    87 
       
    88     suffix := lastOldWOSuffix commonSuffixWith:lastNewWOSuffix.
       
    89     suffix size > 0 ifTrue:[
       
    90         "/ last change changed something at the beginning
       
    91         prefix := oldWOSuffix commonPrefixWith:lastOldWOSuffix.
       
    92         prefix size > 0 ifTrue:[
       
    93             "/ this name starts with the same characters
       
    94             lastRemoved := lastOldWOSuffix copyWithoutLast:suffix size.
       
    95             lastInserted := lastNewWOSuffix copyWithoutLast:suffix size.
       
    96             ^ lastInserted , (oldName copyFrom:lastRemoved size + 1)
       
    97         ].
       
    98     ].
       
    99 
       
   100     ^ nil
       
   101 ! !
       
   102 
       
   103 !Rename methodsFor:'accessing'!
       
   104 
       
   105 renamedFiles
       
   106     "return the value of the instance variable 'lastRenamedFile' (automatically generated)"
       
   107 
       
   108     renamedFiles isNil ifTrue:[
       
   109         renamedFiles := OrderedCollection new.
       
   110     ].
       
   111     ^ renamedFiles
       
   112 ! !
       
   113 
       
   114 !Rename methodsFor:'actions'!
       
   115 
       
   116 filesRename:aColOfFiles
       
   117     "rename the selected file(s)"
       
   118 
       
   119     |queryBox b lastNewName lastOldName initialText oldName|
       
   120 
       
   121     queryBox := FilenameEnterBox new.
       
   122     queryBox okText:'Rename'.
       
   123     aColOfFiles size > 1 ifTrue:[
       
   124         b := queryBox addAbortButtonLabelled:'Cancel All'.
       
   125         b action:[^ self ].
       
   126     ].
       
   127 
       
   128     aColOfFiles do:[:oldFile |
       
   129         oldName := oldFile baseName asString.
       
   130         queryBox title:('Rename ', oldName, ' to:').
       
   131 
       
   132         lastNewName notNil ifTrue:[
       
   133             "/ intelligent default ...
       
   134             initialText := self class goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName
       
   135         ].
       
   136         initialText notNil ifTrue:[
       
   137             queryBox initialText:initialText.
       
   138         ] ifFalse:[                                            
       
   139             queryBox initialText:oldName.
       
   140         ].
       
   141         queryBox action:[:newName |
       
   142             (self renameFrom:oldFile to:newName asString) ifTrue:[
       
   143                 result := true.   
       
   144             ].
       
   145             lastOldName := oldName.
       
   146             lastNewName := newName.
       
   147         ].
       
   148 
       
   149         queryBox showAtPointer
       
   150     ].
       
   151 !
       
   152 
       
   153 renameFrom:oldFile to:newName
       
   154     "rename a file (or directory)"
       
   155 
       
   156     |old new msg|
       
   157 
       
   158     (oldFile isNil or:[newName isNil]) ifTrue:[
       
   159         result := false
       
   160     ].
       
   161     (oldFile asString isBlank or:[newName isBlank]) ifTrue:[
       
   162         result := false
       
   163     ].
       
   164     (oldFile baseName = newName) ifTrue:[
       
   165         result := false
       
   166     ].
       
   167 
       
   168     old := oldFile.
       
   169     new := oldFile directory construct:newName.
       
   170 
       
   171     OperatingSystem errorSignal handle:[:ex|
       
   172         msg := ('Cannot rename file ', old baseName,' to ', newName,' !!'), '\\(' ,(OperatingSystem lastErrorString) , ')'.
       
   173         DialogBox warn:msg withCRs.
       
   174         result := false
       
   175     ] do:[
       
   176         new exists ifTrue:[
       
   177             (DialogBox confirm:(new baseName allBold, ' already exists - rename (i.e. overwrite) anyway ?'))
       
   178             ifFalse:[
       
   179                 result := false.
       
   180                 ^ self.
       
   181             ]
       
   182         ].
       
   183         old renameTo:new.
       
   184         self renamedFiles add:new.
       
   185     ].
       
   186     result := true.
       
   187 ! !
       
   188 
       
   189 !Rename class methodsFor:'documentation'!
       
   190 
       
   191 version
       
   192     ^ '$Header$'
       
   193 ! !