AppModel.st
author ca
Wed, 05 Mar 1997 13:24:26 +0100
changeset 488 1686464333f6
parent 483 bf49c2e7285f
child 500 3a387d00c0ff
permissions -rw-r--r--
encoding

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

Model subclass:#ApplicationModel
	instanceVariableNames:'builder resources device'
	classVariableNames:'DefaultLabels DefaultVisuals'
	poolDictionaries:''
	category:'Interface-Framework'
!

ApplicationModel class instanceVariableNames:'ClassResources'

"
 The following class instance variables are inherited by this class:

	Model - 
	Object - 
"
!

!ApplicationModel class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 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
"
    Since many ST-80 classes are subclasses of ApplicationModel, this class
    is provided here to allow easier porting of ST-80 code.

    It does not (currently) provide all functionality and is NOT
    compatible to the corresponding ST80 class; therefore, manual
    changes have to be made to get those applications to run under ST/X.
    (but at least, this enables you to fileIn that code and have a superclass
     for them)

    As time goes by, ST/X applications are going to be converted to
    become subclasses of this abstract class - see Launcher for a
    first concrete example.


    ApplicationModel is prepared to build a view from a windowSpec, as
    created by the windowBuilder. If your subclass does not provide such
    a spec, you should at least redefine:

        #openInterface   - to create a topview and open it

    you may want to redefine:

        #closeRequest    - to catch window closing
        #focusSequence   - to define a sequence for focus-stepping


    Once the interfaceBuilder is finished & released, subclasses can
    alternatively provide the spec via a #windowSpec method.

    The classResources have been put into this class to allow ST/X
    applications (which used to be subclasses of StandardSystemView)
    to migrate smoothly into ApplicationModels (which is better design ...).


    [Instance variables:]
        resources    ResourcePack       language string translation

        builder      WindowBuilder      a builder who knows how to create
                                        a window hierarchy from a specification


    Notice: this class was implemented using protocol information
    from alpha testers and PD code - it may not be complete or compatible to
    the corresponding ST-80 class. If you encounter any incompatibilities,
    please forward a note to the ST/X team.


    [author:]
        Claus Gittinger

    [see also:]
        StandardSystemView
        WindowGroup DeviceWorkstation
"
! !

!ApplicationModel class methodsFor:'initialization'!

initialize 
    self == ApplicationModel ifTrue:[
        Smalltalk addDependent:self
    ].
    DefaultLabels isNil ifTrue:[
        DefaultLabels := IdentityDictionary new
    ].
    DefaultVisuals isNil ifTrue:[
        DefaultVisuals := IdentityDictionary new
    ].

    "
     ApplicationModel initialize
    "

    "Modified: 28.1.1997 / 12:31:38 / cg"
! !

!ApplicationModel class methodsFor:'instance creation'!

new
    "return a new initialized instance"

    ^ super new basicInitialize initialize

    "Modified: 24.4.1996 / 09:42:14 / cg"
!

onDevice:aDevice
    "return a new initialized instance, which shall open its interface
     on aDevice."

    ^ (super new basicInitialize
        setDevice:aDevice) initialize

    "Modified: 24.4.1996 / 09:42:14 / cg"
    "Created: 5.7.1996 / 12:19:15 / cg"
! !

!ApplicationModel class methodsFor:'accessing'!

application
    ^ self

! !

!ApplicationModel class methodsFor:'bindings'!

actionFor:aKey
    "sent by the builder to ask for an actionBlock for
     a Button. The argument, aKey comes from an UI-spec
     for a buttons #action property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     actionBlocks from a Dictionary or whatever.
     Typically, a block is returned there."

    ^ nil


!

aspectFor:aKey
    "sent by the builder to ask for an aspect (a data model).
     The argument, aKey comes from an UI-spec
     for a components #aspect property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a valueHolder is returned there."

    ^ nil

!

clientFor:aKey
    "sent by the builder to ask for an application provided
     subcanvas's application.
     The argument, aKey comes from an UI-spec
     for a subcanvas's #client property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     appModels from a Dictionary or whatever.
     Typically, an applicationModel is returned there."

    ^ nil

!

componentFor:aKey
    "sent by the builder to ask for an application provided
     component.
     The argument, aKey comes from an UI-spec
     for a viewHolders #view property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a view is returned there."

    (self respondsTo:aKey) ifTrue:[
        ^ self perform:aKey
    ].
    ^ nil
