.
--- a/ActiveHelp.st Wed Aug 30 19:54:43 1995 +0200
+++ b/ActiveHelp.st Sat Sep 09 04:30:16 1995 +0200
@@ -24,7 +24,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/ActiveHelp.st,v 1.4 1995-08-29 23:42:57 claus Exp $
+$Header: /cvs/stx/stx/libview2/ActiveHelp.st,v 1.5 1995-09-09 02:29:12 claus Exp $
"
!
@@ -33,13 +33,107 @@
The active help listener.
The one and only instance of myself intercepts incoming mouse & keyboard
events for the display device, being especially interested in view-enter/
- leave ebents. When such an event arrives, it asks the corresponding view
+ leave enents. When such an event arrives, it asks the corresponding view
or its model for a help message and display it via an ActiveHelpView.
+ This query is repeated along the views superView chain, until any model or
+ view returns a nonNil answer for the #helpTextFor:at or #helpTextFor
+ message.
+
All I need for automatic help is some model/view/applicationModel along
the superview chain of the entered component, which responds to the
#helpTextFor: message with a non-nil (string-) answer.
I close down the help view after a while, if a key is pressed or the mouse
moved to another view.
+
+ Who should provide the helpText:
+
+ the best place is the application object (an instance of ApplicationModel)
+ or the topView, if its a derived class of StandardSystemView.
+ This should know about its components and return the string
+ when asked via #helpTextFor:aComponent.
+ See examples in FileBrowser, NewLauncher etc.
+
+ Be aware, that for applicationModels, there must be a link from the
+ topView to this applicationModel
+ (set via: aTopView application:anApplicationModel)
+ otherwise, the helpManager has no means of finding the application which
+ corresponds to a view.
+
+ Who should display the helpText:
+
+ by default, the helpListener opens a little popup view, which displays the
+ returned help message. However, a nice trick which can be used by applications
+ is to create an infoLabel as a subview of the topFrame (a la windows)
+ and display the text right in the #helpTextFor: method. To cheat the
+ help listener, this method should then return nil, to keep it silent.
+"
+!
+
+examples
+"
+ (make certain that activeHelp is turned on ...)
+
+ the following example uses a Plug as a model replacement.
+ In concrete application, you would create a method to implement the helpText
+ query message.
+
+ |app top button1 button2|
+
+ app := Plug new.
+ app respondTo:#helpTextFor:
+ with:[:view |
+ view == button1 ifTrue:[
+ 'this is button1'
+ ] ifFalse:[
+ view == button2 ifTrue:[
+ 'some help for button2'
+ ] ifFalse:[
+ nil
+ ]
+ ]
+ ].
+
+ top := StandardSystemView new.
+ top extent:300@100.
+ button1 := Button label:'b1' in:top.
+ button1 origin:0.0@0.0 corner:0.5@30.
+ button2 := Button label:'b2' in:top.
+ button2 origin:0.5@0.0 corner:1.0@30.
+ top model:app. '<-- normally this would be: top application:app'.
+ top open
+
+ alternative, display of the helpMessage in a local, private view:
+
+ |app top button1 button2 infoView|
+
+ app := Plug new.
+ app respondTo:#helpTextFor:
+ with:[:view | infoView label:'info ...'.
+ view == button1 ifTrue:[
+ infoView label:'this is button1'
+ ].
+ view == button2 ifTrue:[
+ infoView label:'some help for button2'
+ ].
+ nil
+ ].
+
+ top := StandardSystemView new.
+ top extent:300@100.
+ button1 := Button label:'b1' in:top.
+ button1 origin:0.0@0.0 corner:0.5@30.
+ button2 := Button label:'b2' in:top.
+ button2 origin:0.5@0.0 corner:1.0@30.
+ infoView := Label label:'info ...' in:top.
+ infoView level:-1; origin:0.0@1.0 corner:1.0@1.0.
+ infoView topInset:(infoView preferredExtent y negated - 3);
+ leftInset:3;
+ rightInset:3;
+ bottomInset:3;
+ adjust:#left.
+ top model:app. '<-- normally this would be: top application:app'.
+ top open
+
"
!
@@ -62,13 +156,41 @@
initialize
ShowTime := 15.
- DelayTime := 1.
+ DelayTime := 2.
"
ActiveHelp initialize
"
! !
+!ActiveHelp class methodsFor:'times'!
+
+showTime:numberOfSeconds
+ "set the number of seconds, a help messages is to be shown.
+ The default is 15 seconds."
+
+ ShowTime := numberOfSeconds
+
+ "
+ ActiveHelp showTime:10
+ ActiveHelp showTime:99999
+ ActiveHelp showTime:30
+ "
+!
+
+delayTime:numberOfSeconds
+ "set the delay (the time, the cursor has to be in the view
+ before help is shown). The default is 2 seconds."
+
+ DelayTime := numberOfSeconds
+
+ "
+ ActiveHelp delayTime:0.5
+ ActiveHelp delayTime:2
+ ActiveHelp delayTime:10
+ "
+! !
+
!ActiveHelp class methodsFor:'startup'!
start
@@ -100,12 +222,17 @@
!ActiveHelp methodsFor:'private'!
helpTextFor:aView atX:x y:y
+ "pointer entered aView;
+ walk along the views superView chain,
+ asking models and views encountered while walking.
+ The first one who understands and returns a nonNil answer to the
+ #helpTextFor:at: or #helpTextFor: message ends this walk and the
+ returned string is returned."
+
|model text view org found v sv|
view := aView.
-
(model := aView model) notNil ifTrue:[
-"/ model printNL.
(model respondsTo:#helpTextFor:at:) ifTrue:[
text := model helpTextFor:aView at:x@y.
text notNil ifTrue:[^ text].
@@ -145,12 +272,61 @@
v := sv.
].
+ (v notNil and:[v respondsTo:#application]) ifTrue:[
+ (model := v application) notNil ifTrue:[
+ (model respondsTo:#helpTextFor:at:) ifTrue:[
+ text := model helpTextFor:aView at:x@y.
+ text notNil ifTrue:[^ text].
+ ].
+ (model respondsTo:#helpTextFor:) ifTrue:[
+ text := model helpTextFor:aView.
+ text notNil ifTrue:[^ text].
+ ]
+ ]
+ ].
+ (v notNil and:[v respondsTo:#model]) ifTrue:[
+ (model := v model) notNil ifTrue:[
+ (model respondsTo:#helpTextFor:at:) ifTrue:[
+ text := model helpTextFor:aView at:x@y.
+ text notNil ifTrue:[^ text].
+ ].
+ (model respondsTo:#helpTextFor:) ifTrue:[
+ text := model helpTextFor:aView.
+ text notNil ifTrue:[^ text].
+ ]
+ ]
+ ].
+
(view class respondsTo:#helpText) ifTrue:[
text := view class helpText.
text notNil ifTrue:[^ text].
].
^ nil
+
+ "Modified: 31.8.1995 / 20:38:00 / claus"
+!
+
+initiateHelpFor:aView atX:x y:y
+ |text p|
+
+ text := self helpTextFor:aView atX:x y:y.
+
+ text notNil ifTrue:[
+ DelayTime > 0 ifTrue:[
+ showProcess notNil ifTrue:[
+ p := showProcess. showProcess := nil.
+ p terminate.
+ ].
+ showProcess := [
+ (Delay forSeconds:DelayTime) wait.
+ showProcess := nil.
+ self showHelp:text for:aView
+ ] forkAt:(Processor userSchedulingPriority + 1).
+ ] ifFalse:[
+ self showHelp:text for:aView
+ ]
+ ].
!
hideIfPointerLeft:aView
@@ -189,24 +365,7 @@
^ true
].
- text := self helpTextFor:aView atX:x y:y.
-
- text notNil ifTrue:[
- DelayTime > 0 ifTrue:[
- showProcess notNil ifTrue:[
- p := showProcess. showProcess := nil.
- p terminate.
- ].
- showProcess := [
- (Delay forSeconds:DelayTime) wait.
- showProcess := nil.
- self showHelp:text for:aView
- ] forkAt:(Processor userSchedulingPriority + 1).
- ] ifFalse:[
- self showHelp:text for:aView
- ]
- ].
-
+ self initiateHelpFor:aView atX:x y:y.
^ false
!
@@ -249,7 +408,7 @@
!
showHelp:aHelpText for:view
- |org p|
+ |org p v|
view == currentView ifTrue:[^ self].
@@ -265,22 +424,23 @@
currentFrame := org extent:view extent.
org :=org + (view extent // 2).
- currentHelpView := ActiveHelpView for:aHelpText withCRs.
+ v := ActiveHelpView for:aHelpText withCRs.
org := view device pointerPosition.
- org := org + (20@20).
- (org x + currentHelpView width) > view device width ifTrue:[
- org := (org x - currentHelpView width) @ org y
+ org := org + (10@10).
+ (org x + v width) > view device width ifTrue:[
+ org := (org x - v width) @ org y
].
- (org y + currentHelpView height) > view device height ifTrue:[
- org := org x @ (org y - currentHelpView height).
+ (org y + v height) > view device height ifTrue:[
+ org := org x @ (org y - v height).
].
- currentHelpView origin:org.
+ v origin:org.
"/ currentHelpView open.
- currentHelpView realize.
- currentHelpView enableButtonMotionEvents.
- currentHelpView enableMotionEvents.
+ v realize.
+ v enableButtonMotionEvents.
+ v enableMotionEvents.
+ currentHelpView := v.
currentView := view.
closeProcess := [
@@ -296,6 +456,8 @@
] valueUninterruptably
].
] forkAt:(Processor userSchedulingPriority + 1).
+
+ "Modified: 31.8.1995 / 19:20:45 / claus"
! !
ActiveHelp initialize!
--- a/AlignOrg.st Wed Aug 30 19:54:43 1995 +0200
+++ b/AlignOrg.st Sat Sep 09 04:30:16 1995 +0200
@@ -110,7 +110,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/AlignOrg.st,v 1.5 1995-08-29 17:42:57 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/AlignOrg.st,v 1.6 1995-09-09 02:29:17 claus Exp $
"
! !
@@ -202,3 +202,38 @@
super initialize.
leftAlignmentFraction := topAlignmentFraction := 0.
! !
+
+!AlignmentOrigin methodsFor:'converting'!
+
+literalArrayEncoding
+ "encode myself as an array.
+ The encoding is:
+ (#AlignmentOrigin orgOffsX relOrgX orgOffsY relOrgY leftAlignFract topAlignFract)"
+
+ ^ super literalArrayEncoding
+ , (Array
+ with:leftAlignmentFraction
+ with:topAlignmentFraction)
+
+ "Modified: 1.9.1995 / 02:43:35 / claus"
+!
+
+fromLiteralArrayEncoding:encoding
+ "read my values from an encoding.
+ The encoding is supposed to be of the form:
+ (AlignmentOrigin orgOffsX relOrgX orgOffsY relOrgY leftAlignFract topAlignFract)"
+
+ leftOffset := encoding at:2.
+ leftFraction := encoding at:3.
+ topOffset := encoding at:4.
+ topFraction := encoding at:5.
+ leftAlignmentFraction := encoding at:6.
+ topAlignmentFraction := encoding at:7.
+
+
+ "
+ AlignmentOrigin new fromLiteralArrayEncoding:#(#AlignmentOrigin 70 0 2 0 0.5 0.25)
+ "
+
+ "Modified: 1.9.1995 / 02:23:53 / claus"
+! !
--- a/AlignmentOrigin.st Wed Aug 30 19:54:43 1995 +0200
+++ b/AlignmentOrigin.st Sat Sep 09 04:30:16 1995 +0200
@@ -110,7 +110,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/AlignmentOrigin.st,v 1.5 1995-08-29 17:42:57 claus Exp $
+$Header: /cvs/stx/stx/libview2/AlignmentOrigin.st,v 1.6 1995-09-09 02:29:17 claus Exp $
"
! !
@@ -202,3 +202,38 @@
super initialize.
leftAlignmentFraction := topAlignmentFraction := 0.
! !
+
+!AlignmentOrigin methodsFor:'converting'!
+
+literalArrayEncoding
+ "encode myself as an array.
+ The encoding is:
+ (#AlignmentOrigin orgOffsX relOrgX orgOffsY relOrgY leftAlignFract topAlignFract)"
+
+ ^ super literalArrayEncoding
+ , (Array
+ with:leftAlignmentFraction
+ with:topAlignmentFraction)
+
+ "Modified: 1.9.1995 / 02:43:35 / claus"
+!
+
+fromLiteralArrayEncoding:encoding
+ "read my values from an encoding.
+ The encoding is supposed to be of the form:
+ (AlignmentOrigin orgOffsX relOrgX orgOffsY relOrgY leftAlignFract topAlignFract)"
+
+ leftOffset := encoding at:2.
+ leftFraction := encoding at:3.
+ topOffset := encoding at:4.
+ topFraction := encoding at:5.
+ leftAlignmentFraction := encoding at:6.
+ topAlignmentFraction := encoding at:7.
+
+
+ "
+ AlignmentOrigin new fromLiteralArrayEncoding:#(#AlignmentOrigin 70 0 2 0 0.5 0.25)
+ "
+
+ "Modified: 1.9.1995 / 02:23:53 / claus"
+! !
--- a/AppModel.st Wed Aug 30 19:54:43 1995 +0200
+++ b/AppModel.st Sat Sep 09 04:30:16 1995 +0200
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/AppModel.st,v 1.15 1995-08-29 17:43:06 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/AppModel.st,v 1.16 1995-09-09 02:29:25 claus Exp $
"
!
@@ -130,6 +130,15 @@
EXPERIMENTAL and unfinished."
self new openOnDevice:aDevice
+!
+
+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"
! !
!ApplicationModel class methodsFor:'change & update'!
--- a/ApplicationModel.st Wed Aug 30 19:54:43 1995 +0200
+++ b/ApplicationModel.st Sat Sep 09 04:30:16 1995 +0200
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/ApplicationModel.st,v 1.15 1995-08-29 17:43:06 claus Exp $
+$Header: /cvs/stx/stx/libview2/ApplicationModel.st,v 1.16 1995-09-09 02:29:25 claus Exp $
"
!
@@ -130,6 +130,15 @@
EXPERIMENTAL and unfinished."
self new openOnDevice:aDevice
+!
+
+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"
! !
!ApplicationModel class methodsFor:'change & update'!
--- a/ClrValue.st Wed Aug 30 19:54:43 1995 +0200
+++ b/ClrValue.st Sat Sep 09 04:30:16 1995 +0200
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/ClrValue.st,v 1.5 1995-08-30 17:53:44 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/ClrValue.st,v 1.6 1995-09-09 02:29:30 claus Exp $
"
!
@@ -48,6 +48,24 @@
!ColorValue class methodsFor:'instance creation'!
+doesNotUnderstand:aMessage
+ "catch other instance creation messages"
+
+ |clr|
+
+ (clr := self name:aMessage selector asString) notNil ifTrue:[
+ ^ clr
+ ].
+ ^ super doesNotUnderstand:aMessage
+
+ "
+ ColorValue royalBlue
+ ColorValue funnyGreen
+ "
+! !
+
+!ColorValue class methodsFor:'instance creation'!
+
red:r green:g blue:b
"return a color from red, green and blue values.
The arguments, r, g and b must be in the range (0..1)"
--- a/ColorValue.st Wed Aug 30 19:54:43 1995 +0200
+++ b/ColorValue.st Sat Sep 09 04:30:16 1995 +0200
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/ColorValue.st,v 1.5 1995-08-30 17:53:44 claus Exp $
+$Header: /cvs/stx/stx/libview2/ColorValue.st,v 1.6 1995-09-09 02:29:30 claus Exp $
"
!
@@ -48,6 +48,24 @@
!ColorValue class methodsFor:'instance creation'!
+doesNotUnderstand:aMessage
+ "catch other instance creation messages"
+
+ |clr|
+
+ (clr := self name:aMessage selector asString) notNil ifTrue:[
+ ^ clr
+ ].
+ ^ super doesNotUnderstand:aMessage
+
+ "
+ ColorValue royalBlue
+ ColorValue funnyGreen
+ "
+! !
+
+!ColorValue class methodsFor:'instance creation'!
+
red:r green:g blue:b
"return a color from red, green and blue values.
The arguments, r, g and b must be in the range (0..1)"
--- a/LayoutFrame.st Wed Aug 30 19:54:43 1995 +0200
+++ b/LayoutFrame.st Sat Sep 09 04:30:16 1995 +0200
@@ -110,7 +110,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/LayoutFrame.st,v 1.7 1995-08-29 17:44:07 claus Exp $
+$Header: /cvs/stx/stx/libview2/LayoutFrame.st,v 1.8 1995-09-09 02:29:42 claus Exp $
"
! !
@@ -257,3 +257,41 @@
leftFraction := topFraction := 0.
bottomFraction := rightFraction := 1.
! !
+
+!LayoutFrame methodsFor:'converting'!
+
+literalArrayEncoding
+ "encode myself as an array.
+ The encoding is:
+ (#LayoutOrigin orgOffsX relOrgX orgOffsY relOrgY cornOffsX relCornX cornOffsY relCornY)"
+
+ ^ super literalArrayEncoding
+ , (Array
+ with:rightOffset
+ with:rightFraction
+ with:bottomOffset
+ with:bottomFraction)
+
+ "Modified: 1.9.1995 / 02:43:35 / claus"
+!
+
+fromLiteralArrayEncoding:encoding
+ "read my values from an encoding.
+ The encoding is supposed to be of the form:
+ (LayoutFrame orgOffsX relOrgX orgOffsY relOrgY cornOffsX relCornX cornOffsY relCornY)
+ This is the reverse to literalArrayEncoding."
+
+ leftOffset := encoding at:2.
+ leftFraction := encoding at:3.
+ topOffset := encoding at:4.
+ topFraction := encoding at:5.
+ rightOffset := encoding at:6.
+ rightFraction := encoding at:7.
+ bottomOffset := encoding at:8.
+ bottomFraction := encoding at:9.
+
+ "
+ LayoutFrame new fromLiteralArrayEncoding:#(#LayoutFrame 70 0 2 0 0 1 25 0 )
+ #(#LayoutFrame 70 0 2 0 0 1 25 0 ) decodeAsLiteralArray
+ "
+! !
--- a/LayoutFrm.st Wed Aug 30 19:54:43 1995 +0200
+++ b/LayoutFrm.st Sat Sep 09 04:30:16 1995 +0200
@@ -110,7 +110,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/LayoutFrm.st,v 1.7 1995-08-29 17:44:07 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/LayoutFrm.st,v 1.8 1995-09-09 02:29:42 claus Exp $
"
! !
@@ -257,3 +257,41 @@
leftFraction := topFraction := 0.
bottomFraction := rightFraction := 1.
! !
+
+!LayoutFrame methodsFor:'converting'!
+
+literalArrayEncoding
+ "encode myself as an array.
+ The encoding is:
+ (#LayoutOrigin orgOffsX relOrgX orgOffsY relOrgY cornOffsX relCornX cornOffsY relCornY)"
+
+ ^ super literalArrayEncoding
+ , (Array
+ with:rightOffset
+ with:rightFraction
+ with:bottomOffset
+ with:bottomFraction)
+
+ "Modified: 1.9.1995 / 02:43:35 / claus"
+!
+
+fromLiteralArrayEncoding:encoding
+ "read my values from an encoding.
+ The encoding is supposed to be of the form:
+ (LayoutFrame orgOffsX relOrgX orgOffsY relOrgY cornOffsX relCornX cornOffsY relCornY)
+ This is the reverse to literalArrayEncoding."
+
+ leftOffset := encoding at:2.
+ leftFraction := encoding at:3.
+ topOffset := encoding at:4.
+ topFraction := encoding at:5.
+ rightOffset := encoding at:6.
+ rightFraction := encoding at:7.
+ bottomOffset := encoding at:8.
+ bottomFraction := encoding at:9.
+
+ "
+ LayoutFrame new fromLiteralArrayEncoding:#(#LayoutFrame 70 0 2 0 0 1 25 0 )
+ #(#LayoutFrame 70 0 2 0 0 1 25 0 ) decodeAsLiteralArray
+ "
+! !
--- a/LayoutOrg.st Wed Aug 30 19:54:43 1995 +0200
+++ b/LayoutOrg.st Sat Sep 09 04:30:16 1995 +0200
@@ -94,7 +94,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/LayoutOrg.st,v 1.6 1995-08-29 17:44:11 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/LayoutOrg.st,v 1.7 1995-09-09 02:29:45 claus Exp $
"
! !
@@ -281,3 +281,45 @@
leftOffset := topOffset := 0.
leftFraction := topFraction := 0.
! !
+
+!LayoutOrigin methodsFor:'converting'!
+
+literalArrayEncoding
+ "encode myself as an array.
+ The encoding is:
+ (#LayoutOrigin orgOffsX relOrgX orgOffsY relOrgY)
+ "
+
+ ^ Array
+ with:self class name asSymbol
+ with:leftOffset
+ with:leftFraction
+ with:topOffset
+ with:topFraction
+
+ "
+ LayoutOrigin new fromLiteralArrayEncoding:#(#LayoutOrigin 70 0 2 0)
+ (LayoutOrigin new leftOffset:10; leftFraction:0.2;
+ topOffset:20; topFraction:0.4) literalArrayEncoding
+ "
+
+ "Modified: 1.9.1995 / 02:43:48 / claus"
+!
+
+fromLiteralArrayEncoding:encoding
+ "read my values from an encoding.
+ The encoding is supposed to be of the form:
+ (#LayoutOrigin orgOffsX relOrgX orgOffsY relOrgY)
+ This is the reverse operation to #literalArrayEncoding."
+
+ leftOffset := encoding at:2.
+ leftFraction := encoding at:3.
+ topOffset := encoding at:4.
+ topFraction := encoding at:5.
+
+
+ "
+ LayoutOrigin new fromLiteralArrayEncoding:#(#LayoutOrigin 70 0 2 0)
+ "
+! !
+
--- a/LayoutOrigin.st Wed Aug 30 19:54:43 1995 +0200
+++ b/LayoutOrigin.st Sat Sep 09 04:30:16 1995 +0200
@@ -94,7 +94,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/LayoutOrigin.st,v 1.6 1995-08-29 17:44:11 claus Exp $
+$Header: /cvs/stx/stx/libview2/LayoutOrigin.st,v 1.7 1995-09-09 02:29:45 claus Exp $
"
! !
@@ -281,3 +281,45 @@
leftOffset := topOffset := 0.
leftFraction := topFraction := 0.
! !
+
+!LayoutOrigin methodsFor:'converting'!
+
+literalArrayEncoding
+ "encode myself as an array.
+ The encoding is:
+ (#LayoutOrigin orgOffsX relOrgX orgOffsY relOrgY)
+ "
+
+ ^ Array
+ with:self class name asSymbol
+ with:leftOffset
+ with:leftFraction
+ with:topOffset
+ with:topFraction
+
+ "
+ LayoutOrigin new fromLiteralArrayEncoding:#(#LayoutOrigin 70 0 2 0)
+ (LayoutOrigin new leftOffset:10; leftFraction:0.2;
+ topOffset:20; topFraction:0.4) literalArrayEncoding
+ "
+
+ "Modified: 1.9.1995 / 02:43:48 / claus"
+!
+
+fromLiteralArrayEncoding:encoding
+ "read my values from an encoding.
+ The encoding is supposed to be of the form:
+ (#LayoutOrigin orgOffsX relOrgX orgOffsY relOrgY)
+ This is the reverse operation to #literalArrayEncoding."
+
+ leftOffset := encoding at:2.
+ leftFraction := encoding at:3.
+ topOffset := encoding at:4.
+ topFraction := encoding at:5.
+
+
+ "
+ LayoutOrigin new fromLiteralArrayEncoding:#(#LayoutOrigin 70 0 2 0)
+ "
+! !
+
--- a/PrintConv.st Wed Aug 30 19:54:43 1995 +0200
+++ b/PrintConv.st Sat Sep 09 04:30:16 1995 +0200
@@ -11,7 +11,7 @@
"
Object subclass:#PrintConverter
- instanceVariableNames:'valueToStringBlock stringToValueBlock'
+ instanceVariableNames:'valueToStringBlock stringToValueBlock type'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/PrintConv.st,v 1.7 1995-08-29 17:44:37 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/PrintConv.st,v 1.8 1995-09-09 02:29:54 claus Exp $
"
!
@@ -256,8 +256,39 @@
"
! !
+!PrintConverter methodsFor:'accessing'!
+
+type
+ "return the type if its one of the standard converters,
+ #number, #string etc. nil otherwise"
+
+ ^ type
+! !
+
!PrintConverter methodsFor:'initialization'!
+initFor:aTypeSymbol
+ "initialize to convert to/from objects as specified by aTypeSymbol,
+ which may be one of #number, #string, #symbol, #date or #password ..."
+
+ aTypeSymbol == #number ifTrue:[
+ self initForNumber
+ ].
+ (aTypeSymbol == #string or:[aTypeSymbol == #password]) ifTrue:[
+ self initForString
+ ].
+ aTypeSymbol == #date ifTrue:[
+ self initForDate
+ ].
+ aTypeSymbol == #symbol ifTrue:[
+ self initForSymbol
+ ].
+
+ type := aTypeSymbol
+
+ "Modified: 6.9.1995 / 12:10:38 / claus"
+!
+
toPrint:printBlock toRead:readBlock
"initialize to convert using two custom blocks.
printBlock is supposed to get the objects value as argument,
@@ -364,9 +395,15 @@
!PrintConverter methodsFor:'converting'!
printStringFor:aValue
+ "sent when an inputField wants a models value to be converted to a string
+ for display"
+
^ valueToStringBlock value:aValue
!
readValueFrom:aString
+ "sent when an inputField wants a string to be converted to a value
+ to be returned as its contents value"
+
^ stringToValueBlock value:aString
! !
--- a/PrintConverter.st Wed Aug 30 19:54:43 1995 +0200
+++ b/PrintConverter.st Sat Sep 09 04:30:16 1995 +0200
@@ -11,7 +11,7 @@
"
Object subclass:#PrintConverter
- instanceVariableNames:'valueToStringBlock stringToValueBlock'
+ instanceVariableNames:'valueToStringBlock stringToValueBlock type'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -35,7 +35,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/PrintConverter.st,v 1.7 1995-08-29 17:44:37 claus Exp $
+$Header: /cvs/stx/stx/libview2/PrintConverter.st,v 1.8 1995-09-09 02:29:54 claus Exp $
"
!
@@ -256,8 +256,39 @@
"
! !
+!PrintConverter methodsFor:'accessing'!
+
+type
+ "return the type if its one of the standard converters,
+ #number, #string etc. nil otherwise"
+
+ ^ type
+! !
+
!PrintConverter methodsFor:'initialization'!
+initFor:aTypeSymbol
+ "initialize to convert to/from objects as specified by aTypeSymbol,
+ which may be one of #number, #string, #symbol, #date or #password ..."
+
+ aTypeSymbol == #number ifTrue:[
+ self initForNumber
+ ].
+ (aTypeSymbol == #string or:[aTypeSymbol == #password]) ifTrue:[
+ self initForString
+ ].
+ aTypeSymbol == #date ifTrue:[
+ self initForDate
+ ].
+ aTypeSymbol == #symbol ifTrue:[
+ self initForSymbol
+ ].
+
+ type := aTypeSymbol
+
+ "Modified: 6.9.1995 / 12:10:38 / claus"
+!
+
toPrint:printBlock toRead:readBlock
"initialize to convert using two custom blocks.
printBlock is supposed to get the objects value as argument,
@@ -364,9 +395,15 @@
!PrintConverter methodsFor:'converting'!
printStringFor:aValue
+ "sent when an inputField wants a models value to be converted to a string
+ for display"
+
^ valueToStringBlock value:aValue
!
readValueFrom:aString
+ "sent when an inputField wants a string to be converted to a value
+ to be returned as its contents value"
+
^ stringToValueBlock value:aString
! !
--- a/ProtAdptr.st Wed Aug 30 19:54:43 1995 +0200
+++ b/ProtAdptr.st Sat Sep 09 04:30:16 1995 +0200
@@ -37,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/ProtAdptr.st,v 1.5 1995-08-29 17:44:42 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/ProtAdptr.st,v 1.6 1995-09-09 02:29:58 claus Exp $
"
!
@@ -266,11 +266,19 @@
subjectChannel:aValueHolder
|oldChannel|
+ subjectChannel notNil ifTrue:[
+ subjectChannel removeDependent:self
+ ].
oldChannel := subjectChannel.
subjectChannel := aValueHolder.
+ subjectChannel notNil ifTrue:[
+ subjectChannel addDependent:self
+ ].
oldChannel notNil ifTrue:[
self changed:#value.
].
+
+ "Modified: 6.9.1995 / 01:19:27 / claus"
!
subjectChannel
--- a/ProtocolAdaptor.st Wed Aug 30 19:54:43 1995 +0200
+++ b/ProtocolAdaptor.st Sat Sep 09 04:30:16 1995 +0200
@@ -37,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/ProtocolAdaptor.st,v 1.5 1995-08-29 17:44:42 claus Exp $
+$Header: /cvs/stx/stx/libview2/ProtocolAdaptor.st,v 1.6 1995-09-09 02:29:58 claus Exp $
"
!
@@ -266,11 +266,19 @@
subjectChannel:aValueHolder
|oldChannel|
+ subjectChannel notNil ifTrue:[
+ subjectChannel removeDependent:self
+ ].
oldChannel := subjectChannel.
subjectChannel := aValueHolder.
+ subjectChannel notNil ifTrue:[
+ subjectChannel addDependent:self
+ ].
oldChannel notNil ifTrue:[
self changed:#value.
].
+
+ "Modified: 6.9.1995 / 01:19:27 / claus"
!
subjectChannel
--- a/UIBuilder.st Wed Aug 30 19:54:43 1995 +0200
+++ b/UIBuilder.st Sat Sep 09 04:30:16 1995 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -10,10 +10,10 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 11-apr-1995 at 9:42:52 am'!
+'From Smalltalk/X, Version:2.10.7 on 7-sep-1995 at 10:06:32 pm' !
-WindowBuilder subclass:#UIBuilder
- instanceVariableNames:'view currentMenuSelector menuAspect'
+WindowBuilder subclass:#UIBuilder
+ instanceVariableNames:'view currentMenuSelector menuAspect spec'
classVariableNames:'Verbose'
poolDictionaries:''
category:'Interface-Support-UI'
@@ -21,23 +21,9 @@
!UIBuilder 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.
-"
-!
-
version
"
-$Header: /cvs/stx/stx/libview2/UIBuilder.st,v 1.7 1995-08-29 17:45:13 claus Exp $
+$Header: /cvs/stx/stx/libview2/UIBuilder.st,v 1.8 1995-09-09 02:30:09 claus Exp $
"
!
@@ -52,6 +38,20 @@
The class is not completed yet and certainly not bug free.
Also, it is not quaranteed that all winSpecs are understood.
"
+!
+
+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.
+"
! !
!UIBuilder class methodsFor:'initialization'!
@@ -68,322 +68,184 @@
!UIBuilder methodsFor:'operation'!
-buildFromSpec:aSpec
- |m|
+buildFromSpec:aSpecArray in:aView
+ |m spec|
- self readSpec:aSpec.
+ spec := UISpecification from:aSpecArray.
+
+ view := spec buildViewFor:self in:aView.
menuAspect notNil ifTrue:[
- m := self componentAt:menuAspect.
- m notNil ifTrue:[
- m := m value.
- m notNil ifTrue:[
- m receiver:application.
- topView add:m.
- view topInset:(m heightIncludingBorder).
- ]
- ]
+ m := self componentAt:menuAspect.
+ m notNil ifTrue:[
+ m := m value.
+ m notNil ifTrue:[
+ m receiver:application.
+ topView add:m.
+ view topInset:(m heightIncludingBorder).
+ ]
+ ]
].
^ topView
-! !
-!UIBuilder methodsFor:'private spec component parsing'!
-
-xLabelSpec:aSpec view:aView
- |l|
-
- l := Label in:aView.
- self fixFontFor:l.
- self doSpec:aSpec for:l
-
+ "Modified: 5.9.1995 / 21:48:09 / claus"
!
-xFullSpec:aSpec
- topView isNil ifTrue:[
- topView := StandardSystemView new.
- topView controller:(ApplicationController new).
- topView application:application.
+buildFromSpec:aSpecArray
+ |m spec|
+
+"/ old:
+"/ self readSpec:aSpecArray.
+
+ spec := UISpecification from:aSpecArray.
+ topView := view := spec buildViewFor:self.
+
+ menuAspect notNil ifTrue:[
+ m := self componentAt:menuAspect.
+ m notNil ifTrue:[
+ m := m value.
+ m notNil ifTrue:[
+ m receiver:application.
+ topView add:m.
+ view topInset:(m heightIncludingBorder).
+ ]
+ ]
].
- view := View new.
- self doSpec:aSpec for:view.
+ ^ topView
- topView extent:(view extent).
- view origin:0.0@0.0 corner:1.0@1.0.
- topView add:view.
+ "Modified: 5.9.1995 / 21:43:29 / claus"
+! !
- ^ topView
-!
+!UIBuilder methodsFor:'private arg parsing'!
-xSubCanvasSpec:aSpec view:aView
- |v|
+getLayoutFrame:spec
+ "called for #(LayoutFrame absOrgX relOrgX absOrgY relOrgY absCornX relCornX absCornY relCornY)"
+ " 1 2 3 4 5 6 7 8 9"
- v := SubCanvas in:aView.
- self doSpec:aSpec for:v
-!
+ ^ LayoutFrame new fromLiteralArrayEncoding:spec.
-xSpecCollection:aSpec view:aView
- self doSpec:aSpec for:aView
-
-!
-
-xWindowSpec:aSpec view:aView
- self doSpec:aSpec for:aView
+"/ ^ Array with:#layoutFrame
+"/ with:((spec at:2) @ (spec at:4)) "/ org inset
+"/ with:((spec at:6) @ (spec at:8)) "/ corner inset
+"/ with:((spec at:3) @ (spec at:5)) "/ rel org
+"/ with:((spec at:7) @ (spec at:9)) "/ rel corn
!
-xMenu:aSpec
- |items numItems unknown prevCurrent labels|
-
- topView := PullDownMenu new.
-
- items := aSpec at:2.
- numItems := (aSpec at:3) at:1.
- unknown := (aSpec at:4).
-
- prevCurrent := currentMenuSelector.
+getArg:spec
+ "take something like #(Point 50 100) and return the value"
- "precollect labels ..."
- labels := OrderedCollection new.
- items do:[:item |
- (item at:1) ~~ #MenuItem ifTrue:[
- self halt
- ].
- (item at:2) ~~ #'label:' ifTrue:[
- self halt
- ].
- labels add:(item at:3)
- ].
+ |what|
- topView labels:labels.
-
- items with:(1 to:numItems) do:[:item :index |
- currentMenuSelector := index.
- self doSpec:item for:topView.
- ].
-
- currentMenuSelector := prevCurrent.
- ^ topView
+ what := spec at:1.
+ ^ self perform:('get' , what , ':') asSymbol with:spec
!
-xPopUpMenu:aSpec
- |menu values|
-
- menu := PopUpMenu
- labels:(aSpec at:2).
- values := Array new:((aSpec at:2) size).
+getRectangle:spec
+ "called for #(Rectangle x y)"
- (aSpec at:4) keysAndValuesDo:[:index :item |
- ((item size > 0)
- and:[(item at:1) == #PopUpMenu]) ifTrue:[
- menu subMenuAt:index put:(self xPopUpMenu:item)
- ] ifFalse:[
- values at:index put:item
- ]
- ].
-
- menu values:values.
- ^ menu
+ ^ Array with:#rectangle
+ with:(((spec at:2) @ (spec at:3)) corner:((spec at:4) @ (spec at:5)))
!
-xInputFieldSpec:aSpec view:aView
- |l|
+getPoint:spec
+ "called for #(Point x y)"
- l := EditField in:aView.
- self fixFontFor:l.
- l aspect:#value; change:#value:.
- self doSpec:aSpec for:l
+ ^ Array with:#point
+ with:((spec at:2) @ (spec at:3))
!
-xActionButtonSpec:aSpec view:aView
- |b|
+getLayoutOrigin:spec
+ "called for #(LayoutOrigin xInset relX yInset relY)"
- b := Button in:aView.
- self fixFontFor:b.
- self doSpec:aSpec for:b
-!
-
-xSequenceViewSpec:aSpec view:aView
- |f s|
-
- f := ScrollableView for:SelectionInListView in:aView.
- s := f scrolledView.
- self doSpec:aSpec for:s frame:f.
+ ^ LayoutOrigin new fromLiteralArrayEncoding:spec.
+"/ ^ Array with:#layoutOrigin
+"/ with:((spec at:3) @ (spec at:5)) "/ rels
+"/ with:((spec at:2) @ (spec at:4)) "/ insets
!
-xScrollerSpec:aSpec view:aView
- |s idx orientation|
+getCompositeSpec:spec
+ "called for #(CompositeSpec layout: #(orgx orgy cornx corny)"
+
+ |layout|
- idx := aSpec indexOf:#orientation:.
- idx == 0 ifTrue:[
- orientation := #vertical
- ] ifFalse:[
- orientation := aSpec at:(idx + 1)
+ (spec at:2) == #layout: ifTrue:[
+ layout := spec at:3.
+ (layout at:1) == #Rectangle ifTrue:[
+ ^ Rectangle
+ origin:(layout at:2) @ (layout at:3)
+ corner:(layout at:4) @ (layout at:5)
+ ].
].
- orientation == #horizontal ifTrue:[
- s := HorizontalScroller in:aView
- ] ifFalse:[
- s := Scroller in:aView
- ].
- self doSpec:aSpec for:s
+ self halt:'unimplemented'.
!
-xProgressIndicatorSpec:aSpec view:aView
- |s|
-
- s := ProgressIndicator in:aView.
- self doSpec:aSpec for:s
-!
-
-xSliderSpec:aSpec view:aView
- |s idx orientation|
+getAlignmentOrigin:spec
+ "called for #(AlignmentOrigin ?x ?relX ?x ?y ?relY ?y)"
- idx := aSpec indexOf:#orientation:.
- idx == 0 ifTrue:[
- orientation := #vertical
- ] ifFalse:[
- orientation := aSpec at:(idx + 1)
- ].
- orientation == #horizontal ifTrue:[
- s := HorizontalSlider in:aView
- ] ifFalse:[
- s := Slider in:aView
- ].
- self doSpec:aSpec for:s
+ ^ AlignmentOrigin new fromLiteralArrayEncoding:spec.
+"/ ^ Array with:#alignmentOrigin
+"/ with:((spec at:2) @ (spec at:5)) "/ ?
+"/ with:((spec at:3) @ (spec at:6)) "/ rels ?
+"/ with:((spec at:4) @ (spec at:7)) "/ insets ?
!
-xCompositeSpecCollection:aSpec view:aView
- |v|
+getLookPreferences:spec
+ "called for #(LookPreferences setForegroundColor: (...) setBackgroundColor: (...) ...)"
-"/ 'compositeSpecCollection ignored' printNL.
-"/ ^ self.
- v := View in:aView.
- self doSpec:aSpec for:v
+ |coll|
-!
-
-xArbitraryComponentSpec:aSpec view:aView
- |v|
-
- v := View in:aView.
-"/ v := Label label:'ArbitraryView' in:aView.
- v level:-1.
- self doSpec:aSpec for:v
+ coll := OrderedCollection new.
+ 2 to:spec size by:2 do:[:index |
+ coll add:
+ (Array with:(spec at:index)
+ with:(self getArg:(spec at:index+1)))
+ ].
+ ^ coll.
!
-xCheckBoxSpec:aSpec view:aView
- |b|
+getColorValue:spec
+ "called for #(ColorValue #sym)
+ or #(ColorValue red green blue)"
- b := CheckBox in:aView.
- self fixFontFor:b.
- self doSpec:aSpec for:b
-
-!
-
-xTableViewSpec:aSpec view:aView
- |l|
+ |clr arg|
- 'tableView ignored' printNL.
- l := Label label:'TableView' in:aView.
- l level:-1.
- self doSpec:aSpec for:l
-!
-
-xGroupBoxSpec:aSpec view:aView
- |l|
+ (arg := spec at:2) isSymbol ifTrue:[
+ (Color respondsTo:arg) ifTrue:[
+ ^ Color perform:arg
+ ].
+ ^ Color name:arg asString ifIllegal:[Color black]
+ ].
+ arg isInteger ifTrue:[
+ ^ ColorValue scaledRed:arg
+ scaledGreen:(spec at:3)
+ scaledBlue:(spec at:4)
+ ].
+ ^ ColorValue red:arg
+ green:(spec at:3)
+ blue:(spec at:4)
- l := FramedBox in:aView.
- self doSpec:aSpec for:l
-!
-xDividerSpec:aSpec view:aView
- |l|
-
- l := View in:aView.
- self doSpec:aSpec for:l
! !
!UIBuilder methodsFor:'private spec attribute parsing'!
-yMultipleSelections:args view:aView frame:frameView
- args == true ifTrue:[
- aView multipleSelectOk:true
- ]
-!
-
-XXyMultipleSelections:args view:aView
- aView multipleSelectOk:args
-!
-
-yBounds:args view:aView frame:frameView
- |value r|
-
- value := self getArg:args.
- (value at:1) == #rectangle ifTrue:[
- r := value at:2.
- aView origin:r origin corner:r corner.
- ^ self
- ].
- self halt:'unimplemented'.
-!
-
yCollection:args view:aView frame:frameView
args do:[:aSpec |
self readSpec:aSpec view:aView frame:frameView.
].
!
-yComponent:args view:aView frame:frameView
- |v|
-
- args isSymbol ifTrue:[
- v := application perform:args.
- v origin:0.0@0.0 corner:1.0@1.0.
- aView addSubView:v
- ] ifFalse:[
-"/ v := View origin:0.0@0.0 corner:1.0@1.0 in:aView.
-"/ self readSpec:args view:v frame:frameView.
- self readSpec:args view:aView frame:frameView.
- ]
-!
-
-yColors:args view:aView frame:frameView
- |value|
-
- value := self getArg:args.
- self halt:'unimplemented'.
-!
-
-yCompositeSpec:args view:aView frame:frameView
- |value r|
-
- self doSpec:args for:aView.
-"
- value := self getArg:args.
- (value at:1) == #rectangle ifTrue:[
- r := value at:2.
- aView origin:r origin corner:r corner.
- ^ self
- ].
-
-self halt.
-"
-!
-
-yDefaultable:args view:aView frame:frameView
- 'defaultable ignored' printNL
-!
-
-yLabel:args view:aView frame:frameView
- aView label:args.
-
-!
-
yLayout:args view:aView frame:frameView
|value r org corn orgInset cornInset what|
value := self getArg:args.
+ value isLayout ifTrue:[
+ frameView geometryLayout:value.
+ ^ self
+ ].
what := value at:1.
what == #point ifTrue:[
@@ -456,8 +318,85 @@
self halt:'unimplemented'.
!
+yBounds:args view:aView frame:frameView
+ |value r|
+
+ value := self getArg:args.
+ (value at:1) == #rectangle ifTrue:[
+ r := value at:2.
+ aView origin:r origin corner:r corner.
+ ^ self
+ ].
+ self halt:'unimplemented'.
+!
+
+yMultipleSelections:args view:aView frame:frameView
+ args == true ifTrue:[
+ aView multipleSelectOk:true
+ ]
+!
+
+yComponent:args view:aView frame:frameView
+ |v|
+
+ args isSymbol ifTrue:[
+ v := application perform:args.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ aView addSubView:v
+ ] ifFalse:[
+"/ v := View origin:0.0@0.0 corner:1.0@1.0 in:aView.
+"/ self readSpec:args view:v frame:frameView.
+ self readSpec:args view:aView frame:frameView.
+ ]
+!
+
+XXyMultipleSelections:args view:aView
+ aView multipleSelectOk:args
+!
+
+yColors:args view:aView frame:frameView
+ |value|
+
+ value := self getArg:args.
+ self halt:'unimplemented'.
+!
+
+yName:args view:aView frame:frameView
+ self componentAt:args put:aView
+!
+
+yCompositeSpec:args view:aView frame:frameView
+ |value r|
+
+ self doSpec:args for:aView.
+"
+ value := self getArg:args.
+ (value at:1) == #rectangle ifTrue:[
+ r := value at:2.
+ aView origin:r origin corner:r corner.
+ ^ self
+ ].
+
+self halt.
+"
+!
+
+yDefaultable:args view:aView frame:frameView
+ 'defaultable ignored' printNL
+!
+
yFlags:args view:aView frame:frameView
- 'flags ignored' printNL
+ 'flags: ' print. args print. ' for ' print. aView print. ' ignored' printNL
+"
+32 : initially disabled
+16 : initially invisible
+ 8 : border
+ 4 : menuBar
+ 2 : hScroll
+ 1 : vScroll
+"
+
+ "Modified: 2.9.1995 / 15:44:15 / claus"
!
yIsDefault:args view:aView frame:frameView
@@ -517,10 +456,6 @@
menuAspect := args
!
-yName:args view:aView frame:frameView
- self componentAt:args put:aView
-!
-
yOrientation:args view:aView frame:frameView
'orientation ignored' printNL.
!
@@ -540,6 +475,10 @@
]
!
+yWindow:args view:aView frame:frameView
+ self readSpec:args view:aView frame:frameView.
+!
+
yStart:args view:aView frame:frameView
(aView isKindOf:Scroller) ifTrue:[
aView start:args.
@@ -589,10 +528,6 @@
receiver:nil.
!
-yWindow:args view:aView frame:frameView
- self readSpec:args view:aView frame:frameView.
-!
-
yStyle:args view:aView frame:frameView
'name ignored' printNL.
@@ -607,115 +542,272 @@
].
'type ignored' printNL.
+!
+
+doesNotUnderstand:aMessage
+ |rest sel|
+
+ ((sel := aMessage selector) startsWith:'y') ifTrue:[
+ rest := sel copyFrom:2 to:(sel indexOf:$:).
+ rest at:1 put:(rest at:1) asLowercase.
+ rest := rest asSymbolIfInterned.
+ rest notNil ifTrue:[
+ (aMessage arguments at:2) perform:rest with:(aMessage arguments at:1).
+ ^ self.
+ ]
+ ].
+ super doesNotUnderstand:aMessage
+
+ "Modified: 5.9.1995 / 21:13:16 / claus"
! !
-!UIBuilder methodsFor:'private arg parsing'!
+!UIBuilder methodsFor:'private spec component parsing'!
-getArg:spec
- "take something like #(Point 50 100) and return the value"
+xLabelSpec:aSpec view:aView
+ |l|
- |what|
+ l := Label in:aView.
+ self fixFontFor:l.
+ self doSpec:aSpec for:l
- what := spec at:1.
- ^ self perform:('get' , what , ':') asSymbol with:spec
+!
+
+xSpecCollection:aSpec view:aView
+ self doSpec:aSpec for:aView
+
!
-getPoint:spec
- "called for #(Point x y)"
+xInputFieldSpec:aSpec view:aView
+ |l|
- ^ Array with:#point
- with:((spec at:2) @ (spec at:3))
+ l := EditField in:aView.
+ self fixFontFor:l.
+ l aspect:#value; change:#value:.
+ self doSpec:aSpec for:l
+!
+
+xActionButtonSpec:aSpec view:aView
+ |b|
+
+ b := Button in:aView.
+ self fixFontFor:b.
+ self doSpec:aSpec for:b
!
-getLayoutFrame:spec
- "called for #(LayoutFrame absOrgX relOrgX absOrgY relOrgY absCornX relCornX absCornY relCornY)"
- " 1 2 3 4 5 6 7 8 9"
- ^ Array with:#layoutFrame
- with:((spec at:2) @ (spec at:4)) "/ org inset
- with:((spec at:6) @ (spec at:8)) "/ corner inset
- with:((spec at:3) @ (spec at:5)) "/ rel org
- with:((spec at:7) @ (spec at:9)) "/ rel corn
+xFullSpec:aSpec
+ topView isNil ifTrue:[
+ topView := StandardSystemView new.
+ topView controller:(ApplicationController new).
+ topView application:application.
+ ].
+
+ view := View new.
+ self doSpec:aSpec for:view.
+
+ topView extent:(view extent).
+ view origin:0.0@0.0 corner:1.0@1.0.
+ topView add:view.
+
+ ^ topView
+!
+
+xWindowSpec:aSpec view:aView
+ self doSpec:aSpec for:aView
!
-getRectangle:spec
- "called for #(Rectangle x y)"
+xSubCanvasSpec:aSpec view:aView
+ |v|
- ^ Array with:#rectangle
- with:(((spec at:2) @ (spec at:3)) corner:((spec at:4) @ (spec at:5)))
+ v := SubCanvas in:aView.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ self doSpec:aSpec for:v
+
+ "Modified: 2.9.1995 / 15:26:15 / claus"
!
-getLayoutOrigin:spec
- "called for #(LayoutOrigin xInset relX yInset relY)"
+xMenu:aSpec
+ |items numItems unknown prevCurrent labels|
+
+ topView := PullDownMenu new.
+
+ items := aSpec at:2.
+ numItems := (aSpec at:3) at:1.
+ unknown := (aSpec at:4).
+
+ prevCurrent := currentMenuSelector.
- ^ Array with:#layoutOrigin
- with:((spec at:3) @ (spec at:5)) "/ rels
- with:((spec at:2) @ (spec at:4)) "/ insets
+ "precollect labels ..."
+ labels := OrderedCollection new.
+ items do:[:item |
+ (item at:1) ~~ #MenuItem ifTrue:[
+ self halt
+ ].
+ (item at:2) ~~ #'label:' ifTrue:[
+ self halt
+ ].
+ labels add:(item at:3)
+ ].
+
+ topView labels:labels.
+
+ items with:(1 to:numItems) do:[:item :index |
+ currentMenuSelector := index.
+ self doSpec:item for:topView.
+ ].
+
+ currentMenuSelector := prevCurrent.
+ ^ topView
!
-getCompositeSpec:spec
- "called for #(CompositeSpec layout: #(orgx orgy cornx corny)"
+xPopUpMenu:aSpec
+ |menu values|
- |layout|
+ menu := PopUpMenu
+ labels:(aSpec at:2).
+ values := Array new:((aSpec at:2) size).
- (spec at:2) == #layout: ifTrue:[
- layout := spec at:3.
- (layout at:1) == #Rectangle ifTrue:[
- ^ Rectangle
- origin:(layout at:2) @ (layout at:3)
- corner:(layout at:4) @ (layout at:5)
- ].
+ (aSpec at:4) keysAndValuesDo:[:index :item |
+ ((item size > 0)
+ and:[(item at:1) == #PopUpMenu]) ifTrue:[
+ menu subMenuAt:index put:(self xPopUpMenu:item)
+ ] ifFalse:[
+ values at:index put:item
+ ]
].
- self halt:'unimplemented'.
+
+ menu values:values.
+ ^ menu
+!
+
+xSequenceViewSpec:aSpec view:aView
+ |f s|
+
+ f := ScrollableView for:SelectionInListView in:aView.
+ s := f scrolledView.
+ self doSpec:aSpec for:s frame:f.
!
-getAlignmentOrigin:spec
- "called for #(AlignmentOrigin ?x ?relX ?x ?y ?relY ?y)"
+xScrollerSpec:aSpec view:aView
+ |s idx orientation|
+
+ idx := aSpec indexOf:#orientation:.
+ idx == 0 ifTrue:[
+ orientation := #vertical
+ ] ifFalse:[
+ orientation := aSpec at:(idx + 1)
+ ].
+ orientation == #horizontal ifTrue:[
+ s := HorizontalScroller in:aView
+ ] ifFalse:[
+ s := Scroller in:aView
+ ].
+ self doSpec:aSpec for:s
+!
+
+xProgressIndicatorSpec:aSpec view:aView
+ |s|
+
+ s := ProgressIndicator in:aView.
+ self doSpec:aSpec for:s
+!
- ^ Array with:#alignmentOrigin
- with:((spec at:2) @ (spec at:5)) "/ ?
- with:((spec at:3) @ (spec at:6)) "/ rels ?
- with:((spec at:4) @ (spec at:7)) "/ insets ?
+xSliderSpec:aSpec view:aView
+ |s idx orientation|
+ idx := aSpec indexOf:#orientation:.
+ idx == 0 ifTrue:[
+ orientation := #vertical
+ ] ifFalse:[
+ orientation := aSpec at:(idx + 1)
+ ].
+ orientation == #horizontal ifTrue:[
+ s := HorizontalSlider in:aView
+ ] ifFalse:[
+ s := Slider in:aView
+ ].
+ self doSpec:aSpec for:s
+!
+
+xCompositeSpecCollection:aSpec view:aView
+ |v|
+
+"/ 'compositeSpecCollection ignored' printNL.
+"/ ^ self.
+ v := View in:aView.
+ self doSpec:aSpec for:v
!
-getLookPreferences:spec
- "called for #(LookPreferences setForegroundColor: (...) setBackgroundColor: (...) ...)"
+xArbitraryComponentSpec:aSpec view:aView
+ |v|
- |coll|
+ v := View in:aView.
+"/ v := Label label:'ArbitraryView' in:aView.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ v level:-1.
+ self doSpec:aSpec for:v
+
+ "Modified: 2.9.1995 / 15:26:03 / claus"
+!
- coll := OrderedCollection new.
- 2 to:spec size by:2 do:[:index |
- coll add:
- (Array with:(spec at:index)
- with:(self getArg:(spec at:index+1)))
- ].
- ^ coll.
+xCheckBoxSpec:aSpec view:aView
+ |b|
+
+ b := CheckBox in:aView.
+ self fixFontFor:b.
+ self doSpec:aSpec for:b
+
+!
+
+xTableViewSpec:aSpec view:aView
+ |l|
+
+ 'tableView ignored' printNL.
+ l := Label label:'TableView' in:aView.
+ l level:-1.
+ self doSpec:aSpec for:l
!
-getColorValue:spec
- "called for #(ColorValue #sym)
- or #(ColorValue red green blue)"
+xGroupBoxSpec:aSpec view:aView
+ |l|
+
+ l := FramedBox in:aView.
+ self doSpec:aSpec for:l
+!
+
+xDividerSpec:aSpec view:aView
+ |l|
- |clr arg|
+ l := View in:aView.
+ self doSpec:aSpec for:l
+!
+
+xFramedBoxSpec:aSpec view:aView
+ |v|
+
+ v := FramedBox in:aView.
+ self doSpec:aSpec for:v
- (arg := spec at:2) isSymbol ifTrue:[
- (Color respondsTo:arg) ifTrue:[
- ^ Color perform:arg
- ].
- ^ Color name:arg asString ifIllegal:[Color black]
- ].
- arg isInteger ifTrue:[
- ^ ColorValue scaledRed:arg
- scaledGreen:(spec at:3)
- scaledBlue:(spec at:4)
- ].
- ^ ColorValue red:arg
- green:(spec at:3)
- blue:(spec at:4)
+ "Modified: 5.9.1995 / 21:05:38 / claus"
+!
+
+xVerticalPanelViewSpec:aSpec view:aView
+ |v|
+
+ v := VerticalPanelView in:aView.
+ self doSpec:aSpec for:v
+ "Modified: 5.9.1995 / 21:06:19 / claus"
+!
+xHorizontalPanelViewSpec:aSpec view:aView
+ |v|
+
+ v := HorizontalPanelView in:aView.
+ self doSpec:aSpec for:v
+
+ "Modified: 5.9.1995 / 21:06:25 / claus"
! !
!UIBuilder methodsFor:'private spec parsing'!
@@ -724,10 +816,6 @@
^ self doSpec:aSpec for:aView frame:aView
!
-add:aSpec
- self readSpec:aSpec
-!
-
readSpec:aSpec
|what|
@@ -776,6 +864,10 @@
with:aView
with:frame.
+!
+
+add:aSpec
+ self readSpec:aSpec
! !
!UIBuilder methodsFor:'private special kludges'!
@@ -792,4 +884,4 @@
^ aPoint "/ (aPoint * (1 @ 1.5)) truncated
! !
-UIBuilder initialize!
+UIBuilder initialize!
--- a/WinBuilder.st Wed Aug 30 19:54:43 1995 +0200
+++ b/WinBuilder.st Sat Sep 09 04:30:16 1995 +0200
@@ -10,8 +10,9 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.7 on 7-sep-1995 at 10:06:38 pm' !
-Object subclass:#WindowBuilder
+Object subclass:#WindowBuilder
instanceVariableNames:'topView application bindings aspects focusSequence'
classVariableNames:''
poolDictionaries:''
@@ -36,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/WinBuilder.st,v 1.7 1995-08-30 17:54:30 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/WinBuilder.st,v 1.8 1995-09-09 02:30:16 claus Exp $
"
!
@@ -52,12 +53,12 @@
!WindowBuilder methodsFor:'accessing'!
-bindings
- ^ bindings
+window
+ ^ topView
!
-bindings:aDictionary
- bindings := aDictionary
+application
+ ^ application
!
focusSequence
@@ -69,6 +70,29 @@
^ aspects at:aSymbol ifAbsent:nil
!
+application:anApplicationModel
+ application := anApplicationModel
+!
+
+window:aView
+ topView := aView
+!
+
+bindings
+ ^ bindings
+!
+
+bindings:aDictionary
+ bindings := aDictionary
+!
+
+componentAt:name put:aComponent
+ bindings isNil ifTrue:[
+ bindings := IdentityDictionary new.
+ ].
+ bindings at:name put:aComponent
+!
+
aspectAt:aSymbol put:aModel
aspects isNil ifTrue:[
aspects := IdentityDictionary new
@@ -85,49 +109,16 @@
^ bindings at:name ifAbsent:nil
!
-componentAt:name put:aComponent
- bindings isNil ifTrue:[
- bindings := IdentityDictionary new.
- ].
- bindings at:name put:aComponent
-!
-
-window:aView
- topView := aView
-!
-
-window
- ^ topView
-!
-
windowGroup
^ topView windowGroup
!
-application
- ^ application
-!
-
-application:anApplicationModel
- application := anApplicationModel
-!
-
source:anApplicationModel
application := anApplicationModel
! !
!WindowBuilder methodsFor:'operation'!
-buildFromSpec:aSpec
- self subclassResponsibility
-!
-
-open
- "open my topView, as previously created"
-
- self openWithExtent:nil andType:#normal
-!
-
openWithExtent:aPoint
"open my topView, as previously created, but override
the extent."
@@ -135,20 +126,6 @@
self openWithExtent:aPoint andType:#normal
!
-openDialog
- "open my topView, as previously created as a modal view,
- blocking interaction to the currently active view."
-
- self openWithExtent:nil andType:#dialog
-!
-
-openDialogWithExtent:ext
- "open my topView, as previously created as a modal view,
- blocking interaction to the currently active view."
-
- self openWithExtent:ext andType:#dialog
-!
-
openWithExtent:ext andType:type
"open my topView, as previously created. The type argument
may be #dialog or #normal, and specifies if the view should
@@ -173,6 +150,38 @@
self halt:'unimplemented'
!
+buildFromSpec:aSpec
+ self subclassResponsibility
+!
+
+open
+ "open my topView, as previously created"
+
+ self openWithExtent:nil andType:#normal
+!
+
+openDialog
+ "open my topView, as previously created as a modal view,
+ blocking interaction to the currently active view."
+
+ self openWithExtent:nil andType:#dialog
+!
+
+openDialogWithExtent:ext
+ "open my topView, as previously created as a modal view,
+ blocking interaction to the currently active view."
+
+ self openWithExtent:ext andType:#dialog
+!
+
closeRequest
topView destroy
! !
+
+!WindowBuilder methodsFor:'spec creation callbacks'!
+
+createdComponent:aView forSpec:spec
+
+ "Modified: 5.9.1995 / 21:42:54 / claus"
+! !
+
--- a/WindowBuilder.st Wed Aug 30 19:54:43 1995 +0200
+++ b/WindowBuilder.st Sat Sep 09 04:30:16 1995 +0200
@@ -10,8 +10,9 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.7 on 7-sep-1995 at 10:06:38 pm' !
-Object subclass:#WindowBuilder
+Object subclass:#WindowBuilder
instanceVariableNames:'topView application bindings aspects focusSequence'
classVariableNames:''
poolDictionaries:''
@@ -36,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/WindowBuilder.st,v 1.7 1995-08-30 17:54:30 claus Exp $
+$Header: /cvs/stx/stx/libview2/WindowBuilder.st,v 1.8 1995-09-09 02:30:16 claus Exp $
"
!
@@ -52,12 +53,12 @@
!WindowBuilder methodsFor:'accessing'!
-bindings
- ^ bindings
+window
+ ^ topView
!
-bindings:aDictionary
- bindings := aDictionary
+application
+ ^ application
!
focusSequence
@@ -69,6 +70,29 @@
^ aspects at:aSymbol ifAbsent:nil
!
+application:anApplicationModel
+ application := anApplicationModel
+!
+
+window:aView
+ topView := aView
+!
+
+bindings
+ ^ bindings
+!
+
+bindings:aDictionary
+ bindings := aDictionary
+!
+
+componentAt:name put:aComponent
+ bindings isNil ifTrue:[
+ bindings := IdentityDictionary new.
+ ].
+ bindings at:name put:aComponent
+!
+
aspectAt:aSymbol put:aModel
aspects isNil ifTrue:[
aspects := IdentityDictionary new
@@ -85,49 +109,16 @@
^ bindings at:name ifAbsent:nil
!
-componentAt:name put:aComponent
- bindings isNil ifTrue:[
- bindings := IdentityDictionary new.
- ].
- bindings at:name put:aComponent
-!
-
-window:aView
- topView := aView
-!
-
-window
- ^ topView
-!
-
windowGroup
^ topView windowGroup
!
-application
- ^ application
-!
-
-application:anApplicationModel
- application := anApplicationModel
-!
-
source:anApplicationModel
application := anApplicationModel
! !
!WindowBuilder methodsFor:'operation'!
-buildFromSpec:aSpec
- self subclassResponsibility
-!
-
-open
- "open my topView, as previously created"
-
- self openWithExtent:nil andType:#normal
-!
-
openWithExtent:aPoint
"open my topView, as previously created, but override
the extent."
@@ -135,20 +126,6 @@
self openWithExtent:aPoint andType:#normal
!
-openDialog
- "open my topView, as previously created as a modal view,
- blocking interaction to the currently active view."
-
- self openWithExtent:nil andType:#dialog
-!
-
-openDialogWithExtent:ext
- "open my topView, as previously created as a modal view,
- blocking interaction to the currently active view."
-
- self openWithExtent:ext andType:#dialog
-!
-
openWithExtent:ext andType:type
"open my topView, as previously created. The type argument
may be #dialog or #normal, and specifies if the view should
@@ -173,6 +150,38 @@
self halt:'unimplemented'
!
+buildFromSpec:aSpec
+ self subclassResponsibility
+!
+
+open
+ "open my topView, as previously created"
+
+ self openWithExtent:nil andType:#normal
+!
+
+openDialog
+ "open my topView, as previously created as a modal view,
+ blocking interaction to the currently active view."
+
+ self openWithExtent:nil andType:#dialog
+!
+
+openDialogWithExtent:ext
+ "open my topView, as previously created as a modal view,
+ blocking interaction to the currently active view."
+
+ self openWithExtent:ext andType:#dialog
+!
+
closeRequest
topView destroy
! !
+
+!WindowBuilder methodsFor:'spec creation callbacks'!
+
+createdComponent:aView forSpec:spec
+
+ "Modified: 5.9.1995 / 21:42:54 / claus"
+! !
+