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

'From Smalltalk/X, Version:2.10.4 on 1-feb-1995 at 3:54:12 pm'!

SelectionInListView subclass:#FileSelectionList
	 instanceVariableNames:'pattern directory timeStamp directoryId directoryContents
                directoryFileTypes fileTypes realAction matchBlock
                stayInDirectory ignoreParentDirectory'
	 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.10 1995-02-06 00:52:21 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.10 1995-02-06 00:52:21 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).
    You can specify an optional filename-pattern (such as '*.st') and an
    optional matchBlock (such as: [:name | name startsWith:'A']).

    Only files (plus directories) matching the pattern (if present) and
    for which the matchBlock returns true (if present), 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       (cached) contents of current directory
	    directoryFileTypes      (cached) file types (symbols) of current directory
	    fileTypes               file types as shown in list (i.e only matching ones)
	    matchBlock              if non-nil: block evaluated per full filename;
				    only files for which matchBlock returns true are shown.

	    realAction              (internal) the action to perform when a file is selected

"
!

examples 
"
    Example use:
	FileSelectionLists are typically used in FileSelectionBoxes,
	or file-browser-like applications.
	Thus, the following examples are a bit untypical.

    example1 (plain file-list):
	|list|

	list := FileSelectionList new.
	list open

    example2 (scrolled & some action):
	|top v list|

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example3 (adds a pattern):
	|top v list|

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list pattern:'*.st'.
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example4 (a more complicated pattern):
	|top v list|

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list pattern:'[A-D]*.st'.
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example5 (adds a matchblock to show only writable files):
	|top v list|

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list matchBlock:[:name | 
			    |fileName|
			    fileName := name asFilename.
			    fileName isWritable or:[fileName isDirectory]
			].
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example6 (adds a matchblock to suppress directories):
	|top v list|

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list matchBlock:[:name | 
			    name asFilename isDirectory not
			].
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example7 (adds a matchblock to block moving up (i.e. only allow files here & below):
	|top v list currentDir|

	currentDir := '.' asFilename pathName.

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list matchBlock:[:name | 
			    ((name endsWith:'/..') and:[list directory pathName = currentDir]) not
			].
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example8 (block moving up AND show all .rc-files only):
	|top v list currentDir|

	currentDir := '.' asFilename pathName.

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list pattern:'*.rc'.
	list matchBlock:[:name |  
			    ((name endsWith:'/..') and:[list directory pathName = currentDir]) not
			].
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example9 (show only .rc-files in current directory):
	|top v list currentDir|

	currentDir := '.' asFilename pathName.

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list pattern:'*.rc'.
	list matchBlock:[:name | 
			    name asFilename isDirectory not
			].
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open

    example10 (show only .rc-files in /etc; dont allow directory changes):
	|top v list|

	top := StandardSystemView new.
	top extent:(300 @ 200).
	v := ScrollableView for:FileSelectionList in:top.
	v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
	list := v scrolledView.
	list directory:'/etc'.
	list pattern:'*.rc'.
	list matchBlock:[:name | name printNL.
			    name asFilename isDirectory not
			].
	list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
	top open
"
! !

!FileSelectionList methodsFor:'drawing'!

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

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

!FileSelectionList methodsFor:'accessing'!

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

    |oldPath name|

    nameOrDirectory isString ifTrue:[
        name := nameOrDirectory
    ] ifFalse:[
        nameOrDirectory isNil ifTrue:[
            directory := nil.
            ^ self updateList
        ].
        name := nameOrDirectory pathName
    ].
    directory isNil ifTrue:[
        directory := FileDirectory new.
        oldPath := nil
    ] ifFalse:[
        oldPath := directory pathName.
    ].
    directory pathName:name.
    realized ifTrue:[
        (directory pathName = oldPath) ifFalse:[
            self updateList
        ]
    ]
!

directory
    "return the shown directory"

    ^ directory
!

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

    realAction := aBlock
!

stayInDirectory:aBoolean
    "set/clear the flag which controls if selecting a directory
     should locally change (if false) or be handled just like
     the selection of a file (if true).
     The default is false (i.e. change and do not tell via action)"

    stayInDirectory := aBoolean
!

ignoreParentDirectory:aBoolean
    "set/clear the flag which controls if the parent directory (..)
     is shown in the list. The default is false (i.e. show it)"

    ignoreParentDirectory := aBoolean
!

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

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

selectedPathname
    "if there is a selection, return its full pathname.
     Of there is no selection, return nil."

    |sel|

    sel := self selectionValue.
    sel isNil ifTrue:[^ nil].
    ^ directory pathName , Filename separator asString , sel.

!

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

    matchBlock := aBlock
! !

!FileSelectionList methodsFor:'private'!

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

    |oldCursor files newList index|

    directory isNil ifTrue:[
        super list:nil.
        files :=  newList := fileTypes := nil.
        ^ self
    ].

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

        fullName := directory pathName , Filename separator asString , name.

        (matchBlock isNil or:[matchBlock value:fullName]) ifTrue:[
            (directoryFileTypes at:index) == #directory ifTrue:[
                name = '..' ifTrue:[
                    ignoreParentDirectory ifFalse:[
                        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.
!

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

visibleLineNeedsSpecialCare:visLineNr
    |l|

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

!FileSelectionList methodsFor:'initialization'!

initializeAction
    "setup action as: 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).
            ].
            (stayInDirectory not
            and:[(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
                ]
            ]
        ]
    ]
!

initialize
    directory := FileDirectory currentDirectory.
    stayInDirectory := false.
    ignoreParentDirectory := false.

    super initialize.

    pattern := '*'.
    self initializeAction.

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