FileSelectionBox.st
author Claus Gittinger <cg@exept.de>
Tue, 05 Dec 1995 20:12:25 +0100
changeset 238 a81e517187e4
parent 235 bbd0a7433459
child 240 75a3b67bd91d
permissions -rw-r--r--
examples

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

ListSelectionBox subclass:#FileSelectionBox
	 instanceVariableNames:'patternField'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Views-DialogBoxes'
!

!FileSelectionBox class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1990 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 boxes. Instances show a list of
    files, and perform an action block with the selected pathname as
    argument when ok is clicked.

    There is an optional PatternField, which shows itself when a pattern
    is defined (i.e. if there is no pattern, it is hidden). 
    If there is a pattern, only files matching the pattern will be shown in 
    the list (and directories).

    In addition, there is an optional matchBlock (actually this is defined 
    in the FileSelectionList). Only filenames for which this matchblock
    returns true will be presented.
"
!

examples 
"
    very simple:
	|name|

	name := FileSelectionBox requestFilename.
	Transcript showCr:name


    simple:
	|name|

	name := FileSelectionBox requestFilename:'which file ?'.
	Transcript showCr:name


    with initial selection:
	|name|

	name := FileSelectionBox requestFilename:'which file ?' default:'Make.proto'.
	Transcript showCr:name


    more detailed setup:

	FileSelectionBox new openModal

    setting title:

	|box|
	box := FileSelectionBox new.
	box title:'Which file ?'.
	box open

    setting a matchpattern:

	|box|
	box := FileSelectionBox new.
	box title:'Which file ?'.
	box pattern:'*.rc'.
	box open

    setting a matchblock:

	|box|
	box := FileSelectionBox new.
	box title:'Which file ?'.
	box pattern:'*'.
	box matchBlock:[:name | name first isLowercase].
	box open

    both pattern and matchBlock:

	|box|
	box := FileSelectionBox new.
	box title:'Which directory ?'.
	box pattern:'l*'.
	box matchBlock:[:name | OperatingSystem isDirectory:name].
	box open

    finally, an action:

	|box|
	box := FileSelectionBox new.
	box title:'Which directory ?'.
	box pattern:'l*'.
	box matchBlock:[:name | OperatingSystem isDirectory:name].
	box action:[:name | Transcript showCr:name].
	box open
"
!

version
    ^ '$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.25 1995-12-05 19:12:25 cg Exp $'
! !

!FileSelectionBox class methodsFor:'defaults'!

requestFilename
    ^ self requestFilename:'filename:'

    "
     FileSelectionBox requestFilename
    "
!

requestFilename:title
    |fileBox|

    fileBox := self
		    title:title
		    okText:'ok'
		    abortText:'cancel'
		    action:[:fileName | ^ fileName].

    fileBox showAtPointer.
    ^ nil

    "
     FileSelectionBox requestFilename:'which file ?'
    "
!

requestFilename:title default:aFileName
    |fileBox|

    fileBox := self
		    title:title
		    okText:'ok'
		    abortText:'cancel'
		    action:[:fileName | ^ fileName].

    fileBox initialText:aFileName.
    fileBox showAtPointer.
    ^ nil

    "
     FileSelectionBox requestFilename:'which file ?' default:'Makefile'
    "
!

requestFilename:title  fromDirectory: aDirectory

    |fileBox|

    fileBox := self
		    title:title
		    okText:'ok'
		    abortText:'cancel'
		    action:[:fileName | ^ fileName].

    fileBox directory: aDirectory.
    fileBox showAtPointer.
    ^ nil

    "
     FileSelectionBox requestFilename:'which file ?' fromDirectory:'/etc'
    "

    "Modified: 12.10.1995 / 11:47:27 / markus"
! !

!FileSelectionBox class methodsFor:'requests'!

listViewType
    "return the type of listView - using a FileSelectionList here"

    ^ FileSelectionList
! !

!FileSelectionBox methodsFor:'accessing'!

contents
    "return the current entered value (i.e. the enterFields string).
     redefined to return the full pathname."

    |string sep|

    string := super contents.
    string isNil ifTrue:[
	^ selectionList directory pathName
    ].
    sep := Filename separator.
    (string startsWith:sep) ifTrue:[
	^ string
    ].
    ^ (selectionList directory pathName asFilename construct:string) asString
!

directory:directoryName
    "change the directory shown in the list."

    selectionList directory:directoryName
!

matchBlock:aBlock
    "set the matchBlock (in the selectionList). Only files
     for which the block returns true are shown.
     The matching is actually done in the fileSelectionList."

    selectionList matchBlock:aBlock 
!

openOn:aPath
    "open the box showing files in aPath.
     This is only a shortcut message - no new functionality."

    self directory:aPath.
    self showAtPointer
!

