"
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' }"
Object subclass:#WindowBuilder
instanceVariableNames:'window application bindings visuals labels focusSequence
namedComponents helpKeys componentCreationHook applicationClass
keyboardProcessor subCanvasSpecs'
classVariableNames:'StopOnError Verbose'
poolDictionaries:''
category:'Interface-Support-UI'
!
!WindowBuilder 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
"
a no-op class, for systems which do not use the UIBuilder.
Concrete subclasses know how to create a view (with components) from
some interface spec.
The order of the lookup sequence to access an aspect is defined:
application
application class
additional class (applicationClass).
Methods to access any aspect are located in the category
'spec creation aspect fetch'.
Currently, an experimantal version of UIBuilder exists,
and more may be added in the future (for example, to parse different UI
specs - thinking of motifs UIL specs, Windows DialogSpecs etc.).
[instance variables:]
window <View>
the topView into which the components
are (have been) created from the specification
application <ApplicationModel>
the application object (typically an instance
of a subclass of ApplicationModel).
That one is usually supposed to provide
valueHolders for aspects, action methods
menuSpecs and possibly more windowSpecs.
Usually means, that most of those can also be
provided to the builder via a set of bindings,
which overrides those.
bindings <Dictionary>
can be set (or filled) with bindings for
aspects to be used when setting up the models
for components. Useful either to overwrite
corresponding appModel aspects or if the appModel
does not want to procide those.
(for example, to open a dialog and provide the
bindings in a dictionary - as opposed to
providing them via aspect methods)
visuals not yet used - for compatibility
focusSequence <Collection>
maintained during the build process;
contains tabable components.
This will be replaced by a more intelligent
mechanism in the near future.
namedComponents <Dictionary>
contains name->component associations for
all components which have a non-nil component
name. Created during the build process.
helpKeys not yet used - for compatibility
componentCreationHook <BlockOrNil>
can be set before the components are built
from the spec, to provide an arbitrary
callBacks-hook which will be invoked after
a component has been created from a spec.
The UIPainter uses this to maintain its
component<->spec assiciations.
Can be set by the app, to catch creation of
components and fiddle around during the
creation process (change extents, colors or whatever)
applicationClass <ClassOrNil>
can be set to provide an additional class which
is asked for aspects during the build process.
If not set, the app is asked, which itself asks
its class.
keyboardProcessor not yet used - for compatibility
Will eventually takeover the functionality
of the focusSequence, shortcuts & provide a hook
for the app.
subCanvasSpecs <Dictionary>
can be set by the app to provide subcanvas
specs (much like the bindings dictionary)
[author:]
Claus Gittinger
"
! !
!WindowBuilder class methodsFor:'debugging'!
stopOnError:aBoolean
"enable/disable debug halt when aspects are missing.
Useful during development, to detect missing aspects.
The default is off."
StopOnError := aBoolean
"Modified: / 4.8.1998 / 19:40:09 / cg"
!
verbose:aBoolean
"enable/disable debug messages on the Transcript.
Useful during development, to detect missing aspects.
The default is off."
Verbose := aBoolean
"Created: / 4.8.1998 / 19:39:37 / cg"
"Modified: / 4.8.1998 / 19:40:14 / cg"
! !
!WindowBuilder methodsFor:'Compatibility - VW'!
source
"same as #application, for ST-80 compatibility"
^ application
"Created: 17.1.1997 / 19:03:51 / cg"
!
source:anApplicationModel
"same as #application:, for ST-80 compatibility"
application := anApplicationModel
"Modified: 17.1.1997 / 19:03:57 / cg"
! !
!WindowBuilder methodsFor:'accessing'!
addBindings:moreBindings
"used with subDialogs, which provide local bindings.
All bindings from moreBindings overwrite any local bindings."
moreBindings notNil ifTrue:[
bindings isNil ifTrue:[
bindings := IdentityDictionary new
].
bindings declareAllFrom:moreBindings
]
"Created: 28.2.1997 / 14:14:33 / cg"
!
application
"return the application (an ApplicationModel),
for which the view is built.
This one is supposed to provide the aspects, menus etc."
^ application
"Modified: 17.1.1997 / 19:04:40 / cg"
!
application:anApplicationModel
"set the application (an ApplicationModel),
for which the view is built.
This one is supposed to provide the aspects, menus etc."
application := anApplicationModel
"Modified: 17.1.1997 / 19:04:47 / cg"
!
applicationClass
"return the value of the instance variable 'applicationClass' (automatically generated).
WARNING:
This is a private interface for the UIPainter to pass down the app-class
to the specs when editing."
^ applicationClass
!
applicationClass:something
"set the value of the instance variable 'applicationClass' (automatically generated).
WARNING:
This is a private interface for the UIPainter to pass down the app-class
to the specs when editing."
applicationClass := something.
!
aspectAt:aSymbol
"return the aspect for a symbol or nil.
"
^ self
aspectAt:aSymbol
ifAbsent:[self aspectNotFound:aSymbol error:'no aspect for:']
"Modified: / 4.8.1998 / 19:29:36 / cg"
!
aspectAt:aSymbol ifAbsent:exceptionBlock
"return the aspect for a symbol or the value from exceptionBlock.
"
|b|
aSymbol notNil ifTrue:[
bindings notNil ifTrue:[
b := bindings at:aSymbol ifAbsent:nil.
b notNil ifTrue:[^ b].
].
application notNil ifTrue:[
MessageNotUnderstood
ignoreNotUnderstoodOf:aSymbol
in:[
^ application aspectFor:aSymbol
].
MessageNotUnderstood
ignoreNotUnderstoodOf:aSymbol
in:[
^ application class aspectFor:aSymbol
].
^ exceptionBlock value.
]
].
^ nil
"Created: / 4.8.1998 / 19:28:30 / cg"
"Modified: / 4.8.1998 / 19:37:02 / cg"
!
aspectAt:aSymbol put:aModel
"store an aspect identified by its symbol and its value
"
bindings isNil ifTrue:[
bindings := IdentityDictionary new
].
^ bindings at:aSymbol put:aModel
"Modified: 17.1.1997 / 19:28:37 / cg"
!
bindingAt:aSymbol
"return the binding for a symbol or nil if there is none
"
bindings notNil ifTrue:[
^ bindings at:aSymbol ifAbsent:nil.
].
^ nil
!
bindings
"return my bindings
"
^ bindings
!
bindings:aDictionary
"set bindings to a dictionary
"
bindings := aDictionary
!
componentAt:name
"return a component identified by its name"
|widget|
namedComponents notNil ifTrue:[
widget := namedComponents at:name asSymbol ifAbsent:nil.
widget notNil ifTrue:[^ widget].
].
"/ cg the following code looks in any application-
"/ or master applications builder for the component.
"/ This has an effect, if a subcanvases builder is asked for
"/ a component, which is actually held by the real-apps builder
"/ (in case they have different builders).
"/ For now, this code is disabled, since I dont know what effect this
"/ has to existing code ...
"/ application notNil ifTrue:[
"/ |appBuilder masterApplication masterBuilder|
"/
"/ (appBuilder := application builder) notNil ifTrue:[
"/ appBuilder ~~ self ifTrue:[
"/ ^ appBuilder componentAt:name
"/ ]
"/ ].
"/
"/ (masterApplication := application masterApplication) notNil ifTrue:[
"/ (masterBuilder := masterApplication builder) notNil ifTrue:[
"/ masterBuilder ~~ self ifTrue:[
"/ ^ masterBuilder componentAt:name
"/ ]
"/ ]
"/ ]
"/ ].
^ nil
!
componentAt:name put:aComponent
"store a component identified by its name.
"
namedComponents isNil ifTrue:[
namedComponents := IdentityDictionary new.
].
namedComponents at:name asSymbol put:aComponent
!
componentCreationHook:something
"set the value of the instance variable 'componentCreationHook' (automatically generated)"
componentCreationHook := something.
!
findComponentAt:name
"recursively search for a component identified by its name in myself
and all of my subApplications.
"
^ self findComponentAt:name ignoringViews:(IdentitySet new).
!
findComponentAt:name ignoringViews:triedViews
"recursively search for a component identified by its name in myself
and all of my subApplications.
As a builders applications view might be different from the builders view,
we must be careful to avoid endless recursion if a subview refers to the topviews builder,
(sigh)
"
|comp window app b|
(comp := self componentAt:name) notNil ifTrue:[^ comp].
window := self application window.
(triedViews includes:window) ifTrue:[^ nil].
triedViews add:window.
window allSubViewsDo:[:v |
triedViews add:v.
((app := v application) notNil
and:[(b := app builder) notNil
and:[b ~~ self]])
ifTrue:[
comp := b findComponentAt:name ignoringViews:triedViews.
comp notNil ifTrue:[
^ comp
]
]
].
^ nil
!
focusSequence
"return my focus sequence
"
focusSequence isNil ifTrue:[
focusSequence := OrderedCollection new
].
^ focusSequence
"Modified: / 12.3.1999 / 00:02:04 / cg"
!
helpKeyFor:aComponent
"return the helpkey for a component or nil
"
|v key|
helpKeys isNil ifTrue:[^ nil].
v := aComponent.
[v notNil] whileTrue:[
(key := helpKeys at:v ifAbsent:nil) notNil ifTrue:[
^ key
].
v := v superView
].
^ nil
!
helpKeyFor:aComponent put:aKey
"assign a key for a component which is used to access the help text
from the application.
"
aKey isNil ifTrue:[
helpKeys isNil ifFalse:[
helpKeys removeKey:aComponent ifAbsent:nil
]
] ifFalse:[
helpKeys isNil ifTrue:[
helpKeys := IdentityDictionary new
].
helpKeys at:aComponent put:aKey
]
!
keyboardProcessor
"return my keyboard processor
"
keyboardProcessor isNil ifTrue:[
keyboardProcessor := KeyboardProcessor new
].
^ keyboardProcessor
"Created: 3.3.1997 / 18:31:37 / cg"
"Modified: 3.3.1997 / 18:32:27 / cg"
!
keyboardProcessor:aKeyboardProcessor
"set my keyboard processor
"
keyboardProcessor := aKeyboardProcessor
"Created: / 18.6.1998 / 19:59:38 / cg"
!
labelAt:name
labels isNil ifTrue:[^ nil].
^ labels at:name asSymbol ifAbsent:nil
"Created: / 27.2.1998 / 13:52:28 / cg"
!
labelAt:name put:aLabelString
labels isNil ifTrue:[
labels := IdentityDictionary new.
].
labels at:name asSymbol put:aLabelString
"Created: / 27.2.1998 / 02:30:54 / cg"
!
menuAt:aKey
"Find a binding for the menu named aKey, either in the bindings
or from the source"
^ self menuFor:aKey
!
menuAt:aSymbol put:someMenuOrHolder
"add someMenuOrHolder as the binding for the menu named aSymbol to the bindings"
^ self aspectAt:aSymbol put:someMenuOrHolder
!
namedComponents
"return list of named components
"
^ namedComponents
!
resources
application notNil ifTrue:[
^ application resources
].
^ Dialog classResources.
!
subCanvasAt:majorKey at:minorKey
"get the subCanvas or subSpec specification from major and minor key.
Here, we first look for a spec in the private subCanvasSpecs dictionary,
which can be filled via #specificationAt:at:put: messages.
If not present, or none is found there, we bounce back trying
#specificationFor: (if majorKey is nil) or by sending the minorKey
message to the class named as majorKey.
Notice, that the class named majorKey is first searched in the
application classes namespace - allowing private classes as majorKey.
"
|spec cls dict dkey|
minorKey isNil ifTrue:[^ nil].
subCanvasSpecs notNil ifTrue:[
dkey := majorKey ? #NoMajorKey.
dict := subCanvasSpecs at:dkey ifAbsent:nil.
dict notNil ifTrue:[
spec := dict at:minorKey ifAbsent:nil.
spec notNil ifTrue:[^ spec].
].
].
majorKey isNil ifTrue:[
^ self specificationFor:minorKey
].
application notNil ifTrue:[
"/ look for class in applications namespace ...
cls := application resolveName:majorKey.
] ifFalse:[
"/ fallBack - use that global, if it exists
cls := Smalltalk at:majorKey.
cls isNil ifTrue:[
Transcript showCR:('WindowBuilder[warning]: missing application when fetching majorKey:' , majorKey).
].
].
cls notNil ifTrue:[
MessageNotUnderstood catch:[
^ cls specificationFor:minorKey
].
MessageNotUnderstood catch:[
^ cls perform:minorKey.
]
].
^ nil
!
subCanvasAt:majorKey at:minorKey put:aSpec
"deposit an interfaceSpecification for major and minor key
in my private subCanvasSpecs dictionary.
This will be used later, when building,
to provide an interfaceSpec for a subcanvas or subSpecification
(or possibly override an application provided interfaceSpec).
See #subCanvasAt:at:."
|dict key|
subCanvasSpecs isNil ifTrue:[
"/ lazyly initialize
subCanvasSpecs := IdentityDictionary new
].
key := majorKey ? #NoMajorKey.
dict := subCanvasSpecs at:key ifAbsent:nil.
dict isNil ifTrue:[
dict := IdentityDictionary new.
subCanvasSpecs at:key put:dict
].
dict at:minorKey put:aSpec
"Modified: / 27.1.1998 / 12:21:27 / cg"
"Modified: / 5.2.1998 / 12:05:32 / stefan"
!
visualAt:name
visuals isNil ifTrue:[^ nil].
^ visuals at:name asSymbol ifAbsent:nil
"Created: 3.3.1997 / 16:24:17 / cg"
!
visualAt:name put:aVisual
visuals isNil ifTrue:[
visuals := IdentityDictionary new.
].
visuals at:name asSymbol put:aVisual
"Created: 3.3.1997 / 16:24:41 / cg"
!
visuals
^ visuals
"Created: 3.3.1997 / 16:24:00 / cg"
!
visuals:aDictionary
visuals := aDictionary
"Created: 3.3.1997 / 16:24:06 / cg"
!
window
"return the top window (view), for which an interface
is (being) built"
^ window
"Modified: 17.1.1997 / 19:30:00 / cg"
!
window:aView
"set the top window (view), for which an interface
is (being) built"
window := aView
"Modified: 17.1.1997 / 19:30:22 / cg"
!
windowGroup
^ window windowGroup
"Modified: 17.6.1997 / 18:04:01 / cg"
! !
!WindowBuilder methodsFor:'aspect access support'!
booleanValueAspectFor:aKey
"helper (common code) to generate a boolean aspect if required.
If no binding exists for aKey, a valueHolder holding false is
created and added to the bindings.
Otherwise, the existing binding is returned."
^ self valueAspectFor:aKey initialValue:false
"Modified: 28.7.1997 / 12:53:57 / cg"
!
listAspectFor:aKey
"helper (common code) to generate a list model aspect if required.
If no binding exists for aKey, a new List is
created and added to the bindings.
Otherwise, the existing binding is returned."
|list|
(list := self bindingAt:aKey) isNil ifTrue:[
self aspectAt:aKey put:(list := List new).
].
^ list
"Created: 28.7.1997 / 12:53:45 / cg"
"Modified: 28.7.1997 / 12:54:13 / cg"
!
nilValueAspectFor:aKey
"helper (common code) to generate a valueHolder aspect if required.
If no binding exists for aKey, a valueHolder holding nil is
created and added to the bindings.
Otherwise, the existing binding is returned."
^ self valueAspectFor:aKey initialValue:nil
"Modified: 28.7.1997 / 12:54:06 / cg"
!
valueAspectFor:aKey initialValue:initialValue
"helper (common code) to generate a valueHolder aspect if required.
If no binding exists for aKey, a valueHolder holding initialValue is
created and added to the bindings.
Otherwise, the existing binding is returned."
|holder|
(holder := self bindingAt:aKey) isNil ifTrue:[
self aspectAt:aKey put:(holder := initialValue asValue).
].
^ holder
"Created: 28.7.1997 / 12:53:45 / cg"
"Modified: 28.7.1997 / 12:54:13 / cg"
! !
!WindowBuilder methodsFor:'building'!
buildFromSpec:aSpec
^ self subclassResponsibility
!
makeTabable:aComponent
"add a component to the list of tabable components"
aComponent canTab:true
!
setupWindowFor:aWindow
self subclassResponsibility
! !
!WindowBuilder methodsFor:'error handling'!
aspectNotFound:anAspect error:aString
"show error message on transcript (if Verbose is true)
and/or stop (if StopOnError) is true.
"
Verbose == true ifTrue:[
Transcript showCR:('WindowBuilder: %1 aspect: <%2>' bindWith:aString with:anAspect storeString).
application notNil ifTrue:[
Transcript showCR:('WindowBuilder: (while building for %1)' bindWith:application class name).
].
].
StopOnError == true ifTrue:[
self halt:'aspect not found' "/ avoids debugger in end-user apps
].
^ nil
"Modified: / 18.8.2000 / 14:10:59 / cg"
! !
!WindowBuilder methodsFor:'message sending'!
safelyPerform:aSelector ifNone:aBlock
"send the message aSelector to the application;
the result returned from the send or nil is returned
"
|cls handlerBlock|
aSelector notNil ifTrue:[
handlerBlock := [:ex|
(ex parameter selector ~~ aSelector) ifTrue:[
ex reject
]
].
application notNil ifTrue:[
MessageNotUnderstood handle:handlerBlock do:[
^ application perform:aSelector
].
cls := application class.
MessageNotUnderstood handle:handlerBlock do:[
^ cls perform:aSelector
]
].
"
WARNING:
This is a private interface for the UIPainter to pass down the app-class
"
applicationClass notNil ifTrue:[
MessageNotUnderstood handle:handlerBlock do:[
^ applicationClass perform:aSelector
]
]
].
^ aBlock value
"Modified: / 20.6.1998 / 11:52:19 / cg"
!
safelyPerform:aSelector with:anArgument ifNone:aBlock
"send the one-arg-message aSelector to the application;
the result returned from the send or nil is returned
"
|handlerBlock|
aSelector notNil ifTrue:[
handlerBlock := [:ex| |badSel|
badSel := ex selector.
(badSel ~~ aSelector and:[badSel ~~ anArgument]) ifTrue:[
ex reject
]
].
application notNil ifTrue:[
MessageNotUnderstood handle:handlerBlock do:[
^ application perform:aSelector with:anArgument
].
MessageNotUnderstood handle:handlerBlock do:[
^ application class perform:aSelector with:anArgument
]
].
"
WARNING:
This is a private interface for the UIPainter to pass down the app-class
"
applicationClass notNil ifTrue:[
MessageNotUnderstood handle:handlerBlock do:[
^ applicationClass perform:aSelector with:anArgument
].
]
].
^ aBlock value
"Modified: / 4.8.1998 / 19:33:52 / cg"
!
safelyPerform:aSelector with:arg1 with:arg2 ifNone:aBlock
"send the two-arg-message aSelector to the application;
the result returned from the send or nil is returned
"
|cls handlerBlock|
aSelector notNil ifTrue:[
handlerBlock := [:ex|
|badSel|
badSel := ex parameter selector.
(badSel ~~ aSelector and:[badSel ~~ arg1]) ifTrue:[
ex reject
]
].
application notNil ifTrue:[
MessageNotUnderstood handle:handlerBlock do:[
^ application perform:aSelector with:arg1 with:arg2
].
cls := application class.
MessageNotUnderstood handle:handlerBlock do:[
^ cls perform:aSelector with:arg1 with:arg2
]
].
"
WARNING:
This is a private interface for the UIPainter to pass down the app-class
"
applicationClass notNil ifTrue:[
MessageNotUnderstood handle:handlerBlock do:[
^ applicationClass perform:aSelector with:arg1 with:arg2
].
]
].
^ aBlock value
"Modified: / 18.6.1998 / 21:40:13 / cg"
! !
!WindowBuilder methodsFor:'spec creation aspect fetch'!
actionFor:aKey
"return an action for aKey. This is invoked during window building
(by the builder) to ask for an ActionButtons actionBlock.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a block."
|b|
bindings notNil ifTrue:[
b := bindings at:aKey ifAbsent:nil.
b notNil ifTrue:[^ b].
].
^ self safelyPerform:#actionFor:
with:aKey
ifNone:[ self aspectNotFound:aKey error:'no action for:'. [] ]
!
actionFor:aKey withValue:aValue
"return an action for aKey/value combonation.
This is invoked during window building
(by the builder) to ask for an ActionButtons actionBlock if that button
specified an action with an argument value.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a block."
|b|
bindings notNil ifTrue:[
b := bindings at:aKey ifAbsent:nil.
b notNil ifTrue:[
(b isBlock and:[b numArgs == 1]) ifTrue:[
^ [:arg | b value:arg]
].
^ b
].
].
^ self safelyPerform:#actionFor:withValue:
with:aKey
with:aValue
ifNone:[ self aspectNotFound:aKey error:'no action for:'. [:dummy |] ]
!
aspectFor:aKey
"return a model for aKey. This is invoked during window building
(by the builder) to ask for an Editfields, a Toggles etc. model.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a valueHolder."
|b|
bindings notNil ifTrue:[
b := bindings at:aKey ifAbsent:nil.
b notNil ifTrue:[^ b].
].
^ self safelyPerform:#aspectFor:
with:aKey
ifNone:[ self aspectAt:aKey ]
!
aspectFor:aKey ifAbsent:exceptionBlock
"return a model for aKey. This is invoked during window building
(by the builder) to ask for an Editfields, a Toggles etc. model.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a valueHolder."
|b|
bindings notNil ifTrue:[
b := bindings at:aKey ifAbsent:nil.
b notNil ifTrue:[^ b].
].
^ self safelyPerform:#aspectFor:
with:aKey
ifNone:[self aspectAt:aKey ifAbsent:exceptionBlock]
"Created: / 4.8.1998 / 19:36:39 / cg"
!
componentFor:aKey
"return a component for aKey. This is invoked during window building
(by the builder) to ask for an ArbitraryComponents view.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a view."
^ self safelyPerform:#componentFor:
with:aKey
ifNone:[ self aspectAt:aKey ]
!
labelFor:aKey
"return a label for aKey. This is invoked during window building
(by the builder) to ask for a ???'s label.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a string."
^ self safelyPerform:#labelFor:
with:aKey
ifNone:[ self aspectAt:aKey ]
!
listFor:aKey
"return a list for aKey. This is invoked during window building
(by the builder) to ask for a ???'s label.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding action.
The returned object is typically a list."
^ self safelyPerform:#listFor:
with:aKey
ifNone:[ self aspectAt:aKey ]
!
menuFor:aKey
"Find a binding for the menu named aKey, either in the bindings
or from the source"
|menu|
aKey isNil ifTrue:[^ nil].
(menu := self bindingAt:aKey) notNil ifTrue:[
^ menu
].
menu := self safelyPerform:#menuFor: with:aKey ifNone:[
self safelyPerform:aKey ifNone:[
self aspectNotFound:aKey error:'no menu for:'.
nil
]
].
menu isBlock ifFalse:[
((menu := menu value) notNil and:[application notNil]) ifTrue:[
menu isArray ifTrue:[
menu := Menu new fromLiteralArrayEncoding:menu.
"/ menu receiver:application. -- now done in findGuiResources ...
].
menu findGuiResourcesIn:application
]
].
^ menu
"Modified: / 18.6.1998 / 16:30:31 / cg"
!
specificationFor:aKey
"return a specification for aKey. This is invoked during window building
(by the builder) to ask for the interfaceSpec for a subCanvas or subSpecification.
Here, first the local bindings are searched, then the application and
finally the applications class is asked for a corresponding interfaceSPec.
The returned object is typically an interfaceSpec array."
^ self
safelyPerform:#specificationFor:
with:aKey
ifNone:[ self aspectFor:aKey ]
! !
!WindowBuilder methodsFor:'spec creation callbacks'!
createdComponent:aView forSpec:spec named:name
"callback from the UISpec after a view has been
created for a spec.
If it has a name, add it to the namedComponents dictionary;
if I have a creationHook (application callBack), evaluate it."
|nameKey|
name notNil ifTrue:[
"/ self componentAt:name put:aView.
namedComponents isNil ifTrue:[
namedComponents := IdentityDictionary new.
].
nameKey := name asSymbol.
"/ debugging ...
"/ (namedComponents includesKey:nameKey) ifTrue:[
"/ Transcript showCR:'WARNING multiple UI-build of: ',nameKey
"/ ].
namedComponents at:nameKey put:aView
].
componentCreationHook notNil ifTrue:[
componentCreationHook value:aView value:spec value:self
]
"Modified: / 5.9.1995 / 21:42:54 / claus"
"Created: / 31.10.1997 / 18:47:01 / cg"
"Modified: / 31.10.1997 / 18:51:22 / cg"
! !
!WindowBuilder methodsFor:'startup'!
closeRequest
window destroy
"Modified: 17.1.1997 / 19:30:32 / cg"
!
open
"open my topView, as previously created"
|type|
application isNil ifTrue:[
type := #normal
] ifFalse:[
type := application defaultWindowType
].
^ self
openAt:nil
withExtent:nil
andType:type
!
openAt:aPoint
"open my topView at some location"
^ self
openAt:aPoint
withExtent:nil
andType:(application defaultWindowType)
"Created: 14.2.1997 / 20:21:57 / cg"
"Modified: 28.2.1997 / 22:50:29 / cg"
!
openDialog
"open my topView, as previously created as a modal view,
blocking interaction to the currently active view."
^ self
openAt:nil
withExtent:nil
andType:#dialog
!
openDialogAt:aPoint
"open my topView, as previously created as a modal view,
blocking interaction to the currently active view."
^ self
openAt:aPoint
withExtent:nil
andType:#dialog
"Modified: 17.1.1997 / 19:59:36 / cg"
"Created: 14.2.1997 / 20:24:19 / cg"
!
openDialogAt:aPoint withExtent:ext
"open my topView, as previously created as a modal view,
blocking interaction to the currently active view."
^ self
openAt:aPoint
withExtent:ext
andType:#dialog
"Modified: 17.1.1997 / 19:59:36 / cg"
"Created: 14.2.1997 / 20:24:19 / cg"
!
openDialogWithExtent:ext
"open my topView, as previously created as a modal view,
blocking interaction to the currently active view."
^ self
openAt:nil
withExtent:ext
andType:#dialog
"Modified: 17.1.1997 / 19:59:36 / cg"
!
openModal
"open my topView as a modal dialog, as previously created,
blocking interaction to the currently active view."
^ self
openAt:nil
withExtent:nil
andType:#dialog
"Modified: 3.3.1997 / 19:43:57 / cg"
!
openPopUpAt:aPoint
"open my topView, as previously created as a popUp view,
blocking interaction to the currently active view."
^ self
openAt:aPoint
withExtent:nil
andType:#popUp
"Modified: 17.1.1997 / 19:59:29 / cg"
"Created: 14.2.1997 / 20:24:38 / cg"
!
openPopUpIn:aRectangle
"open my topView, as previously created as a popUp view,
blocking interaction to the currently active view."
^ self
openAt:aRectangle origin
withExtent:aRectangle extent
andType:#popUp
!
openWindow
"open my topView"
^ self
openAt:nil
withExtent:nil
andType:(application defaultWindowType)
!
openWindowAt:aPoint
"open my topView at some location"
^ self
openAt:aPoint
withExtent:nil
andType:(application defaultWindowType)
!
openWindowAt:origin withExtent:ext andType:type
"open my window, as previously created, optionally defining the
windows origin and/or extent.
The type argument may be #dialog or #normal, and specifies if the view
should be opened as a modal view, blocking interaction to the currently
active view, or as a normal view."
^ self
openAt:origin
withExtent:ext
andType:type
!
openWindowCenter
"open my topView centered on the screen (dialog & normal only)"
^ self
openAt:#center
withExtent:nil
andType:(application defaultWindowType)
!
openWithExtent:aPoint
"open my topView, as previously created, but override
the extent."
^ self
openAt:nil
withExtent:aPoint
andType:(application defaultWindowType)
"Modified: 17.1.1997 / 19:58:48 / cg"
!
openWithExtent:ext andType:type
"open my window, as previously created. The type argument
may be #dialog or #normal, and specifies if the view should
be opened as a modal view, blocking interaction to the currently
active view, or as a normal view."
^ self
openAt:nil
withExtent:ext
andType:type
"Modified: 14.2.1997 / 20:22:47 / cg"
! !
!WindowBuilder methodsFor:'startup - basic'!
openAt:origin withExtent:ext andType:type
"open my window, as previously created, optionally defining the
windows origin and/or extent.
The type argument may be #dialog, #popup or #normal,
and specifies if the view should be opened as a
modal view (blocking interaction to the currently active view),
as popUp (also blocking)
or as a normal view."
|appWinClass device|
device := window device.
origin notNil ifTrue:[
"/ kludge
origin ~~ #center ifTrue:[
window origin:origin
]
].
ext notNil ifTrue:[
window extent:ext.
] ifFalse:[
type == #dialog ifTrue:[
window fixSize
]
].
type == #dialog ifTrue:[
((origin isNil and:[window class forceModalBoxesToOpenAtCenter])
or:[origin == #center]) ifTrue:[
window origin:(device center - (window extent // 2))
] ifFalse:[
window fixPosition:(device pointerPosition - window positionOffset).
].
^ window openModal.
].
(type == #normal or:[type = #slave or:[type = #partner]]) ifTrue:[
window isNil ifTrue:[
application notNil ifTrue:[
appWinClass := application applicationWindowClass
] ifFalse:[
appWinClass := ApplicationWindow
].
self setupWindowFor:(appWinClass new).
].
origin == #center ifTrue:[
window origin:(device center - window extent // 2)
].
"/ the following code creates a master-slave relationship, if
"/ the masterApplication is not nil.
"/ Disabled, because: the masterApplication is used to fulfill missing aspects,
"/ which has nothing to do with a window master-slave relationship.
"/ application masterApplication notNil ifTrue:[
"/ masterWindow := application masterApplication window.
"/ (masterWindow isMaster or:[masterWindow isSlave or:[masterWindow isPartner]])
"/ ifFalse:[
"/ "/ master is neutral - make him a master
"/ masterWindow beMaster
"/ ].
"/ window beSlave.
"/ ].
"/ must be done explicit, by passing an appropriate windowType
type = #slave ifTrue:[
window beSlave.
].
type = #partner ifTrue:[
window bePartner.
].
((type = #slave or:[type = #partner])
and:[ window windowGroup isNil ])
ifTrue:[
window openInGroup:(WindowGroup activeGroup).
] ifFalse:[
window open.
].
"/ the following automatism is probably too cryptic and has too much of a side effect.
"/ I prefer to leave things as they are: i.e. enforce the programmer to
"/ do thinks explicit.
"/ type = #slave ifTrue:[
"/ window windowGroup topViews first beMaster
"/ ].
^ self
].
type == #popUp ifTrue:[
window fixPosition:(device pointerPosition).
^ window openAsPopUp.
].
"
if ST-80 supports more types - these may be added later
"
self halt:'unimplemented'
"Created: / 14.2.1997 / 20:22:24 / cg"
"Modified: / 18.6.1998 / 19:10:07 / cg"
! !
!WindowBuilder class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview2/WindowBuilder.st,v 1.107 2003-03-24 13:48:22 ab Exp $'
! !