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

ModalBox subclass:#EnterBox
       instanceVariableNames:'labelField enterField buttonPanel
                              okButton abortButton
                              okAction abortAction'
       classVariableNames:''
       poolDictionaries:''
       category:'Views-DialogBoxes'
!

EnterBox comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.7 1994-08-07 13:21:31 claus Exp $
'!

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

version
"
$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.7 1994-08-07 13:21:31 claus Exp $
"
!

documentation
"
    this class implements a pop-up box to enter some string
    with 2 buttons; a cancel button, and a trigger-action button.
    The boxes title can be changed using: 

        aBox title:'some string'

    The two button-labels default to 'abort' and 'ok'; 
    they can be changed using:

        aBox okText:'someString'
        aBox abortText:'someString'

    The initial text in the enterfield can be set using:

        aBox initialText:'someString'

    when the ok-button is pressed, an action is performed, which is
    set using:

        aBox action:[ ... ]

    the abort-action defaults to no-action, but can also be set.
    The box can be opened modal (i.e. the currently active view will
    be suspended) or modeless. The default is modal (i.e. sending #open
    is equivalent to #openModal).

    example:
        |box|

        box := EnterBox new.
        box title:'your name please:'.
        box action:[:arg | Transcript showCr:'entered: ' , arg printString].
        box open

        |box|

        box := EnterBox new.
        box title:'your name please:'.
        box action:[:arg | Transcript showCr:'entered: ' , arg printString].
        box openModeless
"
! !

!EnterBox class methodsFor:'defaults'!

defaultExtent
    ^ (Display pixelPerMillimeter * (60 @ 30)) rounded
! !

!EnterBox class methodsFor:'instance creation'!

action:aBlock
    "create and return a new EnterBox 
     which will evaluate aBlock when 'ok' is pressed"

    ^ (self new) action:aBlock

    "(EnterBox action:[:string | Transcript showCr:string]) showAtPointer"
!

title:titleString action:aBlock
    "create and return a new EnterBox with title aString,
     which will evaluate aBlock when 'ok' is pressed"

    ^ ((self new) title:titleString) action:aBlock
!

title:titleString okText:okText abortText:abortText action:aBlock
    "create and return a new EnterBox with title aString, and buttons showing
     okText and abortText; it will evaluate aBlock when 'ok' is pressed"

    ^ ((self new) title:titleString 
                 okText:okText 
              abortText:abortText) action:aBlock
! !

!EnterBox methodsFor:'initialization'!

initialize
    |space2 innerWidth|

    super initialize.

    space2 := 2 * ViewSpacing.

    labelField := Label in:self.
    labelField label:''.
    labelField borderWidth:0.
    labelField adjust:#center.

    "kludge: preset extent to something useful since other subviews
     depend on it (extent blocks are not evaluated until view is realized)
     - avoid visible resizing when realized the first time"

    innerWidth := width - space2.

    labelField origin:(ViewSpacing @ ViewSpacing)
               extent:(innerWidth @ labelField height).

    self createEnterField.
    enterField origin:(ViewSpacing @ (space2 + labelField height))
               extent:((width - space2 - (enterField borderWidth * 2) - margin) @ enterField height).
    enterField origin:[ViewSpacing @ (space2 + labelField height)]
               extent:[(width - space2 - (enterField borderWidth * 2) - margin) @ enterField height].
    enterField leaveAction:[:key | self okPressed].
    enterField addDependent:self. "to get preferredExtent-changes"

    buttonPanel := HorizontalPanelView in:self.
    buttonPanel origin:(ViewSpacing @ (height - (font height * 2) - ViewSpacing - (borderWidth * 2)))
                extent:((width - space2 - (ViewSpacing // 2) - (buttonPanel borderWidth * 2)) 
                       @ ((font height * 2) + (borderWidth * 2))).
    buttonPanel origin:[ViewSpacing @ (height - (font height * 2) - ViewSpacing - (borderWidth * 2))]
                extent:[(width - space2 - (ViewSpacing // 2) - (buttonPanel borderWidth * 2)) 
                       @ ((font height * 2) + (borderWidth * 2))].

    buttonPanel layout:"#spread2" #right.
    buttonPanel borderWidth:0.

    abortButton := Button label:(resources at:'abort')
                         action:[
                                    abortButton turnOffWithoutRedraw.
                                    self abortPressed
                                ]
                             in:buttonPanel.

    okButton := Button label:(resources at:'ok')
                      action:[
                                okButton turnOffWithoutRedraw.
                                self okPressed
                             ]
                          in:buttonPanel.
    okButton isReturnButton:true.

    self keyboardHandler:enterField
!

createEnterField
    "
     this has been extracted from initialize method
     to allow redefinition in subclasses.
    "

    enterField := EditField in:self.
!

reAdjustGeometry
    "sent late in snapin processing - gives me a chance
     to resize for new font dimensions"

    super reAdjustGeometry.
    labelField resize.
    okButton resize.
    abortButton resize.
    self resize
! !

!EnterBox methodsFor:'realization'!

positionOffset
    "return the delta, by which the box should be displayed
     from the mouse pointer. Value returned here makes
     okButton appear under the cursor"

    ^ (okButton originRelativeTo:self) + (okButton extent // 2)
! !

!EnterBox methodsFor:'private'!

resize
    "resize myself to make everything visible"

    |wWanted hWanted wPanel vs2 nx ny|

    vs2 := ViewSpacing * 2.
    wWanted := (labelField widthIncludingBorder max:enterField preferredExtent x) + vs2.
    wPanel := buttonPanel preferedExtent x + vs2.
    wPanel > wWanted ifTrue:[
        wWanted := wPanel
    ].
    hWanted := vs2 + labelField height + enterField height +
               (ViewSpacing * 6) + buttonPanel height + ViewSpacing.

    ((wWanted ~= width) or:[hWanted ~= height]) ifTrue:[
        "
         make sure, that we are fully visible
         (by moving origin if nescessary)
        "
        nx := self origin x min:(device width - wWanted).
        ny := self origin y min:(device height - hWanted).
        self origin:nx@ny extent:(wWanted @ hWanted)
    ]
! !

!EnterBox methodsFor:'accessing'!

title:aString
    "set the title to be displayed at top of enterBox"

    |oldSize|

    aString ~= labelField label ifTrue:[
        oldSize := labelField extent.
        labelField label:aString.
        labelField resize.

        labelField extent ~= oldSize ifTrue:[
            self resize
        ]
    ]
!

title:titleString okText:okString abortText:abortString
    "set title and texts in the buttons"

    (titleString ~= labelField label 
     or:[okString ~= okButton label
     or:[abortString ~= abortButton label]]) ifTrue:[
        okButton label:okString.
        okButton resize.
        abortButton label:abortString.
        abortButton resize.
        labelField label:titleString.
        labelField resize.
        self resize.
    ]
!

title:titleString okText:okString
    "set title and text in okbutton"

    (titleString ~= labelField label or:[okString ~= okButton label]) ifTrue:[
        okButton label:okString.
        okButton resize.
        labelField label:titleString.
        labelField resize.
        self resize.
    ]
!

okText:aString
    "set the text to be displayed in the ok-button"

    |oldSize|

    aString ~= okButton label ifTrue:[
        oldSize := okButton extent.
        okButton label:aString.
        okButton resize.
        okButton extent ~= oldSize ifTrue:[
            self resize
        ]
    ]
!

abortText:aString
    "set the text to be displayed in the abort-button"

    |oldSize|

    aString ~= abortButton label ifTrue:[
        oldSize := abortButton extent.
        abortButton label:aString.
        abortButton resize.
        abortButton extent ~= oldSize ifTrue:[
            self resize
        ]
    ]
!

okText:okString abortText:abortString
    "set both texts displayed in the buttons"

    (abortString ~= abortButton label 
    or:[okString ~= okButton label]) ifTrue:[
        okButton label:okString.
        abortButton label:abortString.
        okButton resize.
        abortButton resize.
        self resize
    ]
!

contents
    "return my contents"

    ^ enterField contents
!

initialText:aString
    "define the initial text in the enterfield. all will be selected initially"

    enterField initialText:aString
!

initialText:aString selectFrom:start to:stop
    "define the initial text in the enterfield, and the part to be selected"

    enterField initialText:aString.
    enterField selectFromLine:1 col:start toLine:1 col:stop
!

action:aBlock
    "set the action to be performed when user presses ok-button;
     aBlock must be nil or a block with one argument "

    okAction := aBlock
!

okAction:aBlock
    "same as action - for your convenience"

    okAction := aBlock
!

abortAction:aBlock
    "set the action to be performed when user presses abort-button;
     aBlock must be nil or a block with no arguments"

    abortAction := aBlock
! !

!EnterBox methodsFor:'dependencies'!

update:something with:someArgument
    "sent if my enterbox thinks it needs more real-estate ..."

    |ext|

    something == enterField ifTrue:[
        someArgument == #preferredExtent ifTrue:[
            self resize
        ]
    ]
! !

!EnterBox methodsFor:'user interaction'!

hideAndEvaluate:aBlock
    "common processing for all ok-actions (see subclasses);
     shut down box, fetch entered string and evaluate the action with it"

    |string|

    self hide.
    aBlock notNil ifTrue:[
        string := self contents.
        string isNil ifTrue:[
            string := ''
        ] ifFalse:[
            string := string withoutSeparators
        ].
        aBlock value:string
    ]
!

okPressed
    "user pressed ok button - hide myself and evaluate okAction"

    self hideAndEvaluate:okAction
!

abortPressed
    "user pressed abort button - hide myself and evaluate okAction"

    self hideAndEvaluate:abortAction
! !