HierarchicalFileList.st
author Stefan Vogel <sv@exept.de>
Fri, 04 Oct 2002 11:46:38 +0200
changeset 2248 528313883ea8
parent 2243 617c3310ee6e
child 2256 2a62b98fa33b
permissions -rw-r--r--
More speedup.

"
 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'
	classVariableNames:''
	poolDictionaries:''
	category:'Views-Support'
!

HierarchicalItem subclass:#HierarchicalFileItem
	instanceVariableNames:'fileName icon'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HierarchicalFileList
!

HierarchicalFileList::HierarchicalFileItem subclass:#File
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:HierarchicalFileList
!

HierarchicalFileList::HierarchicalFileItem subclass:#Directory
	instanceVariableNames:'modificationTime'
	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 list:list.
    list root expand.

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

    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
    "
    |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 
        ].
        self root:directory
    ].
! !

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

validateIcon:anIcon for:anItem
    ^ anIcon
! !

!HierarchicalFileList methodsFor:'searching'!

detectItemFor:aPathOrFilename
    "make a filename visible
    "
    |file node p1 p2 sz|

    aPathOrFilename isNil ifTrue:[^ nil].

    file := aPathOrFilename asFilename.

    file exists ifFalse:[
        ^ nil
    ].
    (node := root) isNil ifTrue:[^ nil].

    p1 := node pathName.
    p2 := file pathName.

    (p2 startsWith:p1) ifFalse:[^ nil].
    sz := 1 + p1 size.

    (p1 last == Filename separator) ifFalse:[
        sz := sz + 1.
    ].

    p2 size > sz ifFalse:[^ nil].

    p2 :=  Filename components:(p2 copyFrom:sz).

    p2 do:[:bn|
        node := node detect:[:el| el baseName = bn] ifNone:nil.
        node isNil ifTrue:[^ nil ].
    ].
    ^ node
! !

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

fileName
    "returns the fileName
    "
    ^ fileName


!

fileName:fname
    "instance creation
    "
    fileName := fname.
"/    baseName := fname baseName.
!

icon
    "returns the icon key
    "
    |model|

    icon isNil ifTrue:[
        model := self model.
        model ifNil:[^ nil].

        icon := model iconFor:self.
        icon notNil ifTrue:[
            icon := model validateIcon:icon for:self
        ]
    ].
    ^ icon.
!

label
    "returns the printable name, the baseName
    "
    ^ self baseName
!

pathName
    "returns the pathName
    "
    ^ fileName pathName
! !

!HierarchicalFileList::HierarchicalFileItem methodsFor:'invalidate'!

invalidate
    "invalidate the contents
    "
    self invalidateRepairNow:false

!

invalidateRepairNow
    "invalidate the contents; repair now
    "
    self invalidateRepairNow:true

!

invalidateRepairNow:doRepair
    "invalidate the contents; dependent on the boolean
     do repair immediately
    "


!

matchBlockChanged
    "called if the matchBlock changed
    "

! !

!HierarchicalFileList::HierarchicalFileItem methodsFor:'printing'!

printString

    ^ super printString, ' for: ', self fileName asString
! !

!HierarchicalFileList::HierarchicalFileItem methodsFor:'queries'!

isDirectory
    ^ false
!

isRemoteDirectory
    ^ false
! !

!HierarchicalFileList::File methodsFor:'accessing'!

children
    "always returns an empty list
    "
    ^ #()
! !

!HierarchicalFileList::File methodsFor:'queries'!

hasChildren
    "always returns false
    "
    ^ false
! !

!HierarchicalFileList::Directory methodsFor:'accessing'!

children
    "returns the list of children
    "
    |model|

    children notNil ifTrue:[
        ^ children
    ].

    (model := self model) isNil ifTrue:[
        "/ must reread later
        modificationTime := children := nil.
        ^ nil
    ].

    true "readDirectoriesChildrenInBackground" ifTrue:[
        model triggerUpdateCycle.
        ^ nil.
    ].
self halt.
    self readChildren.
    ^ children
!

