"

 COPYRIGHT (c) 1999 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:libwidg2' }"

HierarchicalList subclass:#HierarchicalFileList

	instanceVariableNames:'matchBlock showCursor mountPoints indicatorList indicatorTask'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-Support'

!

HierarchicalItem subclass:#HierarchicalFileItem

	instanceVariableNames:'fileName icon fileInfo'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HierarchicalFileList

!

HierarchicalFileList::HierarchicalFileItem subclass:#File

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:HierarchicalFileList

!

HierarchicalFileList::HierarchicalFileItem subclass:#Directory

	instanceVariableNames:'modificationTime fetchOperation'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HierarchicalFileList

!

HierarchicalFileList::Directory subclass:#RemoteDirectory

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:HierarchicalFileList

!

!HierarchicalFileList class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1999 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.

"

! !

!HierarchicalFileList class methodsFor:'examples'!

examples

"

                                                                    [exBegin]

    |top sel list|

    list := HierarchicalFileList new.

    list directory:(Filename homeDirectory).

    list showRoot:false.

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

    top := StandardSystemView new; extent:300@300.

    sel := ScrollableView for:HierarchicalListView miniScroller:true

                       origin:0.0@0.0 corner:1.0@1.0 in:top.

    sel doubleClickAction:[:i| (list at:i) toggleExpand ].

    sel   indicatorAction:[:i| (list at:i) toggleExpand ].

    sel list:list.

    list monitoringTaskDelay:0.2.

    top open.

                                                                [exEnd]

"

! !

!HierarchicalFileList class methodsFor:'helpers'!

itemFor:aFileOrDirectoryName fileType:fileType

    "instance creation helper

    "

    fileType == #directory ifTrue:[

        ^ Directory fileName:aFileOrDirectoryName.

    ].

    fileType == #remoteDirectory ifTrue:[

        ^ RemoteDirectory fileName:aFileOrDirectoryName.

    ].

    ^ File fileName:aFileOrDirectoryName.

! !

!HierarchicalFileList methodsFor:'accessing'!

directory

    "returns the root directory or nil

    "

    ^ root notNil ifTrue:[root fileName] ifFalse:[nil]

!

directory:aDirectory

    "set the root directory or nil

    "

    self directory:aDirectory expand:true

!

directory:aDirectory expand:doExpand

    "set the root directory or nil

    "

    |directory|

"/    must explicitly enabled by user: ca

"/    monitoringTaskDelay := 1.

    (aDirectory notNil and:[(directory := aDirectory asFilename) exists]) ifTrue:[

        directory isDirectory ifFalse:[

            directory := directory directory

        ]

    ] ifFalse:[

        directory := nil

    ].

    directory = self directory ifFalse:[

        directory notNil ifTrue:[

            directory := self class itemFor:directory fileType:#directory.

            doExpand ifTrue:[ directory setExpanded:true ].

        ].

        self root:directory

    ].

!

root:aRoot

    "stop update-task

    "

    self criticalDo:[

        indicatorList ifNotNil:[

            indicatorList do:[:el| el resetFetchIndicator ].

            indicatorList removeAll.

        ]

    ].

    aRoot ifNotNil:[

        self showRoot ifFalse:[aRoot setExpanded:true ]

    ].

    ^ super root:aRoot

! !

!HierarchicalFileList methodsFor:'actions'!

matchBlock

    "set the matchBlock - if non-nil, it controls which files are visible.

    "

    ^ matchBlock

!

matchBlock:aBlock

    "set the matchBlock - if non-nil, it controls which files are visible.

    "

    matchBlock := aBlock.

    root notNil ifTrue:[

        self recursionLock critical:[

            self stopMonitoringTask.

            root matchBlockChanged.

        ].

        self startMonitoringTask.

    ].

! !

!HierarchicalFileList methodsFor:'private monitoring task'!

monitoringCycle

    "the block evaluated by the monitoring task; test whether directory is expanded

     otherwise we have not to evaluate the directory contents.

     think about remote file-systems

    "

    |index item mountInfo|