!

labelFor:aKey
    "sent by the builder to ask for an application provided
     label for a component.
     The argument, aKey comes from an UI-spec
     for a components #label property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     labels from a Dictionary or whatever.
     Typically, a string is returned there."

    (self application respondsTo:aKey) ifTrue:[
        ^ self application perform:aKey
    ].
    ^ self application labelAt:aKey ifAbsent:nil

!

listFor:aKey
    "sent by the builder to ask for an application provided
     holder for a list.
     The argument, aKey comes from an UI-spec
     for a listWidgets #list property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a list-holding model (SelectionInList) is returned there."

    |app|

    (app := self application) notNil ifTrue:[
        (app respondsTo:aKey) ifTrue:[
            ^ app perform:aKey
        ]
    ].
    ^ nil.

    "Modified: 4.3.1997 / 00:53:03 / cg"
!

menuFor:aKey
    "sent by the builder to ask for an application provided
     holder for a menu.
     The argument, aKey comes from an UI-spec
     for a widgets #menu property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a menu or a menu-holding valueHolder is returned there."

    ^ self application perform:aKey

!

specificationFor:aKey
    "sent by the builder to ask for an application provided
     component.
     The argument, aKey comes from an UI-spec
     for a viewHolders #specification property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a view is returned there."

    ^ self application perform:aKey

!

visualFor:aKey
    "sent by the builder to ask for an application provided
     image or element for a label.
     The argument, aKey comes from an UI-spec
     for a widgets #label property, if LabelIsImage is turned on.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     images from a Dictionary or whatever.
     Typically, an image is returned there."

    (self application respondsTo:aKey) ifTrue:[
        ^ self application perform:aKey
    ].
    ^ self application visualAt:aKey ifAbsent:nil


! !

!ApplicationModel class methodsFor:'change & update'!

update:something with:aParameter from:changedObject
    "flush resources on language changes"

    something == #Language ifTrue:[
        "flush resources on language changes"
        self flushAllClassResources
    ]

    "Created: 15.6.1996 / 15:13:29 / cg"
! !

!ApplicationModel class methodsFor:'defaults'!

labelAt:aKey
    ^ nil
!

labelAt:aKey ifAbsent:aBlock
    ^ aBlock value
!

labelAt:aKey put:aValue
    "/ not yet implemented
!

labels
    "/ not yet implemented
    ^ nil
!

visualAt:aKey
    ^ nil
!

visualAt:aKey ifAbsent:aBlock
    ^ aBlock value
!

visualAt:aKey put:aValue
    "/ not yet implemented
!

visuals
    "/ not yet implemented
    ^ nil
! !

!ApplicationModel class methodsFor:'queries'!

interfaceSpecFor:aSelector
    "return an interface spec"

    ^ UISpecification from:(self application specificationFor:aSelector)
! !

!ApplicationModel class methodsFor:'resources'!

classResources
    "if not already loaded, get the classes resourcePack
     and return it"

    ClassResources isNil ifTrue:[
	ClassResources := ResourcePack for:self.
    ].
    ^ ClassResources
!

classResources:aResourcePack
    "allow setting of the classResources"

    ClassResources := aResourcePack
!

flushAllClassResources
    "flush all classes resource translations.
     Needed after a resource file / language setting has changed."

    ResourcePack flushCachedResourcePacks.
    self flushClassResources.
    self allSubclassesDo:[:aClass |
	aClass flushClassResources.
    ]
!

flushClassResources
    "flush classes resource string translations.
     Needed whenever a resource file / language setting has changed"

    ClassResources := nil.
!

updateClassResources
    "update my classResources"

    ClassResources := nil.
    self classResources
! !

!ApplicationModel class methodsFor:'startup'!

open
    "create an instance of the application and open its view"

    ^ self new open

    "
     Launcher open
    "

    "Modified: 13.1.1997 / 20:54:50 / cg"
!

openAt:aLocation
    "create an instance of the application and open its view
     at some position."

    ^ self new openAt:aLocation

    "Modified: 14.2.1997 / 20:28:41 / cg"
!

openDialogInterface:anInterfaceSymbol
    "create an instance of the application and open a view as
     specified by anInterfaceSymbol."

    ^ self openDialogInterface:anInterfaceSymbol withBindings:nil

    "Modified: 5.9.1995 / 17:54:50 / claus"
    "Created: 14.2.1997 / 20:33:10 / cg"
    "Modified: 28.2.1997 / 14:07:36 / cg"
