"
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.
"
"{ Package: 'stx:libview2' }"
Model subclass:#ApplicationModel
instanceVariableNames:'builder resources device masterApplication'
classVariableNames:'DefaultLabels DefaultVisuals'
poolDictionaries:''
category:'Interface-Framework'
!
ApplicationModel class instanceVariableNames:'ClassResources'
"
No other class instance variables are inherited by this class.
"
!
!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"
|inst|
inst := super basicNew.
inst basicInitialize.
inst initialize.
^ inst
"Modified: 24.4.1996 / 09:42:14 / cg"
!
onDevice:aDevice
"return a new initialized instance, which shall open its interface
on aDevice."
^ (super basicNew 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:'active help'!
helpSpec
^ IdentityDictionary new.
! !
!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
!
actionFor:aKey withValue:aValue
"sent by the builder to ask for an actionBlock for
a Button which passes a value to the actionMethod.
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."
^ self perform:aKey
"/ ^ nil
"Modified: / 27.10.1997 / 13:43:12 / cg"
!
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
specification for a subcanvas or subspecification.
The argument, aKey comes from an UI-spec
for a subcanvases #specification property (minorKey).
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
interfaceSpecifications from a Dictionary or whatever.
Typically, an interfaceSpecification is returned there."
^ self application perform:aKey
"Modified: / 5.2.1998 / 00:21:57 / stefan"
!
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'!
defaultIcon
^ nil
!
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)
!
isVisualStartable
"return true, if this application can be started via #open"
(self == ApplicationModel) ifTrue:[^ false "I am abstract"].
((self respondsTo:#open) or:[self class implements:#openInterface]) ifFalse:[^ false].
"/ (self respondsTo:#windowSpec) ifFalse:[^ false].
^ true
"Created: / 27.10.1997 / 16:38:02 / cg"
"Modified: / 14.3.1998 / 16:30:50 / cg"
! !
!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.
!
resources
"return the applications resources - thats a ResourcePack containing
language strings"
^ self classResources
"Created: / 19.5.1998 / 20:14:00 / cg"
!
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"
!
openDialogInterfaceSpec:anInterfaceSpec
"create an instance of the application and open a view as
specified by the given spec."
^ self new
openDialogInterfaceSpec:anInterfaceSpec
withBindings:nil
!
openDialogInterfaceSpec:anInterfaceSpec withBindings:bindings
"create an instance of the application and open a view as
specified by the given spec."
^ self new
openDialogInterfaceSpec:anInterfaceSpec
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"
!
openDialogSpec:aSpec
"create an instance of the application and open a view as
specified by aSpec."
^ self openDialogSpec:aSpec withBindings:nil
"Modified: / 5.9.1995 / 17:54:50 / claus"
"Modified: / 28.2.1997 / 14:07:36 / cg"
"Created: / 20.5.1998 / 20:27:08 / cg"
!
openDialogSpec:aSpec withBindings:bindings
"create an instance of the application and open a view as
specified by the spec."
^ self new openDialogSpec:aSpec withBindings:bindings
"Modified: / 5.9.1995 / 17:54:50 / claus"
"Modified: / 13.1.1997 / 20:55:02 / cg"
"Created: / 20.5.1998 / 20:26:37 / 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"
!
openModal
"create an instance of the application and open its view modal"
^ self new openModal
!
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"
!
openOnXScreenNamed:aScreenName
"create an instance of the application and open its view
on some X display screen. The argument aScreenName must be
a valid x-display name (i.e. of the form '<host>:<screenNr>' as in 'foo:0').
For more info, read the document on multiple display
support and the documentation of the DeviceWorkstation class."
|newDevice app|
newDevice := XWorkstation newDispatchingFor:aScreenName.
newDevice isNil ifTrue:[
Screen current notNil ifTrue:[
self warn:('Could not open display: ' , aScreenName).
] ifFalse:[
('Could not open display: ' , aScreenName) errorPrintCR
].
^ nil
].
Screen currentScreenQuerySignal
answer:newDevice
do:[
app := self open.
].
^ app
"
Launcher openOnXScreenNamed:'sgi:0'
Launcher openOnXScreenNamed:'foo:0'
NewLauncher openOnXScreenNamed:'dawn:0'
SystemBrowser openOnXScreenNamed:'dawn:0'
"
"Modified: 13.1.1997 / 20:55:27 / cg"
!
openWithSpec:aSpecSymbol
"ST80 compatibility:
mhmh - what is the difference to #openInterface ?"
^ self openInterface:aSpecSymbol
"Modified: 29.8.1997 / 01:16:52 / cg"
! !
!ApplicationModel methodsFor:'accessing'!
application
"application knows about interfaceSpecs, menuSpecs etc.
Usually this is my class.
This may be redefined in subclasses"
^ self class
"Modified: / 5.2.1998 / 00:45:21 / stefan"
!
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.
(unless the focus is currently attached to a textEditing view,
tabbing is also possible via the tab-key)
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 that sequence.
Notice, that the focuse sequence is asked for at the time of the tabbing
(not only during startup of the view) - so dynamically adding/removing
components is possible."
builder notNil ifTrue:[
^ builder focusSequence
].
^ nil
"Modified: / 31.10.1997 / 19:11:14 / cg"
!
masterApplication
"return the value of the instance variable 'masterApplication' (automatically generated)"
^ masterApplication!
masterApplication:something
"set the value of the instance variable 'masterApplication' (automatically generated)"
something == self ifTrue:[
self error:'an application cannot be its own masterApplication' mayProceed:true.
^ self
].
masterApplication := something.
!
resources
"return the applications resources - thats a ResourcePack containing
language strings"
^ resources
!
resources:aResourcePack
"set the applications resources - usually tis is done automatically,
except for manually built dialogs"
resources := aResourcePack
!
window
"return my topWindow - or nil, if I have no window (yet)"
|win|
builder isNil ifTrue:[^ nil].
(win := builder window) notNil ifTrue:[
^ win
].
masterApplication notNil ifTrue:[
"/ is that true ?
^ masterApplication window
].
^ nil.
"Modified: / 18.9.1998 / 15:18:19 / cg"
!
window:aTopView
"set my topWindow.
As a side effect, this creates a dummy builder if non has yet
been built. This prevents non-GUI-Painter apps from failing later,
when the builder is accessed."
builder isNil ifTrue:[
self createBuilder
].
builder window:aTopView
"Created: 18.4.1996 / 14:55:26 / cg"
!
windowGroup
"return the applications windowGroup"
|w|
builder notNil ifTrue:[
(w := builder window) notNil ifTrue:[
^ w windowGroup
].
].
masterApplication notNil ifTrue:[
^ masterApplication windowGroup
].
^ nil
"Modified: / 7.9.1998 / 23:37:00 / cg"
! !
!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 selfResponsibleFor:aKey) ifTrue:[
^ [self perform:aKey] "/ could use: MessageSend receiver:self selector:aKey
].
^ masterApplication actionFor:aKey
"Modified: / 28.10.1997 / 20:34:51 / cg"
!
actionFor:aKey withValue:aValue
"sent by the builder to ask for an actionBlock for
a Button which passes a value.
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 selfResponsibleFor:aKey) ifTrue:[
^ [self perform:aKey with:aValue]
].
^ masterApplication actionFor:aKey withValue:aValue
!
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 selfResponsibleFor:aKey) ifTrue:[
^ self perform:aKey
].
^ masterApplication aspectFor:aKey
"Modified: / 18.6.1998 / 20:33:23 / cg"
!
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 selfResponsibleFor:aKey) ifTrue:[
^ self perform:aKey
].
^ masterApplication clientFor:aKey
"Modified: / 18.6.1998 / 20:33:30 / cg"
!
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 selfResponsibleFor:aKey) ifTrue:[
^ self perform:aKey
].
^ masterApplication componentFor:aKey
"Modified: / 18.6.1998 / 20:33:36 / cg"
!
helpTextFor:aComponent
"activeHelp interface: return some help text for a widget component"
|key cls|
builder notNil ifTrue:[
cls := self class.
(cls respondsTo:#helpSpec) ifTrue:[
(key := builder helpKeyFor:aComponent) notNil ifTrue:[
^ self helpTextForKey:key
]
]
].
masterApplication notNil ifTrue:[
^ masterApplication helpTextFor:aComponent
].
^ nil
"Modified: / 31.7.1998 / 23:03:10 / cg"
!
helpTextForKey:aKey
"activeHelp interface: return some help text for a key
key is the symbol associated with some widget or menu item.
(from my helpSpec); return a language variant (if available)"
|cls helpText|
cls := self class.
(cls respondsTo:#helpSpec) ifTrue:[
helpText := (cls helpSpec) at:aKey ifAbsent:nil
].
(masterApplication notNil and:[helpText isNil]) ifTrue:[
helpText := masterApplication helpTextForKey:aKey
].
"/ translate.
resources notNil ifTrue:[
^ resources string:helpText
].
^ helpText
"Modified: / 4.2.2000 / 15:30:16 / cg"
!
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 selfResponsibleFor:aKey) ifTrue:[
^ self perform:aKey
].
^ masterApplication labelFor:aKey
"Modified: / 18.6.1998 / 20:33:42 / cg"
!
listFor:aKey
"sent by the builder to ask for an application provided
holder for a list (for example, a popUpLists 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.
If the instance does not provide a value, a corresponding aspect
is asked for. If that fails as well, the app class is asked as a last
chance."
|a|
(self selfResponsibleFor:aKey) ifTrue:[
^ self perform:aKey
].
a := self aspectFor:aKey.
a notNil ifTrue:[
^ a
].
^ self application listFor:aKey
"Modified: / 18.6.1998 / 20:33:50 / 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 selfResponsibleFor:aKey) ifTrue:[
^ self perform:aKey
].
^ masterApplication menuFor:aKey
"Modified: / 18.6.1998 / 20:33:56 / cg"
!
specificationFor:aKey
"sent by the builder to ask for an application provided
specification for a subcanvas or subspecification.
The argument, aKey comes from an UI-spec
for a subcanvases #specification property (minorKey).
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
interfaceSpecifications from a Dictionary or whatever.
Typically, an interfaceSpecification is returned there."
|app|
"/(self selfResponsibleFor:aKey) "/ rubbish
(self respondsTo:aKey)
ifTrue:[
^ self perform:aKey
].
((app := self application) respondsTo:aKey) ifTrue:[
^ app perform:aKey
].
^ masterApplication specificationFor:aKey
"Modified: / 5.2.1998 / 00:31:39 / stefan"
"Modified: / 18.6.1998 / 20:34:02 / cg"
!
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:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
"support for delayed updates -
subclasses which invoke #enqueueDelayedUpdate:with:from: (from #update:with:from:)
must also redefine this method, and perform the actual update there."
^ self
!
enqueueDelayedUpdate:something with:aParameter from:changedObject
"support for delayed updates - to be invoked from a concrete classes
#update:with:from: method.
This will enqueue a delayed update, and resend #delayedUpdate:with:from:
whenever the receiver is handling events.
Especially useful, if many updates arrive at high frequency, to avoid
multiple redraws."
^ self
enqueueMessage:#delayedUpdate:with:from:
for:self
arguments:(Array
with:something
with:aParameter
with:changedObject).
"Modified: / 26.2.2000 / 18:01:44 / cg"
!
enqueueMessage:selector for:someone arguments:argList
"enqueue a message to be sent to myself later, when my process
is back in its eventLoop. Also, filter duplicates.
This is useful, to buffer redraws and avoid flicker due to multiple
redraws (especially in browsers, when reacting on changeMessages resulting
from changes made in other browsers)"
|window sensor|
(window := self window) notNil ifTrue:[
sensor := window sensor.
].
sensor isNil ifTrue:[
"/ already closed, or not yet open
^ someone perform:selector withArguments:argList.
].
"/
"/ if such a message is already in the queue, ignore it.
"/ Otherwise push it as an event, to be handled when my thread is
"/ back in the event loop.
"/
(sensor
hasEvent:selector
for:someone
withArguments:argList) ifTrue:[
^ self
].
sensor
pushUserEvent:selector
for:someone
withArguments:argList
"Modified: / 5.2.2000 / 00:01:54 / cg"
"Created: / 26.2.2000 / 18:01:31 / cg"
! !
!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 componentFor:aSymbol) isNil ifFalse:[
aBlock value:component
]
]
"Modified: 26.3.1997 / 16:23:14 / 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:'copying'!
postCopy
builder := device := nil.
"Created: / 19.4.1998 / 11:44:44 / cg"
! !
!ApplicationModel methodsFor:'drag & drop'!
canDrop:aCollectionOfDropObjects in:aComponent
"drop manager asked if a drop is possible
- should be redefined by apps which can do it, to return true"
^ false
"Modified: 11.4.1997 / 12:42:47 / cg"
!
drop:aCollectionOfDropObjects 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
"Modified: 11.4.1997 / 12:43:19 / cg"
! !
!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 isArray) ifTrue:[
aValueModel onChangeSend:(aSelectorOrArray at:1) to:(aSelectorOrArray at:2)
] ifFalse: [
aValueModel onChangeSend:aSelectorOrArray to:self
].
^aValueModel
"Modified: / 31.10.1997 / 18:19:44 / cg"
!
valueHolderFor:aSelector initialValue:anObject
"Return a ValueHolder on anObject."
^ self valueHolderFor:aSelector initialValue:anObject changeMessage:nil
!
valueHolderFor:aSelector initialValue:anObject changeMessage:aSelectorOrArrayOrNil
"Return a ValueHolder on anObject. aSelectorOrArrayOrNil 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. "
|holder|
(builder bindings includesKey:aSelector) ifFalse:[
holder := ValueHolder with:anObject.
builder aspectAt:aSelector put:holder.
aSelectorOrArrayOrNil notNil ifTrue:[
^ self registerInterestIn:holder using:aSelectorOrArrayOrNil
].
^ holder
].
^ builder aspectAt:aSelector
"Modified: / 21.5.1998 / 03:31:28 / cg"
! !
!ApplicationModel methodsFor:'help'!
openAboutThisApplication
"opens an about box for this application."
|rev box myClass clsRev image msg|
rev := ''.
myClass := self class.
(clsRev := myClass revision) notNil ifTrue: [rev := ' (rev: ', clsRev printString, ')'].
msg := '\' withCRs , myClass name asBoldText, rev.
AboutBox isNil ifTrue:[
"/ this handles bad installations of ST/X,
"/ where the AboutBox is missing.
"/ (May vanish in the future)
^ self information:msg
].
box := AboutBox title:msg.
image := self class defaultIcon.
image notNil ifTrue:[
box image:image
].
box label:'About This Application'.
box autoHideAfter:10 with:[].
box showAtPointer.
!
openHelpViewOnFile:pathToHelpText
"open a help viewer (as opened by the help buttons).
The argument is a relative path within the help directory
(but a file under the current directory is tried first)"
self withWaitCursorDo:[
HTMLDocumentView openFullOnHelpFile:pathToHelpText
]
!
showActiveHelp:aHelpText for:view
"This is invoked from the activeHelp event listener, to display some popup-help
for a component. If false is returned, the help manager will pop up
some active help bubble; if true is returned, it will assume that the
help text has been already displayed and will not do any further actions.
Here, we accept the help text, and push an event into out own input
queue, so that the help text will be displayed asyncronously by myself,
vis the #showHelp:for: method.
This can be redefined in concrete classes to handle active help differently."
|wg mySensor|
self showingHelp ifFalse: [
^ true
].
"/ masterApplication notNil ifTrue:[
"/ (masterApplication showActiveHelp:aHelpText for:view) ifTrue:[
"/ ^ true
"/ ]
"/ ].
"/ NEW: push it into the event queue, to have it displayed
"/ syncronously with other events.
"/ (also any errors are reported as occurring in my context;
"/ instead of occurring in the activeHelp context).
(wg := self windowGroup) notNil ifTrue:[
mySensor := wg sensor.
mySensor notNil ifTrue:[
mySensor flushEventsFor:self withType:#showHelp:for:.
mySensor
pushUserEvent:#showHelp:for: for:self
withArguments:(Array with:aHelpText with:view).
^ true
]
].
"/ mhmh - can this happen ?
^ true
"Modified: / 21.8.1998 / 16:00:37 / cg"
!
showHelp:aHelpText for:view
"actual method which is supposed to display the help text.
Should be redefined in concrete classes, to put the help text
into some info label, or the windows title bar.
Here, the help text is ignored."
masterApplication notNil ifTrue:[
masterApplication showHelp:aHelpText for:view
].
"Modified: / 31.7.1998 / 19:13:59 / cg"
!
showingHelp
"return true, if the activeHelp manager should invoke my #showHelp:for:
method, when the mouse pointer is moved over my widgets.
The default here is true, however, the #showHelp:for: methods are empty.
These should be redefined to put the help text into some info label,
or into the views title bar.
You may also redefine the showingHelp/showingHelp: methods, to
remember the flag setting."
^ true
"Modified: / 31.7.1998 / 17:55:31 / cg"
! !
!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 ..."
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 ...)
"/ "
"/ changed - cg; create the builder later.
"/ some apps (RefactoringBrowser) depend on this being set
"/ late.
"/ builder := self builderClass new.
"/ builder notNil ifTrue:[builder application:self].
resources := self class classResources.
"Modified: / 20.6.1998 / 11:53:36 / cg"
!
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'!
information:aString
"like Objects information, but translates the string via the
resourcePack, thus giving a translated string automatically"
super information:(resources string:aString) withCRs
"Created: / 20.5.1998 / 03:48:43 / cg"
!
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"
!
warn:aString
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString) withCRs
"Created: / 20.5.1998 / 01:14:52 / cg"
!
warn:aString with:arg
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString with:arg) withCRs
!
warn:aString with:arg1 with:arg2
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString with:arg1 with:arg2) withCRs
!
warn:aString with:arg1 with:arg2 with:arg3
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString with:arg1 with:arg2 with:arg3) withCRs
!
warn:aString with:arg1 with:arg2 with:arg3 with:arg4
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString with:arg1 with:arg2 with:arg3 with:arg4) withCRs
"Created: / 23.2.2000 / 09:43:04 / cg"
!
withCursor:aCursor do:aBlock
"evaluate aBlock, showing aCursor in my topView and all of its subviews.
Return the value of aBlock."
|w ret|
w := self window.
w notNil ifTrue:[
^ w withCursor:aCursor do:aBlock
].
aCursor showWhile:[ret := aBlock value].
^ ret.
"Modified: / 23.9.1998 / 17:00:25 / cg"
!
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'!
allButOpen
"create my views from the windowSpec, but do not open the main window."
^ self allButOpenInterface:#windowSpec.
"Modified: / 19.6.1998 / 01:48:26 / cg"
!
allButOpenFrom:aSpec
"create my views but do not open the main window.
The argument is a spec which defines the interface."
|realBuilder window|
"/ 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.
builder isNil ifTrue:[
self createBuilder.
].
self preBuildWith:builder.
builder buildFromSpec:aSpec.
window := builder window.
window model:self.
(window respondsTo:#application:) ifTrue:[
window application:self.
].
self showingHelp ifTrue: [ActiveHelp startFor: self].
self postBuildWith:builder.
"Modified: / 19.6.1998 / 03:35:31 / cg"
!
allButOpenInterface:aSymbol
"create my views but do not open the main window.
The argument specifies a selector of a method,
which when sent to myself should return a spec.
Notice, this returns the windowBuilder."
self allButOpenFrom:(self interfaceSpecFor:aSymbol).
^ builder
"Modified: / 19.6.1998 / 01:48:26 / cg"
!
buildSubCanvas:spec withBuilder:aBuilder
"build a subcanvases spec into aSubcanvas"
|sameApp prevSpec prevSource specToBuild|
builder isNil ifTrue:[
builder := aBuilder.
aBuilder isNil ifTrue:[
self createBuilder
]
] ifFalse:[
prevSpec := aBuilder spec.
prevSource := aBuilder source.
].
aBuilder source:self.
"/ if the subcanvases appModel is NOT the same as
"/ the topApp, it must be pre/post-built.
"/ Otherwise, we invoke pre/post-builtAsSubcanvas.
"/ which provides a hook for redefinition in concrete appModels.
"/ This avoids invoking pre/postBuild twice for subCanvases which
"/ have the topApp as appModel.
sameApp := aBuilder application == aBuilder window topView application.
sameApp ifTrue:[
self preBuildAsSubcanvasWith:aBuilder.
] ifFalse:[
self preBuildWith:aBuilder.
].
"/ subapps should not build the menu and other fullSpec stuff.
spec class == FullSpec ifTrue:[
specToBuild := spec component.
] ifFalse:[
specToBuild := spec.
].
aBuilder buildFromSpec:specToBuild.
sameApp ifTrue:[
self postBuildAsSubcanvasWith:aBuilder.
] ifFalse:[
self postBuildWith:aBuilder.
].
prevSpec notNil ifTrue:[
"/ restore state in builder if original builder was used
aBuilder spec:prevSpec.
aBuilder source:prevSource.
].
^ aBuilder
"Created: / 18.6.1998 / 20:08:45 / cg"
"Modified: / 8.7.1998 / 18:30:46 / cg"
!
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"
!
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, given a spec-selector"
^ SimpleDialog new
openFor:self
interface:aSelector
withBindings:bindings
"Created: / 28.2.1997 / 14:07:45 / cg"
"Modified: / 23.1.1998 / 18:18:14 / cg"
!
openDialogInterfaceSpec:aSpec withBindings:bindings
"open a dialog, given a spec"
^ SimpleDialog new
openFor:self
interfaceSpec:aSpec
withBindings:bindings
"Created: / 28.2.1997 / 14:07:45 / cg"
"Modified: / 23.1.1998 / 18:18:14 / cg"
!
openDialogSpec:aSpec withBindings:bindings
"open a dialog"
^ SimpleDialog new
openFor:self
spec:aSpec
withBindings:bindings
"Modified: / 23.1.1998 / 18:18:14 / cg"
"Created: / 20.5.1998 / 20:27:56 / 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: / 23.1.1998 / 18:16:50 / 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"
"Modified: / 23.1.1998 / 18:17:13 / cg"
!
openInterfaceModal
"open a standard interface as a modal dialog.
Subclasses which do not have an interfaceSpec
should redefine this method and create & open their view(s) there.
(see Launcher as an example)."
^ self openInterfaceModal:#windowSpec
"Modified: / 9.9.1996 / 22:39:23 / stefan"
"Modified: / 23.1.1998 / 18:17:17 / cg"
!
openInterfaceModal:aSymbol
"open a specific interface as a modal dialog.
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 openWindowModal.
^ builder
"Modified: 14.2.1997 / 20:25:33 / cg"
!
openInterfaceModal:aSymbol at:location
"open a specific interface modal at some screen location.
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 openWindowModalAt:location.
^ builder
"Modified: 14.2.1997 / 20:25:33 / cg"
!
openModal
"open a standard interface as a modal dialog"
^ self openInterfaceModal
"Modified: 3.5.1996 / 13:39:15 / 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"
!
openSpec:anInterfaceSpec
"open a view as specified in anInterfaceSpec."
self allButOpenFrom:anInterfaceSpec.
self openWindow.
^ builder
"Modified: / 14.2.1997 / 20:25:33 / cg"
"Created: / 20.5.1998 / 20:08:51 / cg"
!
openSpecModal:anInterfaceSpec
"open an interface spec modal"
self allButOpenFrom:anInterfaceSpec.
self openWindowModal.
^ builder
"Modified: / 14.2.1997 / 20:25:33 / cg"
"Created: / 20.5.1998 / 20:20:21 / cg"
!
openWindow
"open the window - assumes that the builder has already setup
the interface."
builder openWindow.
"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"
!
openWindowAtCenter
"open the window centered on the screen
- assumes that the builder has already setup the interface."
builder openWindowAt:#center
"Created: 14.2.1997 / 20:20:55 / cg"
!
openWindowModal
"open the window - assumes that the builder has already setup
the interface."
"/ builder openDialog.
builder
openAt:nil
withExtent:nil
andType:#dialog
"Created: 14.2.1997 / 20:20:39 / cg"
!
openWindowModalAt:aLocation
"open the window modal - assumes that the builder has already setup
the interface."
builder openDialogAt:aLocation.
"Created: 14.2.1997 / 20:20:55 / cg"
!
postApplicationProcessCreate:newProcess windowGroup:newGroup
"this is sent whenever a new application is launched from this app,
which forks its own windowGroup process. Allows for process group management,
or process-global exception handlers to be installed.
Nothing done here - to be redefined in concrete applications"
!
postBuildAsSubcanvasWith:aBuilder
"this is sent after an interface is built from a spec as subcanvas.
Can be redefined in subclasses for additional setup after
the subcanvas view has been built, but not yet opened."
|sameApp|
sameApp := aBuilder application == aBuilder window topView application.
"/ If I am opened as subcanvas in another application
"/ then treat this like a regular open.
"/ otherwise ignore it.
sameApp ifFalse:[
self postBuildWith:aBuilder.
]
"Modified: / 8.7.1998 / 18:28:55 / cg"
!
postBuildWith:aBuilder
"this is sent after an interface is built from a spec.
Can be redefined in subclasses for additional setup after
the view has been built, but not yet opened."
!
postOpenWith:aBuilder
"this is sent after the applications main window is opened.
Can be redefined in subclasses for actions after opening the view."
!
preBuildAsSubcanvasWith:aBuilder
"this is sent before an interface is built from a spec as a subcanvas.
Can be redefined for apps which need to be informed about that."
"Modified: / 8.7.1998 / 18:29:34 / cg"
!
preBuildWith:aBuilder
"this is sent before an interface is built from a spec.
Can be redefined in subclasses.
mhmh - what should this do here ?"
! !
!ApplicationModel methodsFor:'private'!
builderClass
"return the UIBuilder class for me.
This method can be redefined if (eventually) there are
spec readers for other UI languages (motif UIL ?)"
^ UIBuilder
"Created: / 19.6.1998 / 01:39:26 / cg"
"Modified: / 19.6.1998 / 01:45:24 / cg"
!
createBuilder
builder isNil ifTrue:[
builder := self builderClass new.
builder application:self.
]
"Created: / 19.6.1998 / 03:32:37 / cg"
!
opened:whichTopView
"the topView has been opened.
This is sent by my topView when its really open
(i.e. finally visible)"
self addTopViewsToCurrentProject.
self postOpenWith:builder
!
selfResponsibleFor:aKey
^ (aKey isNil or:[masterApplication isNil or:[self respondsTo:aKey]])
! !
!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"
!
interfaceSpecFor:aSelector
"return an interface spec.
Here, the query is forwarded to my class.
Can be refefined in subclasses which want to provide per-instance specs."
^ self class interfaceSpecFor:aSelector
"Created: / 25.1.1998 / 19:45:12 / cg"
"Modified: / 25.1.1998 / 19:47:09 / cg"
!
processName
"return a name to be shown for me in the process monitor"
self class == ApplicationModel ifTrue:[
^ 'Application'
].
^ self class nameWithoutPrefix
"Modified: / 4.12.1997 / 12:39:14 / cg"
!
resolveClassNamed:something inClass:aClass
"return the class from something, a class, symbol, string or nil.
first we are looking in the namespace of the application, than of the
current namespace and than in Smalltalk
"
^ Smalltalk resolveName:something inClass:aClass.
!
resolveName:something
"return the class from something, a class, symbol, string or nil.
first we are looking in the namespace of the application, than of the
current namespace and than in Smalltalk
"
^ self resolveName:something inClass:self class
!
resolveName:something inClass:aClass
"return the class from something, a class, symbol, string or nil.
first we are looking in the namespace of the application, than of the
current namespace and than in Smalltalk
"
|cls|
aClass notNil ifTrue:[
(cls := Smalltalk resolveName:something inClass:aClass) notNil ifTrue:[
^ cls
].
masterApplication notNil ifTrue:[
^ masterApplication resolveName:something
]
].
^ nil
!
topApplication
"return the top-master application"
masterApplication isNil ifTrue:[
^ self
].
^ masterApplication topApplication
"Created: / 6.6.1998 / 19:40:42 / cg"
! !
!ApplicationModel methodsFor:'startup / release'!
applicationWindowClass
^ ApplicationWindow
!
close
"this is sent by my topView when about to be closed
by the program (not by the windowManager).
Notice, that we get a closeRequest message if closed by the windowManager,
which can be rejected by the app (or confirmed via a dialog)
Could be redefined in subclasses."
self closeDownViews
!
closeDownViews
"close down the applications view(s)"
|wg wgProcess views|
self release.
ActiveHelp stopFor:self.
(wg := self windowGroup) notNil ifTrue:[
wgProcess := wg process.
(Processor activeProcess ~~ wgProcess
and:[wgProcess notNil]) ifTrue:[
wgProcess terminate
] ifFalse:[
wg closeDownViews.
]
]
!
closeRequest
"this is sent by my topView when about to be closed by the windowManager.
Could be redefined in subclasses to suppress close or confirm."
|sav|
(self window isNil
or:[self window isTopView not]) ifTrue:[
'ApplicationModel [warning]: oops - closeRequest for non-TopView arrived' infoPrintCR.
^ self
].
"/ In multiView apps, tell my master.
"/ (but not if I am a modal reincarnation)
(masterApplication notNil
and:[self window isModal not]) ifTrue:[
"/ temporary clear my masterApplication to prevent
"/ endless recursion, in case the master sends me
"/ a closeRequest (although, it is supposed to
"/ send me a closeDownViews ...)
sav := masterApplication.
masterApplication := nil.
sav closeRequestFor:(self window).
"/ restore - in case master did not want me to close ...
masterApplication := sav.
] ifFalse:[
"/ ST/X does close-check by redefining this message without
"/ a supersend;
"/ VW does it by returning false from requestForWindowClose
"/ sigh.
self requestForWindowClose ifTrue:[
self closeDownViews
]
].
"Modified: / 19.6.1998 / 01:37:17 / 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,
effectively closing all of my views.
MultiView applications should redefine this method if closing of individual
views closing is to be caught and/or should not close all of them."
|sav|
"/ In multiView apps, tell my master.
"/ (but not if I am a modal reincarnation)
(masterApplication notNil
and:[self window isModal not]) ifTrue:[
"/ temporary clear my masterApplication to prevent
"/ endless recursion, in case the master sends me
"/ a closeRequest (although, it is supposed to
"/ send me a closeDownViews ...)
sav := masterApplication.
masterApplication := nil.
sav closeRequestFor:(self window).
"/ restore - in case master did not want me to close ...
masterApplication := sav.
] ifFalse:[
self closeRequest
]
!
doAccept
"this is invoked by the Return-Key (if returnIsOK) or
the ok-button (if any), IFF the application has been
opened modal (i.e. as a dialog)."
"/ the following is a bad kludge -
"/ actually, modal apps should inherit from SimpleDialog
"/ (then, things would be clean)
"/ However, it may be useful, to open some app (which is normally
"/ modeless) as a modal one as well.
"/ In that, case, we have no acceptHolder (see SimpleDialog),
"/ to remember the accept vs. cancel case.
"/
self window isModal ifTrue:[
"/ mhmh - is this a good idea ?
(self respondsTo:#accept) ifTrue:[
self accept
] ifFalse:[
self closeRequest.
].
^ self
].
^ self "/ nothing done here ...
!
doCancel
"this is invoked by the Escape-Key (if escapeIsCancel) or
the cancel-button (if any), IFF the application has been
opened modal (i.e. as a dialog)."
"/ the following is a bad kludge -
"/ actually, modal apps should inherit from SimpleDialog
"/ (then, things would be clean)
"/ However, it may be useful, to open some app (which is normally
"/ modeless) as a modal one as well.
"/ In that, case, we have no acceptHolder (see SimpleDialog),
"/ to remember the accept vs. cancel case.
"/
self window isModal ifTrue:[
"/ mhmh - is this a good idea ?
(self respondsTo:#cancel) ifTrue:[
self cancel
] ifFalse:[
self closeRequest.
].
^ self
].
^ self "/ nothing done here ...
!
releaseAsSubCanvas
"a subcanvas is closed or switching to a new application.
Can be redefined to perform a self release in this case."
"/ used to self release here,
"/ but that is incompatible to VW (RefactoryBrowser).
"/ Therefore, if you need it, you MUST now redefine
"/ this method.
!
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
!
windowClass
"return the type of topWindow I would like to have created.
Can be redefined in subclasses to allow for specialized
subclass of ApplicationWindow to be returned here."
^ ApplicationWindow
! !
!ApplicationModel methodsFor:'window events'!
dispatchEvent:event
"dispatch a user-pushed event.
This allows for events for an appModel to be pushed into the event queue
the same way as events for a view are pushable."
^ self
dispatchEvent:event
withFocusOn:nil
delegate:true
!
dispatchEvent:evType arguments:evArgs withFocusOn:focusView delegate:doDelegate
"dispatch a user-pushed event.
This allows for events for an appModel to be pushed into the event queue
the same way as events for a view are pushable."
self perform:evType withArguments:evArgs
"Created: / 20.6.1998 / 16:36:54 / cg"
"Modified: / 20.6.1998 / 16:44:05 / cg"
!
dispatchEvent:ev type:evType arguments:evArgs withFocusOn:focusView delegate:doDelegate
"dispatch a user-pushed event.
This allows for events for an appModel to be pushed into the event queue
the same way as events for a view are pushable."
self perform:evType withArguments:evArgs
"Created: / 20.6.1998 / 16:36:54 / cg"
"Modified: / 20.6.1998 / 16:44:05 / cg"
!
dispatchEvent:event withFocusOn:focusViewOrNil
"dispatch a user-pushed event.
This allows for events for an appModel to be pushed into the event queue
the same way as events for a view are pushable."
^ self
dispatchEvent:event
withFocusOn:focusViewOrNil
delegate:true
!
dispatchEvent:event withFocusOn:focusViewOrNil delegate:doDelegate
"dispatch a user-pushed event.
This allows for events for an appModel to be pushed into the event queue
the same way as events for a view are pushable."
^ self
dispatchEvent:event
type:event type
arguments:(event arguments)
withFocusOn:focusViewOrNil
delegate:doDelegate
!
noticeOfWindowClose:aWindow
"sent when a topView has been closed.
Can be redefined in subclasses for cleanup."
^ self
"Created: / 18.6.1998 / 18:56:31 / cg"
"Modified: / 18.6.1998 / 19:14:16 / cg"
!
requestForWindowClose
"the applicationWindow wants to know, if a close
is ok. Return false if not."
|w k|
builder notNil ifTrue:[
(w := builder window) notNil ifTrue:[
(k := w keyboardProcessor) notNil ifTrue:[
^ k requestForWindowClose
]
]
].
^ true
"Modified: / 18.6.1998 / 19:14:16 / cg"
"Created: / 19.6.1998 / 01:34:58 / cg"
!
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/ApplicationModel.st,v 1.147 2000-11-07 15:15:45 cg Exp $'
! !
ApplicationModel initialize!