"/    mountPoints isNil ifTrue:[

"/        mountPoints := OperatingSystem mountPoints.

"/    ].

    item  := root.

    index := showRoot ifTrue:[1] ifFalse:[0].

    item isNil ifTrue:[

        item  := self at:index ifAbsent:nil.

    ].

    [item notNil] whileTrue:[

        item isDirectory ifTrue:[

            item monitoringCycle

        ].

"/        item isDirectory ifTrue:[

"/            (item getChildren isNil) ifTrue:[

"/                "/ care for auto-mount points - we dont want to look into those automatically

"/                "/ i.e. user must explicitely click into them

"/                mountInfo := mountPoints detect:[:mInfo | mInfo mountPointPath = item fileName name] ifNone:nil.

"/                (mountInfo notNil and:[mountInfo isRemote]) ifTrue:[

"/                    "/ type := #remoteFileSystem.

"/                    item readChildren

"/                ] ifFalse:[

"/                    "/ must read children info

"/                    item readChildren

"/                ].

"/            ] ifFalse:[

"/                "/ children already initialized; thus we can update the contents

"/                item monitoringCycle

"/            ].

"/        ].

        Processor yield.

        index := index + 1.

        item  := self at:index ifAbsent:nil.

    ].

! !

!HierarchicalFileList methodsFor:'protocol'!