!

openDialogInterface:anInterfaceSymbol withBindings:bindings
    "create an instance of the application and open a view as
     specified by anInterfaceSymbol."

    ^ self new openDialogInterface:anInterfaceSymbol withBindings:bindings

    "Modified: 5.9.1995 / 17:54:50 / claus"
    "Modified: 13.1.1997 / 20:55:02 / cg"
    "Created: 28.2.1997 / 14:07:24 / cg"
!

openInterface:anInterfaceSymbol
    "create an instance of the application and open a view as
     specified by anInterfaceSymbol."

    ^ self new openInterface:anInterfaceSymbol

    "Modified: 5.9.1995 / 17:54:50 / claus"
    "Modified: 13.1.1997 / 20:55:02 / cg"
!

openInterface:anInterfaceSymbol at:aPoint
    "create an instance of the application and open a view as
     specified by anInterfaceSymbol."

    ^ self new openInterface:anInterfaceSymbol at:aPoint

    "Modified: 14.2.1997 / 20:28:47 / cg"
!

openOn:anApplicationModel
    "send an open message to the argument, anApplicationModel.
     I dont really understand what this method is useful for ..."

    ^ anApplicationModel open

    "Modified: 13.1.1997 / 20:55:05 / cg"
!

openOnDevice:aDevice
    "create an instance of the application and open its view
     on ANOTHER device. 
     For more info, read the document on multiple display
     support and the documentation of the DeviceWorkstation class."

    ^ (self onDevice:aDevice) open

    "
     Launcher openOnDevice:Display
    "

    "Modified: 13.1.1997 / 20:55:27 / cg"
! !

!ApplicationModel methodsFor:'accessing'!

application
    ^ self class
!

builder
    "return the applications builder; this one has more information
     about views, components etc."

    ^ builder
!

builder:aBuilder
    "set the applications builder. Normally, you should not set it
     directly, but depend on the default builder, as created when the application
     was created."

    builder := aBuilder
!

focusSequence
    "return a focusSequence for stepping through the applications views.
     The builder usually keeps track of so-called 'tabable' views.
     Stepping is done with the FocusNext/FocusPrevius keys, which are 
     typically bound to Meta-CursorUp/Meta-CursorDown.
     Subclasses which do not use the builder (but instead build their view
     programmatically) should redefine this method to return a collection of
     views which defines the sequence."

    builder notNil ifTrue:[
	^ builder focusSequence
    ].
    ^ nil
!

resources
    "return the applications resources - thats a ResourcePack containing
     language strings"

    ^ resources
!

window
    "return my topWindow"

    ^ builder window
!

window:aTopView
    "set my topWindow"

    builder window:aTopView

    "Created: 18.4.1996 / 14:55:26 / cg"
!

windowGroup 
    "return the applications windowGroup"

    ^ builder window windowGroup
! !

!ApplicationModel methodsFor:'binding access'!

actionFor:aKey
    "sent by the builder to ask for an actionBlock for
     a Button. The argument, aKey comes from an UI-spec
     for a buttons #action property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     actionBlocks from a Dictionary or whatever.
     Typically, a block is returned there."

    ^ [self perform:aKey]
!

aspectFor:aKey
    "sent by the builder to ask for an aspect (a data model).
     The argument, aKey comes from an UI-spec
     for a components #aspect property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a valueHolder is returned there."

    ^ self perform:aKey

!

clientFor:aKey
    "sent by the builder to ask for an application provided
     subcanvas's application.
     The argument, aKey comes from an UI-spec
     for a subcanvas's #client property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     appModels from a Dictionary or whatever.
     Typically, an applicationModel is returned there."

    ^ self perform:aKey

!

componentFor:aKey
    "sent by the builder to ask for an application provided
     component.
     The argument, aKey comes from an UI-spec
     for a viewHolders #view property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a view is returned there."

    (self respondsTo:aKey) ifTrue:[
        ^ self perform:aKey
    ].
    ^ self application componentFor:aKey

!

labelFor:aKey
    "sent by the builder to ask for an application provided
     label for a component.
     The argument, aKey comes from an UI-spec
     for a components #label property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     labels from a Dictionary or whatever.
     Typically, a string is returned there."

    ^ self application labelFor:aKey

