"
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 masterApplication'
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:'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'!
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"
!
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"
!
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 halt:'an application cannot be its own masterApplication'.
^ self
].
masterApplication := something.
!
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"
|w|
(w := builder window) notNil ifTrue:[
^ w windowGroup
].
^ nil
! !
!ApplicationModel methodsFor:'active help'!
showHelp:aHelpText for:view
"hook to allow an application to display active help
texts in its own info area.
This method may be redefined in a concrete application.
If it returns false, the ActiveHelp manager will popup a
bubble with the help text."
masterApplication notNil ifTrue:[
^ masterApplication showHelp:aHelpText for:view
].
^ false
! !
!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 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
!
helpTextForKey:aKey
"activeHelp interface: return some help text for a key"
|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
].
^ helpText
!
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) 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:'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:'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 ...)
"/ "
"/ 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: / 19.6.1998 / 01:46:25 / 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"
!
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'!
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 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"
self allButOpenFrom:(self interfaceSpecFor:aSymbol).
^ builder
"Modified: / 19.6.1998 / 01:48:26 / cg"
!
buildSubCanvas:spec withBuilder:aBuilder
"build a subcanvases spec into aSubcanvas"
builder isNil ifTrue:[
builder := aBuilder
].
aBuilder source:self.
self preBuildWith:aBuilder.
aBuilder buildFromSpec:spec.
self postBuildWith:aBuilder.
^ aBuilder
"Created: / 18.6.1998 / 20:08:45 / 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"
^ SimpleDialog new
openFor:self
interface:aSelector
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.
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.
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"
!
openModal
"open a standard interface"
^ 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:aSpec
"open an interface spec modal"
self allButOpenFrom:aSpec.
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 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"
!
openWindowModal
"open the window - assumes that the builder has already setup
the interface."
builder openModal.
"Created: 14.2.1997 / 20:20:39 / 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."
"Modified: / 31.10.1997 / 17:55:54 / 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'!
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 windowManager.
Could be redefined in subclasses to suppress close or confirm."
|sav|
masterApplication notNil 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|
masterApplication notNil 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
]
!
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'!
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/Attic/AppModel.st,v 1.88 1998-06-19 01:37:17 cg Exp $'
! !
ApplicationModel initialize!