pattern:aPattern
    "set the pattern - this also enables the PatternField
     (if the pattern is non-nil) or hides it (if nil)."

    |hidePatternField focusSequence|

    patternField initialText:aPattern.
    selectionList pattern:aPattern.
    aPattern isNil ifTrue:[
	hidePatternField := true.
	realized ifTrue:[
	    patternField hide.
	].
	focusSequence := (Array 
			     with:enterField 
			     with:selectionList 
			     with:okButton 
			     with:abortButton)
    ] ifFalse:[
	hidePatternField := false.
	realized ifTrue:[
	    patternField realize.
	].
	focusSequence := (Array 
			     with:patternField 
			     with:enterField 
			     with:selectionList 
			     with:okButton 
			     with:abortButton)
    ].

    patternField hiddenOnRealize:hidePatternField.
    windowGroup notNil ifTrue:[
	windowGroup focusSequence:focusSequence
    ].
! !

!FileSelectionBox methodsFor:'change & update'!

update:something with:argument from:changedObject
    |commonName index s|

    something == #directory ifTrue:[
	"
	 sent by fileNameEnterField, if a filename
	 completion was not possible due to multiple
	 matches.
	"
	selectionList directory:argument.
	s := enterField contents.
	s notNil ifTrue:[
	    commonName := s asFilename baseName.
	    commonName size > 0 ifTrue:[
		index := selectionList list findFirst:[:entry | entry startsWith:commonName].
		index ~~ 0 ifTrue:[
		    selectionList makeLineVisible:index
		]
	    ]
	]
    ]
! !

!FileSelectionBox methodsFor:'initialization'!

createEnterField
    "if the (optional) class FilenameEditField is present, use
     it, since it provides filename completion. Otherwise, we have
     to live with the dump (default) field ...
    "
    FilenameEditField notNil ifTrue:[
	^ FilenameEditField new.
    ].
    ^ super createEnterField
!

focusSequence
    patternField shown ifTrue:[
	^ Array 
	    with:patternField 
	    with:enterField 
	    with:selectionList 
	    with:abortButton
	    with:okButton 
    ].
    ^ super focusSequence
!

initialize
    |corner|

    super initialize.

    label := resources string:'File dialog'.

    labelField extent:(0.7 @ labelField height).
    labelField label:(resources string:'select a file:').
    labelField adjust:#left.

    patternField := EditField in:self.
    self is3D ifTrue:[
	corner := (1.0 @ (labelField origin y+patternField heightIncludingBorder)).
    ] ifFalse:[
	corner := [(width - ViewSpacing - (patternField borderWidth * 2)) @ (labelField origin y+patternField height"IncludingBorder")].
    ].
    patternField origin:(0.7 @ labelField origin y) corner:corner.
    patternField rightInset:ViewSpacing.
    patternField initialText:'*'.
    patternField leaveAction:[:reason | 
	selectionList pattern:patternField contents. 
	self updateList
    ].
    patternField hiddenOnRealize:true. "delay showing, until a pattern is defined"

    enterField addDependent:self.

    "
     FileSelectionBox open
     FileSelectionBox new show
    "
!

realize
    "if some default is present in the enterField,
     scroll to make this one visible"

    |contents|

    super realize.
    (contents := enterField contents) notNil ifTrue:[
	contents notEmpty ifTrue:[
	    selectionList makeVisible:contents
	]
    ]
! !

!FileSelectionBox methodsFor:'private'!

updateList
    selectionList updateList
! !

!FileSelectionBox methodsFor:'queries'!

preferredExtent
    "return my preferred extent - thats the minimum size 
     to make everything visible"

    |wWanted hWanted|

    wWanted := ViewSpacing + 
	       labelField preferredExtent x + 
	       (ViewSpacing * 2) + 
	       patternField preferredExtent x + 
	       ViewSpacing.
    (wWanted < width) ifTrue:[
	wWanted := width
    ].
    hWanted := ViewSpacing + labelField height +
	       ViewSpacing + enterField height +
	       ViewSpacing + selectionList height +
	       ViewSpacing + buttonPanel preferredExtent y +
	       ViewSpacing.

    (hWanted < height) ifTrue:[
	hWanted := height
    ].
    ^ (wWanted @ hWanted)
! !

!FileSelectionBox methodsFor:'user actions'!

doubleClick
    |entry|

    entry := selectionList selectionValue.
    entry notNil ifTrue:[
	((selectionList directory typeOf:entry) == #directory) ifFalse:[
	    enterField contents:entry.
	    self okPressed
	]
    ].
!

okPressed
    "called for both on ok-press and on return-key"

    |dir string fname|

    string := enterField contents.
    string notNil ifTrue:[
	string := string withoutSeparators.
	string asFilename isAbsolute ifTrue:[
	    fname := string asFilename
	] ifFalse:[
	    dir := selectionList directory pathName asFilename.
	    fname := dir construct:string
	].
	fname isDirectory ifTrue:[
	    selectionList directory:fname asString.
	    self updateList.
	    ^ self
	]
    ].
    super okPressed
!

selectionChanged
    |entry|

    entry := selectionList selectionValue.
    enterField contents:entry
! !