"{ Package: 'stx:libtool' }"

AbstractFileBrowser subclass:#DirectoryTreeBrowser

	instanceVariableNames:'rootHolder dirBrowser updateToExternFileHolderLock oldDropItem

		expandItemTimedBlock updateTreeSelection inDropMode canDropItem

		doubleClickAction newVisibilityHolder allowFileOperations

		multipleSelect treeSelectionHolder'

	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'

            #translateLabel: true

            #isVisible: #allowFileOperations

            #value: #doCopy

            #shortcutKeyCharacter: #Copy

          )

         #(#MenuItem

            #label: 'Cut'

            #translateLabel: true

            #isVisible: #allowFileOperations

            #value: #doCut

            #shortcutKeyCharacter: #Cut

          )

         #(#MenuItem

            #label: 'Paste'

            #translateLabel: true

            #isVisible: #allowFileOperations

            #value: #pasteFiles

            #enabled: #canPaste

            #shortcutKeyCharacter: #Paste

          )

         #(#MenuItem

            #label: 'Delete'

            #translateLabel: true

            #nameKey: #delete

            #isVisible: #allowFileOperations

            #value: #doDelete

            #shortcutKeyCharacter: #Delete

          )

         #(#MenuItem

            #label: 'Rename'

            #translateLabel: true

            #isVisible: #allowFileOperations

            #value: #treeViewFileRename

            #shortcutKeyCharacter: #Replace

          )

         #(#MenuItem

            #label: '-'

            #isVisible: #allowFileOperations

          )

         #(#MenuItem

            #label: 'View Files in Directory Tree'

            #translateLabel: true

            #indication: #viewFilesInDirectoryTree

          )

         #(#MenuItem

            #label: 'Sort'

            #translateLabel: true

            #nameKey: #Sort

            #submenuChannel: #sortMenu

          )

         #(#MenuItem

            #label: 'Set Selection Top'

            #translateLabel: true

            #value: #doSetSelectionToTop

            #enabled: #selectedFilesIncludesNonRootDirectory

          )

         #(#MenuItem

            #label: '-'

          )

         #(#MenuItem

            #label: 'New'

            #translateLabel: true

            #isVisible: #newVisibilityHolder

            #submenuChannel: #newMenu

          )

         #(#MenuItem

            #label: 'Update'

            #translateLabel: true

            #value: #doUpdate

          )

         #(#MenuItem

            #label: 'Properties...'

            #translateLabel: true

            #value: #doShowProperties

            #enabled: #hasSelection

          )

         #(#MenuItem

            #label: 'Others'

            #submenu: 

           #(#Menu

              #(

               #(#MenuItem

                  #label: 'Directory Up'

                  #translateLabel: true

                  #value: #doGoDirectoryUp

                  #enabled: #enableDirectoryUp

                  #shortcutKeyCharacter: #CursorLeft

                )

               #(#MenuItem

                  #label: 'Re-/ Expand Directory'

                  #translateLabel: true

                  #value: #toggleExpandSelectedItem

                  #shortcutKeyCharacter: #CursorRight

                )

               )

              nil

              nil

            )

          )

         )

        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

!

doSetSelectionToTop

    | 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

    self fileList monitoringCycle.

"/    self updateSelectedItem

!

evaluateSortBlock

    self fileList sortBlock:(self sortBlockHolder value).

!

setMatchBlockForList:list

    | selection newSelection|

    selection := self selectedItems.

    self viewFilesInDirectoryTree value ifTrue:[

        | showHidden filter|

        showHidden := self showHiddenFiles value.

        filter := self filterModel value.

        filter = '' ifTrue:[

            filter := '*'.

        ].

        list matchBlock:[:fn :isDir| isDir or:[

                            (showHidden ifFalse:[

                                (fn baseName first = $.) not])

                             and:[filter match:fn baseName]]] 

    ] ifFalse:[

        list matchBlock:[:fn :isDir| isDir ].

    ].

    newSelection := OrderedCollection new.

    selection do:[:item|

        (self fileList includesIdentical:item) ifTrue:[

            newSelection add:item

        ]

    ].

    self updateToExternFileHolderLock doLocked:[

        self selectItems:newSelection.

    ]

!

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.

!