!

listFor:aKey
    "sent by the builder to ask for an application provided
     holder for a list.
     The argument, aKey comes from an UI-spec
     for a listWidgets #list property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a list-holding model (SelectionInList) is returned there."

    (self respondsTo:aKey) ifTrue:[
        ^ self perform:aKey
    ].
    ^ self application listFor:aKey

!

menuFor:aKey
    "sent by the builder to ask for an application provided
     holder for a menu.
     The argument, aKey comes from an UI-spec
     for a widgets #menu property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     holders from a Dictionary or whatever.
     Typically, a menu or a menu-holding valueHolder is returned there."

    (self respondsTo:aKey) ifTrue:[
        ^ self perform:aKey
    ].
    ^ self application menuFor:aKey

!

specificationFor:aKey
    "sent by the builder to ask for an application provided
     subcanvas's application.
     The argument, aKey comes from an UI-spec
     for a subcanvas's #specification property.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     appModels from a Dictionary or whatever.
     Typically, an applicationModel is returned there."

    ^ self perform:aKey

!

visualFor:aKey
    "sent by the builder to ask for an application provided
     image or element for a label.
     The argument, aKey comes from an UI-spec
     for a widgets #label property, if LabelIsImage is turned on.
     Here, a corresponding message is sent to myself,
     which ought to be defined in the application subclass.
     Alternatively, a subclass may redefine this method, to provide
     images from a Dictionary or whatever.
     Typically, an image is returned there."

    ^ self application visualFor:aKey

! !

!ApplicationModel methodsFor:'component manipulations'!

components:aSymbolOrArray do:aBlock
    "evaluate aBlock for all components listed aSymbolOrArray."

    |coll|

    aSymbolOrArray isSymbol ifTrue:[
        "/ a single components name
        coll := Array with:aSymbolOrArray
    ] ifFalse:[
        coll := aSymbolOrArray
    ].
    coll do:[:aSymbol |
        |component|

        (component := self component:aSymbol) isNil ifFalse:[
            aBlock value:component
        ]
    ]

    "Modified: 14.2.1997 / 17:36:42 / cg"
!

disable:aSymbolOrArray
    "disable the components whose id's are aSymbolOrArray."

    self components:aSymbolOrArray do:[:comp | comp disable]

    "Modified: 14.2.1997 / 17:32:09 / cg"
!

enable:aSymbolOrArray
    "enables the component(s) identified by aSymbolOrArray."

    self components:aSymbolOrArray do:[:comp | comp enable]

    "Modified: 14.2.1997 / 17:32:19 / cg"
!

invalidate:aSymbolOrArray
    "invalidates the component(s) identified by aSymbolOrArray."

    self components:aSymbolOrArray do:[:comp | comp invalidate]

    "Modified: 14.2.1997 / 17:32:28 / cg"
!

makeInvisible:aSymbolOrArray
    "makes the components whose id's are aSymbolOrArray invisible"

    self components:aSymbolOrArray do:[:comp | comp beInvisible]

    "Modified: 14.2.1997 / 17:32:42 / cg"
!

makeReadOnly:aSymbolOrArray
    "make all components identified by aSymbolOrArray read only
     (for editText components)."

    self components:aSymbolOrArray do:[:comp | comp readOnly:true]

    "Modified: 14.2.1997 / 17:36:22 / cg"
!

makeVisible:aSymbolOrArray
    "makes the components whose id's are aSymbolOrArray visible"

    self components:aSymbolOrArray do:[:comp | comp beVisible]

    "Modified: 14.2.1997 / 17:32:52 / cg"
!

makeWritable:aSymbolOrArray
    "make all components identified by aSymbolOrArray writable 
     (for editText components)."

    self components:aSymbolOrArray do:[:comp | comp readOnly:false]

    "Created: 14.2.1997 / 17:36:17 / cg"
! !

!ApplicationModel methodsFor:'drag & drop'!

canDrop:anObjectOrCollection in:aComponent
    "drop manager asked if a drop is possible
     - should be redefined by apps which can do it, to return true"

    ^ false


!

drop:anObjectOrCollection in:aComponent at:aPoint
    "drop manager wants to drop.
     This is ony sent, if #canDrop:in: returned true.
     Must be redefined in apps which return true to #canDrop."

    self subclassResponsibility


