DirectoryTreeBrowser.st
author Claus Gittinger <cg@exept.de>
Mon, 20 Jan 2020 21:02:47 +0100
changeset 19422 c6ca1c3e0fd7
parent 19358 4a5ebaaac37d
child 19484 0724ad57f9b9
permissions -rw-r--r--
#REFACTORING by exept class: MultiViewToolApplication added: #askForFile:default:forSave:thenDo: changed: #askForFile:default:thenDo: #askForFile:thenDo: #menuSaveAllAs #menuSaveAs

"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 2002 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libtool' }"

"{ NameSpace: Smalltalk }"

AbstractDirectoryBrowser subclass:#DirectoryTreeBrowser
	instanceVariableNames:'oldDropItem expandItemTimedBlock updateTreeSelection
		doubleClickAction newVisibilityHolder allowFileOperations
		multipleSelect treeSelectionHolder sortInTreeVisibilityHolder
		sortPropertyInTree sortCaseless'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Tools-File'
!

HierarchicalFileList subclass:#DirTreeBrowserHFL
	instanceVariableNames:'draggedItem grayDirectoryIcon'
	classVariableNames:''
	poolDictionaries:''
	privateIn:DirectoryTreeBrowser
!

!DirectoryTreeBrowser class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2002 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

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'!

openOn:aFileName
    | file |

    file := aFileName asFilename.
    file exists ifTrue:[
        ^ self openOn:aFileName withFiles:(file isDirectory not)
    ].
    ^ self open

"
    DirectoryTreeBrowser openOn:Filename homeDirectory   
    DirectoryTreeBrowser openOn:(Filename homeDirectory construct:'.bashrc')  
"
!

openOn:aFileName withFiles:aBoolean

    |instance|

    instance := self new.
    instance open.
    instance viewFilesInDirectoryTree value:aBoolean.
    instance currentFileNameHolder value:(OrderedCollection with:aFileName).
    ^ instance

"
    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)
          bounds: (Rectangle 0 0 300 300)
          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:
              autoScrollHorizontal: false
              postBuildCallback: postBuildDirBrowser:
              properties: 
             (PropertyListDictionary
                enterSelector: dropEnter:
                dragArgument: directoryTreeBrowser
                startDragSelector: doStartDrag:in:
                displayObjectSelector: getDisplayObjects:
                dropObjectSelector: getDropObjects:
                overSelector: dropOver:
                dropArgument: directoryTreeBrowser
                canDropSelector: canDrop:
                leaveSelector: dropLeave:
                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
            keepLinkedMenu: true
          )
         (MenuItem
            label: '-'
            isVisible: newVisibilityHolder
          )
         (MenuItem
            enabled: hasSelection
            label: 'Rename'
            itemValue: renameFileInTreeView
            translateLabel: true
            isVisible: allowFileOperations
            shortcutKey: Rename
          )
         (MenuItem
            enabled: hasSelection
            label: 'Rename each to Include Directory in Name'
            itemValue: renameToIncludeDirectoryInNameInTreeView
            translateLabel: true
            isVisible: allowFileOperations
          )
         (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
                  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
            isVisible: sortInTreeVisibilityHolder
            hideMenuOnActivated: false
            choice: sortPropertyInTree
            choiceValue: baseName
          )
         (MenuItem
            label: 'By Type'
            translateLabel: true
            isVisible: sortInTreeVisibilityHolder
            hideMenuOnActivated: false
            choice: sortPropertyInTree
            choiceValue: suffix
          )
         (MenuItem
            label: 'By Size'
            translateLabel: true
            isVisible: sortInTreeVisibilityHolder
            hideMenuOnActivated: false
            choice: sortPropertyInTree
            choiceValue: fileSize
          )
         (MenuItem
            label: 'By Date && Time'
            translateLabel: true
            isVisible: sortInTreeVisibilityHolder
            hideMenuOnActivated: false
            choice: sortPropertyInTree
            choiceValue: modificationTime
          )
         (MenuItem
            label: '-'
            isVisible: sortInTreeVisibilityHolder
          )
         (MenuItem
            label: 'Ignore Case in Sort'
            translateLabel: true
            hideMenuOnActivated: false
            indication: sortCaseless
          )
         )
        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)."

    ^ #(
        treeSelectionHolder
        rootHolder
        filterModel
        showFiles
        showHiddenFiles
      ).
! !

!DirectoryTreeBrowser methodsFor:'accessing'!