childrenFor:anItem

    "returns all visible children derived from the physical

     directory contents.

    "

    |contents list matchBlock|

    anItem isDirectory ifFalse:[^ #()].

    contents := DirectoryContents directoryNamed:anItem fileName.

    contents ifNil:[ ^ #() ].

    list := OrderedCollection new.

    matchBlock := self matchBlockFor:anItem.

    matchBlock isNil ifTrue:[

        matchBlock := [:fn :isDir | true].

    ].

    contents itemsDo:[:item |

        |fn isDir type|

        fn := item fileName.

        isDir := item isDirectory.

        (matchBlock value:fn value:isDir) ifTrue:[

            |hierarchicalItem|

            hierarchicalItem := self class itemFor:fn fileType:item type.

            list add:hierarchicalItem.

        ]

    ].

    list isEmpty ifTrue:[^ #()].

    list sort:[:a :b|

        a isDirectory == b isDirectory ifTrue:[a baseName <= b baseName]

                                      ifFalse:[a isDirectory].

    ].

    ^ list

!

hasChildrenFor:anItem

    "returns true if the physical directory contains at least

     one visible item otherwise false.

    "

    |block|

    anItem isDirectory ifFalse:[

        ^ false

    ].

    (block := self matchBlockFor:anItem) isNil ifTrue:[

        block := [:aFilename :isDirectory| true ]

    ].

    ^ DirectoryContents directoryNamed:(anItem fileName) detect:block

!

iconFor:anItem

    "returns the icon for an item

    "

    (anItem isExpanded and:[anItem hasChildren]) ifTrue:[

        ^ FileBrowser iconForKeyMatching:#directoryOpen

    ].

    (anItem isRemoteDirectory) ifTrue:[

        ^ FileBrowser iconForKeyMatching:#directoryNetwork

    ].

    ^ FileBrowser iconForFile:(anItem fileName)

!

matchBlockFor:anItem

    "get the matchBlock - if non-nil, it controls which files are

     visible within the physical directory

    "

    ^ matchBlock        

! !

!HierarchicalFileList methodsFor:'searching'!

findLastForFile:aPathOrFile

    "find last item which matches the path or file

     returns the item or nil if not contained in self

    "

    |file searchItem rootDir rootComponents searchComponents|

    (aPathOrFile isNil or:[root isNil]) ifTrue:[

        ^ nil

    ].

    file := aPathOrFile asFilename.

    file exists ifFalse:[ ^ nil ].

    rootDir := root fileName asAbsoluteFilename.

        "not included"

        ^ nil

    ].

    rootComponents   := rootDir components.

    searchComponents := file components.

    searchItem       := root.

    searchComponents from:(rootComponents size + 1) do:[:aName| |child|

        child := searchItem detect:[:el| el baseName = aName ] ifNone:nil.

        child isNil ifTrue:[ ^ searchItem ].

        searchItem := child.

    ].

    ^ searchItem

! !

!HierarchicalFileList methodsFor:'update'!

startIndicatorValidationFor:anItem

    "an item will be registered for an indication update

    "

    |prio|

    self criticalDo:[

        indicatorList size == 0 ifTrue:[

            indicatorList := OrderedCollection new.

        ] ifFalse:[

            indicatorList removeIdentical:anItem ifAbsent:nil.

        ].

        "/ indicatorList addFirst:anItem.

        indicatorList add:anItem.

        indicatorTask ifNil:[

            prio := Processor activePriority.

            indicatorTask := [ self updateIndicatorCycle. ] forkAt:(prio - 1).

            indicatorTask priorityRange:(prio-1 to:prio).

        ]

    ].

!

stopIndicatorValidationFor:anItem

    "stop the indicator validation for an item

    "

    self criticalDo:[

        indicatorList ifNotNil:[

            indicatorList removeIdentical:anItem ifAbsent:nil.

            anItem resetFetchIndicator.

        ]

    ].

!

updateIndicatorCycle

    "run fetching indicator task cycle.

     This is done in the background to avoid long startup

     delays, in case the indicator information takes long to

     gather (i.e. when reading directories)

    "

    |repeat task item|

    repeat := true.

    task   := indicatorTask.

    [ [ task notNil ] whileTrue:[

        self criticalDo:[

            (     dependents    size ~~ 0       "/ no dependencies (stop task)

             and:[indicatorList size ~~ 0]      "/ nothing to do

            ) ifTrue:[

                item := indicatorList removeFirst.

                (self includesIdentical:item) ifFalse:[

                    "/ no longer visible

                    item resetFetchIndicator.

                    item := nil

                ]

            ] ifFalse:[

                item := indicatorTask := task := nil

            ]

        ].

        item ifNotNil:[

            item fetchIndicator.

            Processor yield.

        ].

     ]

    ] valueNowOrOnUnwindDo:[

        task ifNotNil:[

            "/ oops, process terminated

            self criticalDo:[

                "/ test whether a new task already started

                indicatorTask == task ifTrue:[

                    indicatorTask := nil

                ]

            ]

        ]

    ].

! !

!HierarchicalFileList::HierarchicalFileItem class methodsFor:'instance creation'!

fileName:aFileName

    "instance creation

    "

    ^ self new fileName:aFileName.

!

fileName:aFileName isDirectory:isDirectory

    "instance creation

    "

    |item|

    item := isDirectory ifTrue:[HierarchicalFileList::Directory new] ifFalse:[HierarchicalFileList::File new].

    item fileName:aFileName.

  ^ item

! !

!HierarchicalFileList::HierarchicalFileItem methodsFor:'accessing'!

baseName

    "returns the baseName

    "

    ^ fileName baseName.

"/    ^ baseName

!

changed:aParameter

    "the item changed; raise change notification

    "

    aParameter == #icon ifTrue:[ icon := nil ].

    super changed:aParameter.

!

fileName

    "returns the fileName

    "

    ^ fileName

!

fileName:fname

    "instance creation

    "

    fileName := fname.

"/    baseName := fname baseName.

!

filePropertyFor:aKey

    | suffix retVal |

    fileInfo isNil ifTrue:[

        fileInfo := IdentityDictionary new.

    ].

    retVal := fileInfo at:aKey ifAbsent:nil.

    retVal notNil ifTrue:[ ^ retVal].

    aKey == #suffix ifTrue:[

        suffix := (OperatingSystem isUNIXlike and:[(self baseName at:1) == $.]) ifTrue:[

            suffix := ''.

        ] ifFalse:[

            suffix := fileName suffix.

        ].

        fileInfo at:#suffix put:suffix.

        ^ suffix

    ].