hg/stx-libtool: comparison AbstractFileBrowser.st

equal deleted inserted replaced

-:7fa17d36a91c
+:cf7d9fccade1
 ! !
 !AbstractFileBrowser methodsFor:'actions'!
 askForCommandFor:fileName thenDo:aBlock
-"setup and launch a querybox to ask for unix command.
+"setup and launch a querybox to ask for a unix command.
 Then evaluate aBlock passing the command-string as argument."
 |box osName commandString|
 osName := OperatingSystem platformName.
 ! !
 !AbstractFileBrowser methodsFor:'aspects'!
 applications
-"returns the list of registered applications
-"
 ^ aspects at:#applications
 !
 backgroundProcesses
 ! !
 !AbstractFileBrowser methodsFor:'aspects handling'!
 aspectFor:something ifAbsent:aBlock
-"returns the model for an aspect
+"returns the model for an aspect; these are stored in a common dictionary"
-"
 ^ self aspectFor:something ifAbsent:aBlock notPresentDo:nil
 !
 aspectFor:aKey ifAbsent:aBlock notPresentDo:notPresentBlock
-"return the model for an aspect"
+"returns the model for an aspect; these are stored in a common dictionary"
 |holder saveAspectItem aspect|
 holder := aspects at:aKey ifAbsent:[
 masterApplication notNil ifTrue:[
 ].
 ^ holder
 !
 aspectFor:something put:aValueHolder
+"stores the model for an aspect; these are stored in a common dictionary"
 aspects at:something put:aValueHolder
 !
 aspects
+"returns the common aspect dictionary"
 ^ aspects
 !
 runtimeAspectValueFor:something
 "returns the default aspect item from the class variable RuntimeAspects
 ! !
 !AbstractFileBrowser methodsFor:'aspects-visibility'!
 activityVisibilityChannel
-" activityVisibilityChannel switches the activity indicator on/off
+" activityVisibilityChannel switches the activity indicator on/off"
-"
 ^ self aspectFor:#activityVisibilityChannel ifAbsent:[ false asValue ].
 !
 openAlwaysInTextEditor
 ^ self aspectFor:#clipboard ifAbsent:[Clipboard new]
 !
 copyFilesToClipBoard:colOfFiles
-"defete current selected files/directories
-"
 self putInClipBoard:colOfFiles as:#copy.
 !
 cutFilesToClipBoard:colOfFiles
 "defete current selected files/directories
 ! !
 !AbstractFileBrowser methodsFor:'drag & drop'!
 canDropFiles:dropedObjects for:filename
-| filenameDirString filenameDir|
+|filenameDirString filenameDir|
 dropedObjects isEmpty ifTrue:[^ false].
 filenameDir := self getDirWithoutFileName:filename.
 filenameDir isWritable ifFalse:[^ false].
 filenameDirString := filenameDir asString.
 dropedObjects do:[:aDropObject |
-|dropFileName dropFileNameString|
+(self canDropObject:aDropObject into:filenameDir) ifFalse:[^ false].
-dropFileName := aDropObject theObject.
+"/        |dropFileName dropFileNameString physicalPathName|
-dropFileNameString := dropFileName asString.
+"/
-dropFileName isDirectory ifTrue:[
+"/        dropFileName := aDropObject theObject.
-(self fileName:filenameDirString startsWith:dropFileNameString) ifTrue:[
+"/        dropFileNameString := dropFileName asString.
-self notify:'Cannot drop a directory into one of its parent directories'.
+"/        dropFileName isDirectory ifTrue:[
-^ false
+"/            (self fileName:filenameDirString startsWith:dropFileNameString) ifTrue:[
-]
+"/                self notify:'Cannot drop a directory into one of its parent directories'.
-] ifFalse:[
+"/                ^ false
-| physicalPathName |
+"/            ]
-physicalPathName := dropFileName physicalPathName.
+"/        ] ifFalse:[
-(filenameDirString = dropFileName directory asString
+"/            physicalPathName := dropFileName physicalPathName.
-or:[ aDropObject isFileInArchive not and:[physicalPathName notNil
+"/            (filenameDirString = dropFileName directory asString
-and:[ filenameDirString = physicalPathName asFilename directory asString]]]) ifTrue:[
+"/            or:[ aDropObject isFileInArchive not and:[physicalPathName notNil
-self notify:'Cannot drop a file into same directory'.
+"/                 and:[ filenameDirString = physicalPathName asFilename directory asString]]]) ifTrue:[
-^ false
+"/                self notify:'Cannot drop a file into same directory'.
-]
+"/                ^ false
+"/            ]
+"/        ]
+].
+self notify:nil.
+^ true
+!
+canDropObject:aDropObject into:aDirectory
+|filenameDirString dropFileName dropFileNameString physicalPathName|
+dropFileName := aDropObject theObject.
+dropFileNameString := dropFileName asString.
+dropFileName isDirectory ifTrue:[
+filenameDirString := aDirectory asString.
+(self fileName:filenameDirString startsWith:dropFileNameString) ifTrue:[
+self notify:'Cannot drop a directory into one of its parent directories'.
+^ false
 ]
-].
+] ifFalse:[
-^ true
+physicalPathName := dropFileName physicalPathName.
+(aDirectory = dropFileName directory
+or:[ aDropObject isFileInArchive not
+and:[physicalPathName notNil
+and:[ aDirectory = physicalPathName asFilename directory]]]) ifTrue:[
+self notify:'Cannot drop a file into same directory'.
+^ false
+]
+].
+^ true.
 !
 doStartDrag:aDropSource in:aView
 "set the cursors before starting the drag & drop operation
 "
 self notify:msg.
 ^ copy result
 !
 copyFiles:aColOfSourceFiles to:aDirectory
-"copy aColOfSourceFiles to aDirectory
-"
 |copy|
 self withWaitCursorDo:[
 copy := FileOperation copyFiles:aColOfSourceFiles to:aDirectory.
 copy result ifFalse:[
 ! !
 !AbstractFileBrowser methodsFor:'menu queries-tools'!
 anySTFilesPresent
 ^ self anyFilesPresentWithSuffix:'st'
 !
 canCreateNewProject
 ^ nil
 !
 anyFilesPresentWithSuffix:suffix
 |directories|
 directories := self currentDirectories value.
 directories do:[:dir|
 [
 ^ self fileListIsEmpty not.
 !
 fileName:aFilename1 startsWith:aFilename2
+" check if aFilename2 is a prefix of aFilename1"
-" check if aFilename2 starts with the same directories like aFilename1 "
 | file1 file2 |
-aFilename2 isNil ifTrue:[ ^ false].
+(aFilename2 isNil or:[aFilename1 isNil]) ifTrue:[ ^ false].
-aFilename1 isNil ifTrue:[ ^ false].
 file1 := aFilename1 asFilename.
 file2 := aFilename2 asFilename.
 file2 isRootDirectory ifTrue:[ ^ true].
 ((file1 isDirectory)
 and:[(file2 isDirectory)
 and:[file1 directory = file2 directory]]) ifTrue:[
 ^ file1 baseName = file2 baseName
 ].
 ! !
 !AbstractFileBrowser class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.289 2005-04-25 14:33:08 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.290 2005-04-26 12:16:00 cg Exp $'
 ! !

changeset 6284	cf7d9fccade1
parent 6281	e8e47b1b290f
child 6286	fac153824f35