"======================================================================
|
|   Smalltalk GUI wrapper for modal dialogs
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Brad Diller.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
| 
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
| details.
| 
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================
"

Gui subclass:  #ModalDialog
	instanceVariableNames: 'dialogShell messageDispatch'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Windows'
!

!ModalDialog methodsFor: 'initialization'!

message: queryString in: parent
"Initialize dialog and button actions"
    messageDispatch := LookupTable new.
    dialogShell := BTransientWindow new: 'Modal dialog' in: (parent rootView blox).
    dialogShell width: 200 height: 140.
    blox := (BDialog new: dialogShell label: queryString prompt: nil).
    dialogShell createToplevelWindow: 'Modal dialog'.
!

addButton: label message: block
    messageDispatch at: (messageDispatch size + 1) put: block.
    blox addButton: label receiver: self index: (messageDispatch size).
!

alertMessage: queryString in: parent
    self message: queryString in: parent.
    self addButton: 'Ok' message: [].
    self display: parent.
! !

!ModalDialog methodsFor: 'displaying'!

display: parent
    dialogShell map.
    blox center.
    blox loop.
! !

!ModalDialog methodsFor: 'private'!

dispatch: index
    (messageDispatch at: index) value.
! !



Gui subclass:  #Prompter
	instanceVariableNames: 'defaultResponse'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Windows'
!

!Prompter class methodsFor: 'instance creation'!

openFileName: aString default: default in: view
    ^BDialog
	chooseFileToOpen: view rootView blox
	label: aString
	default: default
	defaultExtension: 'st'
	types: #(
	    ('Smalltalk files'  '.st')
	    ('Text files'  '.txt'))
!

saveFileName: aString default: default in: view
    ^BDialog
	chooseFileToSave: view rootView blox
	label: aString
	default: default
	defaultExtension: 'st'
	types: #(
	    ('Smalltalk files'  '.st')
	    ('Text files'  '.txt'))
!

message: aString default: aResponse in: view
    ^self new message: aString default: aResponse in: view
!

message: aString in: view
    ^self new message: aString default: '' in: view
! !

!Prompter methodsFor: 'initialize-delete'!

message: queryString default: aResponse in: view
| dialogShell  |
    "Prompt user for string input.  The default response, queryString, is displayed in
     text portion"
    defaultResponse := aResponse.
    dialogShell := BTransientWindow new: 'Prompter dialog' in: (view rootView blox).
    dialogShell width: 300 height: 180.
    self blox: (BDialog new: dialogShell label: queryString prompt: aResponse).
    dialogShell createToplevelWindow: 'Prompter dialog'.
    blox addButton: 'OK' receiver: self message: #accept.
    blox addButton: 'Cancel' receiver: self message: #cancel.
    dialogShell map.
    self blox center.
    self blox loop.
! !

!Prompter methodsFor: 'accessing'!

accept 
| index |
    "Truncate string after newline character"
    defaultResponse := blox contents.
    (index := defaultResponse findFirst: [ :ch | ch == Character nl ]) > 0
	ifTrue: [ defaultResponse := defaultResponse copyFrom: 1 to: index - 1].
!

cancel
    defaultResponse := ''.
!

response
"Return default response"
    ^defaultResponse
! !

