--- a/NoteBookView.st Wed Apr 12 16:44:29 2000 +0200
+++ b/NoteBookView.st Thu Apr 13 14:32:41 2000 +0200
@@ -11,6 +11,8 @@
"
+"{ Package: 'stx:libwidg2' }"
+
View subclass:#NoteBookView
instanceVariableNames:'list listHolder foregroundColor selection enabled action useIndex
direction numberOfLines selectConditionBlock expandSelection
@@ -216,7 +218,7 @@
"
aCanvas == canvas ifFalse:[
canvas notNil ifTrue:[
- keepCanvas ifTrue:[
+ (keepCanvas or:[(canvas objectAttributeAt:#isTabItem) == true]) ifTrue:[
canvas unmap.
] ifFalse:[
canvas destroy.
@@ -226,12 +228,10 @@
tabModus := false.
self resizeCanvas.
- (keepCanvas not
- or:[subViews size == 0
- or:[(subViews includesIdentical:canvas) not]])
- ifTrue:[
- self addSubView:canvas.
+ (subViews size == 0 or:[(subViews includesIdentical:canvas) not]) ifTrue:[
+ self addSubView:canvas
].
+
realized ifTrue:[
canvas realize.
].
@@ -569,7 +569,6 @@
shadowColor:aColor
"get the color to be used for shadowed edges
"
-Transcript showCR:aColor.
super shadowColor:aColor
!
@@ -967,6 +966,41 @@
]
! !
+!NoteBookView methodsFor:'help'!
+
+helpText
+ "return the helpText for the currently selected item (empty if none)
+ "
+ ^ self helpTextForItemAt:selection
+
+
+!
+
+helpTextAt:srcPoint
+ "return the helpText for aPoint (i.e. when mouse-pointer is moved over an item).
+ "
+ |x y i|
+
+ x := srcPoint x.
+ y := srcPoint y.
+ i := list findFirst:[:aTab| aTab containsPointX:x y:y ].
+
+ ^ self helpTextForItemAt:i
+!
+
+helpTextForItemAt:anIndex
+ |tab|
+
+ ( anIndex notNil
+ and:[anIndex ~~ 0
+ and:[(tab := list at:anIndex ifAbsent:nil) notNil
+ and:[(tab := tab model) notNil]]]
+ ) ifTrue:[
+ ^ tab activeHelpText ? ''
+ ].
+ ^ ''
+! !
+
!NoteBookView methodsFor:'initialization & release'!
destroy
@@ -1575,7 +1609,7 @@
setSelection:anIndexOrNil
"change the selection to index or nil. No notifications are raised
"
- |newSel lnNr|
+ |newSel lnNr tappl model|
newSel := self listIndexOf:anIndexOrNil.
@@ -1591,9 +1625,25 @@
selection notNil ifTrue:[self invalidateTab:(list at:selection)].
selection := newSel.
selection notNil ifTrue:[self invalidateTab:(list at:selection)].
- ]
+ ].
+
+ (canvas notNil and:[(canvas objectAttributeAt:#isTabItem) == true]) ifTrue:[
+ canvas unmap.
+ canvas := nil.
+ ].
- "Modified: / 25.2.2000 / 13:42:27 / cg"
+ ( selection notNil
+ and:[(model := (list at:selection) model) notNil
+ and:[(tappl := model canvasView) notNil]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ canvasHolder notNil ifTrue:[
+ canvasHolder value:tappl
+ ] ifFalse:[
+ self canvas:tappl
+ ].
! !
!NoteBookView::Tab class methodsFor:'instance creation'!
@@ -1659,6 +1709,12 @@
!
+model
+ "returns the model, a TabItem or nil
+ "
+ ^ model
+!
+
printableLabel
"get my printable label
"
@@ -1730,7 +1786,9 @@
addDependent:aGC
"make the noteBook be a dependent of the tab model
"
- model notNil ifTrue:[model addDependent:aGC]
+ model notNil ifTrue:[
+ model addDependent:aGC
+ ]
!
@@ -1738,7 +1796,10 @@
removeDependent:aGC
"make the noteBook be independent of the tab model
"
- model notNil ifTrue:[model removeDependent:aGC]
+ model notNil ifTrue:[
+ model destroyCanvas.
+ model removeDependent:aGC.
+ ]
! !
@@ -1940,12 +2001,9 @@
(aGC isEnabled and:[self isEnabled]) ifTrue:[
dispObj := printableLabel.
- isSelected ifTrue:[
- fgColor := aGC activeForegroundColor
- ] ifFalse:[
- (model isNil or:[(fgColor := model foregroundColor) isNil]) ifTrue:[
- fgColor := aGC foregroundColor
- ]
+ (model isNil or:[(fgColor := model foregroundColor) isNil]) ifTrue:[
+ fgColor := isSelected ifTrue:[aGC activeForegroundColor]
+ ifFalse:[aGC foregroundColor].
]
] ifFalse:[
fgColor := aGC disabledForegroundColor.
@@ -2073,5 +2131,5 @@
!NoteBookView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/NoteBookView.st,v 1.39 2000-02-25 13:11:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/NoteBookView.st,v 1.40 2000-04-13 12:32:41 ca Exp $'
! !
--- a/TabItem.st Wed Apr 12 16:44:29 2000 +0200
+++ b/TabItem.st Thu Apr 13 14:32:41 2000 +0200
@@ -11,9 +11,10 @@
"
+"{ Package: '.:stx/libwidg2' }"
+
Model subclass:#TabItem
- instanceVariableNames:'translateLabel rawLabel label foregroundColor enabled argument
- accessCharacterPosition shortcutKey'
+ instanceVariableNames:'rawLabel label enabled argument canvas adornments activeHelpText'
classVariableNames:''
poolDictionaries:''
category:'Views-Support'
@@ -119,18 +120,45 @@
^ self basicNew initialize
! !
+!TabItem class methodsFor:'tests'!
+
+test
+ |top tab list item|
+
+ top := StandardSystemView new label:'tabs at top'; extent:400@400.
+ tab := NoteBookView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
+
+ tab direction:#top.
+ list := #( 'Foo' 'Bar' 'Baz' ) collect:[:l| TabItem label:l ].
+ item := list at:1.
+ item majorKey:ClockView.
+ item := list at:2.
+ item majorKey:CodingExamples_GUI::GUIDemoNoteBook.
+
+ item := list at:3.
+ item majorKey:CodingExamples_GUI::GUIDemoMenu.
+
+ tab list:list.
+ top open.
+! !
+
!TabItem methodsFor:'accessing'!
accessCharacterPosition
"get the index of the access character in the label text or string, or 0 if none
"
- ^ accessCharacterPosition ? 0
+ ^ self adornmentAt:#accessCharacterPosition ifAbsent:0
!
-accessCharacterPosition:index
+accessCharacterPosition:anIndex
"get the index of the access character in the label text or string, or 0 if none
"
- ^ accessCharacterPosition := index ? 0.
+ |idx|
+
+ anIndex ~~ 0 ifTrue:[
+ idx := anIndex
+ ].
+ self adornmentAt:#accessCharacterPosition put:idx
!
argument
@@ -150,6 +178,27 @@
argument := anArgument
!
+createNewBuilder
+ "returns true if a new builder is used to create the canvas;
+ the default is true
+ "
+ ^ self adornmentAt:#createNewBuilder ifAbsent:true
+
+!
+
+createNewBuilder:aBool
+ "returns true if a new builder is used to create the canvas;
+ the default is true
+ "
+ |flag|
+
+ aBool == false ifTrue:[
+ flag := false
+ ].
+ ^ self adornmentAt:#createNewBuilder put:flag
+
+!
+
enabled
"get the enabled state of the tab
"
@@ -172,16 +221,16 @@
foregroundColor
"get the label color or nil
"
- ^ foregroundColor
+ ^ self adornmentAt:#foregroundColor
!
foregroundColor:aColor
"set the label color or nil
"
- foregroundColor = aColor ifFalse:[
- foregroundColor := aColor.
+ self foregroundColor ~= aColor ifTrue:[
+ self adornmentAt:#foregroundColor put:aColor.
self changed:#foregroundColor
- ]
+ ].
!
label
@@ -217,20 +266,197 @@
shortcutKey
"get the key to press to select the tab item from the keyboard; a symbol or nil
"
- ^ shortcutKey
-
-
+ ^ self adornmentAt:#shortcutKey
!
shortcutKey:aKeyOrNil
"set the key to press to select the tab item from the keyboard; a symbol or nil
"
- aKeyOrNil isNil ifTrue:[
- shortcutKey := nil
- ] ifFalse:[
- shortcutKey := aKeyOrNil asSymbol
- ]
+ |key|
+
+ aKeyOrNil size ~~ 0 ifTrue:[
+ key := aKeyOrNil asSymbol
+ ].
+ self adornmentAt:#shortcutKey put:key
+
+
+! !
+
+!TabItem methodsFor:'accessing canvas'!
+
+canvas
+ "returns the application or nil
+ "
+ |view cls wsel ckey builder|
+
+ canvas notNil ifTrue:[
+ ^ canvas
+ ].
+
+ (ckey := self majorKey) notNil ifTrue:[
+ (cls := Smalltalk resolveName:ckey inClass:self class) isNil ifTrue:[
+ self majorKey:nil.
+ ].
+ canvas := cls new.
+
+ (canvas isKindOf:ApplicationModel) ifTrue:[
+ view := SimpleView new.
+ wsel := self minorKey ? #windowSpec.
+ builder := self adornmentAt:#builder ifAbsent:[ canvas createBuilder. canvas builder ].
+ view client:canvas spec:wsel builder:builder.
+ canvas window:(self setupCanvasView:view).
+ ] ifFalse:[
+ canvas := self setupCanvasView:canvas
+ ].
+ ].
+ ^ canvas
+!
+
+canvasView
+ "returns the view the canvas is running in or nil if no canvas
+ specified or not yet created
+ "
+ |canvas|
+
+ (canvas := self canvas) notNil ifTrue:[
+ ^ canvas perform:#window ifNotUnderstood:[canvas]
+ ].
+ ^ nil
+!
+
+destroyCanvas
+
+ canvas notNil ifTrue:[
+ self canvasView destroy.
+ canvas := nil
+ ].
+!
+
+majorKey
+ ^ self adornmentAt:#majorKey
+!
+
+majorKey:aMajorKey
+ |key|
+
+ aMajorKey notNil ifTrue:[
+ aMajorKey isBehavior ifTrue:[
+ key := aMajorKey name asSymbol
+ ] ifFalse:[
+ aMajorKey size ~~ 0 ifTrue:[
+ key := aMajorKey asSymbol
+ ]
+ ]
+ ].
+
+ self majorKey ~~ key ifTrue:[
+ self destroyCanvas
+ ].
+ self adornmentAt:#majorKey put:key.
+!
+
+minorKey
+ ^ self adornmentAt:#minorKey
+!
+
+minorKey:aMinorKey
+ self adornmentAt:#minorKey put:aMinorKey.
+!
+setupCanvasView:aView
+ |frame isV isH auto|
+
+ isH := self hasHorizontalScrollBar.
+ isV := self hasVerticalScrollBar.
+
+ (isH or:[isV]) ifFalse:[
+ frame := aView
+ ] ifTrue:[
+ frame := ScrollableView for:ViewScroller.
+
+ frame horizontalScrollable:isH.
+ frame verticalScrollable:isV.
+
+ isH ifTrue:[frame horizontalMini:(self miniScrollerHorizontal)].
+ isV ifTrue:[frame verticalMini:(self miniScrollerVertical)].
+
+ (auto := self autoHideScrollBars) notNil ifTrue:[
+ frame autoHideScrollBars:auto
+ ].
+ frame scrolledView scrolledView:aView.
+ ].
+ frame objectAttributeAt:#isTabItem put:true.
+ ^ frame
+! !
+
+!TabItem methodsFor:'accessing scrolling'!
+
+autoHideScrollBars
+ ^ self adornmentAt:#autoHideScrollBars
+!
+
+autoHideScrollBars:aBoolOrNil
+ self adornmentAt:#autoHideScrollBars put:aBoolOrNil
+
+!
+
+hasHorizontalScrollBar
+ ^ self adornmentAt:#hasHorizontalScrollBar ifAbsent:false
+
+!
+
+hasHorizontalScrollBar:aBool
+ |flag|
+
+ aBool == true ifTrue:[flag := true]
+ ifFalse:[self miniScrollerHorizontal:false].
+
+ self adornmentAt:#hasHorizontalScrollBar put:flag
+
+!
+
+hasVerticalScrollBar
+ ^ self adornmentAt:#hasVerticalScrollBar ifAbsent:false
+
+!
+
+hasVerticalScrollBar:aBool
+ |flag|
+
+ aBool == true ifTrue:[flag := true]
+ ifFalse:[self miniScrollerVertical:false].
+
+ self adornmentAt:#hasVerticalScrollBar put:flag
+
+!
+
+miniScrollerHorizontal
+ ^ self adornmentAt:#miniScrollerHorizontal ifAbsent:false
+
+!
+
+miniScrollerHorizontal:aBool
+ |flag|
+
+ aBool == true ifTrue:[
+ flag := true
+ ].
+ self adornmentAt:#miniScrollerHorizontal put:flag
+
+!
+
+miniScrollerVertical
+ ^ self adornmentAt:#miniScrollerVertical ifAbsent:false
+
+!
+
+miniScrollerVertical:aBool
+ |flag|
+
+ aBool == true ifTrue:[
+ flag := true
+ ].
+ self adornmentAt:#miniScrollerVertical put:flag
! !
@@ -291,24 +517,48 @@
setAttributesWithBuilder:aBuilder
"setup attributes dependent on the builder
"
+ |appl key builder |
+
+ self createNewBuilder ifFalse:[builder := aBuilder].
+ self adornmentAt:#builder put:builder.
+
(self translateLabel and:[label isString]) ifTrue:[
rawLabel := aBuilder labelFor:(label asSymbol).
+ ].
- rawLabel notNil ifTrue:[^ rawLabel ]
+ rawLabel isNil ifTrue:[
+ rawLabel := label printString.
].
- rawLabel := label printString
+
+ (aBuilder isEditing or:[(appl := aBuilder application) isNil]) ifFalse:[
+ (key := self activeHelpKey) notNil ifTrue:[
+ activeHelpText := appl helpTextForKey:key.
+ ].
+
+ (self majorKey isNil and:[(key := self minorKey) notNil]) ifTrue:[
+ canvas := SimpleView new.
+ canvas client:appl spec:key.
+ canvas := self setupCanvasView:canvas.
+ ]
+ ].
+
!
translateLabel
"returns true if the label derives from the application
"
- ^ translateLabel ? false
+ ^ self adornmentAt:#translateLabel ifAbsent:false
!
translateLabel:aBool
"returns true if the label derives from the application
"
- translateLabel := aBool
+ |flag|
+
+ aBool == true ifTrue:[
+ flag := true.
+ ].
+ ^ self adornmentAt:aBool put:flag
! !
!TabItem methodsFor:'converting'!
@@ -320,11 +570,10 @@
|selector value|
selector := aLiteralEncodedArray at:i.
+
(self respondsTo:selector) ifTrue:[
- value := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
+ value := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
self perform:selector with:value
- ] ifFalse:[
- Transcript showCR:selector
]
].
@@ -351,25 +600,8 @@
coll := OrderedCollection new.
coll add:#TabItem.
-
coll add:#label: ; add:(label literalArrayEncoding).
- (val := self accessCharacterPosition) ~~ 0 ifTrue:[
- coll add:#accessCharacterPosition: ; add:(val literalArrayEncoding)
- ].
-
- shortcutKey notNil ifTrue:[
- coll add:#shortcutKey: ; add:(shortcutKey literalArrayEncoding).
- ].
-
- self translateLabel ifTrue:[
- coll add:#translateLabel: ; add:true.
- ].
-
- foregroundColor notNil ifTrue:[
- coll add:#foregroundColor: ; add:(foregroundColor literalArrayEncoding)
- ].
-
self enabled ifFalse:[
coll add:#enabled: ; add:false.
].
@@ -378,7 +610,16 @@
coll add:#argument: ; add:(argument literalArrayEncoding).
].
- ^ coll asArray
+ adornments size ~~ 0 ifTrue:[
+ adornments keysAndValuesDo:[:key :val|
+ key ~~ #builder ifTrue:[
+ coll add:((key, ':') asSymbol).
+ coll add:(val literalArrayEncoding).
+ ]
+ ]
+ ].
+
+ ^ coll asArray
"
#(#TabItem
@@ -392,7 +633,84 @@
"
! !
-!TabItem methodsFor:'isEnabled'!
+!TabItem methodsFor:'displaying'!
+
+displayOn:aGC x:x y:y
+ |s|
+
+ (s := rawLabel ? label) isNil ifTrue:[
+ ^ self
+ ].
+ s isNumber ifTrue:[
+ s := s printString
+ ].
+ s displayOn:aGC x:x y:y
+!
+
+heightOn:aGC
+ |s|
+
+ (s := rawLabel ? label) isNil ifTrue:[
+ ^ aGC font height
+ ].
+ ^ s heightOn:aGC
+!
+
+widthOn:aGC
+ |s|
+
+ (s := rawLabel ? label) isNil ifTrue:[
+ ^ 4
+ ].
+ ^ s widthOn:aGC
+! !
+
+!TabItem methodsFor:'help'!
+
+activeHelpKey
+ ^ self adornmentAt:#activeHelpKey
+!
+
+activeHelpKey:aKey
+ |key|
+
+ aKey size > 0 ifTrue:[key := aKey asSymbol].
+ self adornmentAt:#activeHelpKey put:key
+!
+
+activeHelpText
+ ^ activeHelpText
+! !
+
+!TabItem methodsFor:'private'!
+
+adornmentAt:aKey
+ ^ self adornmentAt:aKey ifAbsent:nil
+!
+
+adornmentAt:aKey ifAbsent:exceptionBlock
+ adornments isNil ifTrue:[
+ ^ exceptionBlock value
+ ].
+ ^ adornments at:aKey ifAbsent:exceptionBlock
+!
+
+adornmentAt:aKey put:something
+
+ something isNil ifTrue:[
+ adornments notNil ifTrue:[
+ adornments removeKey:aKey ifAbsent:nil.
+ ]
+ ] ifFalse:[
+ adornments isNil ifTrue:[
+ adornments := IdentityDictionary new.
+ ].
+ adornments at:aKey put:something.
+ ].
+ ^ something
+! !
+
+!TabItem methodsFor:'queries'!
isEnabled
^ self enabled
@@ -401,5 +719,5 @@
!TabItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/TabItem.st,v 1.6 2000-02-03 12:59:52 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/TabItem.st,v 1.7 2000-04-13 12:32:30 ca Exp $'
! !