"======================================================================
|
|   Smalltalk GUI `outside the classes' method
|
|   $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.  
|
 ======================================================================
"

GuiData subclass:  #BrowserMain
	instanceVariableNames: ''
	classVariableNames: 'Shell Windows HandleErrorsWithGui'
	poolDictionaries: ''
	category: 'Graphics-Browser'
!

!BrowserMain class methodsFor: 'accessing'!

addWindow: toplevel
    Windows add: toplevel.
!

removeWindow: toplevel
    Windows remove: toplevel
!

windowsDo: aBlock
    Windows do: aBlock
!

checkExit
    ^Windows isNil or: [ Windows allSatisfy: [ :w | w canClose ] ]
!

handleErrorsWithGui
    ^HandleErrorsWithGui
!

handleErrorsWithGui: aBoolean
    HandleErrorsWithGui := aBoolean
!

saveImage
    | savedShell savedTranscript |
    "There is no guarantee that the image will be loaded running the
     browser. So some variables must be nil'ed out.

     The class variable, 'Shell', is used, secondarily as a flag to
     indicate initialization status.  If it is nil, the browser does
     not attempt to display a Notifier or some other type of window
     before the Tk and Smalltalk system has been initialized"
    
    savedTranscript := Transcript message.
    savedShell := Shell.

    Transcript message: stdout -> #nextPutAll: .
    self handleErrorsWithGui: false.
    Shell := nil.
    Smalltalk snapshot.
    Shell := savedShell.
    self handleErrorsWithGui: true.
    Transcript message: savedTranscript.
!

close
"This method is invoked before quitting the browser and before saving the 
Smalltalk image.  When the system is launched subsequently, it is important 
that the shell be nil until the browser is initialized.  Other methods use the
state of this variable (Shell) to probe the browser's initialization status"
    Shell := nil.
!

shell
"Return application widget pointer.  This method is used to determine whether 
the Tk and browser environment is initialized.  If 'shell' is non-nil, the 
environment is completely initialized"
    ^Shell
! !

!BrowserMain methodsFor: 'initializing'!

initialize
    "Initialize Tk environment.  Create a transcript which will be used to
    operate the browser.  It has a menu from which the user can select the
    desired menu option"
    | win transcriptAndShell |
    self class handleErrorsWithGui: false.
    Smalltalk addFeature: #EventLoop.
    Shell := nil.
    Windows := Set new.
    transcriptAndShell := BrowserShell
	openWorksheet: 'Smalltalk Transcript'
	withText: (Version copyWith: Character nl).

    Transcript message: transcriptAndShell value -> #insertAtEnd: .
    Shell := transcriptAndShell key.
    Shell data: self.
    win := Shell blox.

    win createToplevelWindow: 'window'.
    win callback: self class message: #quit.

    self class handleErrorsWithGui: true.
    Shell display.
    Blox dispatchEvents.
    Shell blox exists ifTrue: [ Shell blox destroy ].

    Smalltalk at: #Transcript put: nil.
    self class handleErrorsWithGui: false.
    Shell := nil.
! !

!BrowserMain class methodsFor: 'blue button messages'!

garbageCollect
    "Force a full garbage collection in order to dispose of all unreferenced 
    instances"
    Smalltalk compact.
!

openWorksheet
    ^BrowserShell openWorksheet: 'Worksheet'
!

openWorksheet: label
    ^BrowserShell openWorksheet: label
!

openBrowser
    ClassHierarchyBrowser new openOn: nil.
!

directQuit
    BrowserMain checkExit ifFalse: [^self beep].
    BrowserMain shell release.
    Blox terminateMainLoop.
    ^true
!

quit
    "Quit Smalltalk browser"
    | exit |
    self checkExit ifFalse: [^self beep].
    exit := false.
    ModalDialog new
	message: 'Save image before quitting?' in: self shell;
	addButton: 'Yes' message: [self saveImage. exit := true];
	addButton: 'No' message: [exit := true];
	addButton: 'Cancel' message: [];
	display: self shell.
    exit ifFalse: [^false].
    self shell release.
    Blox terminateMainLoop.
    ^true
! !

!BrowserMain methodsFor: 'window maintenance'!

addWindow: toplevel
    ^Windows add: toplevel.
!

removeWindow: toplevel
    ^Windows remove: toplevel
! !

BrowserMain handleErrorsWithGui: false!