--- a/CheckBox.st Thu Nov 23 19:15:36 1995 +0100
+++ b/CheckBox.st Thu Nov 23 19:18:39 1995 +0100
@@ -11,8 +11,6 @@
"
-'From Smalltalk/X, Version:2.10.5 on 8-may-1995 at 3:48:28 am'!
-
HorizontalPanelView subclass:#CheckBox
instanceVariableNames:'toggleView labelView'
classVariableNames:''
@@ -22,8 +20,19 @@
!CheckBox class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/CheckBox.st,v 1.13 1995-11-11 16:28:52 cg Exp $'
+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
@@ -191,31 +200,10 @@
Transcript show:'value2: '; showCr:model value2.
]
"
-!
-
-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.
-"
-
! !
!CheckBox class methodsFor:'instance creation'!
-model:aModel
- "create & return a new checkBox, on aModel (typically a ValueHolder)"
-
- ^ self new model:aModel
-!
-
label:aStringOrImage model:aModel
"create & return a new checkBox, on aModel (typically a ValueHolder),
with aStringOrImage as label."
@@ -223,74 +211,12 @@
^ (self new model:aModel) label:aStringOrImage
"Created: 17.9.1995 / 14:20:58 / claus"
-! !
-
-!CheckBox methodsFor:'accessing-mvc'!
-
-changeMessage:aChangeSelector
- "forward to toggle"
-
- toggleView changeMessage:aChangeSelector
-!
-
-aspectMessage:aspectSymbol
- "forward to label & toggle"
-
- labelView aspectMessage:aspectSymbol.
- toggleView aspectMessage:aspectSymbol
!
model:aModel
- "forward to label & toggle"
-
- labelView model:aModel.
- toggleView model:aModel
-! !
-
-!CheckBox methodsFor:'accessing-behavior'!
-
-action:aBlock
- "forward to toggle"
-
- toggleView action:aBlock
-!
-
-pressAction:aBlock
- toggleView pressAction:aBlock.
-
- "Created: 22.9.1995 / 15:54:04 / claus"
-!
-
-releaseAction:aBlock
- toggleView releaseAction:aBlock.
+ "create & return a new checkBox, on aModel (typically a ValueHolder)"
- "Created: 22.9.1995 / 15:54:11 / claus"
-!
-
-enable
- "forward to toggle & change labels color"
-
- toggleView enable.
- labelView foregroundColor:(toggleView foregroundColor).
-!
-
-disable
- "forward to toggle & change labels color"
-
- toggleView disable.
- labelView foregroundColor:(toggleView disabledForegroundColor).
-!
-
-turnOff
- "forward to toggle"
-
- toggleView turnOff
-!
-
-turnOn
- "forward to toggle"
-
- toggleView turnOn
+ ^ self new model:aModel
! !
!CheckBox methodsFor:'accessing'!
@@ -309,21 +235,64 @@
^ toggleView
! !
-!CheckBox methodsFor:'accessing-state'!
+!CheckBox methodsFor:'accessing-behavior'!
+
+action:aBlock
+ "forward to toggle"
+
+ toggleView action:aBlock
+!
+
+disable
+ "forward to toggle & change labels color"
+
+ toggleView disable.
+ labelView foregroundColor:(toggleView disabledForegroundColor).
+!
+
+enable
+ "forward to toggle & change labels color"
+
+ toggleView enable.
+ labelView foregroundColor:(toggleView foregroundColor).
+!
-isOn
- ^ toggleView isOn
+pressAction:aBlock
+ toggleView pressAction:aBlock.
+
+ "Created: 22.9.1995 / 15:54:04 / claus"
+!
+
+releaseAction:aBlock
+ toggleView releaseAction:aBlock.
+
+ "Created: 22.9.1995 / 15:54:11 / claus"
+!
+
+turnOff
+ "forward to toggle"
+
+ toggleView turnOff
+!
+
+turnOn
+ "forward to toggle"
+
+ toggleView turnOn
! !
!CheckBox methodsFor:'accessing-look'!
-label:aString
- "forward to label & resize"
+activeLogo:anImageOrString
+ toggleView activeLogo:anImageOrString
- labelView label:aString.
- labelView forceResize.
- self layoutChanged.
- self resize.
+ "Created: 22.9.1995 / 15:44:08 / claus"
+!
+
+font
+ "forward from label"
+
+ ^ labelView font
!
font:aFont
@@ -335,22 +304,19 @@
self resize.
!
-font
- "forward from label"
-
- ^ labelView font
-!
-
label
"forward from label"
^ labelView label
!
-activeLogo:anImageOrString
- toggleView activeLogo:anImageOrString
+label:aString
+ "forward to label & resize"
- "Created: 22.9.1995 / 15:44:08 / claus"
+ labelView label:aString.
+ labelView forceResize.
+ self layoutChanged.
+ self resize.
!
passiveLogo:anImageOrString
@@ -359,25 +325,32 @@
"Created: 22.9.1995 / 15:44:14 / claus"
! !
-!CheckBox methodsFor:'queries'!
+!CheckBox methodsFor:'accessing-mvc'!
-preferredExtent
- |prefCheck prefLabel bw2|
+aspectMessage:aspectSymbol
+ "forward to label & toggle"
+
+ labelView aspectMessage:aspectSymbol.
+ toggleView aspectMessage:aspectSymbol
+!
-^ super preferredExtent + (10@0).
-"/ prefCheck := toggleView preferredExtent.
-"/ prefLabel := labelView preferredExtent.
-"/ bw2 := borderWidth * 2.
-"/ ^ (prefCheck x + prefLabel x + (3 * ViewSpacing)) @ ((prefCheck y max:prefLabel y) + bw2 + 2)
+changeMessage:aChangeSelector
+ "forward to toggle"
+
+ toggleView changeMessage:aChangeSelector
+!
+
+model:aModel
+ "forward to label & toggle"
+
+ labelView model:aModel.
+ toggleView model:aModel
! !
-!CheckBox methodsFor:'private'!
+!CheckBox methodsFor:'accessing-state'!
-sendChangeMessageWith:aValue
- "redefined to have mimic changes being sent from the toggle
- instead of myself"
-
- toggleView sendChangeMessageWith:aValue
+isOn
+ ^ toggleView isOn
! !
!CheckBox methodsFor:'initialization'!
@@ -411,3 +384,30 @@
b open
"
! !
+
+!CheckBox methodsFor:'private'!
+
+sendChangeMessageWith:aValue
+ "redefined to have mimic changes being sent from the toggle
+ instead of myself"
+
+ toggleView sendChangeMessageWith:aValue
+! !
+
+!CheckBox methodsFor:'queries'!
+
+preferredExtent
+ |prefCheck prefLabel bw2|
+
+^ super preferredExtent + (10@0).
+"/ prefCheck := toggleView preferredExtent.
+"/ prefLabel := labelView preferredExtent.
+"/ bw2 := borderWidth * 2.
+"/ ^ (prefCheck x + prefLabel x + (3 * ViewSpacing)) @ ((prefCheck y max:prefLabel y) + bw2 + 2)
+! !
+
+!CheckBox class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/CheckBox.st,v 1.14 1995-11-23 18:17:40 cg Exp $'
+! !
--- a/HSlider.st Thu Nov 23 19:15:36 1995 +0100
+++ b/HSlider.st Thu Nov 23 19:18:39 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 30-apr-1995 at 1:46:29 am'!
-
Slider subclass:#HorizontalSlider
instanceVariableNames:''
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/Attic/HSlider.st,v 1.7 1995-11-11 16:28:58 cg Exp $'
-!
-
documentation
"
this class implements horizontal sliders.
@@ -62,3 +56,9 @@
h := (device verticalPixelPerMillimeter asFloat * 6) rounded.
^ w @ h.
! !
+
+!HorizontalSlider class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/Attic/HSlider.st,v 1.8 1995-11-23 18:17:51 cg Exp $'
+! !
--- a/HorizontalSlider.st Thu Nov 23 19:15:36 1995 +0100
+++ b/HorizontalSlider.st Thu Nov 23 19:18:39 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 30-apr-1995 at 1:46:29 am'!
-
Slider subclass:#HorizontalSlider
instanceVariableNames:''
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/HorizontalSlider.st,v 1.7 1995-11-11 16:28:58 cg Exp $'
-!
-
documentation
"
this class implements horizontal sliders.
@@ -62,3 +56,9 @@
h := (device verticalPixelPerMillimeter asFloat * 6) rounded.
^ w @ h.
! !
+
+!HorizontalSlider class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/HorizontalSlider.st,v 1.8 1995-11-23 18:17:51 cg Exp $'
+! !
--- a/LEnterFld.st Thu Nov 23 19:15:36 1995 +0100
+++ b/LEnterFld.st Thu Nov 23 19:18:39 1995 +0100
@@ -19,6 +19,20 @@
!LabelledEnterField class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1991 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
"
An EnterField with a name. Its protocol mimics that of an
@@ -72,24 +86,77 @@
top open
"
+! !
+
+!LabelledEnterField methodsFor:'accessing'!
+
+inputField
+ "return the input field component"
+
+ ^ textField
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/Attic/LEnterFld.st,v 1.11 1995-11-11 16:29:07 cg Exp $'
+labelView
+ "return the label component"
+
+ ^ labelField
+! !
+
+!LabelledEnterField methodsFor:'accessing-behavior'!
+
+disable
+ textField disable
+!
+
+enable
+ textField enable
+! !
+
+!LabelledEnterField methodsFor:'accessing-look'!
+
+contents
+ ^ textField contents
+!
+
+contents:aString
+ textField contents:aString
!
-copyright
-"
- COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+editValue
+ ^ textField editValue
+!
+
+editValue:something
+ textField editValue:something
+!
+
+label:aString
+ labelField label:aString
+! !
+
+!LabelledEnterField methodsFor:'accessing-mvc'!
- 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.
-"
+addModelInterfaceTo:aDictionary
+ labelField addModelInterfaceTo:aDictionary.
+ textField addModelInterfaceTo:aDictionary
+!
+
+aspectMessage:aspectSymbol
+ textField aspectMessage:aspectSymbol.
+ labelField aspectMessage:aspectSymbol
+!
+
+changeMessage:aSymbol
+ textField changeMessage:aSymbol
+!
+
+labelMessage:aSymbol
+ labelField labelMessage:aSymbol
+!
+
+model:aModel
+ textField model:aModel.
+ labelField model:aModel
! !
!LabelledEnterField methodsFor:'initialization'!
@@ -133,73 +200,8 @@
^ (lx + ix) @ (ly max:iy)
! !
-!LabelledEnterField methodsFor:'accessing'!
-
-labelView
- "return the label component"
-
- ^ labelField
-!
-
-inputField
- "return the input field component"
-
- ^ textField
-! !
-
-!LabelledEnterField methodsFor:'accessing-behavior'!
-
-disable
- textField disable
-!
-
-enable
- textField enable
-! !
-
-!LabelledEnterField methodsFor:'accessing-mvc'!
-
-model:aModel
- textField model:aModel.
- labelField model:aModel
-!
-
-changeMessage:aSymbol
- textField changeMessage:aSymbol
-!
+!LabelledEnterField class methodsFor:'documentation'!
-aspectMessage:aspectSymbol
- textField aspectMessage:aspectSymbol.
- labelField aspectMessage:aspectSymbol
-!
-
-labelMessage:aSymbol
- labelField labelMessage:aSymbol
-!
-
-addModelInterfaceTo:aDictionary
- labelField addModelInterfaceTo:aDictionary.
- textField addModelInterfaceTo:aDictionary
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/Attic/LEnterFld.st,v 1.12 1995-11-23 18:18:39 cg Exp $'
! !
-
-!LabelledEnterField methodsFor:'accessing-look'!
-
-label:aString
- labelField label:aString
-!
-
-editValue
- ^ textField editValue
-!
-
-editValue:something
- textField editValue:something
-!
-
-contents
- ^ textField contents
-!
-
-contents:aString
- textField contents:aString
-! !
--- a/LabelledEnterField.st Thu Nov 23 19:15:36 1995 +0100
+++ b/LabelledEnterField.st Thu Nov 23 19:18:39 1995 +0100
@@ -19,6 +19,20 @@
!LabelledEnterField class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1991 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
"
An EnterField with a name. Its protocol mimics that of an
@@ -72,24 +86,77 @@
top open
"
+! !
+
+!LabelledEnterField methodsFor:'accessing'!
+
+inputField
+ "return the input field component"
+
+ ^ textField
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/LabelledEnterField.st,v 1.11 1995-11-11 16:29:07 cg Exp $'
+labelView
+ "return the label component"
+
+ ^ labelField
+! !
+
+!LabelledEnterField methodsFor:'accessing-behavior'!
+
+disable
+ textField disable
+!
+
+enable
+ textField enable
+! !
+
+!LabelledEnterField methodsFor:'accessing-look'!
+
+contents
+ ^ textField contents
+!
+
+contents:aString
+ textField contents:aString
!
-copyright
-"
- COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+editValue
+ ^ textField editValue
+!
+
+editValue:something
+ textField editValue:something
+!
+
+label:aString
+ labelField label:aString
+! !
+
+!LabelledEnterField methodsFor:'accessing-mvc'!
- 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.
-"
+addModelInterfaceTo:aDictionary
+ labelField addModelInterfaceTo:aDictionary.
+ textField addModelInterfaceTo:aDictionary
+!
+
+aspectMessage:aspectSymbol
+ textField aspectMessage:aspectSymbol.
+ labelField aspectMessage:aspectSymbol
+!
+
+changeMessage:aSymbol
+ textField changeMessage:aSymbol
+!
+
+labelMessage:aSymbol
+ labelField labelMessage:aSymbol
+!
+
+model:aModel
+ textField model:aModel.
+ labelField model:aModel
! !
!LabelledEnterField methodsFor:'initialization'!
@@ -133,73 +200,8 @@
^ (lx + ix) @ (ly max:iy)
! !
-!LabelledEnterField methodsFor:'accessing'!
-
-labelView
- "return the label component"
-
- ^ labelField
-!
-
-inputField
- "return the input field component"
-
- ^ textField
-! !
-
-!LabelledEnterField methodsFor:'accessing-behavior'!
-
-disable
- textField disable
-!
-
-enable
- textField enable
-! !
-
-!LabelledEnterField methodsFor:'accessing-mvc'!
-
-model:aModel
- textField model:aModel.
- labelField model:aModel
-!
-
-changeMessage:aSymbol
- textField changeMessage:aSymbol
-!
+!LabelledEnterField class methodsFor:'documentation'!
-aspectMessage:aspectSymbol
- textField aspectMessage:aspectSymbol.
- labelField aspectMessage:aspectSymbol
-!
-
-labelMessage:aSymbol
- labelField labelMessage:aSymbol
-!
-
-addModelInterfaceTo:aDictionary
- labelField addModelInterfaceTo:aDictionary.
- textField addModelInterfaceTo:aDictionary
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/LabelledEnterField.st,v 1.12 1995-11-23 18:18:39 cg Exp $'
! !
-
-!LabelledEnterField methodsFor:'accessing-look'!
-
-label:aString
- labelField label:aString
-!
-
-editValue
- ^ textField editValue
-!
-
-editValue:something
- textField editValue:something
-!
-
-contents
- ^ textField contents
-!
-
-contents:aString
- textField contents:aString
-! !
--- a/Separator.st Thu Nov 23 19:15:36 1995 +0100
+++ b/Separator.st Thu Nov 23 19:18:39 1995 +0100
@@ -134,10 +134,6 @@
top open
"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/Separator.st,v 1.7 1995-11-23 00:53:37 cg Exp $'
! !
!Separator methodsFor:'accessing'!
@@ -187,3 +183,8 @@
borderWidth := 0
! !
+!Separator class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/Separator.st,v 1.8 1995-11-23 18:17:21 cg Exp $'
+! !
--- a/Slider.st Thu Nov 23 19:15:36 1995 +0100
+++ b/Slider.st Thu Nov 23 19:18:39 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 30-apr-1995 at 1:46:33 am'!
-
Scroller subclass:#Slider
instanceVariableNames:'sliderHeight'
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg2/Slider.st,v 1.12 1995-11-11 16:29:25 cg Exp $'
-!
-
documentation
"
this class implements sliders - which are simply scrollers
@@ -213,26 +207,45 @@
"
! !
-!Slider methodsFor:'private'!
+!Slider methodsFor:'accessing'!
+
+thumbHeight
+ "redefined since a slider has no height - just origin"
+
+ ^ nil
+! !
-percentFromAbs:absValue
- "given a number of pixels, compute percentage"
+!Slider methodsFor:'forced scroll'!
+
+pageDown
+ "ignored - a slider has no concept of page-wise scrolling"
- |fullSize val|
+ ^ self
+!
+
+pageUp
+ "ignored - a slider has no concept of page-wise scrolling"
- (orientation == #vertical) ifTrue:[
- fullSize := height
- ] ifFalse:[
- fullSize := width
- ].
+ ^ self
+! !
+
+!Slider methodsFor:'initialization'!
+
+initStyle
+ super initStyle.
- val := absValue / (fullSize - sliderHeight - (margin * 2)) * (rangeEnd - rangeStart).
- val := val + rangeStart.
- val < rangeStart ifTrue:[^ rangeStart].
- val > rangeEnd ifTrue:[^ rangeEnd].
- ^ val
+ tallyMarks := StyleSheet at:'sliderNTallyMarks' default:1.
+ tallyLevel := StyleSheet at:'sliderTallyLevel' default:-1.
!
+initialize
+ sliderHeight := (self verticalPixelPerMillimeter:10) rounded.
+ super initialize.
+ thumbHeight := 0.
+! !
+
+!Slider methodsFor:'private'!
+
absFromPercent:percent
"given a percentage, compute number of pixels"
@@ -279,42 +292,28 @@
]
].
thumbFrame := Rectangle left:nx top:ny width:nw height:nh
-! !
-
-!Slider methodsFor:'initialization'!
-
-initStyle
- super initStyle.
-
- tallyMarks := StyleSheet at:'sliderNTallyMarks' default:1.
- tallyLevel := StyleSheet at:'sliderTallyLevel' default:-1.
!
-initialize
- sliderHeight := (self verticalPixelPerMillimeter:10) rounded.
- super initialize.
- thumbHeight := 0.
+percentFromAbs:absValue
+ "given a number of pixels, compute percentage"
+
+ |fullSize val|
+
+ (orientation == #vertical) ifTrue:[
+ fullSize := height
+ ] ifFalse:[
+ fullSize := width
+ ].
+
+ val := absValue / (fullSize - sliderHeight - (margin * 2)) * (rangeEnd - rangeStart).
+ val := val + rangeStart.
+ val < rangeStart ifTrue:[^ rangeStart].
+ val > rangeEnd ifTrue:[^ rangeEnd].
+ ^ val
! !
-!Slider methodsFor:'forced scroll'!
-
-pageUp
- "ignored - a slider has no concept of page-wise scrolling"
-
- ^ self
-!
-
-pageDown
- "ignored - a slider has no concept of page-wise scrolling"
+!Slider class methodsFor:'documentation'!
- ^ self
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/Slider.st,v 1.13 1995-11-23 18:17:56 cg Exp $'
! !
-
-!Slider methodsFor:'accessing'!
-
-thumbHeight
- "redefined since a slider has no height - just origin"
-
- ^ nil
-! !
-