FileSelectionList.st
author claus
Sun, 07 Aug 1994 15:23:42 +0200
changeset 38 4b9b70b2cc87
parent 24 966098a893f8
child 45 e900c30938c8
permissions -rw-r--r--
2.10.3 pre-final version

"
 COPYRIGHT (c) 1993 by Claus Gittinger
              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.
"

SelectionInListView subclass:#FileSelectionList
       instanceVariableNames:'pattern directory timeStamp directoryId
                              directoryContents directoryFileTypes
                              fileTypes realAction matchBlock'
       classVariableNames:''
       poolDictionaries:''
       category:'Views-Text'
!

FileSelectionList comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.4 1994-08-07 13:21:47 claus Exp $
'!

!FileSelectionList class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 by Claus Gittinger
              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.
"
!

version
"
$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.4 1994-08-07 13:21:47 claus Exp $
"
!

documentation
"
    this class implements file selection lists - its basically a
    selection in list, but adds some right-arrows to directories.
    (and will soon remember the previous position when changing directories).
    Only files matching a pattern (plus directories) are shown.

    Instance variables:
            pattern                 the matchpattern
            directory               the current directory
            timeStamp               the time, when directoryContents was last taken
            directoryId             the directories id (inode-nr) when it was taken
            directoryContents       contents of current directory
            directoryFileTypes      file types (symbols) of current directory
            fileTypes               file types as shown in list 
                                    (i.e only matching ones)
            realAction              the action to perform when a file is selected

    Example use:
        FileSelectionLists are typically used in FileSelectionBoxes,
        or file-browser-like applications.
"
! !

!FileSelectionList methodsFor:'initialization'!

initialize
    directory := FileDirectory currentDirectory.
    super initialize.

    pattern := '*'.

    "selections in list get forwarded to enterfield if not a directory;
     otherwise directory is changed"

    actionBlock := [:lineNr |
        |entry ok|

        (self selection isKindOf:Collection) ifFalse:[
            entry := self selectionValue.
            (entry endsWith:' ...') ifTrue:[
                entry := entry copyTo:(entry size - 4).
            ].
            ((directory typeOf:entry) == #directory) ifTrue:[
                ok := false.
                (directory isReadable:entry) ifFalse:[
                    self warn:(resources string:'not allowed to read directory %1' with:entry)
                ] ifTrue:[
                    (directory isExecutable:entry) ifFalse:[
                        self warn:(resources string:'not allowed to change to directory %1' with:entry)
                    ] ifTrue:[
                        self directory:(directory pathName , Filename separator asString , entry).
                        ok := true.
                    ]
                ].
                ok ifFalse:[
                    self deselect
                ]

            ] ifFalse:[
                realAction notNil ifTrue:[
                    realAction value:lineNr
                ]
            ]
        ]
    ]

    "nontypical use ..."
    "
     FileSelectionList new open
     (FileSelectionList new directory:'/etc') open
     (ScrollableView for:FileSelectionList) open
     (HVScrollableView for:FileSelectionList) open
    "
!

reinitialize
    directory := FileDirectory currentDirectory.
    super reinitialize
! !

!FileSelectionList methodsFor:'accessing'!

action:aBlock
    "set the action to be performed on a selection"

    realAction := aBlock
!

directory
    "return the shown directory"

    ^ directory
!

directory:nameOrDirectory
    "set the lists contents to the filenames in the directory"

    |oldPath name|

    nameOrDirectory isString ifTrue:[
        name := nameOrDirectory
    ] ifFalse:[
        name := nameOrDirectory pathName
    ].
    oldPath := directory pathName.
    directory pathName:name.
    (directory pathName = oldPath) ifFalse:[
        self updateList
    ]
!

pattern:aPattern
    "set the pattern - if it changes, update the list."

    pattern ~= aPattern ifTrue:[
        pattern := aPattern.
        realized ifTrue:[
            self updateList
        ].
    ].
!

matchBlock:aBlock
    "set the matchBlock - if non-nil, it controls which
     names are shown in the list."

    matchBlock := aBlock
! !

!FileSelectionList methodsFor:'drawing'!

redrawFromVisibleLine:startVisLineNr to:endVisLineNr
    "redefined to look for directory in every line"

    |l|

    "first, draw chunk of lines"
    super redrawFromVisibleLine:startVisLineNr to:endVisLineNr.

    "then draw marks"
    startVisLineNr to:endVisLineNr do:[:visLineNr |
        l := self visibleLineToListLine:visLineNr.
        l notNil ifTrue:[
            (fileTypes at:l) == #directory ifTrue:[
                self drawRightArrowInVisibleLine:visLineNr
            ]
        ]
    ]
!

redrawVisibleLine:visLineNr
    "if the line is one for a directory, draw a right arrow"

    |l|

    super redrawVisibleLine:visLineNr.
    l := self visibleLineToListLine:visLineNr.
    l notNil ifTrue:[
        (fileTypes at:l) == #directory ifTrue:[
            self drawRightArrowInVisibleLine:visLineNr
        ]
    ]
! !

!FileSelectionList methodsFor:'private'!

visibleLineNeedsSpecialCare:visLineNr
    |l|

    l := self visibleLineToListLine:visLineNr.
    l notNil ifTrue:[
        (fileTypes at:l) == #directory ifTrue:[^ true].
        ^ super visibleLineNeedsSpecialCare:visLineNr
    ].
    ^ false
!

widthForScrollBetween:firstLine and:lastLine
    "return the width in pixels for a scroll between firstLine and lastLine
     - return full width here since there might be directory marks"

    ^ (width - margin - margin)
!

updateList
    "set the lists contents to the filenames in the directory"

    |oldCursor files newList index|

    oldCursor := cursor.
    self cursor:(Cursor read).

    "
     if the directory-id changed, MUST update.
     (can happen after a restart, when a file is no longer
      there, has moved or is NFS-mounted differently)
    "
    directoryId == directory id ifFalse:[
        timeStamp := directory timeOfLastChange.
        directoryId := directory id.
        directoryContents := directory asText sort.
        directoryFileTypes := OrderedCollection new.
        directoryContents do:[:name | directoryFileTypes add:(directory typeOf:name)].
    ].

    files := directoryContents.
    newList := OrderedCollection new.
    fileTypes := OrderedCollection new.
    index := 1.
    files do:[:name |
        (matchBlock isNil or:[matchBlock value:name]) ifTrue:[
            (directoryFileTypes at:index) == #directory ifTrue:[
                name = '..' ifTrue:[
                    newList add:name.
                    fileTypes add:(directoryFileTypes at:index)
                ] ifFalse:[
                    name = '.' ifTrue:[
                        "ignore"
                    ] ifFalse:[
                        newList add:(name ", ' ...'").
                        fileTypes add:(directoryFileTypes at:index)
                    ]
                ]
            ] ifFalse:[
                (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
                    newList add:name.
                    fileTypes add:(directoryFileTypes at:index)
                ]
            ].
        ].
        index := index + 1
    ].
    super list:newList.
    self cursor:oldCursor.
! !

!FileSelectionList methodsFor:'realization'!

realize
    "make the view visible; redefined to check if directory is still 
     valid (using timestamp and inode numbers) - reread if not"

    (timeStamp isNil 
     or:[(directory timeOfLastChange > timeStamp) 
     or:[(directoryId isNil)
     or:[directoryId ~~ directory id]]]) ifTrue:[
        directoryId := nil.
        self updateList
    ].
    super realize
! !