"{ 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: '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

!

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