.
--- a/CheckBox.st Fri May 12 20:40:42 1995 +0200
+++ b/CheckBox.st Wed May 17 14:49:25 1995 +0200
@@ -24,7 +24,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg2/CheckBox.st,v 1.4 1995-05-12 18:34:07 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/CheckBox.st,v 1.5 1995-05-17 12:48:38 claus Exp $
"
!
@@ -330,7 +330,7 @@
toggleView := CheckToggle in:self.
labelView := Label in:self.
- labelView label:'check'.
+ labelView label:'check'; borderWidth:0.
labelView forceResize.
labelView adjust:#left.
self height:labelView preferedExtent y + ViewSpacing.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClrListEntry.st Wed May 17 14:49:25 1995 +0200
@@ -0,0 +1,149 @@
+"
+ 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.
+"
+
+'From Smalltalk/X, Version:2.10.5 on 15-may-1995 at 8:03:34 am'!
+
+ListEntry subclass:#ColoredListEntry
+ instanceVariableNames:'color string'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
+!
+
+!ColoredListEntry 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/libwidg2/Attic/ClrListEntry.st,v 1.1 1995-05-17 12:48:41 claus Exp $
+"
+!
+
+documentation
+"
+ Instances of ColoredListEntry can be used in place of strings
+ as entries of the list in a ListView or SelectionInListView.
+"
+!
+
+examples
+"
+ putting colored entries into a SelectionInListView
+ (instead of strings)'
+
+ |v e myList tabs|
+
+ myList := OrderedCollection new.
+
+ myList add:(ColoredListEntry string:'red' color:Color red).
+ myList add:(ColoredListEntry string:'green' color:Color green).
+ myList add:(ColoredListEntry string:'blue' color:Color blue).
+ myList add:(ColoredListEntry string:'white' color:Color white).
+ myList add:(ColoredListEntry string:'black' color:Color black).
+ myList add:(ColoredListEntry string:'yellow' color:Color yellow).
+
+ v := SelectionInListView new.
+ v setList:myList expandTabs:false.
+ v open
+
+ in a selectionInList
+
+ |v e myList selList tabs|
+
+ myList := OrderedCollection new.
+
+ myList add:(ColoredListEntry string:'red' color:Color red).
+ myList add:(ColoredListEntry string:'green' color:Color green).
+ myList add:(ColoredListEntry string:'blue' color:Color blue).
+ myList add:(ColoredListEntry string:'white' color:Color white).
+ myList add:(ColoredListEntry string:'black' color:Color black).
+ myList add:(ColoredListEntry string:'yellow' color:Color yellow).
+
+ selList := SelectionInList new list:myList.
+
+ v := SelectionInListView on:selList.
+ v printItems:false.
+ v open
+
+
+ in a popUpList
+
+ |v e myList selList tabs|
+
+ myList := OrderedCollection new.
+
+ myList add:(ColoredListEntry string:'red' color:Color red).
+ myList add:(ColoredListEntry string:'green' color:Color green).
+ myList add:(ColoredListEntry string:'blue' color:Color blue).
+ myList add:(ColoredListEntry string:'white' color:Color white).
+ myList add:(ColoredListEntry string:'black' color:Color black).
+ myList add:(ColoredListEntry string:'yellow' color:Color yellow).
+
+ selList := SelectionInList new list:myList.
+
+ v := PopUpList on:selList.
+ v open
+"
+! !
+
+!ColoredListEntry class methodsFor:'instance creation'!
+
+string:aString color:aColor
+ ^ self new string:aString color:aColor
+! !
+
+!ColoredListEntry methodsFor:'drawing'!
+
+displayOn:aGC x:x y:y
+ "display the receiver on a GC"
+
+ aGC paint:color.
+ aGC displayString:string x:x y:y.
+! !
+
+!ColoredListEntry methodsFor:'accessing'!
+
+string:aString color:aColor
+ string := aString.
+ color := aColor
+! !
+
+!ColoredListEntry methodsFor:'converting'!
+
+string
+ ^ string
+!
+
+asString
+ ^ string
+! !
+
+!ColoredListEntry methodsFor:'queries'!
+
+widthIn:aGC
+ "return the width of the receiver when displayed in aGC"
+
+ ^ aGC font widthOf:string
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ColoredListEntry.st Wed May 17 14:49:25 1995 +0200
@@ -0,0 +1,149 @@
+"
+ 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.
+"
+
+'From Smalltalk/X, Version:2.10.5 on 15-may-1995 at 8:03:34 am'!
+
+ListEntry subclass:#ColoredListEntry
+ instanceVariableNames:'color string'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
+!
+
+!ColoredListEntry 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/libwidg2/ColoredListEntry.st,v 1.1 1995-05-17 12:48:41 claus Exp $
+"
+!
+
+documentation
+"
+ Instances of ColoredListEntry can be used in place of strings
+ as entries of the list in a ListView or SelectionInListView.
+"
+!
+
+examples
+"
+ putting colored entries into a SelectionInListView
+ (instead of strings)'
+
+ |v e myList tabs|
+
+ myList := OrderedCollection new.
+
+ myList add:(ColoredListEntry string:'red' color:Color red).
+ myList add:(ColoredListEntry string:'green' color:Color green).
+ myList add:(ColoredListEntry string:'blue' color:Color blue).
+ myList add:(ColoredListEntry string:'white' color:Color white).
+ myList add:(ColoredListEntry string:'black' color:Color black).
+ myList add:(ColoredListEntry string:'yellow' color:Color yellow).
+
+ v := SelectionInListView new.
+ v setList:myList expandTabs:false.
+ v open
+
+ in a selectionInList
+
+ |v e myList selList tabs|
+
+ myList := OrderedCollection new.
+
+ myList add:(ColoredListEntry string:'red' color:Color red).
+ myList add:(ColoredListEntry string:'green' color:Color green).
+ myList add:(ColoredListEntry string:'blue' color:Color blue).
+ myList add:(ColoredListEntry string:'white' color:Color white).
+ myList add:(ColoredListEntry string:'black' color:Color black).
+ myList add:(ColoredListEntry string:'yellow' color:Color yellow).
+
+ selList := SelectionInList new list:myList.
+
+ v := SelectionInListView on:selList.
+ v printItems:false.
+ v open
+
+
+ in a popUpList
+
+ |v e myList selList tabs|
+
+ myList := OrderedCollection new.
+
+ myList add:(ColoredListEntry string:'red' color:Color red).
+ myList add:(ColoredListEntry string:'green' color:Color green).
+ myList add:(ColoredListEntry string:'blue' color:Color blue).
+ myList add:(ColoredListEntry string:'white' color:Color white).
+ myList add:(ColoredListEntry string:'black' color:Color black).
+ myList add:(ColoredListEntry string:'yellow' color:Color yellow).
+
+ selList := SelectionInList new list:myList.
+
+ v := PopUpList on:selList.
+ v open
+"
+! !
+
+!ColoredListEntry class methodsFor:'instance creation'!
+
+string:aString color:aColor
+ ^ self new string:aString color:aColor
+! !
+
+!ColoredListEntry methodsFor:'drawing'!
+
+displayOn:aGC x:x y:y
+ "display the receiver on a GC"
+
+ aGC paint:color.
+ aGC displayString:string x:x y:y.
+! !
+
+!ColoredListEntry methodsFor:'accessing'!
+
+string:aString color:aColor
+ string := aString.
+ color := aColor
+! !
+
+!ColoredListEntry methodsFor:'converting'!
+
+string
+ ^ string
+!
+
+asString
+ ^ string
+! !
+
+!ColoredListEntry methodsFor:'queries'!
+
+widthIn:aGC
+ "return the width of the receiver when displayed in aGC"
+
+ ^ aGC font widthOf:string
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ListEntry.st Wed May 17 14:49:25 1995 +0200
@@ -0,0 +1,84 @@
+"
+ 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.
+"
+
+'From Smalltalk/X, Version:2.10.5 on 15-may-1995 at 9:37:01 am'!
+
+Object subclass:#ListEntry
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
+!
+
+!ListEntry 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/libwidg2/ListEntry.st,v 1.1 1995-05-17 12:49:00 claus Exp $
+"
+!
+
+documentation
+"
+ ListEntry is an abstract superclass for objects which can be used
+ in place of strings in ListViews or SelectionInListViews.
+
+ If you want to create new subclasses, implement (at least) the methods
+ found in the 'required protocol' category.
+"
+! !
+
+!ListEntry methodsFor:'queries'!
+
+includes:aCharacter
+ ^ self string includes:aCharacter
+!
+
+string
+ ^ self asString
+! !
+
+!ListEntry methodsFor:'required protocol'!
+
+displayOn:aGC x:x y:y
+ "display the receiver on a GC"
+
+ ^ self subclassResponsibility
+!
+
+asString
+ "return the receiver as a string (for example, to store it in a file)"
+
+ ^ self subclassResponsibility
+!
+
+widthIn:aGC
+ "return the width (in device units) of the receiver when displayed in aGC"
+
+ ^ self subclassResponsibility
+
+! !
+
--- a/MCLEntry.st Fri May 12 20:40:42 1995 +0200
+++ b/MCLEntry.st Wed May 17 14:49:25 1995 +0200
@@ -10,7 +10,9 @@
hereby transferred.
"
-Object subclass:#MultiColListEntry
+'From Smalltalk/X, Version:2.10.5 on 15-may-1995 at 9:15:44 am'!
+
+ListEntry subclass:#MultiColListEntry
instanceVariableNames:'strings tabSpec'
classVariableNames:''
poolDictionaries:''
@@ -35,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg2/Attic/MCLEntry.st,v 1.4 1995-02-17 13:23:47 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/Attic/MCLEntry.st,v 1.5 1995-05-17 12:49:05 claus Exp $
"
!
@@ -58,198 +60,225 @@
examples
"
- 'putting multiColListEntries into a ListView
- (instead of strings)'
+ putting multiColListEntries into a ListView
+ (instead of strings)'
+
+ |v e myList tabs|
- |v e myList tabs|
+ myList := OrderedCollection new.
- myList := OrderedCollection new.
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 3 4).
+ tabs align:#(left #center #left).
- tabs := TabulatorSpecification new.
- tabs unit:#inch.
- tabs positions:#(0 3 6).
- tabs align:#(left #left #left).
+ e := MultiColListEntry
+ fromString:'left centered left'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+
+ e := MultiColListEntry
+ fromString:'| | |'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+ myList add:''.
- e := MultiColListEntry new.
- e colAt:1 put:'hello'.
- e colAt:2 put:'hallo'.
- e colAt:3 put:'salut'.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry
+ fromString:'hello hallo salut'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+
+ e := MultiColListEntry
+ fromString:'good morning,guten Morgen,bon jour'
+ separatedBy:$,.
+ e tabulatorSpecification:tabs.
+ myList add:e.
- e := MultiColListEntry new.
- e colAt:1 put:'good morning'.
- e colAt:2 put:'guten Morgen'.
- e colAt:3 put:'bon jour'.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:'good bye'.
+ e colAt:2 put:'auf Wiedersehen'.
+ e colAt:3 put:'au revoir '.
+ e tabulatorSpecification:tabs.
+ myList add:e.
- e := MultiColListEntry new.
- e colAt:1 put:'good bye'.
- e colAt:2 put:'auf Wiedersehen'.
- e colAt:3 put:'au revoir '.
- e tabulatorSpecification:tabs.
- myList add:e.
-
- v := ListView new.
- v setList:myList expandTabs:false.
- v open
+ v := ListView new.
+ v setList:myList expandTabs:false.
+ v extent:500@100.
+ v open
- 'many multiColListEntries in a scrollable ListView'
+ many multiColListEntries in a scrollable ListView
- |v e myList tabs|
+ |v l e myList tabs|
- myList := OrderedCollection new.
+ myList := OrderedCollection new.
- tabs := TabulatorSpecification new.
- tabs unit:#cm.
- tabs positions:#(1 3 5).
- tabs align:#(#right #center #left).
+ tabs := TabulatorSpecification new.
+ tabs unit:#cm.
+ tabs positions:#(1 3 5).
+ 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.
- ].
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ 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.
+ ].
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := ScrollableView forView:l.
+ v extent:300@200.
+ v open
- 'like above, but adds nice alignments'
+ like above, but uses nicer decimal alignments
- |v e myList tabs|
+ |v l e myList tabs|
- myList := OrderedCollection new.
-
- tabs := TabulatorSpecification new.
- tabs unit:#cm.
- tabs positions:#(1 3 6 9 12).
- tabs align:#(#right #decimal #decimal #decimal #decimal).
+ myList := OrderedCollection new.
+
+ tabs := TabulatorSpecification new.
+ tabs unit:#cm.
+ tabs positions:#(1 3 6 9 12).
+ 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.
- ].
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ 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.
+ ].
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := ScrollableView forView:l.
+ v extent:600@200.
+ v open
- 'specifying tabs in inches'
+ specifying tabs in inches
- |v e myList tabs|
+ |v l e myList tabs|
- myList := OrderedCollection new.
+ myList := OrderedCollection new.
- tabs := TabulatorSpecification new.
- tabs unit:#inch.
- tabs positions:#(0 2 3.5 4 6 8 10 12).
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 2 3.5 4 6 8 10 12).
- e := MultiColListEntry new.
- e colAt:1 put:'2'.
- e colAt:2 put:'3.5'.
- e colAt:3 put:'4'.
- e colAt:4 put:'6'.
- e colAt:5 put:'8'.
- e colAt:6 put:'10'.
- e colAt:7 put:'12'.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:'2'.
+ e colAt:2 put:'3.5'.
+ e colAt:3 put:'4'.
+ e colAt:4 put:'6'.
+ e colAt:5 put:'8'.
+ e colAt:6 put:'10'.
+ e colAt:7 put:'12'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ myList add:((MultiColListEntry fromString:'| | | | | | |')
+ tabulatorSpecification:tabs).
+ myList add:((MultiColListEntry fromString:'xxx xxx xxx xxx xxx xxx xxx')
+ tabulatorSpecification:tabs).
+
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := HVScrollableView forView:l.
+ v extent:600@200.
+ v open
- 'if you have the columns available as a collection,
- setup can be done easier'
+ if you have the columns available as a collection,
+ setup can be done easier
+
+ |v l e myList tabs|
+
+ myList := OrderedCollection new.
+
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 2 3.5 4 6 8 10 12).
+
+ e := MultiColListEntry new.
+ e strings:#('2' '3.5' '4' '6' '8' '10' '12').
+ e tabulatorSpecification:tabs.
+ myList add:e.
- |v e myList tabs|
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := HVScrollableView forView:l.
+ v extent:600@200.
+ v open
+
- myList := OrderedCollection new.
+ concrete example, show /etc/passwd in a table:
+
+ |v l s myList line e htabs tabs fingerEntry|
+
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 2 3.5 4.5 5 8 11).
+ tabs align: #(left left right right left left left).
- tabs := TabulatorSpecification new.
- tabs unit:#inch.
- tabs positions:#(0 2 3.5 4 6 8 10 12).
+ htabs := TabulatorSpecification new.
+ htabs unit:#inch.
+ htabs positions:#(0 2 3.5 4.5 5 8 11).
+ htabs align: #(left center center center left left left).
+
+ myList := OrderedCollection new.
+
+ e := MultiColListEntry
+ fromString:'login-name:password:uid:gid:finger-entry:home-dir:shell'
+ separatedBy:$:.
+ e tabulatorSpecification:htabs.
+ myList add:e.
+ myList add:''.
- e := MultiColListEntry new.
- e strings:#('2' '3.5' '4' '6' '8' '10' '12').
- e tabulatorSpecification:tabs.
- myList add:e.
-
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ s := '/etc/passwd' asFilename readStream.
+ [s atEnd] whileFalse:[
+ line := s nextLine.
+ e := MultiColListEntry
+ fromString:line
+ separatedBy:$:.
+ fingerEntry := e colAt:5.
+ e colAt:5 put:(fingerEntry asCollectionOfSubstringsSeparatedBy:$,) first.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+ ].
+ s close.
+
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := HVScrollableView forView:l.
+ v extent:600@200.
+ v open
"
! !
-!MultiColListEntry methodsFor:'accessing'!
-
-strings:aCollectionOfStrings
- "replace all substrings"
-
- strings := OrderedCollection withAll:aCollectionOfStrings.
-!
-
-colAt:index
- "return the substring at column index"
+!MultiColListEntry class methodsFor:'instance creation'!
- index > strings size ifTrue:[^ nil].
- ^ strings at:index
-!
-
-colAt:index put:aString
- "replace the substring at column index"
-
- strings isNil ifTrue:[
- strings := OrderedCollection new:index
- ].
- strings grow:index.
- strings at:index put:aString
+fromString:aString
+ ^ self fromString:aString separatedBy:Character space
!
-tabulatorSpecification:aTabSpec
- "set the tabulator spec"
-
- tabSpec := aTabSpec
-! !
-
-!MultiColListEntry methodsFor:'converting'!
-
-asString
- "return the receiver as a string with embedded tabs"
-
- |s sub tab
- nSub "{ Class: SmallInteger }"|
+fromString:aString separatedBy:separatorCharacter
+ |subStrings e|
- s := ''.
- tab := Character tab asString.
- nSub := strings size.
- 1 to:nSub do:[:subStringIndex |
- sub := strings at:subStringIndex.
- sub notNil ifTrue:[
- s := s , sub.
- ].
- subStringIndex == strings size ifFalse:[
- s := s , tab
- ]
+ e := self new.
+ subStrings := aString asCollectionOfSubstringsSeparatedBy:separatorCharacter.
+ subStrings keysAndValuesDo:[:i :sub |
+ e colAt:i put:sub.
].
-
- ^ s
+ ^ e
! !
!MultiColListEntry methodsFor:'drawing'!
@@ -279,6 +308,94 @@
prevString := subString.
]
].
+! !
+!MultiColListEntry methodsFor:'accessing'!
+
+colAt:index put:aString
+ "replace the substring at column index"
+
+ strings isNil ifTrue:[
+ strings := OrderedCollection new:index
+ ].
+ index > strings size ifTrue:[strings grow:index].
+ strings at:index put:aString
+!
+
+tabulatorSpecification:aTabSpec
+ "set the tabulator spec"
+
+ tabSpec := aTabSpec
+!
+
+strings:aCollectionOfStrings
+ "replace all substrings"
+
+ strings := OrderedCollection withAll:aCollectionOfStrings.
+!
+
+colAt:index
+ "return the substring at column index"
+
+ index > strings size ifTrue:[^ nil].
+ ^ strings at:index
! !
+!MultiColListEntry methodsFor:'queries'!
+
+widthIn:aGC
+ "return the width of the receiver when displayed in aGC"
+
+ |xPos xMax subString tabPos w prevLen|
+
+ "just to make certain:
+ do not assume, that the last col is the rightmost one ...
+ "
+ xPos := 0.
+ xMax := 0.
+ prevLen := 0.
+ 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 + prevLen.
+ ] ifFalse:[
+ xPos := tabPos.
+ ].
+ w := prevLen := aGC font widthOf:subString.
+ xMax := xMax max:(xPos + w).
+ ]
+ ].
+ ^ xMax
+! !
+
+!MultiColListEntry methodsFor:'converting'!
+
+asString
+ "return the receiver as a string with embedded tabs"
+
+ |s sub tab
+ nSub "{ Class: SmallInteger }"|
+
+ s := ''.
+ tab := Character tab asString.
+ nSub := strings size.
+ 1 to:nSub do:[:subStringIndex |
+ sub := strings at:subStringIndex.
+ sub notNil ifTrue:[
+ s := s , sub.
+ ].
+ subStringIndex == strings size ifFalse:[
+ s := s , tab
+ ]
+ ].
+
+ ^ s
+! !
+
--- a/Make.proto Fri May 12 20:40:42 1995 +0200
+++ b/Make.proto Wed May 17 14:49:25 1995 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libwidg2/Make.proto,v 1.19 1995-05-12 18:40:42 claus Exp $
+# $Header: /cvs/stx/stx/libwidg2/Make.proto,v 1.20 1995-05-17 12:49:25 claus Exp $
#
# -------------- no need to change anything below ----------
@@ -12,7 +12,7 @@
all:: abbrev.stc objs classList.stc $(OBJTARGET)
#all:: abbrev.stc objs moreObjs classList.stc $(OBJTARGET)
-objs:: \
+OBJS= \
Ruler.$(O) \
Slider.$(O) \
HSlider.$(O) \
@@ -20,17 +20,19 @@
FNmEntrBox.$(O) \
FNmEdtFld.$(O) \
CheckBox.$(O) \
+ Separator.$(O) \
TabSpec.$(O) \
- MCLEntry.$(O)
+ ListEntry.$(O) \
+ MCLEntry.$(O)
moreObjs:
- Separator.$(O) \
ImageView.$(O) \
ImgEditV.$(O) \
TextBox.$(O) \
StepSlider.$(O) \
HStepSLider.$(O) \
TextRuler.$(O) \
+ ClrListEntry.$(O) \
ParSpec.$(O)
# obsolete: \
@@ -110,8 +112,9 @@
ImageView.$(O): ImageView.st $(VIEW)
ImgEditV.$(O): ImgEditV.st $(I)/ImageView.H $(VIEW)
-MCLEntry.$(O): $(OBJECT)
-TabSpec.$(O): $(OBJECT)
+ListEntry.$(O): ListEntry.st $(OBJECT)
+MCLEntry.$(O): MCLEntry.st $(I)/ListEntry.H $(OBJECT)
+ClrListEntry.$(O): ClrListEntry.st $(I)/ListEntry.H $(OBJECT)
TextBox.$(O): TextBox.st $(ENTERBOX)
CheckBox.$(O): CheckBox.st $(HPANELVIEW)
--- a/MultiColListEntry.st Fri May 12 20:40:42 1995 +0200
+++ b/MultiColListEntry.st Wed May 17 14:49:25 1995 +0200
@@ -10,7 +10,9 @@
hereby transferred.
"
-Object subclass:#MultiColListEntry
+'From Smalltalk/X, Version:2.10.5 on 15-may-1995 at 9:15:44 am'!
+
+ListEntry subclass:#MultiColListEntry
instanceVariableNames:'strings tabSpec'
classVariableNames:''
poolDictionaries:''
@@ -35,7 +37,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg2/MultiColListEntry.st,v 1.4 1995-02-17 13:23:47 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/MultiColListEntry.st,v 1.5 1995-05-17 12:49:05 claus Exp $
"
!
@@ -58,198 +60,225 @@
examples
"
- 'putting multiColListEntries into a ListView
- (instead of strings)'
+ putting multiColListEntries into a ListView
+ (instead of strings)'
+
+ |v e myList tabs|
- |v e myList tabs|
+ myList := OrderedCollection new.
- myList := OrderedCollection new.
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 3 4).
+ tabs align:#(left #center #left).
- tabs := TabulatorSpecification new.
- tabs unit:#inch.
- tabs positions:#(0 3 6).
- tabs align:#(left #left #left).
+ e := MultiColListEntry
+ fromString:'left centered left'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+
+ e := MultiColListEntry
+ fromString:'| | |'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+ myList add:''.
- e := MultiColListEntry new.
- e colAt:1 put:'hello'.
- e colAt:2 put:'hallo'.
- e colAt:3 put:'salut'.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry
+ fromString:'hello hallo salut'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+
+ e := MultiColListEntry
+ fromString:'good morning,guten Morgen,bon jour'
+ separatedBy:$,.
+ e tabulatorSpecification:tabs.
+ myList add:e.
- e := MultiColListEntry new.
- e colAt:1 put:'good morning'.
- e colAt:2 put:'guten Morgen'.
- e colAt:3 put:'bon jour'.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:'good bye'.
+ e colAt:2 put:'auf Wiedersehen'.
+ e colAt:3 put:'au revoir '.
+ e tabulatorSpecification:tabs.
+ myList add:e.
- e := MultiColListEntry new.
- e colAt:1 put:'good bye'.
- e colAt:2 put:'auf Wiedersehen'.
- e colAt:3 put:'au revoir '.
- e tabulatorSpecification:tabs.
- myList add:e.
-
- v := ListView new.
- v setList:myList expandTabs:false.
- v open
+ v := ListView new.
+ v setList:myList expandTabs:false.
+ v extent:500@100.
+ v open
- 'many multiColListEntries in a scrollable ListView'
+ many multiColListEntries in a scrollable ListView
- |v e myList tabs|
+ |v l e myList tabs|
- myList := OrderedCollection new.
+ myList := OrderedCollection new.
- tabs := TabulatorSpecification new.
- tabs unit:#cm.
- tabs positions:#(1 3 5).
- tabs align:#(#right #center #left).
+ tabs := TabulatorSpecification new.
+ tabs unit:#cm.
+ tabs positions:#(1 3 5).
+ 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.
- ].
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ 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.
+ ].
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := ScrollableView forView:l.
+ v extent:300@200.
+ v open
- 'like above, but adds nice alignments'
+ like above, but uses nicer decimal alignments
- |v e myList tabs|
+ |v l e myList tabs|
- myList := OrderedCollection new.
-
- tabs := TabulatorSpecification new.
- tabs unit:#cm.
- tabs positions:#(1 3 6 9 12).
- tabs align:#(#right #decimal #decimal #decimal #decimal).
+ myList := OrderedCollection new.
+
+ tabs := TabulatorSpecification new.
+ tabs unit:#cm.
+ tabs positions:#(1 3 6 9 12).
+ 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.
- ].
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ 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.
+ ].
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := ScrollableView forView:l.
+ v extent:600@200.
+ v open
- 'specifying tabs in inches'
+ specifying tabs in inches
- |v e myList tabs|
+ |v l e myList tabs|
- myList := OrderedCollection new.
+ myList := OrderedCollection new.
- tabs := TabulatorSpecification new.
- tabs unit:#inch.
- tabs positions:#(0 2 3.5 4 6 8 10 12).
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 2 3.5 4 6 8 10 12).
- e := MultiColListEntry new.
- e colAt:1 put:'2'.
- e colAt:2 put:'3.5'.
- e colAt:3 put:'4'.
- e colAt:4 put:'6'.
- e colAt:5 put:'8'.
- e colAt:6 put:'10'.
- e colAt:7 put:'12'.
- e tabulatorSpecification:tabs.
- myList add:e.
+ e := MultiColListEntry new.
+ e colAt:1 put:'2'.
+ e colAt:2 put:'3.5'.
+ e colAt:3 put:'4'.
+ e colAt:4 put:'6'.
+ e colAt:5 put:'8'.
+ e colAt:6 put:'10'.
+ e colAt:7 put:'12'.
+ e tabulatorSpecification:tabs.
+ myList add:e.
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ myList add:((MultiColListEntry fromString:'| | | | | | |')
+ tabulatorSpecification:tabs).
+ myList add:((MultiColListEntry fromString:'xxx xxx xxx xxx xxx xxx xxx')
+ tabulatorSpecification:tabs).
+
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := HVScrollableView forView:l.
+ v extent:600@200.
+ v open
- 'if you have the columns available as a collection,
- setup can be done easier'
+ if you have the columns available as a collection,
+ setup can be done easier
+
+ |v l e myList tabs|
+
+ myList := OrderedCollection new.
+
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 2 3.5 4 6 8 10 12).
+
+ e := MultiColListEntry new.
+ e strings:#('2' '3.5' '4' '6' '8' '10' '12').
+ e tabulatorSpecification:tabs.
+ myList add:e.
- |v e myList tabs|
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := HVScrollableView forView:l.
+ v extent:600@200.
+ v open
+
- myList := OrderedCollection new.
+ concrete example, show /etc/passwd in a table:
+
+ |v l s myList line e htabs tabs fingerEntry|
+
+ tabs := TabulatorSpecification new.
+ tabs unit:#inch.
+ tabs positions:#(0 2 3.5 4.5 5 8 11).
+ tabs align: #(left left right right left left left).
- tabs := TabulatorSpecification new.
- tabs unit:#inch.
- tabs positions:#(0 2 3.5 4 6 8 10 12).
+ htabs := TabulatorSpecification new.
+ htabs unit:#inch.
+ htabs positions:#(0 2 3.5 4.5 5 8 11).
+ htabs align: #(left center center center left left left).
+
+ myList := OrderedCollection new.
+
+ e := MultiColListEntry
+ fromString:'login-name:password:uid:gid:finger-entry:home-dir:shell'
+ separatedBy:$:.
+ e tabulatorSpecification:htabs.
+ myList add:e.
+ myList add:''.
- e := MultiColListEntry new.
- e strings:#('2' '3.5' '4' '6' '8' '10' '12').
- e tabulatorSpecification:tabs.
- myList add:e.
-
- v := ScrollableView for:ListView.
- v setList:myList expandTabs:false.
- v open
+ s := '/etc/passwd' asFilename readStream.
+ [s atEnd] whileFalse:[
+ line := s nextLine.
+ e := MultiColListEntry
+ fromString:line
+ separatedBy:$:.
+ fingerEntry := e colAt:5.
+ e colAt:5 put:(fingerEntry asCollectionOfSubstringsSeparatedBy:$,) first.
+ e tabulatorSpecification:tabs.
+ myList add:e.
+ ].
+ s close.
+
+ l := ListView new.
+ l setList:myList expandTabs:false.
+ v := HVScrollableView forView:l.
+ v extent:600@200.
+ v open
"
! !
-!MultiColListEntry methodsFor:'accessing'!
-
-strings:aCollectionOfStrings
- "replace all substrings"
-
- strings := OrderedCollection withAll:aCollectionOfStrings.
-!
-
-colAt:index
- "return the substring at column index"
+!MultiColListEntry class methodsFor:'instance creation'!
- index > strings size ifTrue:[^ nil].
- ^ strings at:index
-!
-
-colAt:index put:aString
- "replace the substring at column index"
-
- strings isNil ifTrue:[
- strings := OrderedCollection new:index
- ].
- strings grow:index.
- strings at:index put:aString
+fromString:aString
+ ^ self fromString:aString separatedBy:Character space
!
-tabulatorSpecification:aTabSpec
- "set the tabulator spec"
-
- tabSpec := aTabSpec
-! !
-
-!MultiColListEntry methodsFor:'converting'!
-
-asString
- "return the receiver as a string with embedded tabs"
-
- |s sub tab
- nSub "{ Class: SmallInteger }"|
+fromString:aString separatedBy:separatorCharacter
+ |subStrings e|
- s := ''.
- tab := Character tab asString.
- nSub := strings size.
- 1 to:nSub do:[:subStringIndex |
- sub := strings at:subStringIndex.
- sub notNil ifTrue:[
- s := s , sub.
- ].
- subStringIndex == strings size ifFalse:[
- s := s , tab
- ]
+ e := self new.
+ subStrings := aString asCollectionOfSubstringsSeparatedBy:separatorCharacter.
+ subStrings keysAndValuesDo:[:i :sub |
+ e colAt:i put:sub.
].
-
- ^ s
+ ^ e
! !
!MultiColListEntry methodsFor:'drawing'!
@@ -279,6 +308,94 @@
prevString := subString.
]
].
+! !
+!MultiColListEntry methodsFor:'accessing'!
+
+colAt:index put:aString
+ "replace the substring at column index"
+
+ strings isNil ifTrue:[
+ strings := OrderedCollection new:index
+ ].
+ index > strings size ifTrue:[strings grow:index].
+ strings at:index put:aString
+!
+
+tabulatorSpecification:aTabSpec
+ "set the tabulator spec"
+
+ tabSpec := aTabSpec
+!
+
+strings:aCollectionOfStrings
+ "replace all substrings"
+
+ strings := OrderedCollection withAll:aCollectionOfStrings.
+!
+
+colAt:index
+ "return the substring at column index"
+
+ index > strings size ifTrue:[^ nil].
+ ^ strings at:index
! !
+!MultiColListEntry methodsFor:'queries'!
+
+widthIn:aGC
+ "return the width of the receiver when displayed in aGC"
+
+ |xPos xMax subString tabPos w prevLen|
+
+ "just to make certain:
+ do not assume, that the last col is the rightmost one ...
+ "
+ xPos := 0.
+ xMax := 0.
+ prevLen := 0.
+ 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 + prevLen.
+ ] ifFalse:[
+ xPos := tabPos.
+ ].
+ w := prevLen := aGC font widthOf:subString.
+ xMax := xMax max:(xPos + w).
+ ]
+ ].
+ ^ xMax
+! !
+
+!MultiColListEntry methodsFor:'converting'!
+
+asString
+ "return the receiver as a string with embedded tabs"
+
+ |s sub tab
+ nSub "{ Class: SmallInteger }"|
+
+ s := ''.
+ tab := Character tab asString.
+ nSub := strings size.
+ 1 to:nSub do:[:subStringIndex |
+ sub := strings at:subStringIndex.
+ sub notNil ifTrue:[
+ s := s , sub.
+ ].
+ subStringIndex == strings size ifFalse:[
+ s := s , tab
+ ]
+ ].
+
+ ^ s
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PullDList.st Wed May 17 14:49:25 1995 +0200
@@ -0,0 +1,572 @@
+"
+ COPYRIGHT (c) 1994 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.
+"
+
+'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:06:03 pm'!
+
+Button subclass:#PullDownList
+ instanceVariableNames:'menu menuAction values useIndex listMsg'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+PullDownList comment:'
+COPYRIGHT (c) 1994 by Claus Gittinger
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libwidg2/Attic/PullDList.st,v 1.1 1995-05-17 12:49:10 claus Exp $
+'!
+
+!PullDownList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1994 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/libwidg2/Attic/PullDList.st,v 1.1 1995-05-17 12:49:10 claus Exp $
+"
+!
+
+documentation
+"
+ a PullDownList is basically a button with a popup menu.
+ The PullDownList label is showing the current selection from the
+ list.
+ When an entry is selected, an actionBlock (if nonNil) is evaluated
+ and (if nonNil), the model is notified via the changeMessage.
+
+ The default changeMessage used is #selection:, which allows a
+ PullDownList to be used with a SelectionInList as model.
+ (if used with some other model, either use an adaptor, or set the
+ changeMessage to something else ..)
+
+ Instance variables:
+
+ menu helpers for the popup menu
+ menuAction
+ values
+
+ useIndex <Boolean> if true, the index of the selected entry
+ is passed to the action block and the
+ model in a change-message.
+ If false (the default), the value is passed.
+ Notice that the default changeMessage is
+ #selection:, which is not ok to be used
+ with useIndex:true and a selectionInList model.
+ (set the changeMessage to #selectionIndex: then)
+
+ listMsg <Symbol> message to aquire a new list from the
+ model. Default is #list.
+"
+!
+
+examples
+"
+ example use:
+
+ |p|
+ p := PullDownList label:'healthy fruit'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p open
+
+
+ with an initial selection:
+
+ |p|
+ p := PullDownList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p selection:'apples'.
+ p open
+
+
+ with separating lines:
+
+ |p|
+ p := PullDownList label:'fruit'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margaritas').
+ p selection:'apples'.
+ p open
+
+
+ with an action:
+
+ |p|
+ p := PullDownList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margaritas').
+ p selection:'apples'.
+ p action:[:what | Transcript showCr:'you selected: ' , what].
+ p open
+
+
+ sometimes, you may like the index instead of the value:
+ (notice, that the separating line counts, so you have take care ...)
+
+ |p|
+ p := PullDownList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margaritas').
+ p selection:'apples'.
+ p action:[:what | Transcript show:'you selected: '; showCr:what].
+ p useIndex:true.
+ p open
+
+
+ since the list is actually a popupMenu, you can add double-separators:
+
+ |p|
+ p := PullDownList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon'
+ '='
+ 'margaritas' 'pina colada'
+ '='
+ 'smalltalk' 'c++' 'eiffel').
+ p values:#(apples bananas grape lemon
+ nil
+ 'mhmh - so good' 'makes headache'
+ nil
+ 'great' 'another headache' 'no bad').
+ p selection:'apples'.
+ p action:[:what | Transcript show:'you selected: '; showCr:what].
+ p open
+
+
+ with values different from the label strings:
+
+ |p|
+ p := PullDownList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margaritas').
+ p selection:'apples'.
+ p values:#(10 20 30 40 nil 50).
+ p action:[:what | Transcript show:'you selected: '; showCr:what].
+ p open
+
+
+ with a model:
+
+ |p model|
+
+ model := SelectionInList with:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+
+ p := PullDownList label:'healthy fruit'.
+ p model:model.
+ p open.
+ model selectionIndexHolder inspect
+
+
+ with a model (using numeric selection values):
+
+ |p model|
+
+ model := SelectionInList with:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+
+ p := PullDownList label:'healthy fruit'.
+ p model:model; useIndex:true; change:#selectionIndex:.
+ p open.
+ model selectionIndexHolder inspect
+
+
+ a popupList and a SelectionInListView on the same model:
+
+ |p slv model|
+
+ model := SelectionInList with:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ model selection:'apples'.
+
+ p := PullDownList on:model.
+ p useIndex:true; aspect:#selectionIndex; change:#selectionIndex:.
+ p open.
+
+ slv := SelectionInListView on:model.
+ slv open.
+
+ p inspect.
+ model selectionIndexHolder inspect
+
+
+ two PullDownList on the same model, different aspects:
+
+ |top panel p model|
+
+ model := Plug new.
+ model respondTo:#eat: with:[:val | Transcript showCr:'eat: ' , val].
+ model respondTo:#drink: with:[:val | Transcript showCr:'drink: ' , val].
+ model respondTo:#meals with:[#(taco burrito enchilada)].
+ model respondTo:#drinks with:[#(margarita water beer)].
+
+ top := StandardSystemView new.
+ top extent:(100@100).
+ panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+ panel horizontalLayout:#fitSpace.
+
+ p := PullDownList label:'meals'.
+ p model:model; listMessage:#meals; aspect:nil; change:#eat:.
+ panel add:p.
+
+ p := PullDownList label:'drinks'.
+ p model:model; listMessage:#drinks; aspect:nil; change:#drink:.
+ panel add:p.
+
+ top open
+"
+! !
+
+!PullDownList class methodsFor:'defaults'!
+
+defaultAspectMessage
+ ^ #selection
+!
+
+defaultListMessage
+ ^ #list
+!
+
+defaultChangeMessage
+ ^ #selection:
+! !
+
+!PullDownList methodsFor:'private'!
+
+realize
+ super realize.
+ model notNil ifTrue:[
+ self getListFromModel.
+ self getSelectionFromModel.
+ ].
+!
+
+computeLabelSize
+ "compute the extent needed to hold the label plus the mark"
+
+ |mmH mmV savedLogo longest longestWidth|
+
+ menu isNil ifTrue:[
+ super computeLabelSize
+ ] ifFalse:[
+ "hack: simulate logo change to longest menu entry"
+
+ font := font on:device.
+ longest := logo.
+ longestWidth := font widthOf:logo.
+ menu labels do:[:entry |
+ |this|
+
+ this := font widthOf:entry printString.
+ this > longestWidth ifTrue:[
+ longest := entry.
+ longestWidth := this
+ ].
+ ].
+ savedLogo := logo.
+ logo := longest.
+ super computeLabelSize.
+ logo := savedLogo.
+"self halt. "
+ ].
+ mmH := device horizontalPixelPerMillimeter.
+ mmV := device verticalPixelPerMillimeter.
+ labelWidth := labelWidth + hSpace + (mmH * 2.5) rounded + hSpace.
+ labelHeight := labelHeight max: (mmV * 2) rounded
+!
+
+createMenuFor:aList
+ menu := PopUpMenu
+ labels:aList
+ selectors:#select:
+ args:(1 to:aList size)
+ receiver:self
+ for:self.
+! !
+
+!PullDownList methodsFor:'drawing'!
+
+showActive
+ "no need to redraw - will pop menu ontop of me anyway ..."
+
+ ^ self
+!
+
+showPassive
+ "no need to redraw - will redraw from unpopped menu anyway ..."
+
+ ^ self
+!
+
+drawWith:fgColor and:bgColor
+ |mmH mmV mW mH|
+
+ controller pressed ifTrue:[
+ super drawWith:enteredFgColor and:enteredBgColor
+ ] ifFalse:[
+ super drawWith:fgColor and:bgColor.
+ ].
+ mmH := device horizontalPixelPerMillimeter rounded.
+ mmV := device verticalPixelPerMillimeter rounded.
+ mW := (device horizontalPixelPerMillimeter * 2.5) rounded.
+ mH := (device verticalPixelPerMillimeter * 1.5) rounded.
+
+ self drawEdgesForX:(width - mW - (hSpace*2)) y:(height - mmV // 2)
+ width:mW height:mH level:2
+! !
+
+!PullDownList methodsFor:'event handling'!
+
+popMenu
+ |org mv w|
+
+ menu notNil ifTrue:[
+ self turnOffWithoutRedraw.
+ menu font:font.
+
+ "
+ adjust the menus width to my current width
+ "
+ mv := menu menuView.
+ mv create. "/ stupid: it resizes itself upon first create
+ w := mv width. "/ to its preferred size.
+ w := w max:(self width - (2 * menu margin) - (menu borderWidth*2)).
+ mv width:w.
+ mv level:0; borderWidth:0.
+
+ "
+ the popupMenu wants Display coordinates in its showAt: method
+ "
+ org := device translatePoint:0@0
+ from:(self id)
+ to:(DisplayRootView new id).
+
+ menu showAt:org "resizing:false"
+ ].
+! !
+
+!PullDownList methodsFor:'accessing'!
+
+selection:indexOrString
+ "set (force) a selection - usually done to set
+ an initial selection without updating others"
+
+ |index wasFix|
+
+ index := menu indexOf:indexOrString.
+ index == 0 ifTrue:[^ self].
+
+ "kludge: dont want label to resize ..."
+ wasFix := fixSize. fixSize := true.
+ self label:(menu labels at:index).
+ fixSize := wasFix
+
+ "
+ |p|
+ p := PullDownList label:'what fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p selection:'grape'.
+ p open
+
+ |p|
+ p := PullDownList label:'what fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p selection:'blabla'.
+ p open
+ "
+!
+
+list:aList
+ "set the list - i.e. the values shown in the pop-up list"
+
+ self createMenuFor:aList.
+ realized ifTrue:[
+ self computeLabelSize
+ ]
+
+ "
+ |p|
+ p := PullDownList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p action:[:val | Transcript showCr:'selected: ' , val printString].
+ p open
+ "
+!
+
+action:aOneArgBlock
+ "set the action to be performed on selection changes;
+ the argument, aOneArgBlock will be evaluated with the
+ selection-value as argument"
+
+ menuAction := aOneArgBlock
+!
+
+useIndex:aBoolean
+ "tell the popuplist to pass the index (instead of the value)
+ to both the actionBlock and model. Notice, that if you use a model,
+ the default changeSelector is not ok for using index and a SelectionInList"
+
+ useIndex := aBoolean
+
+ "
+ |p|
+ p := PullDownList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p action:[:val | Transcript showCr:'selected: ' , val printString].
+ p open.
+ "
+ "
+ |p|
+ p := PullDownList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p action:[:val | Transcript showCr:'selected: ' , val printString].
+ p useIndex:true.
+ p open.
+ "
+!
+
+contents
+ ^ self label
+!
+
+contents:con
+ ^ self selection:con
+
+!
+
+list
+ "return the list - i.e. the values shown in the pop-up list"
+
+ ^ menu labels
+!
+
+values:aList
+ "set a value list - these are reported via the action or changeSymbol instead of
+ the labe strings."
+
+ values := aList.
+ menu args:(1 to:aList size).
+
+ "
+ |p|
+ p := PullDownList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margaritas').
+ p values:#(1 2 3 4 'mhmh - good').
+ p action:[:val | Transcript showCr:'selected: ' , val printString].
+ p open.
+ "
+! !
+
+!PullDownList methodsFor:'accessing-mvc'!
+
+getListFromModel
+ "if I have a model and a listMsg, get my list from it"
+
+ (model notNil
+ and:[listMsg notNil]) ifTrue:[
+ self list:(model perform:listMsg).
+ ].
+!
+
+getSelectionFromModel
+ "if I have a model and an aspectMsg, get my current value from it"
+
+ (model notNil
+ and:[aspectMsg notNil]) ifTrue:[
+ self selection:(model perform:aspectMsg).
+ ].
+!
+
+listMessage:aSelector
+ "set the selector by which we ask the model for the list.
+ Default is #list."
+
+ listMsg := aSelector
+!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#listMessage put:listMsg
+!
+
+listMessage
+ "return the selector by which we ask the model for the list.
+ Default is #list."
+
+ ^ listMsg
+! !
+
+!PullDownList methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ controller beTriggerOnDown.
+ controller action:[self popMenu].
+ self adjust:#left.
+ useIndex := false.
+ self label:'popup'.
+ listMsg := self class defaultListMessage.
+
+ onLevel := offLevel.
+! !
+
+!PullDownList methodsFor:'user actions'!
+
+select:anEntry
+ "this is sent from the popupmenu when an entry was selected"
+
+ |value label|
+
+ label := menu labels at:anEntry.
+ values isNil ifTrue:[
+ value := anEntry.
+ useIndex ifFalse:[
+ value := menu labels at:anEntry.
+ ]
+ ] ifFalse:[
+ value := values at:anEntry
+ ].
+
+ menuAction notNil ifTrue:[
+ menuAction value:value.
+ ].
+ self sizeFixed:true.
+ self label:label printString.
+ "
+ tell my model - if any
+ "
+ self sendChangeMessageWith:value
+! !
+
+!PullDownList methodsFor:'change & update'!
+
+update:something with:aParameter from:changedObject
+ changedObject == model ifTrue:[
+ something == aspectMsg ifTrue:[
+ self getSelectionFromModel.
+ ^ self
+ ].
+ something == listMsg ifTrue:[
+ self getListFromModel.
+ ].
+ ^ self
+ ].
+ super update:something with:aParameter from:changedObject
+! !
+