--- a/FNmEdtFld.st Mon Oct 10 04:13:51 1994 +0100
+++ b/FNmEdtFld.st Fri Oct 28 04:28:34 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1994 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
@@ -19,9 +19,9 @@
FilenameEditField comment:'
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg2/Attic/FNmEdtFld.st,v 1.4 1994-10-10 03:13:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/Attic/FNmEdtFld.st,v 1.5 1994-10-28 03:28:07 claus Exp $
'!
!FilenameEditField class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1994 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
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg2/Attic/FNmEdtFld.st,v 1.4 1994-10-10 03:13:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/Attic/FNmEdtFld.st,v 1.5 1994-10-28 03:28:07 claus Exp $
"
!
@@ -61,49 +61,49 @@
|s f matchSet name words|
enabled ifTrue:[
- key == #Tab ifTrue:[
- s := self contents.
- "
- find the last word ...
- "
- words := s asCollectionOfWords.
- f := words last asFilename.
- matchSet := f filenameCompletion.
- matchSet size ~~ 1 ifTrue:[
- "
- more than one possible completion -
- "
- self changed:#directory with:f directoryName.
- device beep
- ].
- "
- even with more than one possible completion,
- f's name is now common prefix
- "
- name := f asString.
- matchSet size == 1 ifTrue:[
- "
- exactly one possible completion -
- "
- f isDirectory ifTrue:[
- (name endsWith:(Filename separator)) ifFalse:[
- name := (f construct:'') asString
- ].
- ].
- ].
- "
- construct new contents, by taking
- last words completion
- "
- s := ''.
- 1 to:(words size - 1) do:[:idx |
- s := s , (words at:idx) , ' '
- ].
- s := s , name.
- self contents:s.
- self cursorToEndOfLine.
- ^ self
- ].
+ key == #Tab ifTrue:[
+ s := self contents.
+ "
+ find the last word ...
+ "
+ words := s asCollectionOfWords.
+ f := words last asFilename.
+ matchSet := f filenameCompletion.
+ matchSet size ~~ 1 ifTrue:[
+ "
+ more than one possible completion -
+ "
+ self changed:#directory with:f directory.
+ device beep
+ ].
+ "
+ even with more than one possible completion,
+ f's name is now common prefix
+ "
+ name := f asString.
+ matchSet size == 1 ifTrue:[
+ "
+ exactly one possible completion -
+ "
+ f isDirectory ifTrue:[
+ (name endsWith:(Filename separator)) ifFalse:[
+ name := (f construct:'') asString
+ ].
+ ].
+ ].
+ "
+ construct new contents, by taking
+ last words completion
+ "
+ s := ''.
+ 1 to:(words size - 1) do:[:idx |
+ s := s , (words at:idx) , ' '
+ ].
+ s := s , name.
+ self contents:s.
+ self cursorToEndOfLine.
+ ^ self
+ ].
].
^ super keyPress:key x:x y:y.
! !
--- a/FilenameEditField.st Mon Oct 10 04:13:51 1994 +0100
+++ b/FilenameEditField.st Fri Oct 28 04:28:34 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1994 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
@@ -19,9 +19,9 @@
FilenameEditField comment:'
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg2/FilenameEditField.st,v 1.4 1994-10-10 03:13:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/FilenameEditField.st,v 1.5 1994-10-28 03:28:07 claus Exp $
'!
!FilenameEditField class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1994 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
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg2/FilenameEditField.st,v 1.4 1994-10-10 03:13:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/FilenameEditField.st,v 1.5 1994-10-28 03:28:07 claus Exp $
"
!
@@ -61,49 +61,49 @@
|s f matchSet name words|
enabled ifTrue:[
- key == #Tab ifTrue:[
- s := self contents.
- "
- find the last word ...
- "
- words := s asCollectionOfWords.
- f := words last asFilename.
- matchSet := f filenameCompletion.
- matchSet size ~~ 1 ifTrue:[
- "
- more than one possible completion -
- "
- self changed:#directory with:f directoryName.
- device beep
- ].
- "
- even with more than one possible completion,
- f's name is now common prefix
- "
- name := f asString.
- matchSet size == 1 ifTrue:[
- "
- exactly one possible completion -
- "
- f isDirectory ifTrue:[
- (name endsWith:(Filename separator)) ifFalse:[
- name := (f construct:'') asString
- ].
- ].
- ].
- "
- construct new contents, by taking
- last words completion
- "
- s := ''.
- 1 to:(words size - 1) do:[:idx |
- s := s , (words at:idx) , ' '
- ].
- s := s , name.
- self contents:s.
- self cursorToEndOfLine.
- ^ self
- ].
+ key == #Tab ifTrue:[
+ s := self contents.
+ "
+ find the last word ...
+ "
+ words := s asCollectionOfWords.
+ f := words last asFilename.
+ matchSet := f filenameCompletion.
+ matchSet size ~~ 1 ifTrue:[
+ "
+ more than one possible completion -
+ "
+ self changed:#directory with:f directory.
+ device beep
+ ].
+ "
+ even with more than one possible completion,
+ f's name is now common prefix
+ "
+ name := f asString.
+ matchSet size == 1 ifTrue:[
+ "
+ exactly one possible completion -
+ "
+ f isDirectory ifTrue:[
+ (name endsWith:(Filename separator)) ifFalse:[
+ name := (f construct:'') asString
+ ].
+ ].
+ ].
+ "
+ construct new contents, by taking
+ last words completion
+ "
+ s := ''.
+ 1 to:(words size - 1) do:[:idx |
+ s := s , (words at:idx) , ' '
+ ].
+ s := s , name.
+ self contents:s.
+ self cursorToEndOfLine.
+ ^ self
+ ].
].
^ super keyPress:key x:x y:y.
! !
--- a/MCLEntry.st Mon Oct 10 04:13:51 1994 +0100
+++ b/MCLEntry.st Fri Oct 28 04:28:34 1994 +0100
@@ -1,43 +1,55 @@
'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:03 pm'!
Object subclass:#MultiColListEntry
- instanceVariableNames:'strings tabSpec'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Support'
+ instanceVariableNames:'strings tabSpec'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
!
+!MultiColListEntry class methodsFor:'documentation'!
+
+documentation
+"
+ Instances of MultiColListEntry can be used in place of strings
+ of a list in a ListView or SelectionInListView.
+ They allow data to be presented in table form.
+ See example in TabulatorSpecs documentation.
+ Notice, that each entry can have its own (or a shared) tabulator specification.
+"
+! !
+
!MultiColListEntry methodsFor:'accessing'!
colAt:index put:aString
strings isNil ifTrue:[
- strings := OrderedCollection new:index
+ strings := OrderedCollection new:index
].
strings grow:index.
strings at:index put:aString
-
-
-
!
tabulatorSpecification:aTabSpec
tabSpec := aTabSpec
-
-
! !
!MultiColListEntry methodsFor:'converting'!
asString
- |s tab|
+ "return the receiver as a string with embedded tabs"
+
+ |s sub tab|
s := ''.
tab := Character tab asString.
1 to:strings size do:[:subStringIndex |
- s := s , (strings at:subStringIndex).
- subStringIndex == strings size ifFalse:[
- s := s , tab
- ]
+ sub := strings at:subStringIndex.
+ sub notNil ifTrue:[
+ s := s , (strings at:subStringIndex).
+ ].
+ subStringIndex == strings size ifFalse:[
+ s := s , tab
+ ]
].
^ s
@@ -50,23 +62,23 @@
xPos := x.
prevString := ''.
- 1 to:strings size do:[:index |
- subString := strings at:index.
-
- "
- find next tab
- "
- tabPos := tabSpec positionOfTab:index forString:subString on:aGC.
- tabPos isNil ifTrue:[
- "
- no tab - just continue where we are ...
- "
- xPos := xPos + (aGC font widthOf:prevString).
- ] ifFalse:[
- xPos := tabPos + x.
- ].
- aGC displayString:subString x:xPos y:y.
- prevString := subString.
+ strings keysAndValuesDo:[:index :subString |
+ subString notNil ifTrue:[
+ "
+ find next tab
+ "
+ tabPos := tabSpec positionOfTab:index forString:subString on:aGC.
+ tabPos isNil ifTrue:[
+ "
+ no tab - just continue where we are ...
+ "
+ xPos := xPos + (aGC font widthOf:prevString).
+ ] ifFalse:[
+ xPos := tabPos + x.
+ ].
+ aGC displayString:subString x:xPos y:y.
+ prevString := subString.
+ ]
].
"
@@ -115,12 +127,12 @@
tabs align:#(#right #center #left).
1 to:100 do:[:i|
- e := MultiColListEntry new.
- e colAt:1 put:i printString.
- e colAt:2 put:i squared printString.
- e colAt:3 put:i sqrt printString.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:i printString.
+ e colAt:2 put:i squared printString.
+ e colAt:3 put:i sqrt printString.
+ e tabulatorSpecification:tabs.
+ myList add:e.
].
v := ScrollableView for:ListView.
v setList:myList expandTabs:false.
@@ -137,14 +149,14 @@
tabs align:#(#right #decimal #decimal #decimal #decimal).
1 to:100 do:[:i|
- e := MultiColListEntry new.
- e colAt:1 put:i printString.
- e colAt:2 put:i log printString.
- e colAt:3 put:i sqrt printString.
- e colAt:4 put:i sin printString.
- e colAt:5 put:i cos printString.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:i printString.
+ e colAt:2 put:i log printString.
+ e colAt:3 put:i sqrt printString.
+ e colAt:4 put:i sin printString.
+ e colAt:5 put:i cos printString.
+ e tabulatorSpecification:tabs.
+ myList add:e.
].
v := ScrollableView for:ListView.
v setList:myList expandTabs:false.
@@ -170,15 +182,5 @@
v setList:myList expandTabs:false.
v open
"
-
-
-
-
-
-
-
-
-
-
! !
--- a/Make.proto Mon Oct 10 04:13:51 1994 +0100
+++ b/Make.proto Fri Oct 28 04:28:34 1994 +0100
@@ -45,7 +45,11 @@
libwidg2/*.st \
libwidg2/Make.proto \
libwidg2/bitmaps)
- compress $(TOP)/DISTRIB/libwidg2.tar
+ gzip $(TOP)/DISTRIB/libwidg2.tar
+
+uutar:
+ $(MAKE) tar
+ (cd $(TOP)/DISTRIB; uuencode libwidg2.tar.gz libwidg2.tar.gz > libwidg2.tar.gz.uue)
#
# next thing I'll build into stc is a makedepend feature for this ...
--- a/MultiColListEntry.st Mon Oct 10 04:13:51 1994 +0100
+++ b/MultiColListEntry.st Fri Oct 28 04:28:34 1994 +0100
@@ -1,43 +1,55 @@
'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:03 pm'!
Object subclass:#MultiColListEntry
- instanceVariableNames:'strings tabSpec'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Support'
+ instanceVariableNames:'strings tabSpec'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
!
+!MultiColListEntry class methodsFor:'documentation'!
+
+documentation
+"
+ Instances of MultiColListEntry can be used in place of strings
+ of a list in a ListView or SelectionInListView.
+ They allow data to be presented in table form.
+ See example in TabulatorSpecs documentation.
+ Notice, that each entry can have its own (or a shared) tabulator specification.
+"
+! !
+
!MultiColListEntry methodsFor:'accessing'!
colAt:index put:aString
strings isNil ifTrue:[
- strings := OrderedCollection new:index
+ strings := OrderedCollection new:index
].
strings grow:index.
strings at:index put:aString
-
-
-
!
tabulatorSpecification:aTabSpec
tabSpec := aTabSpec
-
-
! !
!MultiColListEntry methodsFor:'converting'!
asString
- |s tab|
+ "return the receiver as a string with embedded tabs"
+
+ |s sub tab|
s := ''.
tab := Character tab asString.
1 to:strings size do:[:subStringIndex |
- s := s , (strings at:subStringIndex).
- subStringIndex == strings size ifFalse:[
- s := s , tab
- ]
+ sub := strings at:subStringIndex.
+ sub notNil ifTrue:[
+ s := s , (strings at:subStringIndex).
+ ].
+ subStringIndex == strings size ifFalse:[
+ s := s , tab
+ ]
].
^ s
@@ -50,23 +62,23 @@
xPos := x.
prevString := ''.
- 1 to:strings size do:[:index |
- subString := strings at:index.
-
- "
- find next tab
- "
- tabPos := tabSpec positionOfTab:index forString:subString on:aGC.
- tabPos isNil ifTrue:[
- "
- no tab - just continue where we are ...
- "
- xPos := xPos + (aGC font widthOf:prevString).
- ] ifFalse:[
- xPos := tabPos + x.
- ].
- aGC displayString:subString x:xPos y:y.
- prevString := subString.
+ strings keysAndValuesDo:[:index :subString |
+ subString notNil ifTrue:[
+ "
+ find next tab
+ "
+ tabPos := tabSpec positionOfTab:index forString:subString on:aGC.
+ tabPos isNil ifTrue:[
+ "
+ no tab - just continue where we are ...
+ "
+ xPos := xPos + (aGC font widthOf:prevString).
+ ] ifFalse:[
+ xPos := tabPos + x.
+ ].
+ aGC displayString:subString x:xPos y:y.
+ prevString := subString.
+ ]
].
"
@@ -115,12 +127,12 @@
tabs align:#(#right #center #left).
1 to:100 do:[:i|
- e := MultiColListEntry new.
- e colAt:1 put:i printString.
- e colAt:2 put:i squared printString.
- e colAt:3 put:i sqrt printString.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:i printString.
+ e colAt:2 put:i squared printString.
+ e colAt:3 put:i sqrt printString.
+ e tabulatorSpecification:tabs.
+ myList add:e.
].
v := ScrollableView for:ListView.
v setList:myList expandTabs:false.
@@ -137,14 +149,14 @@
tabs align:#(#right #decimal #decimal #decimal #decimal).
1 to:100 do:[:i|
- e := MultiColListEntry new.
- e colAt:1 put:i printString.
- e colAt:2 put:i log printString.
- e colAt:3 put:i sqrt printString.
- e colAt:4 put:i sin printString.
- e colAt:5 put:i cos printString.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:i printString.
+ e colAt:2 put:i log printString.
+ e colAt:3 put:i sqrt printString.
+ e colAt:4 put:i sin printString.
+ e colAt:5 put:i cos printString.
+ e tabulatorSpecification:tabs.
+ myList add:e.
].
v := ScrollableView for:ListView.
v setList:myList expandTabs:false.
@@ -170,15 +182,5 @@
v setList:myList expandTabs:false.
v open
"
-
-
-
-
-
-
-
-
-
-
! !
--- a/TabSpec.st Mon Oct 10 04:13:51 1994 +0100
+++ b/TabSpec.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
! !
--- 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
! !