TabulatorSpecification.st
changeset 25 e07adf47d209
parent 19 79ab6bc98651
child 28 ca403f4c5b86
--- a/TabulatorSpecification.st	Mon Oct 10 04:13:51 1994 +0100
+++ b/TabulatorSpecification.st	Fri Oct 28 04:28:34 1994 +0100
@@ -1,12 +1,72 @@
 'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:09 pm'!
 
 Object subclass:#TabulatorSpecification
-	 instanceVariableNames:'tabUnit tabPositions tabTypes'
+	 instanceVariableNames:'tabUnit unitReference tabPositions tabTypes'
 	 classVariableNames:''
 	 poolDictionaries:''
 	 category:'Views-Support'
 !
 
+!TabulatorSpecification class methodsFor:'documentation'!
+
+documentation
+"
+    This is a helper class for table widgets and tabular data in
+    lists.
+    A tabulatorSpecification keeps track of where the tabs are,
+    and how they align. They are to be used un conjunction with
+    MultiColumnListEntry or the upcoming tableWidget.
+
+    Example use (in a ListView):
+
+	|listView tabSpec entry|
+
+	listView := ListView new.
+
+	tabSpec := TabulatorSpecification new.
+	tabSpec unit:#inch.
+	tabSpec positions:#(0     1     2.5    3.5    4       5        ).
+	tabSpec align:    #(#left #left #right #right #center #decimal ).
+
+	entry := MultiColListEntry new.
+	entry tabulatorSpecification:tabSpec.
+	entry colAt:1 put:'left';
+	      colAt:2 put:'left';
+	      colAt:3 put:'right';
+	      colAt:4 put:'right';
+	      colAt:5 put:'center';
+	      colAt:6 put:'.decimal'.
+
+	listView at:1 put:entry.
+
+	entry := MultiColListEntry new.
+	entry tabulatorSpecification:tabSpec.
+	entry colAt:1 put:'col1';
+	      colAt:2 put:'col2';
+	      colAt:3 put:'col3';
+	      colAt:4 put:'col4';
+	      colAt:5 put:'col5';
+	      colAt:6 put:'col6.decimal'.
+
+	listView at:2 put:entry.
+
+	entry := MultiColListEntry new.
+	entry tabulatorSpecification:tabSpec.
+	entry colAt:1 put:'foo';
+	      colAt:2 put:'fooBar';
+	      colAt:3 put:'bar';
+	      colAt:4 put:'barFoo';
+	      colAt:5 put:'baz';
+	      colAt:6 put:'1234.56'.
+
+	listView at:3 put:entry.
+	listView open
+
+		tabSpec widths:     #(2     0.3   2     1      0.7    0.5      1).
+		"                   name  type  mode  owner  group  size     type"
+"
+! !
+
 !TabulatorSpecification methodsFor:'queries'!
 
 pixelsPerUnitOn:aGC
@@ -15,19 +75,22 @@
      takes on aGC
     "
     tabUnit isNil ifTrue:[
-        tabUnit := #col
+	tabUnit := #col
+    ].
+    tabUnit == #relative ifTrue:[
+	^ unitReference width
     ].
     tabUnit == #col ifTrue:[
-        ^ aGC font width
+	^ aGC font width
     ].
     tabUnit == #inch ifTrue:[
-        ^ aGC device horizontalPixelPerInch
+	^ aGC device horizontalPixelPerInch
     ].
     tabUnit == #mm ifTrue:[
-        ^ aGC device horizontalPixelPerMillimeter
+	^ aGC device horizontalPixelPerMillimeter
     ].
     tabUnit == #cm ifTrue:[
-        ^ aGC device horizontalPixelPerMillimeter * 10
+	^ aGC device horizontalPixelPerMillimeter * 10
     ].
     "
      assume pixels
@@ -36,6 +99,8 @@
 !
 
 positionOfTab:index on:aGC
+    "return the position (in device units) of the tab at index"
+
     |unit pos|
 
     tabPositions isNil ifTrue:[^ nil].
@@ -46,34 +111,37 @@
 !
 
 positionOfTab:index forString:aString on:aGC
+    "return the position (in device units) of the string to be drawn
+     at position index."
+
     |pos type idx left|
 
     pos := self positionOfTab:index on:aGC.
     pos isNil ifTrue:[^ nil].
 
     tabTypes notNil ifTrue:[
-        (tabTypes isMemberOf:Symbol) ifTrue:[
-            type := tabTypes
-        ] ifFalse:[
-            type := tabTypes at:(index).
-        ].
+	(tabTypes isMemberOf:Symbol) ifTrue:[
+	    type := tabTypes
+	] ifFalse:[
+	    type := tabTypes at:(index).
+	].
     ] ifFalse:[
-        type := #left
+	type := #left
     ].
 
     type == #right ifTrue:[
-        ^ pos - (aGC font widthOf:aString).
+	^ pos - (aGC font widthOf:aString).
     ].
     type == #center ifTrue:[
-        ^ pos - ((aGC font widthOf:aString) // 2).
+	^ pos - ((aGC font widthOf:aString) // 2).
     ].
     type == #decimal ifTrue:[
-        idx := aString indexOf:$..
-        idx == 0 ifTrue:[
-             ^ pos - (aGC font widthOf:aString).
-        ].
-        left := aString copyTo:(idx-1).
-        ^ pos - (aGC font widthOf:left).
+	idx := aString indexOf:$..
+	idx == 0 ifTrue:[
+	     ^ pos - (aGC font widthOf:aString).
+	].
+	left := aString copyTo:(idx-1).
+	^ pos - (aGC font widthOf:left).
     ].
     "default is left"
     ^ pos
@@ -83,22 +151,33 @@
 !TabulatorSpecification methodsFor:'accessing'!
 
 unit:aSymbol
-    "allowed are: #inch, #mm, #cm, #pixel and #col"
+    "set the unit.
+     allowed are: #inch, #mm, #cm, #pixel and #col"
 
     tabUnit := aSymbol
 !
 
+unitRelativeTo:someObject
+    "set for a relative unit. someObject should return its width
+     and the tabs are set fraction-relative to this number (in pixel)."
+
+    tabUnit := #relative.
+    unitReference := someObject
+!
+
 unit
+    "return the unit"
+
     ^ tabUnit
 !
 
 align:types
     "
      an array of tab-types; each one is
-        #left
-        #right
-        #center
-        #decimal
+	#left
+	#right
+	#center
+	#decimal
      or a symbol which gives align of all tabs
 
     "
@@ -106,14 +185,34 @@
 !
 
 align
+    "return the align-vector"
+
     ^ tabTypes
 !
 
+widths:fieldWidths
+    "set the position-vector from a vector of field widths"
+
+    |pos|
+
+    pos := 0.
+    tabPositions := fieldWidths collect:[:w | 
+					    |p|
+
+					    p := pos.
+					    pos := pos + w.
+					    p].
+!
+
 positions:tabs
+    "set the position-vector"
+
     tabPositions := tabs
 !
 
 positions
+    "return the position-vector"
+
     ^ tabPositions
 ! !