! !

!ApplicationModel methodsFor:'easy bindings'!

registerInterestIn: aValueModel using: aSelectorOrArray
    "Register interest in a change in aValueModel using information in aSelectorOrArray.
     aSelectorOrArray can be one of three things:  

            1) nil                  in which case no interest is registered
            2) a selector           in which case the receiver is understood to be self
            3) an Array             in which case the size is two where the first element is the
                                            message to be sent and the second element is the receiver."

    aSelectorOrArray isNil ifTrue: [^ aValueModel].

    (aSelectorOrArray isKindOf:Array) ifTrue:[
        aValueModel onChangeSend:(aSelectorOrArray at: 1) to:(aSelectorOrArray at: 2)
    ] ifFalse: [
        aValueModel onChangeSend:aSelectorOrArray to:self
    ].
    ^aValueModel


!

valueHolderFor:aSelector initialValue:anObject
    "Return a ValueHolder on anObject." 

    ^ self valueHolderFor:aSelector initialValue:anObject changeMessage:nil


!

valueHolderFor: aSelector initialValue: anObject changeMessage: aSelectorOrArray
    "Return a ValueHolder on anObject.  aSelectorOrArray is the change information 
     for the ValueHolder.  This argument is either a Symbol or an Array of two elements.  
     If it is a Symbol, then it is the change message and the interested object is understood
     to be the reciever.  If it is an Array, then the first element is the change message and 
     the second element is the interested object. " 

    (self builder bindings includesKey:aSelector) ifFalse:[
        ^ self registerInterestIn:(ValueHolder with:anObject) using:aSelectorOrArray
    ].
    ^ self builder aspectAt:aSelector

! !

!ApplicationModel methodsFor:'initialization'!

addTopViewsToCurrentProject
    "add all of my topViews to the current projects list of views.
     This allows hiding views on a per-project basis.
     Applications which do not want to be switched with projects
     (such as the Launcher), may redefine this to a noop."

    self windowGroup topViews do:[:aView |
        aView addToCurrentProject
    ]

    "Modified: 17.1.1997 / 19:43:39 / cg"
!

basicInitialize
    "initialize the application.
     Since ST-80 applications seem commonly to redefine #initialize
     without doing a super initialize, the real initialization is
     done here ..."

    super initialize.

    device := Screen current.

    "claus: I wanted to delay the creation & assignment of the
     builder till later, to allow setting to another builder.
     however, some ST-80 code accesses the builder right after instance
     creation ..."

"/    "
"/     Create a windowBuilder to have someone around which
"/     understands the builder protocol. Since UIBuilder is not present
"/     in all systems, this allows operation without one (unless a spec
"/     is read later ...)
"/    "
    builder := self createBuilder.
    builder notNil ifTrue:[builder application:self].
    resources := self class classResources.

    "Modified: 17.1.1997 / 19:41:59 / cg"
!

createBuilder 
    "create a UI Builder for me.
     This method can be redefined if (eventually) there are
     spec readers for other UI languages (motif UIL ?)"

    |cls|

    (cls := UIBuilder) isNil ifTrue:[
	(cls := WindowBuilder) isNil ifTrue:[
	    ^ nil
	]
    ].
    ^ cls new
!

initialize
    "nothing done here;
     but can be redefined in concrete applications"
!

setDevice:aDevice
    "set the device (i.e. some Screen), where the application
     shall open its view(s).
     The default device (if not set here) will be the current screen."

    device := aDevice

    "Created: 5.7.1996 / 12:01:40 / cg"
    "Modified: 17.1.1997 / 19:44:09 / cg"
! !

!ApplicationModel methodsFor:'misc'!

restoreCursors
    "restore the original cursors in all of my views"

    ^ self window windowGroup restoreCursors

    "Created: 1.6.1996 / 17:01:24 / cg"
!

showCursor:aCursor
    "set all of my views cursor to aCursor.
     It can be restored with #restoreCursor."

    ^ self window windowGroup showCursor:aCursor

    "Created: 1.6.1996 / 17:01:09 / cg"
!

withCursor:aCursor do:aBlock
    "evaluate aBlock, showing aCursor in my topView and all of its subviews.
     Return the value of aBlock."

    ^ self window withCursor:aCursor do:aBlock
!

