checkin from browser
authorClaus Gittinger <cg@exept.de>
Thu, 23 Nov 1995 19:18:39 +0100
changeset 100 3d33433f459c
parent 99 27c080be3479
child 101 85422b262e51
checkin from browser
CheckBox.st
HSlider.st
HorizontalSlider.st
LEnterFld.st
LabelledEnterField.st
Separator.st
Slider.st
--- 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
-! !
-