"{ Package: 'stx:libtool' }"
AbstractDirectoryBrowser subclass:#DirectoryTreeBrowser
instanceVariableNames:'oldDropItem expandItemTimedBlock updateTreeSelection
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
"
An application for displaying directories as a tree.
To be used as a building block in file browsers and fileSelection dialogs.
This is used as the top-left component in the new fileBrowser.
[author:]
Christian Penk (penk@bierfix)
[see also:]
FileBrowserV2
"
!
examples
"
[exBegin]
DirectoryTreeBrowser open
[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: 'Cut'
#itemValue: #doCut
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Cut
)
#(#MenuItem
#label: 'Copy'
#itemValue: #doCopy
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Copy
)
#(#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
#label: 'New'
#translateLabel: true
#isVisible: #newVisibilityHolder
#submenuChannel: #newMenu
)
#(#MenuItem
#label: '-'
#isVisible: #newVisibilityHolder
)
#(#MenuItem
#enabled: #hasSelection
#label: 'Rename'
#itemValue: #treeViewFileRename
#translateLabel: true
#isVisible: #allowFileOperations
#shortcutKey: #Rename
)
#(#MenuItem
#enabled: #hasSelection
#label: 'Properties...'
#itemValue: #doShowProperties
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#enabled: #enableDirectoryUp
#label: 'Directory Up'
#itemValue: #doGoDirectoryUp
#translateLabel: true
)
#(#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
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#enabled: #selectedFilesIncludesNonRootDirectory
#label: 'Make Selected Directory new Root'
#itemValue: #doSetSelectionToRoot
#translateLabel: true
)
#(#MenuItem
#label: 'Re-/ Expand Directory'
#itemValue: #toggleExpandSelectedItem
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#itemValue: #updateCurrentDirectory
#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
!
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 updateList.
"/ 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
browser 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.
browser notNil ifTrue:[
browser 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'!
dropDestinationPath
|destination|
destination := self fileList draggedItem.
destination ifNil:[^ nil].
^ destination fileName.
!
dropOver:aDropContext
"called during drag & drop while moving over the widget."
|lineNr newDest pointerY|
inDropMode ifFalse:[^ self].
lineNr := self getLineNumberFor:aDropContext.
lineNr notNil ifTrue:[
newDest := self fileList at:lineNr ifAbsent:nil.
pointerY := aDropContext targetPoint y.
pointerY <= 3 ifTrue:[
self initiateAutoScrollUpFor:aDropContext.
] ifFalse:[
pointerY >= (browser height - 3) ifTrue:[
self initiateAutoScrollDownFor:aDropContext
].
].
].
(newDest isNil or:[newDest == self fileList draggedItem]) ifTrue:[
^ self
].
newDest isDirectory not ifTrue:[
newDest := nil.
canDropItem := false.
].
self dropTargetItemChangedTo:newDest in:aDropContext.
newDest notNil ifTrue:[
aDropContext dropSource argument == #archivApplication ifTrue:[
canDropItem := true.
] ifFalse:[
canDropItem := self canDropFiles:(aDropContext 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 makeIconGray:false.
current changed:#icon.
]
].
anItem ifNotNil:[
anItem isDirectory ifTrue:[
anItem makeIconGray:true.
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).
]
].
].
browser shown ifTrue:[
browser repairDamage.
].
!
expandForDrop:item with:aDropContext
aDropContext saveDraw:[
(self doExpand:item) ifTrue:[
self windowGroup processExposeEvents
].
]
!
getDisplayObjects:anArgument
|selectedItems string fnName stream|
selectedItems := self selectedItems.
selectedItems isEmpty ifTrue:[ ^ ''].
stream := WriteStream on:''.
stream nextPutAll:(selectedItems first baseName).
selectedItems size == 1 ifTrue:[
fnName := 'ui_menuitem.xpm'.
] ifFalse:[
fnName := 'ui_submenu_open.xpm'.
stream nextPutAll:' ... '.
stream nextPutAll:(selectedItems last baseName).
].
string := stream contents.
stream close.
fnName := 'ui_menuitem.xpm'.
^ Array with:(LabelAndIcon icon:(Image fromFile:fnName)
string:(Text string:string emphasis:#bold)
)
!
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"
|focusView key rawKey|
anEvent isKeyPressEvent ifFalse:[^ false].
focusView := anEvent targetView.
(focusView isNil or:[focusView ~~ browser]) ifTrue:[ ^ 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
].
^ 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 == #Cut) ifTrue:[
self doCut.
^ true
].
(key == #Copy) ifTrue:[
self doCopy.
^ true
].
(key == #Delete) ifTrue:[
self doDelete.
^ true
].
(key == #Paste) ifTrue:[
self pasteFiles.
^ true
].
^ false
! !
!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.
!
selectedItems
| selection |
selection := self treeSelectionHolder value.
selection isNil ifTrue:[ ^ #() ].
multipleSelect ifTrue:[^ selection ].
^ Array with:selection. "Wrap single value into Array"
! !
!DirectoryTreeBrowser methodsFor:'startup & release'!
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
browser := aWidget scrolledView.
browser hasConstantHeight:true.
browser openEditorAction:[:ln :aGC|
|field item filename newFileString rename newFilename alreadyAccepted|
alreadyAccepted := false.
browser closeEditorAction:[:editor |
alreadyAccepted ifFalse:[
editor acceptAction value:(editor contents).
].
].
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:true.
field acceptAction:[:x|
alreadyAccepted := true.
filename := item fileName.
newFileString := x asString withoutSeparators.
filename baseName ~= newFileString ifTrue:[
(self renameFile:filename to:newFileString update:false) ifTrue:[
newFilename := filename directory construct:newFileString.
self withWaitCursorDo:[
self updateAndSelect:(OrderedCollection with:newFilename).
]
].
].
aGC closeEditor.
(field leaveKey == #CursorUp
or:[field leaveKey == #CursorDown]) ifTrue:[
browser keyPress:field leaveKey x:0 y:0
].
field destroy. "/ takes it from my windowGroup; prevents it from shifting focus
browser requestFocus.
].
field font:(aGC font).
field contents:(item label).
].
field
] ifFalse:[
nil
]
].
browser multipleSelectOk:self multipleSelect.
!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
!
postOpen
self rootHolderChanged.
self currentFileNameHolderChangedForCommon.
self currentFileNameHolderChanged.
self sortFileListsBy:self sortPropertyInTree value.
self windowGroup addPreEventHook:self.
!
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
"
"/ Transcript showCR:'iconFor:anItem'.
draggedItem == anItem ifTrue:[
^ self grayDirectoryIcon.
].
^ super iconFor:anItem.
! !
!DirectoryTreeBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/DirectoryTreeBrowser.st,v 1.56 2003-03-30 13:07:54 cg Exp $'
! !