withExecuteCursorDo:aBlock
    "evaluate aBlock, showing an executeCursor in my topView and all of its subviews.
     Return the value of aBlock."

    ^ self withCursor:(Cursor execute) do:aBlock

    "Created: 14.12.1995 / 20:57:03 / cg"
!

withReadCursorDo:aBlock
    "evaluate aBlock, showing a readCursor in my topView and all of its subviews.
     Return the value of aBlock."

    ^ self withCursor:(Cursor read) do:aBlock

    "Created: 14.12.1995 / 20:56:47 / cg"
    "Modified: 14.12.1995 / 20:57:36 / cg"
!

withWaitCursorDo:aBlock
    "evaluate aBlock, showing a waitCursor in my topView and all of its subviews.
     Return the value of aBlock."

    ^ self withCursor:Cursor wait do:aBlock
! !

!ApplicationModel methodsFor:'opening'!

openDialog
    "open the window - assumes that the builder has already setup
     the interface."

    ^ builder openDialog.

    "Modified: 14.2.1997 / 20:32:52 / cg"
!

openDialogInterface:aSelector
    "open a dialog"

    ^ self openDialogInterface:aSelector withBindings:nil

    "Modified: 28.2.1997 / 14:08:01 / cg"
!

openDialogInterface:aSelector withBindings:bindings
    "open a dialog"

    ^ SimpleDialog new openFor:self interface:aSelector withBindings:bindings

    "Created: 28.2.1997 / 14:07:45 / cg"
!

openWindow
    "open the window - assumes that the builder has already setup
     the interface."

    builder open.

    "Created: 14.2.1997 / 20:20:39 / cg"
!

openWindowAt:aLocation
    "open the window - assumes that the builder has already setup
     the interface."

    builder openWindowAt:aLocation.

    "Created: 14.2.1997 / 20:20:55 / cg"
! !

!ApplicationModel methodsFor:'private'!

opened
    "the topView has been opened.
     This is sent by my topView when its really open
     (i.e. finally visible)"

    self addTopViewsToCurrentProject.
    self postOpenWith:builder

    "Modified: 14.2.1997 / 20:26:16 / cg"
! !

!ApplicationModel methodsFor:'queries'!

defaultWindowType
    "Applications come up non-modal, by default"

    ^ #normal

    "Created: 17.1.1997 / 19:57:34 / cg"
!