readChildren
    "reads the list of children
    "
    |model list|

    (model := self model) isNil ifTrue:[
        "/ must reread later
        modificationTime := children := nil.
        ^ nil
    ].

    children := #().
    modificationTime := fileName modificationTime.
    list := model childrenFor:self.

    list size ~~ 0 ifTrue:[
        list do:[:aChild| aChild parent:self].
        children := list.
    ].

    children size > 0 ifTrue:[
        self changed.
    ].
    ^ children
! !

!HierarchicalFileList::Directory methodsFor:'accessing-hierarchy'!

collapse
    icon := nil.
    super collapse.
!

expand
    "expand children; must redefine to raise a notification
     if children are not yet initialized and after initialization empty.
    "
    |notInit|

    notInit := children isNil.
    icon := nil.
    super expand.

    notInit ifTrue:[
        (children notNil and:[children isEmpty]) ifTrue:[
            "/ no children exists
            "/ indicator +/- has changed to unexistant
            self changed:#redraw
        ]
    ].
!

recursiveCollapse
    icon := nil.
    super recursiveCollapse.
!

recursiveExpand
    "redefined to expand
    "
    self expand


! !

!HierarchicalFileList::Directory methodsFor:'queries'!

hasChildren
    "returns true if children exists
    "
    self model.
"/self halt.
 ^ super hasChildren
"/    ^ children isNil or:[children notEmpty]
!

isDirectory
    "always returns true
    "
    ^ true


! !

!HierarchicalFileList::Directory methodsFor:'validation'!

invalidateRepairNow:doRepair
    "invalidate contents
    "
    modificationTime := nil.

    doRepair ifTrue:[
        self monitoringCycle
    ] ifFalse:[
        (isExpanded or:[children size == 0]) ifFalse:[
            children := nil
        ]
    ].

!

matchBlockChanged
    "called if the matchBlock changed
    "
    modificationTime := nil.

    isExpanded ifFalse:[
        children := nil.
    ] ifTrue:[
        self monitoringCycle.

        children size ~~ 0 ifTrue:[
            children do:[:aChild| aChild matchBlockChanged]
        ]
    ].
!

monitoringCycle
    "run monitoring cycle
    "
    |list existingNames size name modifyTime isNotEmpty wasNotEmpty model shownNames|

    children isNil ifTrue:[
        self readChildren.
    ].

    modifyTime := fileName modificationTime.
    (modificationTime notNil and:[modifyTime <= modificationTime]) ifTrue:[
        ^ self
    ].

    "/ something changed
    icon := nil.

    model := self model.
    modificationTime := modifyTime.

    isExpanded ifFalse:[

     "/ CHECK WHETHER CHILDREN EXIST( INDICATOR )
     "/ =========================================

        isNotEmpty := model hasChildrenFor:self.

     "/ check whether has changed durring evaluation
        (isExpanded or:[modificationTime ~= modifyTime]) ifFalse:[
            wasNotEmpty := children isNil.
            children    := isNotEmpty ifTrue:[nil] ifFalse:[#()].

            wasNotEmpty ~~ isNotEmpty ifTrue:[
                self changed
            ]
        ].
        ^ self

    ].

 "/ START MERGING( CONTENTS IS VISIBLE )
 "/ ====================================

    list := model childrenFor:self.

    list size == 0 ifTrue:[                         "/ contents becomes empty
        self removeAll.                             "/ clear contents
        ^ self.                              
    ].
    size := children size.
    size == 0 ifTrue:[                              "/ old contents was empty 
        self addAll:list.                           "/ take over new contents
        ^ self.
    ].

    existingNames := Set new:list size.
    list do:[:l| existingNames add:l baseName].
    size to:1 by:-1 do:[:anIndex|                   "/ remove invisible items from tail
        name := (children at:anIndex) baseName.
        (existingNames includes:name) ifFalse:[
            self removeIndex:anIndex
        ]
    ].

    shownNames := Set new:children size.
    children do:[:l| shownNames add:l baseName].
    list keysAndValuesDo:[:anIndex :anItem|         "/ add new visible items
        (shownNames includes:anItem baseName) ifFalse:[
            self add:anItem beforeIndex:anIndex
        ]
    ].
! !

!HierarchicalFileList::RemoteDirectory methodsFor:'queries'!

isRemoteDirectory
    ^ true
! !

!HierarchicalFileList class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.22 2002-10-04 09:46:38 stefan Exp $'
! !