"
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 directoryName
directoryContents directoryFileTypes fileTypes realAction
matchBlock stayInDirectory ignoreParentDirectory markDirectories
ignoreDirectories directoryChangeCheckBlock'
classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
!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.
"
!
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.
Except for file-browser like applications, FileSelectionLists are almost
exclusively used with FileSelectionBoxes (see examples there).
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
directoryName the path 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
"
FileSelectionLists are typically used in FileSelectionBoxes,
or file-browser-like applications.
Thus, the following examples are a bit untypical.
example (plain file-list):
|list|
list := FileSelectionList new.
list open
example (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
ignore the parentDirectory:
|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 ignoreParentDirectory:true.
top open
ignore all 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 ignoreDirectories:true.
top open
dont show the directory arrow-mark:
|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 markDirectories:false.
top open
example (adds a pattern, only showing .st files and 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 pattern:'*.st'.
list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
top open
example (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
example (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
example (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
example (the above can be done more convenient)
|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 ignoreDirectories:true.
list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
top open
example (adds a matchblock to block parent dirs (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
example (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
example (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
example (show only h*-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:'h*'.
list matchBlock:[:name | name printNL.
name asFilename isDirectory not
].
list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
top open
example (only allow changing into directories below the current one; i.e. not up;
but show it)
|top v list here|
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 directoryChangeCheckBlock:[:dirPath |
dirPath asFilename pathName
startsWith:Filename currentDirectory pathName].
list action:[:index | Transcript showCr:'you selected: ' , list selectionValue].
top open
"
! !
!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.
This does not validate the change with any directoryChangeBlock."
|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
]
]
!
directoryChangeCheckBlock:aBlock
"set the directoryChangeCheckBlock - if non-nil, it controls if
a directory change is legal."
directoryChangeCheckBlock := aBlock
!
ignoreDirectories:aBoolean
"set/clear the flag which controls if directories are ignored
(i.e. hidden). The default is false (i.e. dirs are shown)"
ignoreDirectories := 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
!
markDirectories:aBoolean
"turn on/off marking of directories with an arrow.
The default is on"
markDirectories := aBoolean
!
matchBlock:aBlock
"set the matchBlock - if non-nil, it controls which
names are shown in the list."
matchBlock := aBlock
!
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.
!
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
! !
!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.
markDirectories ifFalse:[^ self].
"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.
markDirectories ifFalse:[^ self].
l := self visibleLineToListLine:visLineNr.
l notNil ifTrue:[
(fileTypes at:l) == #directory ifTrue:[
self drawRightArrowInVisibleLine:visLineNr
]
]
! !
!FileSelectionList methodsFor:'events'!
sizeChanged:how
"redraw marks if any"
super sizeChanged:how.
(shown and:[markDirectories]) ifTrue:[
self redraw
]
! !
!FileSelectionList methodsFor:'initialization'!
initialize
directory := FileDirectory currentDirectory.
stayInDirectory := ignoreParentDirectory := ignoreDirectories := false.
markDirectories := true.
super initialize.
pattern := '*'.
self initializeAction.
"nontypical use ..."
"
FileSelectionList new open
(FileSelectionList new directory:'/etc') open
(ScrollableView for:FileSelectionList) open
(HVScrollableView for:FileSelectionList) open
"
!
initializeAction
"setup action as: selections in list get forwarded to enterfield if not
a directory; otherwise directory is changed"
actionBlock := [:lineNr | self selectionChanged].
!
reinitialize
directory := FileDirectory currentDirectory.
super reinitialize
! !
!FileSelectionList methodsFor:'private'!
selectionChanged
"if the selection changed, check for it being a directory
and possibly go there. If its not a directory, perform the realAction."
|entry ok newDir warnMessage|
self selection isCollection ifFalse:[
entry := self selectionValue.
(entry endsWith:' ...') ifTrue:[
entry := entry copyWithoutLast:4.
].
(stayInDirectory not
and:[(directory typeOf:entry) == #directory]) ifTrue:[
ok := false.
newDir := directory pathName , Filename separator asString , entry.
(directoryChangeCheckBlock isNil
or:[directoryChangeCheckBlock value:newDir]) ifTrue:[
(directory isReadable:entry) ifFalse:[
warnMessage := 'not allowed to read directory %1'
] ifTrue:[
(directory isExecutable:entry) ifFalse:[
warnMessage := 'not allowed to change to directory %1'
] ifTrue:[
ok := true.
]
].
].
ok ifFalse:[
warnMessage notNil ifTrue:[
self warn:(resources string:warnMessage with:entry).
].
self deselect
] ifTrue:[
self directory:newDir.
].
] ifFalse:[
realAction notNil ifTrue:[
realAction value:self selection
]
]
]
!
updateList
"set the lists contents to the filenames in the directory"
|oldCursor files newList index path obsolete matching patternList|
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)
"
obsolete := directoryId ~~ directory id
or:[directoryName ~= directory pathName
or:[timeStamp notNil
and:[directory timeOfLastChange > timeStamp]]].
obsolete ifTrue:[
timeStamp := directory timeOfLastChange.
directoryId := directory id.
directoryName := directory pathName.
directoryContents := directory asStringCollection sort.
directoryFileTypes := OrderedCollection new.
directoryContents do:[:name | directoryFileTypes add:(directory typeOf:name)].
].
files := directoryContents.
newList := OrderedCollection new.
fileTypes := OrderedCollection new.
index := 1.
path := directory pathName , Filename separator asString.
files do:[:name |
|type|
(matchBlock isNil or:[matchBlock value:(path , name)]) ifTrue:[
type := directoryFileTypes at:index.
type == #directory ifTrue:[
ignoreDirectories ifFalse:[
name = '..' ifTrue:[
ignoreParentDirectory ifFalse:[
newList add:name.
fileTypes add:type
]
] ifFalse:[
name = '.' ifTrue:[
"ignore"
] ifFalse:[
newList add:(name ", ' ...'").
fileTypes add:type
]
]
]
] ifFalse:[
matching := true.
(pattern isNil
or:[pattern isEmpty]) ifFalse:[
pattern = '*' ifFalse:[
(pattern includes:$;) ifTrue:[
patternList := pattern asCollectionOfSubstringsSeparatedBy:$;.
matching := (patternList findFirst:[:subPattern | subPattern match:name]) ~~ 0.
] ifFalse:[
matching := pattern match:name
]
]
].
matching ifTrue:[
newList add:name.
fileTypes add:type
]
].
].
index := index + 1
].
super list:newList.
self cursor:oldCursor.
!
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)
! !
!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
! !
!FileSelectionList class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.24 1996-02-10 09:32:49 ca Exp $'
! !