allowRenameOnOneClick

    ^ false
!

browser
    "return the value of the instance variable 'browser' (automatically generated)"

    ^ browser
!

directory
    ^ self fileList directory.

    "Created: / 17-07-2018 / 12:55:22 / Claus Gittinger"
!

doubleClickAction

    ^ doubleClickAction
!

doubleClickAction:aBlock

    " aBlock is a one arg block with selected index as argument "

    doubleClickAction := aBlock
!

updateTreeSelection
    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
    "

    |indicatorItem selectedItemNotUnderIndicatorItem selection|

    indicatorItem := self fileList at:anIndex ifAbsent:nil.
    selection := self selectedItems asOrderedCollection.
    selectedItemNotUnderIndicatorItem := 
        selection 
            detect:[:anItem |
                (anItem fileName directory asString startsWith:(indicatorItem fileName asString)) not] 
            ifNone:[nil].
    selectedItemNotUnderIndicatorItem isNil ifTrue:[
        self setCurrentFileName:(indicatorItem fileName).
    ].
    self toggleExpand:indicatorItem.
!

doSetSelectionToRoot
    | selDir|

    selDir := self firstSelectedDirectory.
    selDir notNil ifTrue:[
        self rootHolder value asFilename = selDir ifTrue:[ ^ self].
        self rootHolder value:selDir.
        self setCurrentFileName: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.
!

expandEnforceSelectedItems
" expand the selected item if one directory selected"

    | items |

    items := self selectedDirectoryItems.
    items do:[:eachItem |
        eachItem enforcedExpand
    ].
!

expandSelectedItems
" expand the selected item if one directory selected"

    | items |

    items := self selectedDirectoryItems.
    items do:[:eachItem |
        eachItem expand
    ].
!

renameFileInTreeView
    self allowRenameOnOneClick ifTrue:[
        browser openEditor.
    ] ifFalse:[
        browser openEditorAction:self openEditorAction.
        [browser openEditor.] ensure:[
            browser openEditorAction:nil.
        ].
    ].
!

renameToIncludeDirectoryInNameInTreeView
    |numAffected|

    numAffected := 0.
    self withWaitCursorDo:[
        self selectedDirectories do:[:eachDirectory |
            |prefix|

            prefix := eachDirectory baseName , '_'.   
            eachDirectory directoryContentsAsFilenamesDo:[:eachFile |
                (eachFile baseName startsWith:prefix) ifFalse:[
                    numAffected := numAffected + 1.
                ].                              
            ].                              
        ].
    ].
    numAffected == 0 ifTrue:[
        Dialog information:(resources string:'No files to rename').
        ^ self.
    ].
    (Dialog confirm:(resources stringWithCRs:'Continue renaming %1 files?' with:numAffected)) ifFalse:[^ self].

    self withWaitCursorDo:[
        self selectedDirectories do:[:eachDirectory |
            |prefix|

            prefix := eachDirectory baseName , '_'.   
            eachDirectory directoryContentsAsFilenamesDo:[:eachFile |
                (eachFile baseName startsWith:prefix) ifFalse:[
                    eachFile renameTo:(eachDirectory construct:(prefix,eachFile baseName)).
                ].                              
            ].                              
        ].
    ].
!

setMatchBlockInList:list

    | selection matchBlock filterBlock viewFiles|

    selection := self selectedItems.
    filterBlock := self filterBlockHolder value.
    viewFiles := self viewFilesInDirectoryTree value.

    matchBlock := 
        [:fileName :isDir|
            |show|

            show := self showHiddenFiles value or:[fileName isHidden not].
            show
                and:[ isDir 
                      or:[viewFiles and:[filterBlock value:fileName value:fileName baseName]]]
        ].
    list matchBlock:matchBlock.
!

sortFileListsBy:instanceName 

    |aSymbol instanceSortBlock treeSortBlock locSortCaseless|

    locSortCaseless := self sortCaseless value.
    aSymbol := instanceName asSymbol.

    instanceSortBlock := 
        [:a :b | 
            |entry1 entry2|

            entry1 := (a perform:aSymbol).
            entry2 := (b perform:aSymbol).
            ((entry1 isNil) or:[entry2 isNil]) ifTrue:[
                true
            ] ifFalse:[
                (aSymbol = #baseName) ifTrue:[
                    entry1 := entry1 asString.
                    entry2 := entry2 asString.
                    locSortCaseless ifTrue:[
                        entry1 := entry1 asLowercase.
                        entry2 := entry2 asLowercase.
                    ].
                ].
                entry1 < entry2
            ]
        ].

    treeSortBlock := 
        [ :a :b |
            |aIsDir bIsDir res entry1 entry2|

            aIsDir := a isDirectory.
            bIsDir := b isDirectory.
            (aIsDir and:[bIsDir]) ifTrue:[
                entry1 := a baseName asString.
                entry2 := b baseName asString.
                locSortCaseless ifTrue:[
                    entry1 := entry1 asLowercase.
                    entry2 := entry2 asLowercase.
                ].
                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:[
"/        self withWaitCursorDo:[
            anItem toggleExpand
"/        ]
    ].

    "Modified: / 25-07-2006 / 09:09:05 / cg"
!

toggleExpandSelectedItem
    |selDir|

    selDir := self selectedDirectoryItems.
    selDir do:[:item|
        self toggleExpand:item.
    ].
!

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 setMatchBlockInList:list.
        "/ do not set the directory holder in startup
        "/ list directory:(self rootHolder value).
        builder aspectAt:#fileList put:list.
        "/ list monitoringTaskDelay:2
    ].
    ^ list

    "Modified: / 08-09-2006 / 13:29:17 / cg"
!

multipleSelect
    ^ multipleSelect ? false
!

multipleSelect:aBoolean
    multipleSelect := aBoolean.
    browser notNil ifTrue:[
        browser multipleSelectOk:aBoolean.
    ].
!

newVisibilityHolder
    "newVisibilityHolder"

    newVisibilityHolder isNil ifTrue:[
        newVisibilityHolder := true asValue.
    ].
    ^ newVisibilityHolder.
!

sortCaseless    
    sortCaseless isNil ifTrue:[
        sortCaseless := super sortCaseless.
        sortCaseless addDependent:self.
    ].
    ^ sortCaseless.
!

sortCaseless:aValueHolder
    sortCaseless notNil ifTrue:[
        sortCaseless removeDependent:self.
    ].
    sortCaseless := aValueHolder.
    sortCaseless notNil ifTrue:[
        sortCaseless addDependent:self.
    ].
!

sortCaselessInTreeBrowser
    <resource: #obsolete>

    "only for backward compat.
     We do not need two such flags"

    ^ self sortCaseless
!

sortInTreeVisibilityHolder
    "newVisibilityHolder
    "
    sortInTreeVisibilityHolder isNil ifTrue:[
        sortInTreeVisibilityHolder := self viewFilesInDirectoryTree value asValue.
    ].
    ^ sortInTreeVisibilityHolder.
!

sortPropertyInTree

    sortPropertyInTree isNil ifTrue:[
        sortPropertyInTree := #baseName asValue.
        sortPropertyInTree addDependent:self.
    ].
    ^ sortPropertyInTree.
!

sortPropertyInTree:aValueHolder
    sortPropertyInTree removeDependent:self.
    sortPropertyInTree := aValueHolder.
    sortPropertyInTree addDependent:self.
!

treeSelectionHolder
    treeSelectionHolder isNil ifTrue:[
        treeSelectionHolder := ValueHolder new.
        treeSelectionHolder addDependent:self.
    ].
    ^ treeSelectionHolder
!

treeSelectionHolder:aValueHolder
    treeSelectionHolder removeDependent:self.
    treeSelectionHolder := aValueHolder.
    treeSelectionHolder addDependent:self.
! !

!DirectoryTreeBrowser methodsFor:'change & update'!

changeMatchBlock
    self setMatchBlockInList:(self fileList).
    self currentFileNameHolderChanged.
!

currentFileNameHolderChanged
    |filesToSelect viewFiles|

    viewFiles:= self viewFilesInDirectoryTree value.
    viewFiles ifTrue:[
        filesToSelect := self currentSelectedObjects.
    ] ifFalse:[
        filesToSelect := self currentSelectedDirectories.
    ].
    self rootHolder notNil ifTrue:[
        self selectFiles:filesToSelect.
    ].

    "Modified: / 04-12-2006 / 13:15:42 / cg"
!

rootHolderChanged
    |list file rootHolder|

    list := self fileList.
    rootHolder := self rootHolder.
    file := rootHolder value.
    file notNil ifTrue:[
        file := file asFilename.
        file isDirectory ifTrue:[
"/            self withWaitCursorDo:[
                list directory:file
"/            ].
        ]
    ].
    rootHolder value:(list directory asString) withoutNotifying:self.
    (list size == 1 and:[list first isDirectory]) ifTrue:[list first expand:true]

    "Modified: / 25-07-2006 / 09:08:59 / cg"
!

selectionChanged
    |sel currentFileDir|

    "if viewFiles is false i can't take my 
     selection to overwrite currentFileNameHolder"
    sel := self selectedFiles.
    self viewFilesInDirectoryTree value ifFalse:[
        (self currentFilesAreInSameDirectory 
         and:[sel size == 1 and:[self currentSelectedObjects notEmpty]]) ifTrue:[
            currentFileDir := self class getDirectoryOf:(self currentSelectedObjects first).
            sel first = currentFileDir ifTrue:[
                ^ self.
            ].
        ].
    ].
    self setCurrentFileNames:sel.

    "Modified: / 04-12-2006 / 13:15:51 / cg"
!

update:something with:aParameter from:aModel 
    "one of my models changed"

    "the execution of selectionChanged and currentFileNameHolderChanged must
     lock against each other because values aren't required to be the same 
     (e.g. no files in tree view)"

    (aModel == self currentFileNameHolder or:[aModel == self currentDirectories]) 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 sortCaseless ifTrue:[
        self sortPropertyInTree setValue:#baseName; 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 isNil ifTrue:[^ nil].

    ^ destination fileName.
!

dropOver:aDropContext 
    "called during drag & drop while moving over the widget."

    |lineNr newDest|

    inDropMode ifFalse:[^ self].

    lineNr  := self getLineNumberFor:aDropContext.
    lineNr notNil ifTrue:[
        newDest := self fileList at:lineNr ifAbsent:nil.
    ].
    (newDest isNil or:[newDest == self fileList draggedItem]) ifTrue:[
        ^ self
    ].
    newDest isDirectory ifFalse:[
        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 notNil ifTrue:[
        current isDirectory ifTrue:[
            self removeExpandItemTimedBlock.
            current makeIconGray:false.
            current changed:#icon.
        ]
    ].

    anItem notNil ifTrue:[
        anItem isDirectory ifTrue:[
            anItem makeIconGray:true.
            anItem changed:#icon.
            (anItem notNil and:[anItem fileName isWritableDirectory]) ifTrue:[
                self 
                    setupAutoExpandItemTimedBlock:
                        [
                            self expandForDrop:anItem with:aDropContext.    
                        ].
            ]
        ].
    ].
    browser shown ifTrue:[
        browser repairDamage.
    ].

    "Modified: / 08-08-2010 / 14:42:21 / cg"
!

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 := CharacterWriteStream with:(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:(string allBold))

    "Modified (format): / 20-06-2017 / 08:17:36 / cg"
!

removeExpandItemTimedBlock
    |b|

    (b := expandItemTimedBlock) notNil ifTrue:[
        expandItemTimedBlock := nil.
        Processor removeTimedBlock:b.
    ]
!

setupAutoExpandItemTimedBlock:aBlock
    expandItemTimedBlock := aBlock.
    Processor 
        addTimedBlock:expandItemTimedBlock
        afterMilliseconds:(self class timeForExpandOnDropInMilliseconds).
! !

!DirectoryTreeBrowser methodsFor:'event handling'!

processEvent:anEvent
    "filter keyboard events.
     Return true, if I have eaten the event"

    <resource: #keyboard (#CursorLeft #FocusPrevious #FocusNext
                          #Cut #Copy #Delete #Replace #Paste 
                          #BackSpace)>

    |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 renameFileInTreeView.
        ^ true
    ].
    (key == #Cut) ifTrue:[
        self doCut.
        ^ true
    ].
    (key == #Copy) ifTrue:[
        self doCopy.
        ^ true
    ].
    ((key == #Delete) or:[ key == #BackSpace ]) ifTrue:[
        self doDelete.
        ^ true
    ].
    (key == #Paste) ifTrue:[
        self pasteFiles.
        ^ true
    ].

    ^ false
! !

!DirectoryTreeBrowser methodsFor:'queries'!

hasOpenEditor

    ^ browser hasOpenEditor
!

masterIsFileBrowser

    ^ self masterApplication isKindOf: FileBrowserV2

    "Modified: / 04-05-2012 / 16:24:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

selectedFilesIncludesNonRootDirectory
    ^ self selectedDirectories contains:[:aDir | (aDir asString) ~= (self rootHolder value)].

"/    |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"

    |root items directory item newRoot rootDir|

    aColOfFileOrDirectory isEmpty ifTrue:[ 
        self selectItems:#().
        ^ self.
    ].

    root := self fileList root. 
    root notNil ifTrue:[ rootDir := root fileName asAbsoluteFilename ].

    items := OrderedCollection new.
    aColOfFileOrDirectory do:[:eachFile|
        (eachFile notNil and:[eachFile exists]) ifTrue:[
            item := self fileList findLastForFile:eachFile inRoot:root directory:rootDir.
            item isNil ifTrue:[
                "/ set a new root directory
                newRoot := self commonPrefixOfFiles:(aColOfFileOrDirectory collect:[:each | each directory]).
                newRoot := self class getDirectoryOf:newRoot.
                newRoot := newRoot pathName.
                newRoot ~= self rootHolder value ifTrue:[
                    self rootHolder value:newRoot.
                ].
                item := self fileList root.

                eachFile isDirectory ifTrue:[ directory := eachFile ]
                                 ifFalse:[ directory := eachFile directory ]
                                  .
                directory == eachFile ifFalse:[
                    item := item detect:[:el| el fileName = eachFile ] ifNone:item.
                ].
            ].
            item notNil ifTrue:[
                "if it is a directory it should be expanded"
                "/ item enforcedExpand.
                items add:item.
            ].
        ].
    ].
    self selectItems:items

    "Modified: / 12-07-2012 / 11:31:20 / cg"
    "Modified: / 11-04-2019 / 18:03:58 / Stefan Vogel"
!

selectItems:aColOfItems
    |currentSelection newSelection|

    currentSelection := self selectedItems.
"/    aColOfItems do:[:anItem| anItem isDirectory ifTrue:[ anItem expand ]].

    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 do:#makeVisible.
    ].
    self updateToExternFileHolderLock doLocked:[
        self treeSelectionHolder value:newSelection.
    ].

    "Modified: / 17-07-2018 / 13:29:56 / Claus Gittinger"
!

selectNextFile
    self halt:'unimplemented'.
!

selectPreviousFile
    self halt:'unimplemented'.
!

selectedDirectories
    ^ self selectedDirectoryItems collect:[: el | el fileName ].
!

selectedDirectoryItems
    ^ self selectedItems select:[: el | el isDirectory ].
!

selectedFilenameDirectories
    ^ self selectedItems 
        collect:[:item | self class getDirectoryOf:(item fileName)] 
        as:Set
!

selectedItems
    | selection |

    selection := self treeSelectionHolder value.
    selection isNil ifTrue:[ ^ #() ].
    self multipleSelect ifTrue:[^ selection ].
    ^ Array with:selection. "Wrap single value into Array"
! !

!DirectoryTreeBrowser methodsFor:'startup & release'!

makeDependent

    super makeDependent.
    self currentFileNameHolder addDependent:self.
    self currentDirectories addDependent:self.
    self rootHolder addDependent:self.
    self viewFilesInDirectoryTree addDependent:self.
    self filterBlockHolder addDependent:self.
!

openEditorAction 
    ^ [:ln :aGC | 
                self openEditorIn:aGC forLine:ln
    ].
!

openEditorIn:aGC forLine:ln 
    |item alreadyAccepted filename field newFileString newFilename|

    alreadyAccepted := false.
    browser 
        closeEditorAction:[:editor | 
            alreadyAccepted ifFalse:[
                editor acceptAction value:(editor contents)
            ]
        ].

    self allowFileOperations value ifFalse:[^ nil].

    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 := field contents 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.
                browser requestFocus    "/ takes it from my windowGroup; prevents it from shifting focus
            ].
        field font:(aGC font).
        field contents:(item label)
    ].
    ^ field

    "Modified: / 25-07-2006 / 09:08:45 / cg"
!

postBuildDirBrowser:aWidget 
    browser := aWidget scrolledView.
    "/ browser hasConstantHeight:true.
    self allowRenameOnOneClick ifTrue:[
        browser openEditorAction:self openEditorAction
    ].
    browser multipleSelectOk:self multipleSelect
!

postOpenFromMaster:fromMaster

"/    self windowGroup application class == FileBrowserV2 ifTrue:[
"/        self multipleSelect:true.
"/    ].
    self rootHolderChanged.
    fromMaster ifFalse:[
        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 := (MIMETypeIconLibrary 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$'
!

version_CVS
    ^ '$Header$'
! !