graphicsDevice
    "return the device I want to open my views on.
     The default (if not created with #onDevice:) is the currently
     active screen."

    ^ device

    "Created: 5.7.1996 / 17:51:31 / cg"
!

processName
    "return a name to be shown for me in the process monitor"

    ^ 'Application'
! !

!ApplicationModel methodsFor:'startup / release'!

allButOpenFrom:aSpec
    "create my views but do not open the main window"

    |realBuilder|

"/ DISABLED; see comment in basicInitialize
"/
"/    "
"/     here, we kludge a bit: up to now, the builder was an
"/     instance of the no-op WindowBuilder. Now, it becomes
"/     a UIBuilder ....
"/     This allows for ApplicationModels without a UIBuilder
"/     if not needed.
"/    "
"/    realBuilder := UIBuilder new.
"/    builder := realBuilder.
"/    builder application:self.
"/    builder bindings:builder bindings.

    self preBuildWith:builder.
    builder buildFromSpec:aSpec.
    builder window model:self.
    (builder window respondsTo:#application:) ifTrue:[
        builder window application:self.
    ].
    self postBuildWith:builder.
!

allButOpenInterface:aSymbol
    "create my views but do not open the main window"

    |spec|

    spec := self class interfaceSpecFor:aSymbol.
    self allButOpenFrom:spec.
    ^ builder
!

close
    "this is sent by my topView when about to be closed
     by the program (not by the windowManager).
     Could be redefined in subclasses."

    self closeDownViews
!

closeDownViews
    "close down the applications view(s)"

    |wg views|

    (wg := self windowGroup) notNil ifTrue:[
        views := wg topViews.
        views notNil ifTrue:[
            views copy do:[:aView |
                aView notNil ifTrue:[aView destroy]
            ]
        ]
    ]
!

closeRequest
    "this is sent by my topView when about to be closed
     by the program (not by the windowManager).
     Could be redefined in subclasses to suppress close or confirm."

    self closeDownViews

    "Modified: 4.3.1997 / 00:48:15 / cg"
!

closeRequestFor:aTopView
    "this is sent by any of my topViews when about to be closed by the
     windowmanager. For backward compatibility with single-view applications,
     this is forwarded here to a simple (non topView-specific) closeRequest.
     MultiView applications should redefine this method if closing of individual
     views closing is to be cought."

    ^ self closeRequest
!

open
    "open a standard interface"

    ^ self openInterface

    "Modified: 3.5.1996 / 13:39:15 / cg"
!

openAt:aPoint
    "open a standard interface at some point"

    ^ self openInterfaceAt:aPoint

    "Modified: 3.5.1996 / 13:39:15 / cg"
    "Created: 14.2.1997 / 20:17:41 / cg"
!

openInterface
    "open a standard interface.

     Subclasses which do not have an interfaceSpec 
     should redefine this method and create & open their view(s) there.
     (see Launcher as an example)."

    self openInterface:#windowSpec

    "Modified: 9.9.1996 / 22:39:23 / stefan"
    "Modified: 14.2.1997 / 20:18:26 / cg"
!

openInterface:aSymbol
    "open a specific interface. 
     The argument, aSymbol specifies which interface. The concrete
     application subclass must provide a method with that name,
     which must return an interfaceSpec. This is forwarded to
     the builder to create the views.
     Typically, applications only use one interface, 
     returned by the #windowSpec method."

    self allButOpenInterface:aSymbol.
    self openWindow.
    ^ builder

    "Modified: 14.2.1997 / 20:25:33 / cg"
!

openInterface:aSymbol at:aLocation
    "open a specific interface. 

     The argument, aSymbol specifies which interface. The concrete
     application subclass must provide a method with that name,
     which must return an interfaceSpec. This is forwarded to
     the builder to create the views.
     Typically, applications only use one interface, 
     returned by the #windowSpec method."

    self allButOpenInterface:aSymbol.
    self openWindowAt:aLocation.
    ^ builder

    "Created: 14.2.1997 / 20:19:44 / cg"
!

openInterfaceAt:aLocation
    "open a standard interface."

    self openInterface:#windowSpec at:aLocation

    "Created: 14.2.1997 / 20:18:20 / cg"
!

openOnDevice:aDevice
    "open a standard interface on some other device"

    self setDevice:aDevice.
    ^ self open

    "Created: 13.1.1997 / 21:24:11 / cg"
    "Modified: 13.1.1997 / 21:24:30 / cg"
!

postBuildWith:aBuilder
    "this is sent after an interface is built from a spec.
     Can be redefined in subclasses.
     mhmh - what should this do here ?"
!

postOpenWith:aBuilder
    "this is sent after the applications main window is opened.
     Can be redefined in subclasses.
     mhmh - what should this do here ?"
!

preBuildWith:aBuilder
    "this is sent before an interface is built from a spec.
     Can be redefined in subclasses.
     mhmh - what should this do here ?"
!

restarted
    "sent by my topWindow, when restarted from an image.
     Nothing done here, but can be redefined to perform any actions
     required to reset the application after an image-restart.
     (for example: check if application files are still around, restart
      subprocesses etc.)."

    "Modified: 1.6.1996 / 16:55:50 / cg"
!

saveAndTerminateRequest
    "some windowManagers send this to shut down an application
     and have it save its state for restart.
     Can be redefined in subclasses"

    self closeRequest
!

saveAndTerminateRequestFor:aTopView
    "some windowManagers send this to shut down an application
     and have it save its state for restart.
     Can be redefined in subclasses"

    self saveAndTerminateRequest
! !

!ApplicationModel methodsFor:'window events'!

showActivity:someMessage
    "some activityNotification shalt be communicated to
     the user. Forwarded from the topView and ignored here.
     Can be redefined in concrete applications to show the
     message either in some infoView (infoLabel as in Windows)
     or in the title area (as done in the browsers)"

    ^ self

    "Created: 16.12.1995 / 18:41:04 / cg"
    "Modified: 24.4.1996 / 09:34:22 / cg"
!

windowEvent:anEvent from:anApplicationWindow
    "dummy: windowEvent forwarding is not yet implemented"

    ^ self

    "Modified: 24.4.1996 / 09:32:50 / cg"
! !

!ApplicationModel class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/Attic/AppModel.st,v 1.47 1997-03-04 00:25:30 cg Exp $'
! !
ApplicationModel initialize!