"{ Package: 'stx:libtool' }"
AbstractFileBrowser subclass:#DirectoryTreeBrowser
instanceVariableNames:'dirBrowser updateToExternFileHolderLock oldDropItem
expandItemTimedBlock updateTreeSelection inDropMode canDropItem
doubleClickAction newVisibilityHolder allowFileOperations
multipleSelect treeSelectionHolder sortInTreeVisibilityHolder
sortPropertyInTree sortCaselessInTreeBrowser'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools-File'
!
HierarchicalFileList subclass:#DirTreeBrowserHFL
instanceVariableNames:'draggedItem grayDirectoryIcon'
classVariableNames:''
poolDictionaries:''
privateIn:DirectoryTreeBrowser
!
!DirectoryTreeBrowser class methodsFor:'documentation'!
documentation
"
documentation to be added.
[author:]
Christian Penk (penk@bierfix)
[see also:]
[instance variables:]
[class variables:]
"
!
examples
"
Starting the application:
[exBegin]
DirectoryTreeBrowser open
[exEnd]
more examples to be added:
[exBegin]
... add code fragment for
... executable example here ...
[exEnd]
"
! !
!DirectoryTreeBrowser class methodsFor:'instance creation'!
open
^ super open
"
DirectoryTreeBrowser open
"
!
openOn:aFileName
| file |
file := aFileName asFilename.
file exists ifTrue:[
self openOn:aFileName withFiles:(file isDirectory not)
]
"
DirectoryTreeBrowser openOn:Filename homeDirectory
DirectoryTreeBrowser openOn:(Filename homeDirectory construct:'.bashrc')
"
!
openOn:aFileName withFiles:aBoolean
| instance|
instance := DirectoryTreeBrowser new.
instance open.
instance viewFilesInDirectoryTree value:aBoolean.
instance currentFileNameHolder value:(OrderedCollection with:aFileName).
"
DirectoryTreeBrowser openOn:Filename homeDirectory
DirectoryTreeBrowser openOn:(Filename homeDirectory construct:'.bashrc') withFiles:false
"
! !
!DirectoryTreeBrowser class methodsFor:'defaults'!
timeForExpandOnDropInMilliseconds
^ 1500
! !
!DirectoryTreeBrowser class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:DirectoryTreeBrowser andSelector:#windowSpec
DirectoryTreeBrowser new openInterface:#windowSpec
DirectoryTreeBrowser open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'DirectoryTreeBrowser'
#name: 'DirectoryTreeBrowser'
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
#bounds: #(#Rectangle 16 42 316 342)
#menu: #mainMenu
)
#component:
#(#SpecCollection
#collection: #(
#(#HierarchicalListViewSpec
#name: 'HierarchicalListView'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#model: #treeSelectionHolder
#menu: #menu
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: false
#miniScrollerVertical: false
#listModel: #fileList
#multipleSelectOk: true
#useIndex: false
#highlightMode: #label
#doubleClickSelector: #doDoubleClick:
#indicatorSelector: #doIndicatorClick:
#postBuildCallback: #postBuildDirBrowser:
#properties:
#(#PropertyListDictionary
#overSelector: #dropOver:
#dragArgument: #directoryTreeBrowser
#startDragSelector: #doStartDrag:in:
#displayObjectSelector: #getDisplayObjects:
#dropObjectSelector: #getDropObjects:
#dropArgument: #directoryTreeBrowser
#canDropSelector: #canDrop:
#leaveSelector: #dropLeave:
#enterSelector: #dropEnter:
#dropSelector: #doDrop:
)
)
)
)
)
! !
!DirectoryTreeBrowser class methodsFor:'menu specs'!
menu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:DirectoryTreeBrowser andSelector:#menu
(Menu new fromLiteralArrayEncoding:(DirectoryTreeBrowser menu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Copy'
#itemValue: #doCopy
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Copy
)
#(#MenuItem
#label: 'Cut'
#itemValue: #doCut
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Cut
)
#(#MenuItem
#enabled: #canPaste
#label: 'Paste'
#itemValue: #pasteFiles
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Paste
)
#(#MenuItem
#label: 'Delete'
#itemValue: #doDelete
#nameKey: #delete
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Delete
)
#(#MenuItem
#label: '-'
#isVisible: #allowFileOperations
)
#(#MenuItem
#enabled: #hasSelection
#label: 'Rename'
#itemValue: #treeViewFileRename
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Rename
)
#(#MenuItem
#enabled: #hasSelection
#label: 'Properties...'
#itemValue: #doShowProperties
#translateLabel: true
)
#(#MenuItem
#label: '-'
#isVisible: #allowFileOperations
)
#(#MenuItem
#enabled: #selectedFilesIncludesNonRootDirectory
#label: 'Set Root to Selection'
#itemValue: #doSetSelectionToRoot
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New'
#translateLabel: true
#isVisible: #newVisibilityHolder
#submenuChannel: #newMenu
)
#(#MenuItem
#label: 'More'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#enabled: #enableDirectoryUp
#label: 'Directory Up'
#itemValue: #doGoDirectoryUp
#translateLabel: true
)
#(#MenuItem
#label: 'Re-/ Expand Directory'
#itemValue: #toggleExpandSelectedItem
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'View'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#enabled: #sortInTreeVisibilityHolder
#label: 'Sort'
#nameKey: #Sort
#translateLabel: true
#submenuChannel: #sortInTreeMenu
)
#(#MenuItem
#label: 'Show'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Files'
#translateLabel: true
#indication: #viewFilesInDirectoryTree
)
)
nil
nil
)
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#itemValue: #doUpdate
#translateLabel: true
)
)
nil
nil
)
!
sortInTreeMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:DirectoryTreeBrowser andSelector:#sortInTreeMenu
(Menu new fromLiteralArrayEncoding:(DirectoryTreeBrowser sortInTreeMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'By Filename'
#translateLabel: true
#hideMenuOnActivated: false
#choice: #sortPropertyInTree
#choiceValue: #baseName
)
#(#MenuItem
#label: 'By Type'
#translateLabel: true
#hideMenuOnActivated: false
#choice: #sortPropertyInTree
#choiceValue: #suffix
)
#(#MenuItem
#label: 'By Size'
#translateLabel: true
#hideMenuOnActivated: false
#choice: #sortPropertyInTree
#choiceValue: #fileSize
)
#(#MenuItem
#label: 'By Date && Time'
#translateLabel: true
#hideMenuOnActivated: false
#choice: #sortPropertyInTree
#choiceValue: #modificationTime
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Ignore Case in Sort'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #sortCaselessInTreeBrowser
)
)
nil
nil
)
! !
!DirectoryTreeBrowser class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#selectedDirectoryModel
).
! !
!DirectoryTreeBrowser methodsFor:'accessing'!
doubleClickAction
^ doubleClickAction
!
doubleClickAction:aBlock
" aBlock is a one arg block with selected index as argument "
doubleClickAction := aBlock
!
updateToExternFileHolderLock
"return the value of the instance variable 'updateToExternFileHolder' (automatically generated)"
updateToExternFileHolderLock isNil ifTrue:[
updateToExternFileHolderLock := self class newLock.
].
^ updateToExternFileHolderLock
!
updateTreeSelection
"return the value of the instance variable 'updateToExternFileHolder' (automatically generated)"
updateTreeSelection isNil ifTrue:[
updateTreeSelection := self class newLock.
].
^ updateTreeSelection
! !
!DirectoryTreeBrowser methodsFor:'actions'!
doDoubleClick:anIndex
"handle a doubleClick on a directory
"
| item file isDirectory|
self doubleClickAction notNil ifTrue:[
self doubleClickAction value:anIndex.
].
item := self fileList at:anIndex ifAbsent:nil.
item notNil ifTrue:[
isDirectory := item isDirectory.
file := item fileName.
isDirectory ifTrue:[
(file isReadable and:[file isExecutable]) ifTrue:[
self doExpand:item.
]
] ifFalse:[
"/ self openApplByFileItem:item.
]
]
!
doExpand:anItem
" expand the item; return true the item have expanded "
(anItem notNil and:[anItem isDirectory and:[anItem isExpanded not]]) ifTrue:[
anItem toggleExpand.
^ true.
].
^ false
!
doIndicatorClick:anIndex
"handle a click on the indicator
"
|item|
item := self fileList at:anIndex ifAbsent:nil.
self toggleExpand:item
!
doSetSelectionToRoot
| selDir|
selDir := self firstSelectedDirectory.
selDir notNil ifTrue:[
self rootHolder value asFilename = selDir ifTrue:[ ^ self].
self rootHolder value:selDir.
self currentFileNameHolder value:(OrderedCollection with:selDir).
].
!
doUpdate
DirectoryContents flushCache.
self fileList monitoringCycle.
"/ self updateSelectedItem
!
evaluateSortBlockWith:aBlock
| sel model|
model := self treeSelectionHolder.
sel := model value.
model setValue:nil.
self fileList sortBlock:aBlock.
model value:sel withoutNotifying:self.
!
setMatchBlockForList:list
| selection matchBlock filterBlock viewFiles|
selection := self selectedItems.
filterBlock := self filterBlockHolder value.
viewFiles := self viewFilesInDirectoryTree value.
matchBlock := [:fileName :isDir|
(isDir
or:[viewFiles
and:[filterBlock value:fileName baseName]])
].
list matchBlock:matchBlock.
!
sortFileListsBy:instanceName
| aSymbol cmpOp instanceSortBlock treeSortBlock|
aSymbol := instanceName asSymbol.
cmpOp := #'<'.
instanceSortBlock := [:a :b |
|entry1 entry2|
entry1 := (a perform:aSymbol).
entry2 := (b perform:aSymbol).
((entry1 isNil) or:[entry2 isNil]) ifTrue:[
true
] ifFalse:[
(aSymbol = #baseName) ifTrue:[
self sortCaselessInTreeBrowser value ifTrue:[
entry1 := entry1 asString asLowercase.
entry2 := entry2 asString asLowercase.
] ifFalse:[
entry1 := entry1 asString.
entry2 := entry2 asString.
].
].
entry1 perform:cmpOp with:entry2
]
].
treeSortBlock := [ :a :b |
|aIsDir bIsDir res|
aIsDir := a isDirectory.
bIsDir := b isDirectory.
(aIsDir and:[bIsDir]) ifTrue:[
| entry1 entry2 |
entry1 := a baseName.
entry2 := b baseName.
res := entry1 < entry2.
] ifFalse:[
(aIsDir or:[bIsDir]) ifTrue:[
res := aIsDir
] ifFalse:[
res := instanceSortBlock value:a value:b.
]
].
res
].
self evaluateSortBlockWith:treeSortBlock.
!
toggleExpand:anItem
(anItem notNil and:[anItem isDirectory]) ifTrue:[
anItem toggleExpand
].
!
toggleExpandSelectedItem
|selDir|
selDir := self selectedDirectoryItems.
selDir do:[:item|
self toggleExpand:item.
].
!
treeViewFileRename
dirBrowser openEditor.
!
updateSelectedItem
| sel |
sel := self selectedItems.
sel isEmpty ifTrue:[ ^ self].
sel do:[:item|
item invalidateRepairNow:true.
]
! !
!DirectoryTreeBrowser methodsFor:'aspects'!
allowFileOperations
"allowFileOperations
"
allowFileOperations isNil ifTrue:[
allowFileOperations := true asValue.
].
^ allowFileOperations.
!
fileList
"holder, which keeps the current list of file entries shown by the directory-browser
"
|list|
(list := builder bindingAt:#fileList) isNil ifTrue:[
list := DirTreeBrowserHFL new.
list application:self.
list showRoot:true.
self setMatchBlockForList:list.
list directory:(self rootHolder value).
builder aspectAt:#fileList put:list.
list monitoringTaskDelay:2
].
^ list
!
multipleSelect
multipleSelect isNil ifTrue:[
multipleSelect := true.
].
^ multipleSelect
!
multipleSelect:aBoolean
multipleSelect := aBoolean.
dirBrowser multipleSelectOk:aBoolean.
!
newVisibilityHolder
"newVisibilityHolder
"
newVisibilityHolder isNil ifTrue:[
newVisibilityHolder := true asValue.
].
^ newVisibilityHolder.
!
sortCaselessInTreeBrowser
sortCaselessInTreeBrowser isNil ifTrue:[
sortCaselessInTreeBrowser := (Filename isCaseSensitive not) asValue.
sortCaselessInTreeBrowser addDependent:self.
].
^ sortCaselessInTreeBrowser.
!
sortInTreeVisibilityHolder
"newVisibilityHolder
"
sortInTreeVisibilityHolder isNil ifTrue:[
sortInTreeVisibilityHolder := self viewFilesInDirectoryTree value asValue.
].
^ sortInTreeVisibilityHolder.
!
sortPropertyInTree
sortPropertyInTree isNil ifTrue:[
sortPropertyInTree := #baseName asValue.
sortPropertyInTree addDependent:self.
].
^ sortPropertyInTree.
!
treeSelectionHolder
treeSelectionHolder isNil ifTrue:[
treeSelectionHolder := ValueHolder new.
treeSelectionHolder addDependent:self.
].
^ treeSelectionHolder
! !
!DirectoryTreeBrowser methodsFor:'change & update'!
changeMatchBlock
|list|
list := self fileList.
self setMatchBlockForList:list.
self currentFileNameHolderChanged.
!
currentFileNameHolderChanged
| selectFiles viewFiles|
viewFiles:= self viewFilesInDirectoryTree value.
viewFiles ifTrue:[
selectFiles := self currentFileNameHolder value.
] ifFalse:[
selectFiles := self currentDirectories value.
].
self rootHolder notNil ifTrue:[
self selectFiles:selectFiles.
self selectedItems do:[:item|
(item isDirectory and:[item isExpanded not]) ifTrue:[
item expand.
]
].
^ self
].
!
rootHolderChanged
|list file rootHolder|
list := self fileList.
rootHolder := self rootHolder.
file := rootHolder value.
file notNil ifTrue:[
file := Filename named:(file asString).
file isDirectory ifTrue:[
list directory:file
]
].
self rootHolder value:(list directory asString) withoutNotifying:self.
!
selectionChanged
|sel currentFileDir|
" if viewFiles is false i can't take my
selection to overwrite currentFileNameHolder"
sel := self selectedFiles.
(self viewFilesInDirectoryTree value not) ifTrue:[
(self currentFilesAreInSameDirectory and:[sel size == 1]) ifTrue:[
currentFileDir := self getDirWithoutFileName:(self currentFileNameHolder value first).
(sel first = currentFileDir) ifTrue:[
^ self.
].
].
].
self currentFileNameHolder value:sel.
!
update:something with:aParameter from:aModel
"one of my models changed
"
" the execution of selectionChanged and currentFileNameHolderChanged must
lock against each other because values dont must be the same (e.g. no files
in tree view)
"
aModel == self currentFileNameHolder ifTrue:[
super update:something with:aParameter from:aModel.
self updateTreeSelection doIfUnLocked:[
self updateToExternFileHolderLock doLocked:[
self currentFileNameHolderChanged.
].
].
^ self.
].
aModel == self treeSelectionHolder ifTrue:[
self updateToExternFileHolderLock doIfUnLocked:[
self updateTreeSelection doLocked:[
self selectionChanged.
]
].
^ self
].
aModel == self rootHolder ifTrue:[
self rootHolderChanged.
^ self.
].
aModel == self viewFilesInDirectoryTree ifTrue:[
self sortInTreeVisibilityHolder value:(aModel value).
self updateToExternFileHolderLock doLocked:[
self changeMatchBlock.
].
^ self.
].
aModel == self sortPropertyInTree ifTrue:[
self sortFileListsBy:aModel value.
^ self.
].
aModel == self sortCaselessInTreeBrowser ifTrue:[
self sortPropertyInTree setValue:#baseName.
self sortPropertyInTree changed.
].
aModel == self filterBlockHolder ifTrue:[
" filter goes only on fileNames not on directories
have to change the matchBlock only if files are shown"
self viewFilesInDirectoryTree value ifTrue:[
self changeMatchBlock.
].
^ self
].
super update:something with:aParameter from:aModel.
^ self
! !
!DirectoryTreeBrowser methodsFor:'drag & drop'!
canDrop:aContext
^ canDropItem
!
doDrop:aContext
|col destination destinationPath receiver|
destination := self fileList draggedItem.
self dropLeave:aContext.
destination ifNil:[^ false].
destinationPath := destination fileName.
aContext dropSource argument == #archivApplication ifTrue:[
receiver := aContext dropSource receiver.
receiver extractSelectedFilesTo:destinationPath askForExtractOptions:true.
^ true
].
col := OrderedCollection new.
aContext dropObjects do:[:obj |
col add:(obj theObject)
].
self copyOrMoveFiles:col to:destinationPath.
^ true
!
dropEnter:aContext
|dropedObjects|
self dropTargetItemChangedTo:nil in:aContext.
inDropMode := false.
dropedObjects := aContext dropObjects.
dropedObjects do:[:aObject| |checkObject checkObjectString|
aObject isFileObject ifFalse:[^ self].
checkObject := aObject theObject.
checkObject isFilename not ifTrue:[^ self].
((aContext dropSource argument == #archivApplication) not) ifTrue:[
checkObject isSpecialFile ifTrue:[^ self].
checkObject isReadable ifFalse:[^ self].
].
].
inDropMode := true.
!
dropLeave:aDropContext
"send the last time, when leaving the widget
"
inDropMode ifTrue:[
self dropTargetItemChangedTo:nil in:aDropContext.
self removeExpandItemTimedBlock.
inDropMode := false.
].
!
dropOver:aContext
"send the last time, when leaving the widget
"
|lineNr newDest|
inDropMode ifFalse:[^ self].
lineNr := self getLineNumberFor:aContext.
lineNr notNil ifTrue:[
newDest := self fileList at:lineNr ifAbsent:nil.
].
(newDest isNil or:[newDest == self fileList draggedItem]) ifTrue:[
^ self
].
newDest isDirectory not ifTrue:[
newDest := nil.
canDropItem := false.
].
self dropTargetItemChangedTo:newDest in:aContext.
newDest notNil ifTrue:[
aContext dropSource argument == #archivApplication ifTrue:[
canDropItem := true.
] ifFalse:[
canDropItem := self canDropFiles:(aContext dropObjects) for:newDest fileName.
].
].
!
dropTargetItemChangedTo:anItem in:aDropContext
|current|
current := self fileList draggedItem.
current == anItem ifTrue:[^ self].
self fileList draggedItem:anItem.
aDropContext contentsWillChange.
current ifNotNil:[
current isDirectory ifTrue:[
self removeExpandItemTimedBlock.
current changed:#icon.
]
].
anItem ifNotNil:[
anItem isDirectory ifTrue:[
anItem changed:#icon.
(anItem notNil and:[anItem isDirectory and:[anItem fileName isWritable]]) ifTrue:[
expandItemTimedBlock := [
self expandForDrop:anItem with:aDropContext.
].
Processor addTimedBlock:expandItemTimedBlock
afterMilliseconds:(self class timeForExpandOnDropInMilliseconds).
]
].
].
dirBrowser shown ifTrue:[
dirBrowser repairDamage.
].
!
expandForDrop:item with:aDropContext
aDropContext saveDraw:[
(self doExpand:item) ifTrue:[
self windowGroup processExposeEvents
].
]
!
getDisplayObjects:anArgument
| string fnName sel size stream|
sel := self selectedItems.
size := sel size.
size == 0 ifTrue:[^ ''].
stream := WriteStream on:''.
stream nextPutAll:sel first baseName.
size == 1 ifTrue:[
fnName := 'ui_menuitem.xpm'.
] ifFalse:[
fnName := 'ui_submenu_open.xpm'.
stream nextPutAll:' ... '.
stream nextPutAll:sel last baseName.
].
string := stream contents.
stream close.
fnName := 'ui_menuitem.xpm'.
^ Array with:(LabelAndIcon icon:(Image fromFile:fnName)
string:(Text string:string emphasis:#bold)
)
!
getDropObjects:anArgument
| sel ret|
sel := self selectedFiles.
sel isEmpty ifTrue:[ ^ self ].
ret := sel collect:[:file|
DropObject newFile:file
].
^ ret
!
getLineNumberFor:aDropContext
| yVisible|
yVisible := (aDropContext targetPoint y).
^ dirBrowser yVisibleToLineNr:yVisible.
!
removeExpandItemTimedBlock
expandItemTimedBlock notNil ifTrue:[
Processor removeTimedBlock:expandItemTimedBlock.
expandItemTimedBlock := nil
]
! !
!DirectoryTreeBrowser methodsFor:'event handling'!
processEvent:anEvent
"filter keyboard events.
Return true, if I have eaten the event"
|evView key rawKey|
anEvent isKeyPressEvent ifTrue:[
evView := anEvent targetView.
evView isNil ifTrue:[ ^ false].
evView == dirBrowser ifFalse:[ ^ false].
key := anEvent key.
rawKey := anEvent rawKey.
(key == #CursorLeft) ifTrue:[
"go to last selection in selection history"
(self rootSelected and:[(self fileList at:1) isExpanded not]) ifTrue:[
self doGoDirectoryUp.
^ true
] ifFalse:[
^ false
]
].
(key == #FocusPrevious) ifTrue:[
"go to last selection in selection history"
self doBack.
^ true
].
(key == #FocusNext) ifTrue:[
"go to next selection in selection history"
self doForward.
^ true
].
(key == #Replace) ifTrue:[
self treeViewFileRename.
^ true
].
(key == #Delete) ifTrue:[
self doDelete.
^ true
].
(key == #Cut) ifTrue:[
self doCut.
^ true
].
(key == #Paste) ifTrue:[
self pasteFiles.
^ true
].
(key == #Copy) ifTrue:[
self doCopy.
^ true
].
].
^ false
! !
!DirectoryTreeBrowser methodsFor:'file actions'!
doCopy
"copy current selected files/directories
"
self copyFilesToClipBoard:self selectedItems.
!
doCut
"cut current selected files/directories
"
self cutFilesToClipBoard:self selectedItems.
!
doDelete
"delete current selected files/directories
"
self deleteFiles:self selectedFiles.
! !
!DirectoryTreeBrowser methodsFor:'queries'!
masterIsFileBrowser
^ self masterApplication class = FileBrowserV2
!
selectedFilesIncludesNonRootDirectory
| directories|
directories := self selectedDirectories.
directories isEmpty ifTrue:[^ false].
directories do:[:aDir|
(aDir asString) ~= (self rootHolder value) ifTrue:[
^ true
]
].
^ false
! !
!DirectoryTreeBrowser methodsFor:'selection'!
firstSelectedDirectory
| selection dirs dirIndices|
selection := self selectedItems.
selection isEmpty ifTrue:[ ^ nil ].
dirs := selection collect:[:item| item isDirectory].
dirs isEmpty ifTrue:[^ nil].
dirIndices := selection collect:[:item |
self fileList identityIndexOf:item.
].
^ (self fileList at:(dirIndices min)) fileName.
!
rootSelected
| selectedItems |
selectedItems := self selectedItems.
selectedItems isEmpty ifTrue:[^ false].
^ selectedItems includesIdentical:self fileList root
!
selectFiles:aColOfFileOrDirectory
"selects a file; if the file is not included in my
root directory, the root will be changed
"
|items directory item newRoot|
aColOfFileOrDirectory isEmpty ifTrue:[ self selectItems:#()].
items := OrderedCollection new.
aColOfFileOrDirectory do:[:file|
file exists ifTrue:[
item := self fileList findLastForFile:file.
item isNil ifTrue:[
newRoot := self getCommonForCurrentFiles.
newRoot := self getDirWithoutFileName:newRoot.
self rootHolder value:newRoot.
item := self fileList root.
file isDirectory ifTrue:[ directory := file ]
ifFalse:[ directory := file directory ]
.
directory == file ifFalse:[
item := item detect:[:el| el fileName = file ] ifNone:item.
].
].
"/ set a new root directory
items add:item.
].
].
self selectItems:items
!
selectItems:aColOfItems
|currentSelection newSelection|
currentSelection := self selectedItems.
self multipleSelect ifTrue:[
currentSelection notNil ifTrue:[
aColOfItems size == currentSelection size ifTrue:[
(aColOfItems findFirst:[:item | (currentSelection includesIdentical:item) not ]) ~~ 0 ifFalse:[
^ self
].
]
].
newSelection := aColOfItems.
] ifFalse:[
newSelection := aColOfItems isEmpty ifTrue:[nil] ifFalse:[aColOfItems first].
newSelection == currentSelection ifTrue:[
^ self
]
].
aColOfItems notEmpty ifTrue:[
aColOfItems first makeVisible.
].
self updateToExternFileHolderLock doLocked:[
self treeSelectionHolder value:newSelection.
].
!
selectedDirectories
| selItems |
selItems := self selectedDirectoryItems.
^ selItems collect:[: el | el fileName ].
!
selectedDirectoryItems
| sel |
sel := self selectedItems.
^ sel select:[: el | el isDirectory ].
!
selectedFilenameDirectories
| selectedItems setOfDirectories|
selectedItems := self selectedItems.
setOfDirectories := Set new.
selectedItems do:[:item|
| filename|
filename := self getDirWithoutFileName:(item fileName).
setOfDirectories add:filename.
].
^ setOfDirectories.
!
selectedFiles
^ self selectedItems collect:[:item| item fileName].
!
selectedItems
| selection |
selection := self treeSelectionHolder value.
selection isNil ifTrue:[ ^ #() ].
multipleSelect ifTrue:[^ selection ].
^ Array with:selection. "Wrap single value into Array"
! !
!DirectoryTreeBrowser methodsFor:'startup & release'!
initialize
inDropMode := false.
^ super initialize.
!
makeDependent
super makeDependent.
self currentFileNameHolder addDependent:self.
self rootHolder addDependent:self.
self viewFilesInDirectoryTree addDependent:self.
self filterBlockHolder addDependent:self.
!
postBuildAsSubcanvasWith:aBuilder
super postBuildAsSubcanvasWith:aBuilder.
!
postBuildDirBrowser:aWidget
dirBrowser := aWidget scrolledView.
dirBrowser hasConstantHeight:true.
dirBrowser openEditorAction:[:ln :aGC| |field item filename newFileString rename newFilename|
self allowFileOperations value ifTrue:[
item := self fileList at:ln.
item label isString ifFalse:[
field := nil
] ifTrue:[
field := EditField new.
field level:0.
field acceptOnReturn:true.
field acceptOnLeave:false.
field acceptAction:[:x|
filename := item fileName.
newFileString := x at:1.
filename baseName = newFileString ifFalse:[
(self renameFile:filename to:newFileString update:false) ifTrue:[
newFilename := filename directory construct:newFileString.
self updateAndSelect:(OrderedCollection with:newFilename).
].
].
aGC closeEditor.
].
field font:(aGC font).
field contents:(item label).
].
field
].
].
!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
!
postOpen
self rootHolderChanged.
self abstractCurrentFileNameHolderChanged.
self currentFileNameHolderChanged.
self sortFileListsBy:self sortPropertyInTree value.
self windowGroup addPreEventHook:self.
!
postOpenAsSubcanvasWith:aBuilder
super postOpenAsSubcanvasWith:aBuilder.
self postOpen.
!
postOpenWith:aBuilder
"only invoked if the application not started from a master"
super postOpenWith:aBuilder.
self postOpen.
!
preBuildWith:aBuilder
self masterApplication isNil ifTrue:[
self masterApplication:nil.
].
^ super preBuildWith:aBuilder.
!
release
self fileList stopMonitoringTask.
^ super release.
! !
!DirectoryTreeBrowser::DirTreeBrowserHFL methodsFor:'accessing'!
draggedItem
^ draggedItem
!
draggedItem:anItemOrNil
draggedItem := anItemOrNil.
! !
!DirectoryTreeBrowser::DirTreeBrowserHFL methodsFor:'protocol'!
grayDirectoryIcon
grayDirectoryIcon isNil ifTrue:[
grayDirectoryIcon := (FileBrowser iconForKeyMatching:#directoryOpenGray).
].
^ grayDirectoryIcon
!
iconFor:anItem
"returns the icon for an item
"
draggedItem == anItem ifTrue:[
^ self grayDirectoryIcon.
].
^ super iconFor:anItem.
! !
!DirectoryTreeBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/DirectoryTreeBrowser.st,v 1.38 2002-12-28 14:52:14 cg Exp $'
! !