--- a/ArrButton.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ArrButton.st Sun Aug 07 15:23:42 1994 +0200
@@ -13,157 +13,443 @@
Button subclass:#ArrowButton
instanceVariableNames:'passiveForm activeForm'
classVariableNames:'DownArrowForm UpArrowForm
- LeftArrowForm RightArrowForm'
+ LeftArrowForm RightArrowForm
+ CachedStyle'
poolDictionaries:''
category:'Views-Interactors'
!
ArrowButton comment:'
-
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-Buttons of scrollbars - show arrows.
+$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.5 1994-08-07 13:20:36 claus Exp $
+'!
+
+!ArrowButton class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1993 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/libwidg/Attic/ArrButton.st,v 1.5 1994-08-07 13:20:36 claus Exp $
+"
+!
+
+documentation
+"
+ ArrowButtons display an arrow-bitmap as their label; they are mainly
+ used for scrollbars, but can be useful on their own in some applications.
+
+ ArrowButtons are created by sending one of:
+ ArrowButton upIn:aView /downIn: / leftIn: or rightIn:
+ passing the parent view as argument.
-$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.4 1994-01-13 00:14:23 claus Exp $
+ example1:
+ |v p b1 b2 b3 b4|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
+ b1 := ArrowButton upIn:p.
+ b2 := ArrowButton downIn:p.
+ b3 := ArrowButton leftIn:p.
+ b4 := ArrowButton rightIn:p.
+
+ b1 action:['whatEver you like here ...'].
+ b2 action:['whatEver you like here ...'].
+ b3 action:['whatEver you like here ...'].
+ b4 action:['whatEver you like here ...'].
+
+ v open
+
-written summer 93 by claus
-'!
+ example2:
+ |v p b1 b2 b3 b4|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
+ b1 := (ArrowButton upIn:p) extent:30@30.
+ b2 := (ArrowButton downIn:p) extent:30@30.
+ b3 := (ArrowButton leftIn:p) extent:30@30.
+ b4 := (ArrowButton rightIn:p) extent:30@30.
+
+ b1 action:['whatEver you like here ...'].
+ b2 action:['whatEver you like here ...'].
+ b3 action:['whatEver you like here ...'].
+ b4 action:['whatEver you like here ...'].
+
+ v open
+"
+! !
!ArrowButton class methodsFor:'defaults'!
-upArrowButtonForm:style
- "answer the form used for the scrollUp Button"
+upArrowButtonForm:style on:aDevice
+ "return the form used for the scrollUp Button"
+
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
- UpArrowForm isNil ifTrue:[
- UpArrowForm := Form fromFile:(self classResources at:'SCROLL_UP_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollUp_win.xbm']
- ifFalse:['ScrollUp.xbm'])
- )
- resolution:100.
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[UpArrowForm notNil]) ifTrue:[
+ ^ UpArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollUp_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollUp_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollUp.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_UP_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- UpArrowForm isNil ifTrue:[
- UpArrowForm := Form width:16 height:16
- fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r01000000
- 2r00000100 2r00100000
- 2r00001000 2r00010000
- 2r00010000 2r00001000
- 2r00100000 2r00000100
- 2r01000000 2r00000010
- 2r01111000 2r00011110
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001111 2r11110000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:aDevice.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:0 y:6 toX:4 y:2.
+ form displayLineFromX:4 y:2 toX:8 y:6.
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00000001 2r10000000
+ 2r00000010 2r01000000
+ 2r00000100 2r00100000
+ 2r00001000 2r00010000
+ 2r00010000 2r00001000
+ 2r00100000 2r00000100
+ 2r01000000 2r00000010
+ 2r01111000 2r00011110
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001111 2r11110000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- UpArrowForm := UpArrowForm on:Display.
].
- ^ UpArrowForm
+
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ UpArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
!
-downArrowButtonForm:style
+downArrowButtonForm:style on:aDevice
"retun the form used for the scrollDown Button"
- DownArrowForm isNil ifTrue:[
- DownArrowForm := Form fromFile:(self classResources at:'SCROLL_DOWN_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollDn_win.xbm']
- ifFalse:['ScrollDn.xbm'])
- )
- resolution:100.
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[
+ ^ DownArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollDn_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollDn_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollDn.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_DOWN_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- DownArrowForm isNil ifTrue:[
- DownArrowForm := Form width:16 height:16
- fromArray:#(2r00000000 2r00000000
- 2r00001111 2r11110000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r01111000 2r00011110
- 2r01000000 2r00000010
- 2r00100000 2r00000100
- 2r00010000 2r00001000
- 2r00001000 2r00010000
- 2r00000100 2r00100000
- 2r00000010 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:Display.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:0 y:2 toX:4 y:6.
+ form displayLineFromX:4 y:6 toX:8 y:2
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00001111 2r11110000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r01111000 2r00011110
+ 2r01000000 2r00000010
+ 2r00100000 2r00000100
+ 2r00010000 2r00001000
+ 2r00001000 2r00010000
+ 2r00000100 2r00100000
+ 2r00000010 2r01000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- DownArrowForm := DownArrowForm on:Display.
].
- ^ DownArrowForm
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ DownArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
!
-leftArrowButtonForm:style
- LeftArrowForm isNil ifTrue:[
- LeftArrowForm := Form fromFile:(self classResources at:'SCROLL_LEFT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollLt_win.xbm']
- ifFalse:['ScrollLt.xbm']))
- resolution:100.
+leftArrowButtonForm:style on:aDevice
+ "retun the form used for the scrollLeft Button"
+
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
+
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[
+ ^ LeftArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollLt_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollLt_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollLt.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_LEFT_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- LeftArrowForm isNil ifTrue:[
- LeftArrowForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r10000000
- 2r00000100 2r10000000
- 2r00001000 2r11111110
- 2r00010000 2r00000010
- 2r00100000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r00100000 2r00000010
- 2r00010000 2r00000010
- 2r00001000 2r11111110
- 2r00000100 2r10000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:Display.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:6 y:0 toX:2 y:4.
+ form displayLineFromX:2 y:4 toX:6 y:8.
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00000001 2r10000000
+ 2r00000010 2r10000000
+ 2r00000100 2r10000000
+ 2r00001000 2r11111110
+ 2r00010000 2r00000010
+ 2r00100000 2r00000010
+ 2r01000000 2r00000010
+ 2r01000000 2r00000010
+ 2r00100000 2r00000010
+ 2r00010000 2r00000010
+ 2r00001000 2r11111110
+ 2r00000100 2r10000000
+ 2r00000010 2r10000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- LeftArrowForm := LeftArrowForm on:Display.
].
- ^ LeftArrowForm
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ LeftArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
!
-rightArrowButtonForm:style
- RightArrowForm isNil ifTrue:[
- RightArrowForm := Form fromFile:(self classResources at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollRt_win.xbm']
- ifFalse:['ScrollRt.xbm']))
- resolution:100.
+rightArrowButtonForm:style on:aDevice
+ "retun the form used for the scrollRight Button"
+
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
+
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
+ ^ RightArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollRt_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollRt_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollRt.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- RightArrowForm isNil ifTrue:[
- RightArrowForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000001 2r01000000
- 2r00000001 2r00100000
- 2r01111111 2r00010000
- 2r01000000 2r00001000
- 2r01000000 2r00000100
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000100
- 2r01000000 2r00001000
- 2r01111111 2r00010000
- 2r00000001 2r00100000
- 2r00000001 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:Display.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:2 y:0 toX:6 y:4.
+ form displayLineFromX:6 y:4 toX:2 y:8
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00000001 2r10000000
+ 2r00000001 2r01000000
+ 2r00000001 2r00100000
+ 2r01111111 2r00010000
+ 2r01000000 2r00001000
+ 2r01000000 2r00000100
+ 2r01000000 2r00000010
+ 2r01000000 2r00000010
+ 2r01000000 2r00000100
+ 2r01000000 2r00001000
+ 2r01111111 2r00010000
+ 2r00000001 2r00100000
+ 2r00000001 2r01000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- RightArrowForm := RightArrowForm on:Display.
].
- ^ RightArrowForm
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ RightArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
! !
!ArrowButton class methodsFor:'instance creation'!
@@ -190,16 +476,16 @@
|form|
aDirectionSymbol == #up ifTrue:[
- form := (self class upArrowButtonForm:style)
+ form := (self class upArrowButtonForm:style on:device)
].
aDirectionSymbol == #down ifTrue:[
- form := (self class downArrowButtonForm:style)
+ form := (self class downArrowButtonForm:style on:device)
].
aDirectionSymbol == #left ifTrue:[
- form := (self class leftArrowButtonForm:style)
+ form := (self class leftArrowButtonForm:style on:device)
].
aDirectionSymbol == #right ifTrue:[
- form := (self class rightArrowButtonForm:style)
+ form := (self class rightArrowButtonForm:style on:device)
].
self form:form
! !
@@ -211,7 +497,14 @@
style == #motif ifTrue:[
onLevel := 0.
offLevel := 0.
- self level:0
+ self level:0.
+ bgColor := viewBackground.
+ fgColor := viewBackground.
+ activeFgColor := Color darkGrey.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ activeFgColor := White
+ ]
]
! !
@@ -220,13 +513,27 @@
drawWith:fg and:bg
"this is a q&d hack for motif ..."
- |topLeft botRight|
+ |topLeft botRight deep|
style ~~ #motif ifTrue:[
^ super drawWith:fg and:bg.
].
logo notNil ifTrue:[
+ shadowColor := Black.
+ lightColor := White.
+ deep := false.
+
+"/ shadowColor := shadowColor on:device.
+"/ lightColor := lightColor on:device.
+
+"/ shadowColor ditherForm notNil ifTrue:[
+"/ shadowColor := Black on:device
+"/ ].
+"/ lightColor ditherForm notNil ifTrue:[
+"/ lightColor := White on:device
+"/ ].
+
pressed ifTrue:[
topLeft := shadowColor.
botRight := lightColor
@@ -234,40 +541,122 @@
topLeft := lightColor.
botRight := shadowColor
].
+
self paint:bg.
- self clear.
+ self fillRectangleX:0 y:0 width:width height:height.
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 1 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 1.
+ ].
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 1 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 1.
+ ].
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 2 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 2.
+ ].
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 2 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 2.
+ ].
+ ].
+
+
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX-2 y:labelOriginY - 2 .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-2 y:labelOriginY - 2.
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY - 1 .
- self foreground:topLeft background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY - 1.
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY - 1.
+ ].
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 2 .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 2.
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 1 .
- self foreground:topLeft background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 1.
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 1.
+ ].
+
+
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX -2 y:labelOriginY .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX -2 y:labelOriginY .
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
- self foreground:topLeft background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
+ ].
+
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY .
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
- self foreground:botRight background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
+ ].
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY + 2 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY + 2.
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1 .
- self foreground:botRight background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1.
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1.
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX y:labelOriginY .
- self foreground:bg background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX y:labelOriginY .
-
+ fg colorId ~~ 0 ifTrue:[
+ self foreground:fg background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY .
+ ].
self function:#copy
-
]
! !
--- a/ArrowButton.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ArrowButton.st Sun Aug 07 15:23:42 1994 +0200
@@ -13,157 +13,443 @@
Button subclass:#ArrowButton
instanceVariableNames:'passiveForm activeForm'
classVariableNames:'DownArrowForm UpArrowForm
- LeftArrowForm RightArrowForm'
+ LeftArrowForm RightArrowForm
+ CachedStyle'
poolDictionaries:''
category:'Views-Interactors'
!
ArrowButton comment:'
-
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-Buttons of scrollbars - show arrows.
+$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.5 1994-08-07 13:20:36 claus Exp $
+'!
+
+!ArrowButton class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1993 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/libwidg/ArrowButton.st,v 1.5 1994-08-07 13:20:36 claus Exp $
+"
+!
+
+documentation
+"
+ ArrowButtons display an arrow-bitmap as their label; they are mainly
+ used for scrollbars, but can be useful on their own in some applications.
+
+ ArrowButtons are created by sending one of:
+ ArrowButton upIn:aView /downIn: / leftIn: or rightIn:
+ passing the parent view as argument.
-$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.4 1994-01-13 00:14:23 claus Exp $
+ example1:
+ |v p b1 b2 b3 b4|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
+ b1 := ArrowButton upIn:p.
+ b2 := ArrowButton downIn:p.
+ b3 := ArrowButton leftIn:p.
+ b4 := ArrowButton rightIn:p.
+
+ b1 action:['whatEver you like here ...'].
+ b2 action:['whatEver you like here ...'].
+ b3 action:['whatEver you like here ...'].
+ b4 action:['whatEver you like here ...'].
+
+ v open
+
-written summer 93 by claus
-'!
+ example2:
+ |v p b1 b2 b3 b4|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
+ b1 := (ArrowButton upIn:p) extent:30@30.
+ b2 := (ArrowButton downIn:p) extent:30@30.
+ b3 := (ArrowButton leftIn:p) extent:30@30.
+ b4 := (ArrowButton rightIn:p) extent:30@30.
+
+ b1 action:['whatEver you like here ...'].
+ b2 action:['whatEver you like here ...'].
+ b3 action:['whatEver you like here ...'].
+ b4 action:['whatEver you like here ...'].
+
+ v open
+"
+! !
!ArrowButton class methodsFor:'defaults'!
-upArrowButtonForm:style
- "answer the form used for the scrollUp Button"
+upArrowButtonForm:style on:aDevice
+ "return the form used for the scrollUp Button"
+
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
- UpArrowForm isNil ifTrue:[
- UpArrowForm := Form fromFile:(self classResources at:'SCROLL_UP_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollUp_win.xbm']
- ifFalse:['ScrollUp.xbm'])
- )
- resolution:100.
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[UpArrowForm notNil]) ifTrue:[
+ ^ UpArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollUp_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollUp_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollUp.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_UP_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- UpArrowForm isNil ifTrue:[
- UpArrowForm := Form width:16 height:16
- fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r01000000
- 2r00000100 2r00100000
- 2r00001000 2r00010000
- 2r00010000 2r00001000
- 2r00100000 2r00000100
- 2r01000000 2r00000010
- 2r01111000 2r00011110
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001111 2r11110000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:aDevice.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:0 y:6 toX:4 y:2.
+ form displayLineFromX:4 y:2 toX:8 y:6.
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00000001 2r10000000
+ 2r00000010 2r01000000
+ 2r00000100 2r00100000
+ 2r00001000 2r00010000
+ 2r00010000 2r00001000
+ 2r00100000 2r00000100
+ 2r01000000 2r00000010
+ 2r01111000 2r00011110
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001111 2r11110000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- UpArrowForm := UpArrowForm on:Display.
].
- ^ UpArrowForm
+
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ UpArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
!
-downArrowButtonForm:style
+downArrowButtonForm:style on:aDevice
"retun the form used for the scrollDown Button"
- DownArrowForm isNil ifTrue:[
- DownArrowForm := Form fromFile:(self classResources at:'SCROLL_DOWN_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollDn_win.xbm']
- ifFalse:['ScrollDn.xbm'])
- )
- resolution:100.
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[
+ ^ DownArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollDn_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollDn_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollDn.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_DOWN_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- DownArrowForm isNil ifTrue:[
- DownArrowForm := Form width:16 height:16
- fromArray:#(2r00000000 2r00000000
- 2r00001111 2r11110000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r01111000 2r00011110
- 2r01000000 2r00000010
- 2r00100000 2r00000100
- 2r00010000 2r00001000
- 2r00001000 2r00010000
- 2r00000100 2r00100000
- 2r00000010 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:Display.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:0 y:2 toX:4 y:6.
+ form displayLineFromX:4 y:6 toX:8 y:2
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00001111 2r11110000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r00001000 2r00010000
+ 2r01111000 2r00011110
+ 2r01000000 2r00000010
+ 2r00100000 2r00000100
+ 2r00010000 2r00001000
+ 2r00001000 2r00010000
+ 2r00000100 2r00100000
+ 2r00000010 2r01000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- DownArrowForm := DownArrowForm on:Display.
].
- ^ DownArrowForm
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ DownArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
!
-leftArrowButtonForm:style
- LeftArrowForm isNil ifTrue:[
- LeftArrowForm := Form fromFile:(self classResources at:'SCROLL_LEFT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollLt_win.xbm']
- ifFalse:['ScrollLt.xbm']))
- resolution:100.
+leftArrowButtonForm:style on:aDevice
+ "retun the form used for the scrollLeft Button"
+
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
+
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[
+ ^ LeftArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollLt_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollLt_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollLt.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_LEFT_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- LeftArrowForm isNil ifTrue:[
- LeftArrowForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r10000000
- 2r00000100 2r10000000
- 2r00001000 2r11111110
- 2r00010000 2r00000010
- 2r00100000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r00100000 2r00000010
- 2r00010000 2r00000010
- 2r00001000 2r11111110
- 2r00000100 2r10000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:Display.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:6 y:0 toX:2 y:4.
+ form displayLineFromX:2 y:4 toX:6 y:8.
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00000001 2r10000000
+ 2r00000010 2r10000000
+ 2r00000100 2r10000000
+ 2r00001000 2r11111110
+ 2r00010000 2r00000010
+ 2r00100000 2r00000010
+ 2r01000000 2r00000010
+ 2r01000000 2r00000010
+ 2r00100000 2r00000010
+ 2r00010000 2r00000010
+ 2r00001000 2r11111110
+ 2r00000100 2r10000000
+ 2r00000010 2r10000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- LeftArrowForm := LeftArrowForm on:Display.
].
- ^ LeftArrowForm
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ LeftArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
!
-rightArrowButtonForm:style
- RightArrowForm isNil ifTrue:[
- RightArrowForm := Form fromFile:(self classResources at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollRt_win.xbm']
- ifFalse:['ScrollRt.xbm']))
- resolution:100.
+rightArrowButtonForm:style on:aDevice
+ "retun the form used for the scrollRight Button"
+
+ |form fName|
+
+ "
+ flush cached form on style-changes
+ "
+ CachedStyle ~~ style ifTrue:[
+ DownArrowForm := nil.
+ UpArrowForm := nil.
+ LeftArrowForm := nil.
+ RightArrowForm := nil
+ ].
+
+ "
+ use cached form, if device is appropriate
+ "
+ ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
+ ^ RightArrowForm
+ ].
+
+ "
+ get bitmaps filename from resources, use a style-dependent
+ default, if resources do not contain a filename
+ "
+ style == #mswindows ifTrue:[
+ fName := 'ScrollRt_win.xbm'.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ fName := 'ScrollRt_st.xbm'
+ ] ifFalse:[
+ fName := 'ScrollRt.xbm'
+ ]
+ ].
+ form := Form fromFile:(self classResources
+ at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
+ default:fName)
+ resolution:100
+ on:aDevice.
- RightArrowForm isNil ifTrue:[
- RightArrowForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000001 2r01000000
- 2r00000001 2r00100000
- 2r01111111 2r00010000
- 2r01000000 2r00001000
- 2r01000000 2r00000100
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000100
- 2r01000000 2r00001000
- 2r01111111 2r00010000
- 2r00000001 2r00100000
- 2r00000001 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
+ "
+ form to use as a fallback, if no bitmap file is present
+ (actually not really needed - just to show something useful, in
+ case of a bad installation)
+ "
+ form isNil ifTrue:[
+ style == #st80 ifTrue:[
+ form := Form width:9 height:9 depth:1 on:Display.
+ form clear.
+ form lineWidth:2.
+ form capStyle:#round.
+ form paint:(Color colorId:1).
+ form displayLineFromX:2 y:0 toX:6 y:4.
+ form displayLineFromX:6 y:4 toX:2 y:8
+ ] ifFalse:[
+ form := Form width:16 height:16
+ fromArray:#(2r00000000 2r00000000
+ 2r00000001 2r10000000
+ 2r00000001 2r01000000
+ 2r00000001 2r00100000
+ 2r01111111 2r00010000
+ 2r01000000 2r00001000
+ 2r01000000 2r00000100
+ 2r01000000 2r00000010
+ 2r01000000 2r00000010
+ 2r01000000 2r00000100
+ 2r01000000 2r00001000
+ 2r01111111 2r00010000
+ 2r00000001 2r00100000
+ 2r00000001 2r01000000
+ 2r00000001 2r10000000
+ 2r00000000 2r00000000)
+ on:aDevice
].
- RightArrowForm := RightArrowForm on:Display.
].
- ^ RightArrowForm
+ form := form on:aDevice.
+
+ "
+ remember form for next use
+ "
+ (aDevice == Display) ifTrue:[
+ RightArrowForm := form
+ ].
+
+ CachedStyle := style.
+ ^ form
! !
!ArrowButton class methodsFor:'instance creation'!
@@ -190,16 +476,16 @@
|form|
aDirectionSymbol == #up ifTrue:[
- form := (self class upArrowButtonForm:style)
+ form := (self class upArrowButtonForm:style on:device)
].
aDirectionSymbol == #down ifTrue:[
- form := (self class downArrowButtonForm:style)
+ form := (self class downArrowButtonForm:style on:device)
].
aDirectionSymbol == #left ifTrue:[
- form := (self class leftArrowButtonForm:style)
+ form := (self class leftArrowButtonForm:style on:device)
].
aDirectionSymbol == #right ifTrue:[
- form := (self class rightArrowButtonForm:style)
+ form := (self class rightArrowButtonForm:style on:device)
].
self form:form
! !
@@ -211,7 +497,14 @@
style == #motif ifTrue:[
onLevel := 0.
offLevel := 0.
- self level:0
+ self level:0.
+ bgColor := viewBackground.
+ fgColor := viewBackground.
+ activeFgColor := Color darkGrey.
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ activeFgColor := White
+ ]
]
! !
@@ -220,13 +513,27 @@
drawWith:fg and:bg
"this is a q&d hack for motif ..."
- |topLeft botRight|
+ |topLeft botRight deep|
style ~~ #motif ifTrue:[
^ super drawWith:fg and:bg.
].
logo notNil ifTrue:[
+ shadowColor := Black.
+ lightColor := White.
+ deep := false.
+
+"/ shadowColor := shadowColor on:device.
+"/ lightColor := lightColor on:device.
+
+"/ shadowColor ditherForm notNil ifTrue:[
+"/ shadowColor := Black on:device
+"/ ].
+"/ lightColor ditherForm notNil ifTrue:[
+"/ lightColor := White on:device
+"/ ].
+
pressed ifTrue:[
topLeft := shadowColor.
botRight := lightColor
@@ -234,40 +541,122 @@
topLeft := lightColor.
botRight := shadowColor
].
+
self paint:bg.
- self clear.
+ self fillRectangleX:0 y:0 width:width height:height.
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 1 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 1.
+ ].
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 1 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 1.
+ ].
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 2 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 2.
+ ].
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 2 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 2.
+ ].
+ ].
+
+
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX-2 y:labelOriginY - 2 .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-2 y:labelOriginY - 2.
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY - 1 .
- self foreground:topLeft background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY - 1.
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY - 1.
+ ].
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 2 .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 2.
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 1 .
- self foreground:topLeft background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 1.
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY - 1.
+ ].
+
+
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX -2 y:labelOriginY .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX -2 y:labelOriginY .
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
- self foreground:topLeft background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
+ topLeft colorId ~~ 0 ifTrue:[
+ self foreground:topLeft background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
+ ].
+
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY .
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
- self foreground:botRight background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
+ ].
+ deep ifTrue:[
+ self foreground:(Color noColor) background:(Color allColor) function:#and.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY + 2 .
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY + 2.
+ ].
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1 .
- self foreground:botRight background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1.
+ botRight colorId ~~ 0 ifTrue:[
+ self foreground:botRight background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1.
+ ].
self foreground:(Color noColor) background:(Color allColor) function:#and.
self displayOpaqueForm:logo x:labelOriginX y:labelOriginY .
- self foreground:bg background:(Color noColor) function:#or.
- self displayOpaqueForm:logo x:labelOriginX y:labelOriginY .
-
+ fg colorId ~~ 0 ifTrue:[
+ self foreground:fg background:(Color noColor) function:#or.
+ self displayOpaqueForm:logo x:labelOriginX y:labelOriginY .
+ ].
self function:#copy
-
]
! !
--- a/Button.st Sun Aug 07 15:22:53 1994 +0200
+++ b/Button.st Sun Aug 07 15:23:42 1994 +0200
@@ -31,7 +31,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.7 1994-08-07 13:18:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.8 1994-08-07 13:20:59 claus Exp $
'!
!Button class methodsFor:'documentation'!
@@ -52,7 +52,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Button.st,v 1.7 1994-08-07 13:18:26 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Button.st,v 1.8 1994-08-07 13:20:59 claus Exp $
"
!
--- a/ChckTggle.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ChckTggle.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,17 +18,40 @@
!
CheckToggle comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-CheckButtons like Toggles do something when pressed/released;
-but show an ok-marker if on; nothing if off
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.5 1994-08-07 13:21:08 claus Exp $
+'!
+
+!CheckToggle class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.4 1994-01-08 17:22:52 claus Exp $
+ 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.
+"
+!
-written spring 92 by claus
-'!
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/ChckTggle.st,v 1.5 1994-08-07 13:21:08 claus Exp $
+"
+!
+
+documentation
+"
+ CheckButtons are like Toggles in toggling their state when pressed.
+ However, they show an ok-marker if on; nothing if off.
+"
+! !
!CheckToggle class methodsFor:'defaults'!
--- a/CheckToggle.st Sun Aug 07 15:22:53 1994 +0200
+++ b/CheckToggle.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,17 +18,40 @@
!
CheckToggle comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-CheckButtons like Toggles do something when pressed/released;
-but show an ok-marker if on; nothing if off
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.5 1994-08-07 13:21:08 claus Exp $
+'!
+
+!CheckToggle class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.4 1994-01-08 17:22:52 claus Exp $
+ 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.
+"
+!
-written spring 92 by claus
-'!
+version
+"
+$Header: /cvs/stx/stx/libwidg/CheckToggle.st,v 1.5 1994-08-07 13:21:08 claus Exp $
+"
+!
+
+documentation
+"
+ CheckButtons are like Toggles in toggling their state when pressed.
+ However, they show an ok-marker if on; nothing if off.
+"
+! !
!CheckToggle class methodsFor:'defaults'!
--- a/ClckMenuV.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ClckMenuV.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,15 +18,40 @@
!
ClickMenuView comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-like a menuView - deselects after clicked on an entry
+$Header: /cvs/stx/stx/libwidg/Attic/ClckMenuV.st,v 1.4 1994-08-07 13:21:12 claus Exp $
+'!
+
+!ClickMenuView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ClckMenuV.st,v 1.3 1993-10-13 02:46:54 claus Exp $
-written spring 91 by claus
-'!
+ 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/libwidg/Attic/ClckMenuV.st,v 1.4 1994-08-07 13:21:12 claus Exp $
+"
+!
+
+documentation
+"
+ ClickMenuViews are like menuViews, but deselects automatically
+ after clicked on an entry.
+"
+! !
!ClickMenuView methodsFor:'event handling'!
--- a/ClickMenuView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ClickMenuView.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,15 +18,40 @@
!
ClickMenuView comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-like a menuView - deselects after clicked on an entry
+$Header: /cvs/stx/stx/libwidg/ClickMenuView.st,v 1.4 1994-08-07 13:21:12 claus Exp $
+'!
+
+!ClickMenuView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ClickMenuView.st,v 1.3 1993-10-13 02:46:54 claus Exp $
-written spring 91 by claus
-'!
+ 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/libwidg/ClickMenuView.st,v 1.4 1994-08-07 13:21:12 claus Exp $
+"
+!
+
+documentation
+"
+ ClickMenuViews are like menuViews, but deselects automatically
+ after clicked on an entry.
+"
+! !
!ClickMenuView methodsFor:'event handling'!
--- a/CodeView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/CodeView.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,98 +18,73 @@
!
CodeView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.8 1994-06-03 14:51:20 claus Exp $
-written winter-89 by claus
+$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.9 1994-08-07 13:21:14 claus Exp $
'!
!CodeView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/CodeView.st,v 1.9 1994-08-07 13:21:14 claus Exp $
+"
+!
+
documentation
"
a view for code which can recompile its contents. It adds accept and explain
to the menu, and defines two actions: acceptAction to be performed for accept
and explainAction to be performed for explain.
- These actions are to be defined by the user of this view (i.e. the surrounding browser)
+ These actions are to be defined by the user of this view
+ (i.e. ususally the owning browser)
"
! !
!CodeView methodsFor:'initialization'!
initializeMiddleButtonMenu
- self middleButtonMenu:(PopUpMenu
- labels: (resources array:#(
-"
- 'undo'
-"
- 'again'
- '-'
- 'copy'
- 'cut'
- 'paste'
- '-'
- 'doIt'
- 'printIt'
- 'inspectIt'
- '-'
- 'accept'
- '-'
- 'others'
- ))
- selectors:#(
-"
- undo
-"
- again
- nil
- copySelection
- cut
- paste
- nil
- doIt
- printIt
- inspectIt
- nil
- accept
- nil
- others
- )
- receiver:self
- for:self).
+ |sub idx|
+
+ super initializeMiddleButtonMenu.
- middleButtonMenu subMenuAt:#others put:(PopUpMenu
- labels:(resources array:#(
- 'search ...'
- 'goto ...'
- '-'
- 'explain'
- '-'
- 'font ...'
- '-'
- 'indent'
- '-'
- 'save as ...'
- 'print'
- ))
- selectors:#(
- search
- gotoLine
- nil
- explain
- nil
- changeFont
- nil
- indent
- nil
- save
- print
- )
- receiver:self
- for:self).
+ "
+ codeViews do support #accept
+ "
+ idx := middleButtonMenu indexOf:#inspectIt.
+ idx ~~ 0 ifTrue:[
+ middleButtonMenu addLabel:'-'
+ selector:nil
+ after:idx.
+ middleButtonMenu addLabel:(resources string:'accept')
+ selector:#accept
+ after:idx + 1.
+ ].
+
+ sub := middleButtonMenu subMenuAt:#others.
+ idx := sub indexOf:#gotoLine.
+ sub addLabel:'-'
+ selector:nil
+ after:idx.
+ sub addLabel:(resources string:'explain')
+ selector:#explain
+ after:idx + 1.
self enableOrDisableSelectionMenuEntries
! !
@@ -139,15 +114,19 @@
disableSelectionMenuEntries
"disable relevant menu entries for a selection"
- super disableSelectionMenuEntries.
- middleButtonMenu disable:#explain
+ middleButtonMenu notNil ifTrue:[
+ super disableSelectionMenuEntries.
+ middleButtonMenu disable:#explain
+ ]
!
enableSelectionMenuEntries
"enable relevant menu entries for a selection"
- super enableSelectionMenuEntries.
- middleButtonMenu enable:#explain
+ middleButtonMenu notNil ifTrue:[
+ super enableSelectionMenuEntries.
+ middleButtonMenu enable:#explain
+ ]
! !
!CodeView methodsFor:'user actions'!
--- a/EFGroup.st Sun Aug 07 15:22:53 1994 +0200
+++ b/EFGroup.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,21 +18,45 @@
!
EnterFieldGroup comment:'
-
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-EnterFieldGroup controlls the interaction between EnterFields
-enabling next/prev field when a field is left. Instances of
-this class keep track of which field of the group is the currentField
-(i.e. the one getting keyboard input).
-The block accessable as leaveAction is evaluated when the last
-field of the group is left (by cursor-down or cr). Usually this block
-triggers some action on the fields.
+$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.5 1994-08-07 13:21:19 claus Exp $
+'!
+
+!EnterFieldGroup class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.4 1993-12-11 01:42:31 claus Exp $
-written nov 91 by claus
-'!
+ 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/libwidg/Attic/EFGroup.st,v 1.5 1994-08-07 13:21:19 claus Exp $
+"
+!
+
+documentation
+"
+ EnterFieldGroup controlls the interaction between EnterFields
+ enabling next/prev field when a field is left. Instances of
+ this class keep track of which field of the group is the currentField
+ (i.e. the one getting keyboard input).
+ The block accessable as leaveAction is evaluated when the last
+ field of the group is left (by cursor-down or cr). Usually this block
+ triggers some action on the fields.
+"
+! !
!EnterFieldGroup methodsFor:'adding / removing'!
--- a/ETxtView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ETxtView.st Sun Aug 07 15:23:42 1994 +0200
@@ -30,7 +30,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.11 1994-08-06 10:23:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.12 1994-08-07 13:21:21 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -51,7 +51,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.11 1994-08-06 10:23:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.12 1994-08-07 13:21:21 claus Exp $
"
!
--- a/EditField.st Sun Aug 07 15:22:53 1994 +0200
+++ b/EditField.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,24 +18,42 @@
!
EditField comment:'
-
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.5 1994-01-08 17:24:11 claus Exp $
-written jan-90 by claus
+$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.6 1994-08-07 13:21:28 claus Exp $
'!
!EditField class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1990 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/libwidg/EditField.st,v 1.6 1994-08-07 13:21:28 claus Exp $
+"
+!
+
documentation
"
-an editable text-field. Realized by using an EditTextView,
-and forcing its size to 1 line - disabling cursor movement
-in the vertical direction.
-An action (leaveAction) is performed when the field is left
-by either Return or a cursor movement, or if 'accept' is
-performed from the menu.
+ an editable text-field. Realized by using an EditTextView,
+ and forcing its size to 1 line - disabling cursor movement
+ in the vertical direction.
+ An action (leaveAction) is performed when the field is left
+ by either Return or a cursor movement, or if 'accept' is
+ performed from the menu.
"
! !
@@ -129,8 +147,54 @@
^ self
! !
+!EditField methodsFor:'queries'!
+
+preferredExtent
+ "return the preferred extent of this view.
+ That is the width of the string plus some extra,
+ but not wider than half of the screen"
+
+ |string w|
+
+ string := self contents.
+ (string isNil or:[string isBlank]) ifTrue:[
+ ^ super preferredExtent
+ ].
+ w := (((font on:device) widthOf:string) * 1.5) rounded.
+ w := w min:(device width // 2).
+ ^ w @ self height
+! !
+
+!EditField methodsFor:'editing'!
+
+paste:someText
+ "redefined to force text to 1 line"
+
+ super paste:someText.
+ list size > 1 ifTrue:[
+ self deleteFromLine:2 toLine:(list size)
+ ]
+! !
+
!EditField methodsFor:'accessing'!
+list:someText
+ "redefined to force text to 1 line, and notify dependents
+ of any changed extent-wishes."
+
+ |l oldWidth|
+
+ l := someText.
+ l size > 1 ifTrue:[
+ l := OrderedCollection with:(l at:1)
+ ].
+ oldWidth := self widthOfContents.
+ super list:l.
+ self widthOfContents ~~ oldWidth ifTrue:[
+ self changed:self with:#preferredExtent
+ ]
+!
+
contents
"return contents as a string
- redefined since EditFields hold only one line of text"
@@ -195,10 +259,9 @@
!EditField methodsFor:'cursor movement'!
cursorLine:line col:col
- ((line >= 1) and:[line <= nLinesShown]) ifTrue:[
- super cursorLine:line col:col
- ]
- "ignore"
+ "catch cursor movement"
+
+ super cursorLine:1 col:col
!
cursorDown
@@ -250,7 +313,7 @@
"if keyHandler is defined, pass input; otherwise check for leave
keys"
- |leave xCol|
+ |leave xCol newOffset oldWidth newWidth|
enabled ifFalse:[
(keyboardHandler notNil
@@ -280,17 +343,40 @@
].
^ self
].
+
+ oldWidth := self widthOfContents.
super keyPress:key x:x y:y.
+ newWidth := self widthOfContents.
+
+ "
+ should (& can) we resize ?
+ "
xCol := (self xOfCol:cursorCol inLine:cursorLine) - leftOffset.
(xCol > (width * (5/6))) ifTrue:[
- leftOffset := leftOffset + (width // 2).
+ self changed:self with:#preferredExtent
+ ] ifFalse:[
+ self widthOfContents < (width * (1/6)) ifTrue:[
+ self changed:self with:#preferredExtent
+ ]
+ ].
+
+ "
+ did someone react ?
+ (if not, we scroll horizontally)
+ "
+ xCol := (self xOfCol:cursorCol inLine:cursorLine) - leftOffset.
+ (xCol > (width * (5/6))) ifTrue:[
+ newOffset := leftOffset + (width // 2).
+ ] ifFalse:[
+ (xCol < (width * (1/6))) ifTrue:[
+ newOffset := 0 max: leftOffset - (width // 2).
+ ] ifFalse:[
+ newOffset := leftOffset
+ ]
+ ].
+ newOffset ~~ leftOffset ifTrue:[
+ leftOffset := newOffset.
self clear.
self redraw
- ] ifFalse:[
- (xCol < (width * (1/6))) ifTrue:[
- leftOffset := 0 max: leftOffset - (width // 2).
- self clear.
- self redraw
- ]
]
! !
--- a/EditTextView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/EditTextView.st Sun Aug 07 15:23:42 1994 +0200
@@ -30,7 +30,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.11 1994-08-06 10:23:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.12 1994-08-07 13:21:21 claus Exp $
'!
!EditTextView class methodsFor:'documentation'!
@@ -51,7 +51,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.11 1994-08-06 10:23:16 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EditTextView.st,v 1.12 1994-08-07 13:21:21 claus Exp $
"
!
--- a/EnterBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/EnterBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -16,54 +16,80 @@
okAction abortAction'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
EnterBox comment:'
-
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.6 1994-01-08 17:24:13 claus Exp $
-
-written Feb 90 by claus
+$Header: /cvs/stx/stx/libwidg/EnterBox.st,v 1.7 1994-08-07 13:21:31 claus Exp $
'!
!EnterBox class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1990 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/libwidg/EnterBox.st,v 1.7 1994-08-07 13:21:31 claus Exp $
+"
+!
+
documentation
"
-this class implements a pop-up box to enter some string
-with 2 buttons; one to cancel, another to start some action.
-The boxes title can be changed using:
+ this class implements a pop-up box to enter some string
+ with 2 buttons; a cancel button, and a trigger-action button.
+ The boxes title can be changed using:
- aBox title:'some string'
+ aBox title:'some string'
+
+ The two button-labels default to 'abort' and 'ok';
+ they can be changed using:
-The two button-labels default to 'abort' and 'ok'; they can be changed
-using:
+ aBox okText:'someString'
+ aBox abortText:'someString'
+
+ The initial text in the enterfield can be set using:
- aBox okText:'someString'
- aBox abortText:'someString'
+ aBox initialText:'someString'
-The initial text in the enterfield can be set using:
-
- aBox initialText:'someString'
+ when the ok-button is pressed, an action is performed, which is
+ set using:
-when the ok-button is pressed, an action is performed, which is
-set using:
+ aBox action:[ ... ]
- aBox action:[ ... ]
+ the abort-action defaults to no-action, but can also be set.
+ The box can be opened modal (i.e. the currently active view will
+ be suspended) or modeless. The default is modal (i.e. sending #open
+ is equivalent to #openModal).
-the abort-action defaults to no-action, but can also be set.
+ example:
+ |box|
-example:
- |box|
+ box := EnterBox new.
+ box title:'your name please:'.
+ box action:[:arg | Transcript showCr:'entered: ' , arg printString].
+ box open
- box := EnterBox new.
- box title:'press ok for beep'.
- box okText:'beep'.
- box abortText:'silence'.
- box okAction:[Display beep]
+ |box|
+
+ box := EnterBox new.
+ box title:'your name please:'.
+ box action:[:arg | Transcript showCr:'entered: ' , arg printString].
+ box openModeless
"
! !
@@ -123,19 +149,20 @@
labelField origin:(ViewSpacing @ ViewSpacing)
extent:(innerWidth @ labelField height).
- enterField := EditField in:self.
+ self createEnterField.
enterField origin:(ViewSpacing @ (space2 + labelField height))
extent:((width - space2 - (enterField borderWidth * 2) - margin) @ enterField height).
enterField origin:[ViewSpacing @ (space2 + labelField height)]
extent:[(width - space2 - (enterField borderWidth * 2) - margin) @ enterField height].
enterField leaveAction:[:key | self okPressed].
+ enterField addDependent:self. "to get preferredExtent-changes"
buttonPanel := HorizontalPanelView in:self.
buttonPanel origin:(ViewSpacing @ (height - (font height * 2) - ViewSpacing - (borderWidth * 2)))
- extent:((width - space2 - (buttonPanel borderWidth * 2))
+ extent:((width - space2 - (ViewSpacing // 2) - (buttonPanel borderWidth * 2))
@ ((font height * 2) + (borderWidth * 2))).
buttonPanel origin:[ViewSpacing @ (height - (font height * 2) - ViewSpacing - (borderWidth * 2))]
- extent:[(width - space2 - (buttonPanel borderWidth * 2))
+ extent:[(width - space2 - (ViewSpacing // 2) - (buttonPanel borderWidth * 2))
@ ((font height * 2) + (borderWidth * 2))].
buttonPanel layout:"#spread2" #right.
@@ -157,12 +184,15 @@
okButton isReturnButton:true.
self keyboardHandler:enterField
-
!
-initEvents
- super initEvents.
- self enableKeyEvents
+createEnterField
+ "
+ this has been extracted from initialize method
+ to allow redefinition in subclasses.
+ "
+
+ enterField := EditField in:self.
!
reAdjustGeometry
@@ -191,24 +221,25 @@
resize
"resize myself to make everything visible"
- |wWanted hWanted wPanel|
+ |wWanted hWanted wPanel vs2 nx ny|
- wWanted := labelField widthIncludingBorder + ViewSpacing + ViewSpacing.
-"
- (wWanted > width) ifFalse:[
- wWanted := width
- ].
-"
- wPanel := buttonPanel preferedExtent x + ViewSpacing + ViewSpacing.
+ vs2 := ViewSpacing * 2.
+ wWanted := (labelField widthIncludingBorder max:enterField preferredExtent x) + vs2.
+ wPanel := buttonPanel preferedExtent x + vs2.
wPanel > wWanted ifTrue:[
wWanted := wPanel
].
- hWanted := ViewSpacing + labelField height +
- ViewSpacing + enterField height +
- (ViewSpacing * 6) + buttonPanel height +
- ViewSpacing.
+ hWanted := vs2 + labelField height + enterField height +
+ (ViewSpacing * 6) + buttonPanel height + ViewSpacing.
+
((wWanted ~= width) or:[hWanted ~= height]) ifTrue:[
- self extent:(wWanted @ hWanted)
+ "
+ make sure, that we are fully visible
+ (by moving origin if nescessary)
+ "
+ nx := self origin x min:(device width - wWanted).
+ ny := self origin y min:(device height - hWanted).
+ self origin:nx@ny extent:(wWanted @ hWanted)
]
! !
@@ -327,6 +358,12 @@
okAction := aBlock
!
+okAction:aBlock
+ "same as action - for your convenience"
+
+ okAction := aBlock
+!
+
abortAction:aBlock
"set the action to be performed when user presses abort-button;
aBlock must be nil or a block with no arguments"
@@ -334,6 +371,20 @@
abortAction := aBlock
! !
+!EnterBox methodsFor:'dependencies'!
+
+update:something with:someArgument
+ "sent if my enterbox thinks it needs more real-estate ..."
+
+ |ext|
+
+ something == enterField ifTrue:[
+ someArgument == #preferredExtent ifTrue:[
+ self resize
+ ]
+ ]
+! !
+
!EnterBox methodsFor:'user interaction'!
hideAndEvaluate:aBlock
--- a/EnterBox2.st Sun Aug 07 15:22:53 1994 +0200
+++ b/EnterBox2.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,20 +14,45 @@
instanceVariableNames:'okButton2 okAction2'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
EnterBox2 comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-like an EnterBox but with 2 action buttons.
+$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.5 1994-08-07 13:21:33 claus Exp $
+'!
+
+!EnterBox2 class methodsFor:'documentation '!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.4 1993-12-13 17:05:47 claus Exp $
+ 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.
+"
+!
-written Sep 91 by claus
-'!
+version
+"
+$Header: /cvs/stx/stx/libwidg/EnterBox2.st,v 1.5 1994-08-07 13:21:33 claus Exp $
+"
+!
+
+documentation
+"
+ An EnterBox2 is like an EnterBox but with 2 action buttons.
+ This is used (for example) in the search-boxes, where two ok-buttons
+ 'find-previous' and 'find-next' are needed in addition to the abort button.
+"
+! !
!EnterBox2 class methodsFor:'instance creation'!
--- a/EnterFieldGroup.st Sun Aug 07 15:22:53 1994 +0200
+++ b/EnterFieldGroup.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,21 +18,45 @@
!
EnterFieldGroup comment:'
-
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-EnterFieldGroup controlls the interaction between EnterFields
-enabling next/prev field when a field is left. Instances of
-this class keep track of which field of the group is the currentField
-(i.e. the one getting keyboard input).
-The block accessable as leaveAction is evaluated when the last
-field of the group is left (by cursor-down or cr). Usually this block
-triggers some action on the fields.
+$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.5 1994-08-07 13:21:19 claus Exp $
+'!
+
+!EnterFieldGroup class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.4 1993-12-11 01:42:31 claus Exp $
-written nov 91 by claus
-'!
+ 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/libwidg/EnterFieldGroup.st,v 1.5 1994-08-07 13:21:19 claus Exp $
+"
+!
+
+documentation
+"
+ EnterFieldGroup controlls the interaction between EnterFields
+ enabling next/prev field when a field is left. Instances of
+ this class keep track of which field of the group is the currentField
+ (i.e. the one getting keyboard input).
+ The block accessable as leaveAction is evaluated when the last
+ field of the group is left (by cursor-down or cr). Usually this block
+ triggers some action on the fields.
+"
+! !
!EnterFieldGroup methodsFor:'adding / removing'!
--- a/FSelBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/FSelBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,29 +14,84 @@
instanceVariableNames:'patternField'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
FileSelectionBox comment:'
-
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.6 1994-01-08 17:27:15 claus Exp $
-written Jan 90 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.7 1994-08-07 13:21:43 claus Exp $
'!
!FileSelectionBox class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1990 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/libwidg/Attic/FSelBox.st,v 1.7 1994-08-07 13:21:43 claus Exp $
+"
+!
+
documentation
"
-this class implements file selection boxes. Instances show a list of
-files, and perform an action block with the selected pathname as
-argument when ok is clicked.
+ this class implements file selection boxes. Instances show a list of
+ files, and perform an action block with the selected pathname as
+ argument when ok is clicked.
+
+ There is an optional PatternField, which shows itself when a pattern
+ is defined (i.e. if there is no pattern, it is hidden).
+ If there is a pattern, only files matching the pattern will be shown in
+ the list (and directories).
+
+ In addition, there is an optional matchBlock (actually this is defined
+ in the FileSelectionList). Only filenames for which this matchblock
+ returns true will be presented.
+
+ Example1:
+
+ FileSelectionBox open
+
+ Example2:
+
+ FileSelectionBox new open
-There is an optional PatternField, which shows itself when a pattern
-is defined. If there is such a pattern, only files matching the pattern
-will be shown in the list (and directories).
+ Example3:
+
+ |box|
+ box := FileSelectionBox new.
+ box title:'Which file ?'.
+ box open
+
+ Example4:
+
+ |box|
+ box := FileSelectionBox new.
+ box title:'Which file ?'.
+ box pattern:'*.doc'.
+ box open
+
+ Example5:
+
+ |box|
+ box := FileSelectionBox new.
+ box title:'Which file ?'.
+ box pattern:'*'.
+ box matchBlock:[:name | name first isLowercase].
+ box open
"
! !
@@ -57,16 +112,16 @@
labelField label:(resources string:'select a file:').
labelField adjust:#left.
- patternField := EditField
- origin:(0.7 @ labelField origin y)
- corner:(1.0 @ labelField corner y)
- in:self.
+ patternField := EditField in:self.
+ patternField
+ origin:(0.7 @ labelField origin y)
+ corner:(1.0 @ (labelField origin y+patternField heightIncludingBorder)).
patternField initialText:'*'.
patternField leaveAction:[:reason |
selectionList pattern:patternField contents.
self updateList
].
- patternField hidden:true.
+ patternField hidden:true. "delay showing, until a pattern is defined"
selectionList action:[:line |
|entry|
@@ -74,15 +129,58 @@
entry := selectionList selectionValue.
enterField contents:entry
].
+
selectionList doubleClickAction:[:line |
|entry|
entry := selectionList selectionValue.
- enterField contents:entry.
- self okPressed
+ entry notNil ifTrue:[
+ ((selectionList directory typeOf:entry) == #directory) ifFalse:[
+ enterField contents:entry.
+ self okPressed
+ ]
+ ]
].
"FileSelectionBox new show"
+!
+
+createEnterField
+ "
+ if the (optional) class FilenameEditField is present, use
+ it, since it provides filename completion. Otherwise, we have
+ to live with the dump field ...
+ "
+ FilenameEditField notNil ifTrue:[
+ enterField := FilenameEditField in:self.
+ ] ifFalse:[
+ super createEnterField
+ ]
+! !
+
+!FileSelectionBox methodsFor:'user actions'!
+
+okPressed
+ "called for both on ok-press and on return-key"
+
+ |dir string fname|
+
+ string := enterField contents.
+ string notNil ifTrue:[
+ string := string withoutSeparators.
+ string asFilename isAbsolute ifTrue:[
+ fname := string asFilename
+ ] ifFalse:[
+ dir := selectionList directory pathName asFilename.
+ fname := dir construct:string
+ ].
+ fname isDirectory ifTrue:[
+ selectionList directory:fname asString.
+ self updateList.
+ ^ self
+ ]
+ ].
+ super okPressed
! !
!FileSelectionBox methodsFor:'private'!
@@ -93,14 +191,23 @@
!FileSelectionBox methodsFor:'accessing'!
+openOn:aPath
+ "open the box showing files in aPath.
+ This is only a shortcut message - no new functionality."
+
+ self directory:aPath.
+ self showAtPointer
+!
+
directory:nameOrDirectory
- "change the directory shown in the list"
+ "change the directory shown in the list."
selectionList directory:nameOrDirectory
!
pattern:aPattern
- "set the pattern - this enables the PatternField."
+ "set the pattern - this also enables the PatternField
+ (if the pattern is non-nil) or hides it (if nil)."
patternField initialText:aPattern.
selectionList pattern:aPattern.
@@ -115,24 +222,29 @@
patternField realize.
].
].
-! !
-
-!FileSelectionBox methodsFor:'user interaction'!
+!
-okPressed
- "redefined, since action will be evaluated with full path as argument
- (instead of enterfields contents only as inherited by EnterBox"
+matchBlock:aBlock
+ "set the matchBlock (in the selectionList). Only files
+ for which the block returns true are shown.
+ This matching is actually done in the fileSeelctionList."
- |absPath|
+ selectionList matchBlock:aBlock
+!
- self hideAndEvaluate:[:string |
- okAction notNil ifTrue:[
- (string startsWith:(Filename separator)) ifTrue:[
- absPath := string
- ] ifFalse:[
- absPath := selectionList directory pathName , Filename separator asString , string
- ].
- okAction value:absPath
- ]
- ]
+contents
+ "return the current entered value (i.e. the enterFields string).
+ redefined to return the full pathname."
+
+ |string sep|
+
+ string := super contents.
+ string isNil ifTrue:[
+ ^ selectionList directory pathName
+ ].
+ sep := Filename separator.
+ (string startsWith:sep) ifTrue:[
+ ^ string
+ ].
+ ^ (selectionList directory pathName asFilename construct:string) asString
! !
--- a/FSelList.st Sun Aug 07 15:22:53 1994 +0200
+++ b/FSelList.st Sun Aug 07 15:23:42 1994 +0200
@@ -13,35 +13,62 @@
SelectionInListView subclass:#FileSelectionList
instanceVariableNames:'pattern directory timeStamp directoryId
directoryContents directoryFileTypes
- realAction fileTypes'
+ fileTypes realAction matchBlock'
classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
FileSelectionList comment:'
-
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.3 1994-01-13 00:15:25 claus Exp $
-written Dec 93 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.4 1994-08-07 13:21:47 claus Exp $
'!
!FileSelectionList class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1993 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/libwidg/Attic/FSelList.st,v 1.4 1994-08-07 13:21:47 claus Exp $
+"
+!
+
documentation
"
-this class implements file selection lists - its basically a
-selection in list, but remembers the previous position when
-changing directories.
-Only files matching a pattern (plus directories) are shown.
+ this class implements file selection lists - its basically a
+ selection in list, but adds some right-arrows to directories.
+ (and will soon remember the previous position when changing directories).
+ Only files matching a pattern (plus directories) are shown.
-Instance variables:
- directoryContents contents of current directory
- directoryFileTypes file types (symbols) of current directory
- fileTypes file types as shown in list
- (i.e only matching ones)
+ Instance variables:
+ pattern the matchpattern
+ directory the current directory
+ timeStamp the time, when directoryContents was last taken
+ directoryId the directories id (inode-nr) when it was taken
+ directoryContents contents of current directory
+ directoryFileTypes file types (symbols) of current directory
+ fileTypes file types as shown in list
+ (i.e only matching ones)
+ realAction the action to perform when a file is selected
+
+ Example use:
+ FileSelectionLists are typically used in FileSelectionBoxes,
+ or file-browser-like applications.
"
! !
@@ -57,7 +84,7 @@
otherwise directory is changed"
actionBlock := [:lineNr |
- |entry|
+ |entry ok|
(self selection isKindOf:Collection) ifFalse:[
entry := self selectionValue.
@@ -65,15 +92,21 @@
entry := entry copyTo:(entry size - 4).
].
((directory typeOf:entry) == #directory) ifTrue:[
+ ok := false.
(directory isReadable:entry) ifFalse:[
self warn:(resources string:'not allowed to read directory %1' with:entry)
] ifTrue:[
(directory isExecutable:entry) ifFalse:[
self warn:(resources string:'not allowed to change to directory %1' with:entry)
] ifTrue:[
- self directory:(directory pathName , Filename separator asString , entry)
+ self directory:(directory pathName , Filename separator asString , entry).
+ ok := true.
]
].
+ ok ifFalse:[
+ self deselect
+ ]
+
] ifFalse:[
realAction notNil ifTrue:[
realAction value:lineNr
@@ -82,7 +115,13 @@
]
]
- "FileSelectionList new realize"
+ "nontypical use ..."
+ "
+ FileSelectionList new open
+ (FileSelectionList new directory:'/etc') open
+ (ScrollableView for:FileSelectionList) open
+ (HVScrollableView for:FileSelectionList) open
+ "
!
reinitialize
@@ -109,7 +148,7 @@
|oldPath name|
- (nameOrDirectory isKindOf:String) ifTrue:[
+ nameOrDirectory isString ifTrue:[
name := nameOrDirectory
] ifFalse:[
name := nameOrDirectory pathName
@@ -130,6 +169,13 @@
self updateList
].
].
+!
+
+matchBlock:aBlock
+ "set the matchBlock - if non-nil, it controls which
+ names are shown in the list."
+
+ matchBlock := aBlock
! !
!FileSelectionList methodsFor:'drawing'!
@@ -195,6 +241,11 @@
oldCursor := cursor.
self cursor:(Cursor read).
+ "
+ if the directory-id changed, MUST update.
+ (can happen after a restart, when a file is no longer
+ there, has moved or is NFS-mounted differently)
+ "
directoryId == directory id ifFalse:[
timeStamp := directory timeOfLastChange.
directoryId := directory id.
@@ -208,23 +259,25 @@
fileTypes := OrderedCollection new.
index := 1.
files do:[:name |
- (directoryFileTypes at:index) == #directory ifTrue:[
- name = '..' ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
+ (matchBlock isNil or:[matchBlock value:name]) ifTrue:[
+ (directoryFileTypes at:index) == #directory ifTrue:[
+ name = '..' ifTrue:[
+ newList add:name.
+ fileTypes add:(directoryFileTypes at:index)
+ ] ifFalse:[
+ name = '.' ifTrue:[
+ "ignore"
+ ] ifFalse:[
+ newList add:(name ", ' ...'").
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ]
] ifFalse:[
- name = '.' ifTrue:[
- "ignore"
- ] ifFalse:[
- newList add:(name ", ' ...'").
+ (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
+ newList add:name.
fileTypes add:(directoryFileTypes at:index)
]
- ]
- ] ifFalse:[
- (pattern isEmpty or:[pattern = '*' or:[pattern match:name]]) ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
- ]
+ ].
].
index := index + 1
].
--- a/FileSelectionBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/FileSelectionBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,29 +14,84 @@
instanceVariableNames:'patternField'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
FileSelectionBox comment:'
-
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.6 1994-01-08 17:27:15 claus Exp $
-written Jan 90 by claus
+$Header: /cvs/stx/stx/libwidg/FileSelectionBox.st,v 1.7 1994-08-07 13:21:43 claus Exp $
'!
!FileSelectionBox class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1990 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/libwidg/FileSelectionBox.st,v 1.7 1994-08-07 13:21:43 claus Exp $
+"
+!
+
documentation
"
-this class implements file selection boxes. Instances show a list of
-files, and perform an action block with the selected pathname as
-argument when ok is clicked.
+ this class implements file selection boxes. Instances show a list of
+ files, and perform an action block with the selected pathname as
+ argument when ok is clicked.
+
+ There is an optional PatternField, which shows itself when a pattern
+ is defined (i.e. if there is no pattern, it is hidden).
+ If there is a pattern, only files matching the pattern will be shown in
+ the list (and directories).
+
+ In addition, there is an optional matchBlock (actually this is defined
+ in the FileSelectionList). Only filenames for which this matchblock
+ returns true will be presented.
+
+ Example1:
+
+ FileSelectionBox open
+
+ Example2:
+
+ FileSelectionBox new open
-There is an optional PatternField, which shows itself when a pattern
-is defined. If there is such a pattern, only files matching the pattern
-will be shown in the list (and directories).
+ Example3:
+
+ |box|
+ box := FileSelectionBox new.
+ box title:'Which file ?'.
+ box open
+
+ Example4:
+
+ |box|
+ box := FileSelectionBox new.
+ box title:'Which file ?'.
+ box pattern:'*.doc'.
+ box open
+
+ Example5:
+
+ |box|
+ box := FileSelectionBox new.
+ box title:'Which file ?'.
+ box pattern:'*'.
+ box matchBlock:[:name | name first isLowercase].
+ box open
"
! !
@@ -57,16 +112,16 @@
labelField label:(resources string:'select a file:').
labelField adjust:#left.
- patternField := EditField
- origin:(0.7 @ labelField origin y)
- corner:(1.0 @ labelField corner y)
- in:self.
+ patternField := EditField in:self.
+ patternField
+ origin:(0.7 @ labelField origin y)
+ corner:(1.0 @ (labelField origin y+patternField heightIncludingBorder)).
patternField initialText:'*'.
patternField leaveAction:[:reason |
selectionList pattern:patternField contents.
self updateList
].
- patternField hidden:true.
+ patternField hidden:true. "delay showing, until a pattern is defined"
selectionList action:[:line |
|entry|
@@ -74,15 +129,58 @@
entry := selectionList selectionValue.
enterField contents:entry
].
+
selectionList doubleClickAction:[:line |
|entry|
entry := selectionList selectionValue.
- enterField contents:entry.
- self okPressed
+ entry notNil ifTrue:[
+ ((selectionList directory typeOf:entry) == #directory) ifFalse:[
+ enterField contents:entry.
+ self okPressed
+ ]
+ ]
].
"FileSelectionBox new show"
+!
+
+createEnterField
+ "
+ if the (optional) class FilenameEditField is present, use
+ it, since it provides filename completion. Otherwise, we have
+ to live with the dump field ...
+ "
+ FilenameEditField notNil ifTrue:[
+ enterField := FilenameEditField in:self.
+ ] ifFalse:[
+ super createEnterField
+ ]
+! !
+
+!FileSelectionBox methodsFor:'user actions'!
+
+okPressed
+ "called for both on ok-press and on return-key"
+
+ |dir string fname|
+
+ string := enterField contents.
+ string notNil ifTrue:[
+ string := string withoutSeparators.
+ string asFilename isAbsolute ifTrue:[
+ fname := string asFilename
+ ] ifFalse:[
+ dir := selectionList directory pathName asFilename.
+ fname := dir construct:string
+ ].
+ fname isDirectory ifTrue:[
+ selectionList directory:fname asString.
+ self updateList.
+ ^ self
+ ]
+ ].
+ super okPressed
! !
!FileSelectionBox methodsFor:'private'!
@@ -93,14 +191,23 @@
!FileSelectionBox methodsFor:'accessing'!
+openOn:aPath
+ "open the box showing files in aPath.
+ This is only a shortcut message - no new functionality."
+
+ self directory:aPath.
+ self showAtPointer
+!
+
directory:nameOrDirectory
- "change the directory shown in the list"
+ "change the directory shown in the list."
selectionList directory:nameOrDirectory
!
pattern:aPattern
- "set the pattern - this enables the PatternField."
+ "set the pattern - this also enables the PatternField
+ (if the pattern is non-nil) or hides it (if nil)."
patternField initialText:aPattern.
selectionList pattern:aPattern.
@@ -115,24 +222,29 @@
patternField realize.
].
].
-! !
-
-!FileSelectionBox methodsFor:'user interaction'!
+!
-okPressed
- "redefined, since action will be evaluated with full path as argument
- (instead of enterfields contents only as inherited by EnterBox"
+matchBlock:aBlock
+ "set the matchBlock (in the selectionList). Only files
+ for which the block returns true are shown.
+ This matching is actually done in the fileSeelctionList."
- |absPath|
+ selectionList matchBlock:aBlock
+!
- self hideAndEvaluate:[:string |
- okAction notNil ifTrue:[
- (string startsWith:(Filename separator)) ifTrue:[
- absPath := string
- ] ifFalse:[
- absPath := selectionList directory pathName , Filename separator asString , string
- ].
- okAction value:absPath
- ]
- ]
+contents
+ "return the current entered value (i.e. the enterFields string).
+ redefined to return the full pathname."
+
+ |string sep|
+
+ string := super contents.
+ string isNil ifTrue:[
+ ^ selectionList directory pathName
+ ].
+ sep := Filename separator.
+ (string startsWith:sep) ifTrue:[
+ ^ string
+ ].
+ ^ (selectionList directory pathName asFilename construct:string) asString
! !
--- a/FileSelectionList.st Sun Aug 07 15:22:53 1994 +0200
+++ b/FileSelectionList.st Sun Aug 07 15:23:42 1994 +0200
@@ -13,35 +13,62 @@
SelectionInListView subclass:#FileSelectionList
instanceVariableNames:'pattern directory timeStamp directoryId
directoryContents directoryFileTypes
- realAction fileTypes'
+ fileTypes realAction matchBlock'
classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
FileSelectionList comment:'
-
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.3 1994-01-13 00:15:25 claus Exp $
-written Dec 93 by claus
+$Header: /cvs/stx/stx/libwidg/FileSelectionList.st,v 1.4 1994-08-07 13:21:47 claus Exp $
'!
!FileSelectionList class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1993 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/libwidg/FileSelectionList.st,v 1.4 1994-08-07 13:21:47 claus Exp $
+"
+!
+
documentation
"
-this class implements file selection lists - its basically a
-selection in list, but remembers the previous position when
-changing directories.
-Only files matching a pattern (plus directories) are shown.
+ this class implements file selection lists - its basically a
+ selection in list, but adds some right-arrows to directories.
+ (and will soon remember the previous position when changing directories).
+ Only files matching a pattern (plus directories) are shown.
-Instance variables:
- directoryContents contents of current directory
- directoryFileTypes file types (symbols) of current directory
- fileTypes file types as shown in list
- (i.e only matching ones)
+ Instance variables:
+ pattern the matchpattern
+ directory the current directory
+ timeStamp the time, when directoryContents was last taken
+ directoryId the directories id (inode-nr) when it was taken
+ directoryContents contents of current directory
+ directoryFileTypes file types (symbols) of current directory
+ fileTypes file types as shown in list
+ (i.e only matching ones)
+ realAction the action to perform when a file is selected
+
+ Example use:
+ FileSelectionLists are typically used in FileSelectionBoxes,
+ or file-browser-like applications.
"
! !
@@ -57,7 +84,7 @@
otherwise directory is changed"
actionBlock := [:lineNr |
- |entry|
+ |entry ok|
(self selection isKindOf:Collection) ifFalse:[
entry := self selectionValue.
@@ -65,15 +92,21 @@
entry := entry copyTo:(entry size - 4).
].
((directory typeOf:entry) == #directory) ifTrue:[
+ ok := false.
(directory isReadable:entry) ifFalse:[
self warn:(resources string:'not allowed to read directory %1' with:entry)
] ifTrue:[
(directory isExecutable:entry) ifFalse:[
self warn:(resources string:'not allowed to change to directory %1' with:entry)
] ifTrue:[
- self directory:(directory pathName , Filename separator asString , entry)
+ self directory:(directory pathName , Filename separator asString , entry).
+ ok := true.
]
].
+ ok ifFalse:[
+ self deselect
+ ]
+
] ifFalse:[
realAction notNil ifTrue:[
realAction value:lineNr
@@ -82,7 +115,13 @@
]
]
- "FileSelectionList new realize"
+ "nontypical use ..."
+ "
+ FileSelectionList new open
+ (FileSelectionList new directory:'/etc') open
+ (ScrollableView for:FileSelectionList) open
+ (HVScrollableView for:FileSelectionList) open
+ "
!
reinitialize
@@ -109,7 +148,7 @@
|oldPath name|
- (nameOrDirectory isKindOf:String) ifTrue:[
+ nameOrDirectory isString ifTrue:[
name := nameOrDirectory
] ifFalse:[
name := nameOrDirectory pathName
@@ -130,6 +169,13 @@
self updateList
].
].
+!
+
+matchBlock:aBlock
+ "set the matchBlock - if non-nil, it controls which
+ names are shown in the list."
+
+ matchBlock := aBlock
! !
!FileSelectionList methodsFor:'drawing'!
@@ -195,6 +241,11 @@
oldCursor := cursor.
self cursor:(Cursor read).
+ "
+ if the directory-id changed, MUST update.
+ (can happen after a restart, when a file is no longer
+ there, has moved or is NFS-mounted differently)
+ "
directoryId == directory id ifFalse:[
timeStamp := directory timeOfLastChange.
directoryId := directory id.
@@ -208,23 +259,25 @@
fileTypes := OrderedCollection new.
index := 1.
files do:[:name |
- (directoryFileTypes at:index) == #directory ifTrue:[
- name = '..' ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
+ (matchBlock isNil or:[matchBlock value:name]) ifTrue:[
+ (directoryFileTypes at:index) == #directory ifTrue:[
+ name = '..' ifTrue:[
+ newList add:name.
+ fileTypes add:(directoryFileTypes at:index)
+ ] ifFalse:[
+ name = '.' ifTrue:[
+ "ignore"
+ ] ifFalse:[
+ newList add:(name ", ' ...'").
+ fileTypes add:(directoryFileTypes at:index)
+ ]
+ ]
] ifFalse:[
- name = '.' ifTrue:[
- "ignore"
- ] ifFalse:[
- newList add:(name ", ' ...'").
+ (pattern isNil or:[pattern isEmpty or:[pattern = '*' or:[pattern match:name]]]) ifTrue:[
+ newList add:name.
fileTypes add:(directoryFileTypes at:index)
]
- ]
- ] ifFalse:[
- (pattern isEmpty or:[pattern = '*' or:[pattern match:name]]) ifTrue:[
- newList add:name.
- fileTypes add:(directoryFileTypes at:index)
- ]
+ ].
].
index := index + 1
].
--- a/FontPanel.st Sun Aug 07 15:22:53 1994 +0200
+++ b/FontPanel.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,7 +18,7 @@
currentStyle currentFaceAndStyle currentSize'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
FontPanel comment:'
@@ -28,7 +28,7 @@
this class implements a font chooser
-$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.4 1993-12-11 01:44:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.5 1994-08-07 13:21:49 claus Exp $
written fall 91 by claus
'!
@@ -74,7 +74,7 @@
innerWidth := width - space2.
previewField origin:(ViewSpacing @ ViewSpacing)
- extent:((innerWidth - (2 * bw)) @ (height // 4)).
+ extent:((innerWidth - (2 * bw) - (ViewSpacing // 2)) @ (height // 4)).
previewField origin:(ViewSpacing @ ViewSpacing)
extent:[(width - space2 - (2 * bw)) @ (height // 4)].
@@ -328,7 +328,7 @@
index := aString indexOf:$-.
(index ~~ 0) ifTrue:[
currentFaceAndStyle := aString.
- currentFace := aString copyFrom:1 to:(index - 1).
+ currentFace := aString copyTo:(index - 1).
currentStyle := aString copyFrom:(index + 1)
]
--- a/FramedBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/FramedBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -11,24 +11,51 @@
"
View subclass:#FramedBox
- instanceVariableNames:'label layout fgColor'
+ instanceVariableNames:'label layout fgColor showFrame'
classVariableNames:''
poolDictionaries:''
category:'Views-Layout'
!
FramedBox comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-a frame around something. The frame may have a label, whose position
-is controlled by the layout variable, aSymbol which may be one of:
-[#topCenter #topLeft #topRight #bottomLeft #bottomCenter #bottomRight]
+$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.7 1994-08-07 13:21:57 claus Exp $
+'!
+
+!FramedBox class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/FramedBox.st,v 1.6 1994-01-16 04:01:45 claus Exp $
-written spring 91 by claus
-'!
+ 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/libwidg/FramedBox.st,v 1.7 1994-08-07 13:21:57 claus Exp $
+"
+!
+
+documentation
+"
+ a frame around something. The frame may have a label, whose position
+ is controlled by the layout variable, aSymbol which may be one of:
+ [#topCenter #topLeft #topRight #bottomLeft #bottomCenter #bottomRight]
+
+ Its also possible, to not show the frame but only the label, by setting
+ showFrame to false.
+"
+! !
!FramedBox methodsFor:'private'!
@@ -56,6 +83,22 @@
]
!
+frameShown
+ "return true, if frame is shown;
+ if false, oly the label is shown"
+
+ ^ showFrame
+!
+
+showFrame:aBoolean
+ "turn on/off showing of the frame -
+ without a frame, only the label is shown at its position"
+
+ aBoolean ~~ showFrame ifTrue:[
+ showFrame := aBoolean.
+ self redrawIfShown
+ ]
+!
label
"return the frames labelstring"
@@ -90,17 +133,25 @@
sep := font height.
m2 := sep + sep "+ sep".
- ^ (sep @ sep) extent:((width - m2) @ (height - m2))
+ showFrame ifFalse:[
+ ^ (0 @ sep) extent:(width @ height)
+ ].
+ ^ (sep @ sep) extent:((width - sep) @ (height - sep))
+"/ WRONG:
+"/ ^ (sep @ sep) extent:((width - m2) @ (height - m2))
!
layout
+ "return the current layout, which is a symbol describing
+ the labels position."
+
^ layout
!
layout:aSymbol
"define the position of the label;
- aSymbol may be: topLeft, topCenter, topRight;
- bottomLeft, bottomCenter or bottomRight"
+ aSymbol may be: #topLeft, #topCenter, #topRight;
+ #bottomLeft, #bottomCenter or #bottomRight"
layout ~~ aSymbol ifTrue:[
layout := aSymbol.
@@ -120,35 +171,48 @@
drawFrame
"redraw the frame"
- |sep halfSep right bot left top bm1 rm3|
+ |sep halfSep w h|
- sep := font height.
- halfSep := sep // 2.
- self is3D ifFalse:[
- self displayRectangleX:halfSep y:halfSep
- width:(width - sep) height:(height - sep).
+ "
+ if there is no label, give more real estate to the inside
+ "
+ label isNil ifTrue:[
+ sep := 4.
+ halfSep := 2
+ ] ifFalse:[
+halfSep := font height // 2.
+sep := halfSep * 2.
+"
+ sep := font height.
+ halfSep := sep // 2.
+"
+ ].
+
+ w := width - sep.
+ h := height - sep.
+
+ ((style == #normal) or:[style == #mswindows]) ifTrue:[
+ self displayRectangleX:halfSep
+ y:halfSep
+ width:w
+ height:h.
^ self
].
- self paint:lightColor.
- right := width - halfSep.
- bot := height - halfSep.
- self displayRectangleX:halfSep y:halfSep
- width:(width - sep) height:(height - sep + 1).
+
+ w := w + 1.
+ h := h + 1.
self paint:shadowColor.
- left := halfSep - 1.
- top := halfSep - 1.
- bm1 := bot - 1.
- self displayLineFromX:left y:top toX:(right - 1) y:top.
- self displayLineFromX:left y:top toX:left y:bm1.
+ self displayRectangleX:halfSep-1
+ y:halfSep-1
+ width:w
+ height:h.
- rm3 := right - 3.
-"
- self displayLineFromX:rm3 y:(halfSep + 1) toX:rm3 y:bm1.
- self displayLineFromX:(halfSep + 2) y:(bot - 2) toX:(right - 2) y:(bot - 2)
-"
- self displayLineFromX:rm3 y:(halfSep + 1) toX:rm3 y:bm1-1.
- self displayLineFromX:(halfSep + 2) y:(bot - 2) toX:(right - 2 - 1) y:(bot - 2)
+ self paint:lightColor.
+ self displayRectangleX:halfSep
+ y:halfSep
+ width:w
+ height:h
!
redraw
@@ -157,14 +221,16 @@
|labelLen l x y|
label isNil ifTrue:[
- l := ' '.
labelLen := 0
] ifFalse:[
l := ' ' , label , ' '.
labelLen := font widthOf:l
].
- self drawFrame.
+ showFrame ifTrue:[
+ self drawFrame.
+ ].
+
labelLen > 0 ifTrue:[
labelLen < width ifTrue:[
(#(topLeft topCenter topRight) includes:layout) ifTrue:[
@@ -189,13 +255,19 @@
!FramedBox methodsFor:'initialization'!
+initialize
+ super initialize.
+ showFrame := true
+!
+
initStyle
"default position is top-center, except for ms-windows, where
the text is positioned at top-left"
super initStyle.
+
fgColor := Black.
- style == #mswindows ifTrue:[
+ ((style == #mswindows) or:[style == #motif]) ifTrue:[
layout := #topLeft
] ifFalse:[
layout := #topCenter
--- a/HPanelV.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HPanelV.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,17 +18,99 @@
!
HorizontalPanelView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-a View for childViews oriented horizontal
-all real work is done in PanelView - just redefine layout
+$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.4 1994-08-07 13:22:03 claus Exp $
+'!
+
+!HorizontalPanelView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Attic/HPanelV.st,v 1.4 1994-08-07 13:22:03 claus Exp $
+"
+!
+
+documentation
+"
+ a View which arranges its child-views in a horizontal row.
+ All real work is done in PanelView - only the layout computation is
+ redefined here.
+
+ example: default layout (centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
-$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.3 1993-10-13 02:47:53 claus Exp $
+ example: left-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p layout:#left.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: right-layout
+
+ |v p b1 b2 b3|
-written spring/summer 89 by claus
-'!
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p layout:#right.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p layout:#spread.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+"
+! !
!HorizontalPanelView methodsFor:'queries'!
@@ -63,7 +145,7 @@
"(re)compute position of every child whenever childs are added or
my size has changed"
- |xpos ypos space sumOfChildWidths numChilds l|
+ |xpos ypos space sumOfWidths numChilds l|
subViews isNil ifTrue:[^ self].
@@ -71,11 +153,8 @@
"compute net width needed"
- sumOfChildWidths := 0.
+ sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
numChilds := subViews size.
- subViews do:[:child |
- sumOfChildWidths := sumOfChildWidths + child widthIncludingBorder.
- ].
l := layout.
((l == #center) and:[numChilds == 1]) ifTrue:[
@@ -85,33 +164,46 @@
"compute position of leftmost subview and space between them;
if they do hardly fit, leave no space between them "
- (sumOfChildWidths >= width) ifTrue:[
+ (sumOfWidths >= (width - (margin * 2))) ifTrue:[
xpos := 0.
space := 0
] ifFalse: [
(l == #right) ifTrue:[
- xpos := width - (horizontalSpace * numChilds)
- - sumOfChildWidths.
+ xpos := width - (space * numChilds) - sumOfWidths.
+"
borderWidth == 0 ifTrue:[
- xpos := xpos + horizontalSpace
+ xpos := xpos + space
].
+"
+ xpos < 0 ifTrue:[
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ xpos := width - (space * numChilds) - sumOfWidths.
+ ]
] ifFalse:[
(l == #spread) ifTrue:[
- space := (width - sumOfChildWidths) // (numChilds + 1).
+ space := (width - sumOfWidths) // (numChilds + 1).
xpos := space.
(space == 0) ifTrue:[
- xpos := (width - sumOfChildWidths) // 2
+ xpos := (width - sumOfWidths) // 2
]
] ifFalse:[
(l == #center) ifTrue:[
- xpos := (width - (sumOfChildWidths
- + ((numChilds - 1) * space))) // 2
+ xpos := (width - (sumOfWidths
+ + ((numChilds - 1) * space))) // 2.
+ xpos < 0 ifTrue:[
+ space := (width - sumOfWidths) // (numChilds + 1).
+ xpos := (width - (sumOfWidths
+ + ((numChilds - 1) * space))) // 2.
+ ]
] ifFalse:[
+ "left"
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ xpos := space.
+"
borderWidth == 0 ifTrue:[
xpos := 0
- ] ifFalse:[
- xpos := horizontalSpace
- ]
+ ].
+"
]
]
]
--- a/HScrBar.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HScrBar.st Sun Aug 07 15:23:42 1994 +0200
@@ -12,147 +12,88 @@
ScrollBar subclass:#HorizontalScrollBar
instanceVariableNames:''
- classVariableNames:'DefaultScrollRightForm
- DefaultScrollLeftForm'
+ classVariableNames:''
poolDictionaries:''
category:'Views-Interactors'
!
HorizontalScrollBar comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-this class implements horizontal scrollbars with scroller and
-2 step-scroll buttons. when moved or stepped, it perform a
-predefined action.
-
-$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.5 1994-01-08 17:27:18 claus Exp $
-
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
'!
-!HorizontalScrollBar class methodsFor:'defaults'!
+!HorizontalScrollBar class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
-scrollLeftButtonForm:style
- DefaultScrollLeftForm isNil ifTrue:[
- DefaultScrollLeftForm := Form fromFile:(self classResources at:'SCROLL_LEFT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollLt_win.xbm']
- ifFalse:['ScrollLt.xbm']))
- resolution:100
- ].
- DefaultScrollLeftForm isNil ifTrue:[
- DefaultScrollLeftForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r10000000
- 2r00000100 2r10000000
- 2r00001000 2r11111110
- 2r00010000 2r00000010
- 2r00100000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r00100000 2r00000010
- 2r00010000 2r00000010
- 2r00001000 2r11111110
- 2r00000100 2r10000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollLeftForm
+ 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.
+"
!
-scrollRightButtonForm:style
- DefaultScrollRightForm isNil ifTrue:[
- DefaultScrollRightForm := Form fromFile:(self classResources at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollRt_win.xbm']
- ifFalse:['ScrollRt.xbm']))
- resolution:100
- ].
- DefaultScrollRightForm isNil ifTrue:[
- DefaultScrollRightForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000001 2r01000000
- 2r00000001 2r00100000
- 2r01111111 2r00010000
- 2r01000000 2r00001000
- 2r01000000 2r00000100
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000100
- 2r01000000 2r00001000
- 2r01111111 2r00010000
- 2r00000001 2r00100000
- 2r00000001 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollRightForm
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
+"
+!
+
+documentation
+"
+ this class implements horizontal scrollbars with scroller and
+ 2 step-scroll buttons. when moved or stepped, it perform a
+ predefined action.
+"
! !
!HorizontalScrollBar methodsFor:'initialization'!
-initialize
- |bwn sep h w leftForm rightForm c|
+createElements
+ button1 := ArrowButton leftIn:self.
+ button1 name:'LeftButton'.
+ button2 := ArrowButton rightIn:self.
+ button2 name:'RightButton'.
+ thumb := HorizontalScroller in:self.
+!
- super initialize.
-
+computeInitialExtent
"compute my extent from sub-components"
- leftForm := self class scrollLeftButtonForm:style.
- rightForm := self class scrollRightButtonForm:style.
- w := leftForm width + rightForm width
- + (1 "self defaultBorderWidth" * 2)
- + (HorizontalScroller defaultExtent x).
- h := (leftForm height) max:(rightForm height).
- self is3D ifTrue:[
- h := h + 4.
- w := w + 4
+
+ |w h leftForm rightForm|
+
+ "need fix - this is a kludge;
+ the if should not be needed ..."
+ style == #mswindows ifTrue:[
+ h := button1 height max:button2 height.
+ w := button1 width + button2 width + (Scroller defaultExtent x).
+ ] ifFalse:[
+ leftForm := ArrowButton leftArrowButtonForm:style on:device.
+ rightForm := ArrowButton rightArrowButtonForm:style on:device.
+ w := leftForm width + rightForm width + (1 * 2) + (HorizontalScroller defaultExtent x).
+ h := (leftForm height) max:(rightForm height).
+ (style ~~ #normal) ifTrue:[
+ h := h + 4.
+ w := w + 4
+ ].
].
self extent:w @ h.
+!
+
+setElementPositions
+ "position sub-components"
+
+ |bwn sep|
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
-
- "poor design - destroy and re-create thumgs"
- button1 destroy.
- button2 destroy.
- thumb destroy.
-
- button1 := ArrowButton leftIn:self.
- button1 name:'LeftButton'.
- button1 borderWidth:borderWidth.
- button1 autoRepeat.
-
- thumb := HorizontalScroller in:self.
- style ~~ #next ifTrue:[
- thumb borderWidth:borderWidth.
- ].
-
- button2 := ArrowButton rightIn:self.
- button2 name:'RightButton'.
- button2 borderWidth:borderWidth.
- button2 autoRepeat.
-
- ((style == #iris) and:[Display hasGreyscales])ifTrue:[
- "have to change some of Buttons defaults"
- c := (Color grey:25) on:device.
- button1 offLevel:2.
- button2 offLevel:2.
- button1 foregroundColor:c.
- button1 activeForegroundColor:c.
- button1 enteredForegroundColor:c.
- button2 foregroundColor:c.
- button2 activeForegroundColor:c.
- button2 enteredForegroundColor:c.
- ].
+ sep := self spaceBetweenElements.
(layout == #bottom) ifTrue:[
"buttons at left"
@@ -161,30 +102,40 @@
button2 origin:(button1 width @ bwn).
button2 viewGravity:#West.
thumb origin:((button1 width + borderWidth + button2 width + sep + sep) @ bwn).
+ thumb viewGravity:#West.
+ ^ self
+ ].
+
+ (layout == #top) ifTrue:[
+ "buttons at right"
+ button1 viewGravity:#West.
+ button2 viewGravity:#West.
+ thumb origin:(bwn @ bwn).
thumb viewGravity:#West
- ] ifFalse:[
- (layout == #top) ifTrue:[
- "buttons at right"
- button1 viewGravity:#West.
- button2 viewGravity:#West.
- thumb origin:(bwn @ bwn).
- thumb viewGravity:#West
- ] ifFalse:[
- button1 origin:(bwn @ bwn).
- button1 viewGravity:#West.
- button2 viewGravity:#West.
- thumb origin:((button1 width + sep) @ bwn).
- thumb viewGravity:#West
- ]
- ]
+ ].
+
+ "layout == #around "
+ button1 origin:(bwn @ bwn).
+ button1 viewGravity:#West.
+ button2 viewGravity:#West.
+ thumb origin:((button1 width + sep) @ bwn).
+ thumb viewGravity:#West
! !
!HorizontalScrollBar methodsFor:'accessing'!
+scrollLeftAction
+ ^ button1 action
+!
+
scrollLeftAction:aBlock
button1 action:aBlock
!
+scrollRightAction
+ ^ button2 action
+!
+
scrollRightAction:aBlock
button2 action:aBlock
! !
@@ -203,11 +154,7 @@
rightWidth := button2 width + borderWidth.
leftAndRightWidth := leftWidth + rightWidth.
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
+ sep := self spaceBetweenElements.
thumbWidth := width - leftAndRightWidth - borderWidth - (sep * 3).
"
@@ -254,8 +201,8 @@
h := height - (margin * 2).
(h ~~ button1 height) ifTrue:[
- button1 height:height.
- button2 height:height
+ button1 height:h.
+ button2 height:h
].
thumbHeight := h.
@@ -265,6 +212,14 @@
].
+ "
+ a kludge: views with width or height of 0 are illegal
+ avoid error from view-creation (it will be hidden anyway)
+ "
+ thumbWidth <= 0 ifTrue:[
+ thumbWidth := 1
+ ].
+
(layout == #bottom) ifTrue:[
"buttons at left"
thumb extent:(thumbWidth @ thumbHeight).
@@ -274,6 +229,7 @@
sep2 := sep * 2.
(layout == #top) ifTrue:[
"buttons at right"
+ thumbWidth := thumbWidth + borderWidth.
(how == #smaller) ifTrue:[
thumb extent:(thumbWidth @ thumbHeight).
button1 origin:((thumbWidth + sep2) @ bwn).
@@ -288,7 +244,7 @@
"button around thumb"
button1 origin:(bwn @ bwn).
- button2 origin:((leftWidth + thumbWidth + sep2) @ bwn).
- thumb extent:((thumbWidth + margin) @ thumbHeight).
+ button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
+ thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
thumb origin:((leftWidth - borderWidth + sep) @ bwn)
! !
--- a/HScroller.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HScroller.st Sun Aug 07 15:23:42 1994 +0200
@@ -24,7 +24,7 @@
the scroller part of a horizontal scrollbar
-$Header: /cvs/stx/stx/libwidg/Attic/HScroller.st,v 1.4 1994-01-13 00:16:13 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HScroller.st,v 1.5 1994-08-07 13:22:36 claus Exp $
written spring/summer 89 by claus
'!
@@ -56,13 +56,18 @@
]
].
(realNewOrigin = thumbOrigin) ifFalse:[
- oldFrame := thumbFrame.
thumbOrigin := realNewOrigin.
- self computeThumbFrame.
- (thumbHeight = 100) ifTrue:[^ self].
shown ifTrue:[
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (thumbHeight = 100) ifTrue:[^ self].
+
(thumbFrame ~~ oldFrame) ifTrue:[
+ oldFrame isNil ifTrue:[
+ self drawThumb.
+ ^ self
+ ].
tH := thumbFrame height.
tW := thumbFrame width.
oldLeft := oldFrame left.
@@ -81,12 +86,11 @@
^ self
].
+ self catchExpose.
self copyFrom:self x:oldLeft y:top
toX:thumbLeft y:top
width:tW height:tH.
- self catchExpose.
-
oldLeft > thumbLeft ifTrue:[
delta := oldLeft - thumbLeft.
oldLeft > thumbRight ifTrue:[
@@ -112,58 +116,12 @@
]
!
-setThumbFor:aView
- "get contents and size info from aView and adjust thumb"
-
- |percentHeight percentOrigin totalWidth|
-
- aView isNil ifTrue:[
- totalWidth := 0
- ] ifFalse:[
- totalWidth := aView widthOfContents
- ].
- (totalWidth = 0) ifTrue:[
- percentHeight := 100.
- percentOrigin := 100
- ] ifFalse:[
- percentHeight := (aView innerWidth) * 100 // totalWidth.
- percentOrigin := (aView xOriginOfContents) * 100 // totalWidth
- ].
- (percentHeight = thumbHeight) ifTrue:[
- self thumbOrigin:percentOrigin
- ] ifFalse:[
- (percentOrigin = thumbOrigin) ifTrue:[
- self thumbHeight:percentHeight
- ] ifFalse:[
- self thumbOrigin:percentOrigin thumbHeight:percentHeight
- ]
- ]
+scrollLeftAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
!
-setThumbHeightFor:aView
- "get contents and size info from aView and adjust thumb height"
-
- |percent totalWidth|
-
- totalWidth := aView widthOfContents.
- (totalWidth = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- percent := (aView innerWidth) * 100 // totalWidth
- ].
- self thumbHeight:percent
-!
-
-setThumbOriginFor:aView
- "get contents and size info from aView and adjust thumb origin"
-
- |percent totalWidth|
-
- totalWidth := aView widthOfContents.
- (totalWidth = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- percent := (aView xOriginOfContents) * 100 // totalWidth
- ].
- self thumbOrigin:percent
+scrollRightAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
! !
--- a/HVScrView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HVScrView.st Sun Aug 07 15:23:42 1994 +0200
@@ -22,80 +22,113 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-a view containing both horizontal and vertical scrollbars
-and some other (slave-)view
-
-$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.5 1994-01-08 17:27:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.6 1994-08-07 13:22:38 claus Exp $
written jan 91 by claus
'!
+!HVScrollableView methodsFor:'documentation'!
+
+documentation
+"
+ a view containing both horizontal and vertical scrollbars
+ and some other (slave-)view
+"
+! !
+
!HVScrollableView methodsFor:'initialization'!
-initializeFor:aViewClass
- |negativeOffset halfMargin|
+initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV
+ |negativeOffset halfMargin orgX mrg halfSpacing is3D cls|
+
+"/ self initStyle.
- hScrollBar := HorizontalScrollBar in:self.
+ cls := miniH ifTrue:[HorizontalMiniScroller] ifFalse:[HorizontalScrollBar].
+ style == #st80 ifTrue:[cls := HorizontalScrollBar].
+
+ hScrollBar := cls in:self.
- super initializeFor:aViewClass.
+ super
+ initializeFor:aViewClass
+ miniScrollerH:miniH
+ miniScrollerV:miniV.
negativeOffset := borderWidth negated.
halfMargin := innerMargin // 2.
-
- "change vertical scrollbars size"
+ is3D := (style ~~ #normal) and:[style ~~ #mswindows].
- self is3D ifTrue:[
- scrollBar extent:[scrollBar width
- @
- (height - hScrollBar height - innerMargin)
- ]
+ "
+ change vertical scrollbars size
+ "
+ is3D ifTrue:[
+ mrg := innerMargin + innerMargin + hScrollBar borderWidth.
+ halfSpacing := ViewSpacing // 2.
] ifFalse:[
-"
- aViewClass isNil ifTrue:[
-"
- scrollBar extent:[scrollBar width
- @
- (height - hScrollBar height
- - (1 * hScrollBar borderWidth))
- ]
-"
- ] ifFalse:[
- scrollBar extent:[scrollBar width
- @
- (height - hScrollBar height
- - hScrollBar borderWidth
- - scrolledView borderWidth)
- ]
- ]
-"
+ mrg := hScrollBar borderWidth
].
+ scrollBar extent:[scrollBar width @ (height - hScrollBar height - mrg)].
hScrollBar thumbOrigin:0 thumbHeight:100.
- self is3D ifTrue:[
- hScrollBar origin:[(scrollBar origin x + scrollBar width + innerMargin)
+
+ scrollBarPosition == #left ifTrue:[
+ orgX := scrollBar origin x + scrollBar width.
+ is3D ifTrue:[
+ orgX := orgX + halfSpacing + 1.
+ style == #st80 ifTrue:[
+ orgX := orgX - (scrolledView margin)
+ ]
+ ]
+ ] ifFalse:[
+ orgX := 0 - hScrollBar borderWidth
+ ].
+ is3D ifTrue:[
+ hScrollBar origin:[(orgX + innerMargin - halfSpacing - hScrollBar margin)
@
(height - hScrollBar height - halfMargin)
]
- extent:[(width - scrollBar width - (innerMargin * 2))
+ extent:[(width -
+ scrollBar width -
+ (innerMargin * 2))
@
hScrollBar height
]
] ifFalse:[
- hScrollBar origin:[(scrollBar origin x + scrollBar width + scrollBar borderWidth)
- @
- (height - hScrollBar height - (hScrollBar borderWidth "* 2"))
- ]
- extent:[(width - scrollBar width) @ hScrollBar height
- ]
+ scrollBarPosition == #left ifTrue:[
+ hScrollBar
+ origin:[(orgX + scrollBar borderWidth)
+ @
+ (height - hScrollBar height - (hScrollBar borderWidth "* 2"))
+ ]
+ extent:[(width -
+ scrollBar width "- (2 * hScrollBar borderWidth)")
+ @
+ hScrollBar height
+ ]
+ ] ifFalse:[
+ hScrollBar
+ origin:[(orgX)
+ @
+ (height - hScrollBar height - (hScrollBar borderWidth "* 2"))
+ ]
+ extent:[(width - scrollBar width - hScrollBar borderWidth)
+ @
+ hScrollBar height
+ ]
+ ]
].
- "redefine subviews size"
- self is3D ifTrue:[
- helpView extent:[(width - scrollBar width - (innerMargin * 2))
- @
- (height - hScrollBar height - (innerMargin * 2))
+ scrolledView notNil ifTrue:[
+ "redefine subviews size"
+ is3D ifTrue:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - (innerMargin * 2))
+ @
+ (height
+ - hScrollBar height
+ - (innerMargin * 2))
]
- ] ifFalse:[
- scrolledView notNil ifTrue:[
+ ] ifFalse:[
scrolledView
extent:[(width
- scrollBar width
@@ -108,16 +141,16 @@
"- scrolledView borderWidth")
]
].
+ self setScrollActions
].
-
- scrolledView notNil ifTrue:[
- self setScrollActions
- ]
+ self viewGravity:#south
!
realize
super realize.
- hScrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ hScrollBar setThumbFor:scrolledView
+ ]
! !
!HVScrollableView methodsFor:'private'!
@@ -164,12 +197,26 @@
!
scrolledView:aView
+ |is3D|
+
"set the scrolled view"
super scrolledView:aView.
+ is3D := (style ~~ #normal) and:[style ~~ #mswindows].
+
"redefine subviews size"
- self is3D ifFalse:[
+ is3D ifTrue:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - (innerMargin * 2))
+ @
+ (height
+ - hScrollBar height
+ - (innerMargin * 2))
+ ]
+ ] ifFalse:[
scrolledView
extent:[(width
- scrollBar width
@@ -182,7 +229,6 @@
"- scrolledView borderWidth")
]
].
-
self setScrollActions
! !
@@ -190,5 +236,7 @@
sizeChanged:how
super sizeChanged:how.
- hScrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ hScrollBar setThumbFor:scrolledView
+ ]
! !
--- a/HVScrollableView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HVScrollableView.st Sun Aug 07 15:23:42 1994 +0200
@@ -22,80 +22,113 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-a view containing both horizontal and vertical scrollbars
-and some other (slave-)view
-
-$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.5 1994-01-08 17:27:21 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.6 1994-08-07 13:22:38 claus Exp $
written jan 91 by claus
'!
+!HVScrollableView methodsFor:'documentation'!
+
+documentation
+"
+ a view containing both horizontal and vertical scrollbars
+ and some other (slave-)view
+"
+! !
+
!HVScrollableView methodsFor:'initialization'!
-initializeFor:aViewClass
- |negativeOffset halfMargin|
+initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV
+ |negativeOffset halfMargin orgX mrg halfSpacing is3D cls|
+
+"/ self initStyle.
- hScrollBar := HorizontalScrollBar in:self.
+ cls := miniH ifTrue:[HorizontalMiniScroller] ifFalse:[HorizontalScrollBar].
+ style == #st80 ifTrue:[cls := HorizontalScrollBar].
+
+ hScrollBar := cls in:self.
- super initializeFor:aViewClass.
+ super
+ initializeFor:aViewClass
+ miniScrollerH:miniH
+ miniScrollerV:miniV.
negativeOffset := borderWidth negated.
halfMargin := innerMargin // 2.
-
- "change vertical scrollbars size"
+ is3D := (style ~~ #normal) and:[style ~~ #mswindows].
- self is3D ifTrue:[
- scrollBar extent:[scrollBar width
- @
- (height - hScrollBar height - innerMargin)
- ]
+ "
+ change vertical scrollbars size
+ "
+ is3D ifTrue:[
+ mrg := innerMargin + innerMargin + hScrollBar borderWidth.
+ halfSpacing := ViewSpacing // 2.
] ifFalse:[
-"
- aViewClass isNil ifTrue:[
-"
- scrollBar extent:[scrollBar width
- @
- (height - hScrollBar height
- - (1 * hScrollBar borderWidth))
- ]
-"
- ] ifFalse:[
- scrollBar extent:[scrollBar width
- @
- (height - hScrollBar height
- - hScrollBar borderWidth
- - scrolledView borderWidth)
- ]
- ]
-"
+ mrg := hScrollBar borderWidth
].
+ scrollBar extent:[scrollBar width @ (height - hScrollBar height - mrg)].
hScrollBar thumbOrigin:0 thumbHeight:100.
- self is3D ifTrue:[
- hScrollBar origin:[(scrollBar origin x + scrollBar width + innerMargin)
+
+ scrollBarPosition == #left ifTrue:[
+ orgX := scrollBar origin x + scrollBar width.
+ is3D ifTrue:[
+ orgX := orgX + halfSpacing + 1.
+ style == #st80 ifTrue:[
+ orgX := orgX - (scrolledView margin)
+ ]
+ ]
+ ] ifFalse:[
+ orgX := 0 - hScrollBar borderWidth
+ ].
+ is3D ifTrue:[
+ hScrollBar origin:[(orgX + innerMargin - halfSpacing - hScrollBar margin)
@
(height - hScrollBar height - halfMargin)
]
- extent:[(width - scrollBar width - (innerMargin * 2))
+ extent:[(width -
+ scrollBar width -
+ (innerMargin * 2))
@
hScrollBar height
]
] ifFalse:[
- hScrollBar origin:[(scrollBar origin x + scrollBar width + scrollBar borderWidth)
- @
- (height - hScrollBar height - (hScrollBar borderWidth "* 2"))
- ]
- extent:[(width - scrollBar width) @ hScrollBar height
- ]
+ scrollBarPosition == #left ifTrue:[
+ hScrollBar
+ origin:[(orgX + scrollBar borderWidth)
+ @
+ (height - hScrollBar height - (hScrollBar borderWidth "* 2"))
+ ]
+ extent:[(width -
+ scrollBar width "- (2 * hScrollBar borderWidth)")
+ @
+ hScrollBar height
+ ]
+ ] ifFalse:[
+ hScrollBar
+ origin:[(orgX)
+ @
+ (height - hScrollBar height - (hScrollBar borderWidth "* 2"))
+ ]
+ extent:[(width - scrollBar width - hScrollBar borderWidth)
+ @
+ hScrollBar height
+ ]
+ ]
].
- "redefine subviews size"
- self is3D ifTrue:[
- helpView extent:[(width - scrollBar width - (innerMargin * 2))
- @
- (height - hScrollBar height - (innerMargin * 2))
+ scrolledView notNil ifTrue:[
+ "redefine subviews size"
+ is3D ifTrue:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - (innerMargin * 2))
+ @
+ (height
+ - hScrollBar height
+ - (innerMargin * 2))
]
- ] ifFalse:[
- scrolledView notNil ifTrue:[
+ ] ifFalse:[
scrolledView
extent:[(width
- scrollBar width
@@ -108,16 +141,16 @@
"- scrolledView borderWidth")
]
].
+ self setScrollActions
].
-
- scrolledView notNil ifTrue:[
- self setScrollActions
- ]
+ self viewGravity:#south
!
realize
super realize.
- hScrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ hScrollBar setThumbFor:scrolledView
+ ]
! !
!HVScrollableView methodsFor:'private'!
@@ -164,12 +197,26 @@
!
scrolledView:aView
+ |is3D|
+
"set the scrolled view"
super scrolledView:aView.
+ is3D := (style ~~ #normal) and:[style ~~ #mswindows].
+
"redefine subviews size"
- self is3D ifFalse:[
+ is3D ifTrue:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - (innerMargin * 2))
+ @
+ (height
+ - hScrollBar height
+ - (innerMargin * 2))
+ ]
+ ] ifFalse:[
scrolledView
extent:[(width
- scrollBar width
@@ -182,7 +229,6 @@
"- scrolledView borderWidth")
]
].
-
self setScrollActions
! !
@@ -190,5 +236,7 @@
sizeChanged:how
super sizeChanged:how.
- hScrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ hScrollBar setThumbFor:scrolledView
+ ]
! !
--- a/HorizontalPanelView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HorizontalPanelView.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,17 +18,99 @@
!
HorizontalPanelView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-a View for childViews oriented horizontal
-all real work is done in PanelView - just redefine layout
+$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.4 1994-08-07 13:22:03 claus Exp $
+'!
+
+!HorizontalPanelView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/HorizontalPanelView.st,v 1.4 1994-08-07 13:22:03 claus Exp $
+"
+!
+
+documentation
+"
+ a View which arranges its child-views in a horizontal row.
+ All real work is done in PanelView - only the layout computation is
+ redefined here.
+
+ example: default layout (centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
-$Header: /cvs/stx/stx/libwidg/HorizontalPanelView.st,v 1.3 1993-10-13 02:47:53 claus Exp $
+ example: left-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p layout:#left.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: right-layout
+
+ |v p b1 b2 b3|
-written spring/summer 89 by claus
-'!
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p layout:#right.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+
+
+ example: spread-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := HorizontalPanelView in:v.
+ p layout:#spread.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:300 @ 100.
+ v open
+"
+! !
!HorizontalPanelView methodsFor:'queries'!
@@ -63,7 +145,7 @@
"(re)compute position of every child whenever childs are added or
my size has changed"
- |xpos ypos space sumOfChildWidths numChilds l|
+ |xpos ypos space sumOfWidths numChilds l|
subViews isNil ifTrue:[^ self].
@@ -71,11 +153,8 @@
"compute net width needed"
- sumOfChildWidths := 0.
+ sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
numChilds := subViews size.
- subViews do:[:child |
- sumOfChildWidths := sumOfChildWidths + child widthIncludingBorder.
- ].
l := layout.
((l == #center) and:[numChilds == 1]) ifTrue:[
@@ -85,33 +164,46 @@
"compute position of leftmost subview and space between them;
if they do hardly fit, leave no space between them "
- (sumOfChildWidths >= width) ifTrue:[
+ (sumOfWidths >= (width - (margin * 2))) ifTrue:[
xpos := 0.
space := 0
] ifFalse: [
(l == #right) ifTrue:[
- xpos := width - (horizontalSpace * numChilds)
- - sumOfChildWidths.
+ xpos := width - (space * numChilds) - sumOfWidths.
+"
borderWidth == 0 ifTrue:[
- xpos := xpos + horizontalSpace
+ xpos := xpos + space
].
+"
+ xpos < 0 ifTrue:[
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ xpos := width - (space * numChilds) - sumOfWidths.
+ ]
] ifFalse:[
(l == #spread) ifTrue:[
- space := (width - sumOfChildWidths) // (numChilds + 1).
+ space := (width - sumOfWidths) // (numChilds + 1).
xpos := space.
(space == 0) ifTrue:[
- xpos := (width - sumOfChildWidths) // 2
+ xpos := (width - sumOfWidths) // 2
]
] ifFalse:[
(l == #center) ifTrue:[
- xpos := (width - (sumOfChildWidths
- + ((numChilds - 1) * space))) // 2
+ xpos := (width - (sumOfWidths
+ + ((numChilds - 1) * space))) // 2.
+ xpos < 0 ifTrue:[
+ space := (width - sumOfWidths) // (numChilds + 1).
+ xpos := (width - (sumOfWidths
+ + ((numChilds - 1) * space))) // 2.
+ ]
] ifFalse:[
+ "left"
+ space := space min:(width - sumOfWidths) // (numChilds + 1).
+ xpos := space.
+"
borderWidth == 0 ifTrue:[
xpos := 0
- ] ifFalse:[
- xpos := horizontalSpace
- ]
+ ].
+"
]
]
]
--- a/HorizontalScrollBar.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HorizontalScrollBar.st Sun Aug 07 15:23:42 1994 +0200
@@ -12,147 +12,88 @@
ScrollBar subclass:#HorizontalScrollBar
instanceVariableNames:''
- classVariableNames:'DefaultScrollRightForm
- DefaultScrollLeftForm'
+ classVariableNames:''
poolDictionaries:''
category:'Views-Interactors'
!
HorizontalScrollBar comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-this class implements horizontal scrollbars with scroller and
-2 step-scroll buttons. when moved or stepped, it perform a
-predefined action.
-
-$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.5 1994-01-08 17:27:18 claus Exp $
-
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
'!
-!HorizontalScrollBar class methodsFor:'defaults'!
+!HorizontalScrollBar class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
-scrollLeftButtonForm:style
- DefaultScrollLeftForm isNil ifTrue:[
- DefaultScrollLeftForm := Form fromFile:(self classResources at:'SCROLL_LEFT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollLt_win.xbm']
- ifFalse:['ScrollLt.xbm']))
- resolution:100
- ].
- DefaultScrollLeftForm isNil ifTrue:[
- DefaultScrollLeftForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r10000000
- 2r00000100 2r10000000
- 2r00001000 2r11111110
- 2r00010000 2r00000010
- 2r00100000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r00100000 2r00000010
- 2r00010000 2r00000010
- 2r00001000 2r11111110
- 2r00000100 2r10000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollLeftForm
+ 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.
+"
!
-scrollRightButtonForm:style
- DefaultScrollRightForm isNil ifTrue:[
- DefaultScrollRightForm := Form fromFile:(self classResources at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollRt_win.xbm']
- ifFalse:['ScrollRt.xbm']))
- resolution:100
- ].
- DefaultScrollRightForm isNil ifTrue:[
- DefaultScrollRightForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000001 2r01000000
- 2r00000001 2r00100000
- 2r01111111 2r00010000
- 2r01000000 2r00001000
- 2r01000000 2r00000100
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000100
- 2r01000000 2r00001000
- 2r01111111 2r00010000
- 2r00000001 2r00100000
- 2r00000001 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollRightForm
+version
+"
+$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
+"
+!
+
+documentation
+"
+ this class implements horizontal scrollbars with scroller and
+ 2 step-scroll buttons. when moved or stepped, it perform a
+ predefined action.
+"
! !
!HorizontalScrollBar methodsFor:'initialization'!
-initialize
- |bwn sep h w leftForm rightForm c|
+createElements
+ button1 := ArrowButton leftIn:self.
+ button1 name:'LeftButton'.
+ button2 := ArrowButton rightIn:self.
+ button2 name:'RightButton'.
+ thumb := HorizontalScroller in:self.
+!
- super initialize.
-
+computeInitialExtent
"compute my extent from sub-components"
- leftForm := self class scrollLeftButtonForm:style.
- rightForm := self class scrollRightButtonForm:style.
- w := leftForm width + rightForm width
- + (1 "self defaultBorderWidth" * 2)
- + (HorizontalScroller defaultExtent x).
- h := (leftForm height) max:(rightForm height).
- self is3D ifTrue:[
- h := h + 4.
- w := w + 4
+
+ |w h leftForm rightForm|
+
+ "need fix - this is a kludge;
+ the if should not be needed ..."
+ style == #mswindows ifTrue:[
+ h := button1 height max:button2 height.
+ w := button1 width + button2 width + (Scroller defaultExtent x).
+ ] ifFalse:[
+ leftForm := ArrowButton leftArrowButtonForm:style on:device.
+ rightForm := ArrowButton rightArrowButtonForm:style on:device.
+ w := leftForm width + rightForm width + (1 * 2) + (HorizontalScroller defaultExtent x).
+ h := (leftForm height) max:(rightForm height).
+ (style ~~ #normal) ifTrue:[
+ h := h + 4.
+ w := w + 4
+ ].
].
self extent:w @ h.
+!
+
+setElementPositions
+ "position sub-components"
+
+ |bwn sep|
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
-
- "poor design - destroy and re-create thumgs"
- button1 destroy.
- button2 destroy.
- thumb destroy.
-
- button1 := ArrowButton leftIn:self.
- button1 name:'LeftButton'.
- button1 borderWidth:borderWidth.
- button1 autoRepeat.
-
- thumb := HorizontalScroller in:self.
- style ~~ #next ifTrue:[
- thumb borderWidth:borderWidth.
- ].
-
- button2 := ArrowButton rightIn:self.
- button2 name:'RightButton'.
- button2 borderWidth:borderWidth.
- button2 autoRepeat.
-
- ((style == #iris) and:[Display hasGreyscales])ifTrue:[
- "have to change some of Buttons defaults"
- c := (Color grey:25) on:device.
- button1 offLevel:2.
- button2 offLevel:2.
- button1 foregroundColor:c.
- button1 activeForegroundColor:c.
- button1 enteredForegroundColor:c.
- button2 foregroundColor:c.
- button2 activeForegroundColor:c.
- button2 enteredForegroundColor:c.
- ].
+ sep := self spaceBetweenElements.
(layout == #bottom) ifTrue:[
"buttons at left"
@@ -161,30 +102,40 @@
button2 origin:(button1 width @ bwn).
button2 viewGravity:#West.
thumb origin:((button1 width + borderWidth + button2 width + sep + sep) @ bwn).
+ thumb viewGravity:#West.
+ ^ self
+ ].
+
+ (layout == #top) ifTrue:[
+ "buttons at right"
+ button1 viewGravity:#West.
+ button2 viewGravity:#West.
+ thumb origin:(bwn @ bwn).
thumb viewGravity:#West
- ] ifFalse:[
- (layout == #top) ifTrue:[
- "buttons at right"
- button1 viewGravity:#West.
- button2 viewGravity:#West.
- thumb origin:(bwn @ bwn).
- thumb viewGravity:#West
- ] ifFalse:[
- button1 origin:(bwn @ bwn).
- button1 viewGravity:#West.
- button2 viewGravity:#West.
- thumb origin:((button1 width + sep) @ bwn).
- thumb viewGravity:#West
- ]
- ]
+ ].
+
+ "layout == #around "
+ button1 origin:(bwn @ bwn).
+ button1 viewGravity:#West.
+ button2 viewGravity:#West.
+ thumb origin:((button1 width + sep) @ bwn).
+ thumb viewGravity:#West
! !
!HorizontalScrollBar methodsFor:'accessing'!
+scrollLeftAction
+ ^ button1 action
+!
+
scrollLeftAction:aBlock
button1 action:aBlock
!
+scrollRightAction
+ ^ button2 action
+!
+
scrollRightAction:aBlock
button2 action:aBlock
! !
@@ -203,11 +154,7 @@
rightWidth := button2 width + borderWidth.
leftAndRightWidth := leftWidth + rightWidth.
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
+ sep := self spaceBetweenElements.
thumbWidth := width - leftAndRightWidth - borderWidth - (sep * 3).
"
@@ -254,8 +201,8 @@
h := height - (margin * 2).
(h ~~ button1 height) ifTrue:[
- button1 height:height.
- button2 height:height
+ button1 height:h.
+ button2 height:h
].
thumbHeight := h.
@@ -265,6 +212,14 @@
].
+ "
+ a kludge: views with width or height of 0 are illegal
+ avoid error from view-creation (it will be hidden anyway)
+ "
+ thumbWidth <= 0 ifTrue:[
+ thumbWidth := 1
+ ].
+
(layout == #bottom) ifTrue:[
"buttons at left"
thumb extent:(thumbWidth @ thumbHeight).
@@ -274,6 +229,7 @@
sep2 := sep * 2.
(layout == #top) ifTrue:[
"buttons at right"
+ thumbWidth := thumbWidth + borderWidth.
(how == #smaller) ifTrue:[
thumb extent:(thumbWidth @ thumbHeight).
button1 origin:((thumbWidth + sep2) @ bwn).
@@ -288,7 +244,7 @@
"button around thumb"
button1 origin:(bwn @ bwn).
- button2 origin:((leftWidth + thumbWidth + sep2) @ bwn).
- thumb extent:((thumbWidth + margin) @ thumbHeight).
+ button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
+ thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
thumb origin:((leftWidth - borderWidth + sep) @ bwn)
! !
--- a/HorizontalScroller.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HorizontalScroller.st Sun Aug 07 15:23:42 1994 +0200
@@ -24,7 +24,7 @@
the scroller part of a horizontal scrollbar
-$Header: /cvs/stx/stx/libwidg/HorizontalScroller.st,v 1.4 1994-01-13 00:16:13 claus Exp $
+$Header: /cvs/stx/stx/libwidg/HorizontalScroller.st,v 1.5 1994-08-07 13:22:36 claus Exp $
written spring/summer 89 by claus
'!
@@ -56,13 +56,18 @@
]
].
(realNewOrigin = thumbOrigin) ifFalse:[
- oldFrame := thumbFrame.
thumbOrigin := realNewOrigin.
- self computeThumbFrame.
- (thumbHeight = 100) ifTrue:[^ self].
shown ifTrue:[
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (thumbHeight = 100) ifTrue:[^ self].
+
(thumbFrame ~~ oldFrame) ifTrue:[
+ oldFrame isNil ifTrue:[
+ self drawThumb.
+ ^ self
+ ].
tH := thumbFrame height.
tW := thumbFrame width.
oldLeft := oldFrame left.
@@ -81,12 +86,11 @@
^ self
].
+ self catchExpose.
self copyFrom:self x:oldLeft y:top
toX:thumbLeft y:top
width:tW height:tH.
- self catchExpose.
-
oldLeft > thumbLeft ifTrue:[
delta := oldLeft - thumbLeft.
oldLeft > thumbRight ifTrue:[
@@ -112,58 +116,12 @@
]
!
-setThumbFor:aView
- "get contents and size info from aView and adjust thumb"
-
- |percentHeight percentOrigin totalWidth|
-
- aView isNil ifTrue:[
- totalWidth := 0
- ] ifFalse:[
- totalWidth := aView widthOfContents
- ].
- (totalWidth = 0) ifTrue:[
- percentHeight := 100.
- percentOrigin := 100
- ] ifFalse:[
- percentHeight := (aView innerWidth) * 100 // totalWidth.
- percentOrigin := (aView xOriginOfContents) * 100 // totalWidth
- ].
- (percentHeight = thumbHeight) ifTrue:[
- self thumbOrigin:percentOrigin
- ] ifFalse:[
- (percentOrigin = thumbOrigin) ifTrue:[
- self thumbHeight:percentHeight
- ] ifFalse:[
- self thumbOrigin:percentOrigin thumbHeight:percentHeight
- ]
- ]
+scrollLeftAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
!
-setThumbHeightFor:aView
- "get contents and size info from aView and adjust thumb height"
-
- |percent totalWidth|
-
- totalWidth := aView widthOfContents.
- (totalWidth = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- percent := (aView innerWidth) * 100 // totalWidth
- ].
- self thumbHeight:percent
-!
-
-setThumbOriginFor:aView
- "get contents and size info from aView and adjust thumb origin"
-
- |percent totalWidth|
-
- totalWidth := aView widthOfContents.
- (totalWidth = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- percent := (aView xOriginOfContents) * 100 // totalWidth
- ].
- self thumbOrigin:percent
+scrollRightAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
! !
--- a/InfoBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/InfoBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -11,11 +11,11 @@
"
ModalBox subclass:#InfoBox
- instanceVariableNames:'formLabel textLabel okButton okAction
+ instanceVariableNames:'formLabel textLabel buttonPanel okButton okAction
acceptReturnAsOK'
classVariableNames:'InfoBitmap'
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
InfoBox comment:'
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/InfoBox.st,v 1.5 1993-12-13 17:06:07 claus Exp $
+$Header: /cvs/stx/stx/libwidg/InfoBox.st,v 1.6 1994-08-07 13:22:40 claus Exp $
written Spring/Summer 89 by claus
'!
@@ -31,10 +31,85 @@
documentation
"
-this class implements a pop-up box to show an information message.
-It has a single ok-Button, which closes the box.
-Also entering return has (by default) the same effect as pressing
-the ok-button.
+ this class implements a pop-up box to show an information message.
+ It has a single ok-Button, which closes the box.
+ Also entering return has (by default) the same effect as pressing
+ the ok-button.
+ InfoBox is a superclass of some other boxes - see WaringBox, YesNoBox etc.
+
+ They are created with:
+
+ aBox := InfoBox title:'some title'.
+
+ and shown with:
+
+ aBox showAtPointer
+
+ The default box shows 'yes' in its button; this can be changed with:
+
+ aBox okText:'some string'.
+
+ the boxes bitmap-image can be changed with:
+
+ aBox form:aForm
+
+ (the name 'form:' is historical - any bitmap or image is allowed).
+
+
+ Examples:
+
+ |aBox|
+ aBox := InfoBox title:'a simple Info'.
+ aBox showAtPointer.
+
+ |aBox|
+ aBox := InfoBox title:'a simple Info'.
+ aBox showAt:0@0.
+
+ |aBox|
+ aBox := InfoBox title:'a simple Info'.
+ aBox acceptReturnAsOK:false.
+ aBox showAtPointer.
+
+ |aBox|
+ aBox := InfoBox title:'Press ''YES'' to continue\(or type return)' withCRs.
+ aBox okText:'YES'.
+ aBox showAtPointer.
+
+ |aBox|
+ aBox := InfoBox title:'another one'.
+ aBox form:(Form fromFile:'SBrowser.xbm').
+ aBox showAtPointer
+
+ |aBox|
+ aBox := InfoBox title:'a nice one'.
+ aBox form:(Image fromFile:'bitmaps/garfield.gif').
+ aBox showAtPointer
+
+ |aBox|
+ aBox := InfoBox title:'a nice one'.
+ aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
+ aBox showAtPointer
+
+ |aBox|
+ aBox := InfoBox title:'a nice one'.
+ aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
+ aBox formLabel level:-1.
+ aBox showAtPointer
+
+ |aBox|
+ aBox := InfoBox title:'a nice one'.
+ aBox form:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.3@0.3).
+ aBox formLabel borderWidth:2.
+ aBox formLabel borderColor:Color red.
+ aBox showAtPointer
+
+ |aBox|
+ aBox := InfoBox title:'start printing'.
+ aBox form:(Image fromFile:'bitmaps/ljet3.xpm').
+ aBox formLabel level:-2.
+ aBox okText:'print'.
+ aBox showAtPointer
"
! !
@@ -51,10 +126,6 @@
initialize
super initialize.
- InfoBitmap isNil ifTrue:[
- InfoBitmap := Form fromFile:'Information.xbm' resolution:100 on:device
- ].
-
acceptReturnAsOK := true.
formLabel := Label in:self.
@@ -64,18 +135,24 @@
textLabel := Label label:'Information' in:self.
textLabel borderWidth:0.
+"
textLabel origin:((ViewSpacing + formLabel width + ViewSpacing) @ ViewSpacing).
+"
+ textLabel origin:[(ViewSpacing + formLabel widthIncludingBorder + ViewSpacing) @ ViewSpacing].
- okButton := Button label:(resources at:'ok')
- action:[
- okButton turnOffWithoutRedraw.
- self okPressed
- ]
- in:self.
+ okButton := Button
+ label:(resources at:'ok')
+ action:[
+ okButton turnOffWithoutRedraw.
+ self okPressed
+ ]
+ in:self.
okButton isReturnButton:true.
- okButton origin:[(width // 4) @ (height - ViewSpacing - okButton height)]
- extent:[(width // 2) @ okButton height]
+ okButton origin:[((width - okButton width) // 2)
+ @
+ (height - ViewSpacing - okButton heightIncludingBorder" - okButton borderWidth")].
+
!
initFormBitmap
@@ -83,6 +160,10 @@
extracted into a separate method for easier redefinition
in subclasses"
+ InfoBitmap isNil ifTrue:[
+ InfoBitmap := Form fromFile:'Information.xbm' resolution:100 on:Display
+ ].
+
formLabel form:InfoBitmap
! !
@@ -115,6 +196,18 @@
self resize
!
+textLabel
+ "return the textLabel = can be used to change its appearance"
+
+ ^ textLabel
+!
+
+formLabel
+ "return the formLabel = can be used to change its appearance"
+
+ ^ formLabel
+!
+
title:aString
"set the boxes title string"
@@ -131,6 +224,12 @@
^ textLabel label
!
+okButton
+ "return the okButton"
+
+ ^ okButton
+!
+
okAction:aBlock
"define the action to be performed when ok is pressed"
@@ -142,6 +241,7 @@
aString ~= okButton label ifTrue:[
okButton label:aString.
+ okButton resize.
self resize
]
! !
@@ -155,11 +255,12 @@
|w h extra|
- w := ViewSpacing + formLabel width + ViewSpacing + textLabel width + ViewSpacing.
+ w := ViewSpacing + formLabel widthIncludingBorder + ViewSpacing + textLabel width + ViewSpacing.
+ w := w max:(okButton preferredExtent x + (ViewSpacing * 2)).
h := ViewSpacing
- + ((formLabel height) max:(textLabel height))
+ + ((formLabel heightIncludingBorder) max:(textLabel height))
+ ViewSpacing + ViewSpacing
- + okButton height
+ + okButton heightIncludingBorder
+ ViewSpacing.
extra := 0 "margin * 2".
--- a/LSelBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/LSelBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,20 +14,54 @@
instanceVariableNames:'selectionList'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
ListSelectionBox comment:'
-
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-this class implements boxes for selection from a list
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.5 1994-08-07 13:22:42 claus Exp $
+'!
+
+!ListSelectionBox class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1990 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.
+"
+!
-$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.4 1993-12-16 11:03:01 claus Exp $
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.5 1994-08-07 13:22:42 claus Exp $
+"
+!
-written Jan 90 by claus
-'!
+documentation
+"
+ this class implements boxes for selection from a list. It offers
+ both an ok- and abort-buttons. The ok-button, if pressed will
+ evaluate the okAction (see EnterBox>>action).
+ typical use is:
+
+ |box|
+
+ box := ListSelectionBox new.
+ box title:'select something:'.
+ box list:#('foo' 'bar' 'baz').
+ box okAction:[:sel | Transcript showCr:'the selection was:' , sel].
+ box showAtPointer
+"
+! !
!ListSelectionBox class methodsFor:'defaults'!
@@ -100,7 +134,15 @@
selectionList action:[:lineNr |
enterField contents:(selectionList selectionValue)
].
- selectionList keyboardHandler:enterField
+ selectionList doubleClickAction:[:lineNr |
+ enterField contents:(selectionList selectionValue).
+ self okPressed
+ ].
+ "
+ mhm: the lists keyboard functions are disabled,
+ and input passed to the enterfield
+ "
+ selectionList keyboardHandler:self
!
updateList
--- a/Label.st Sun Aug 07 15:22:53 1994 +0200
+++ b/Label.st Sun Aug 07 15:23:42 1994 +0200
@@ -22,56 +22,80 @@
!
Label comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.6 1994-01-16 04:02:06 claus Exp $
-
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.7 1994-08-07 13:22:44 claus Exp $
'!
!Label class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Label.st,v 1.7 1994-08-07 13:22:44 claus Exp $
+"
+!
+
documentation
"
-This class implements labels, which are views to display a string or image.
-The Label will try to do its best to make its contents fit into the
-view. The contents can be a String, a collection of Strings (i.e.
-Text) or a Form/Image. The contents is drawn in fgColor/bgColor,
-which can be changed using:
- aLabel foregroundColor:aColor
- aLabel backgroundColor:aColor
+ This class implements labels, which are views to display a string or image.
+ The Label will try to do its best to make its contents fit into the
+ view. The contents can be a String, a collection of Strings (i.e.
+ Text) or a Form/Image. The contents is drawn in fgColor/bgColor,
+ which can be changed using:
+ aLabel foregroundColor:aColor
+ aLabel backgroundColor:aColor
-When a label is assigned a contents, it will resize itself to fit
-the required size. This resizing can be suppressed by setting the
-fixsize attribute to true using:
- aLabel sizeFixed:true
+ When a label is assigned a contents, it will resize itself to fit
+ the required size. This resizing can be suppressed by setting the
+ fixsize attribute to true using:
+ aLabel sizeFixed:true
-This can be used, if resizing of the label is not wanted.
+ This can be used, if resizing of the label is not wanted.
+
+ The placement of the contents within the label is controlled by
+ the adjust attribute, it can be set with
+ aLabel adjust:how
+ , where how is one of the symbols left, #right, #center, #centerLeft or
+ #centerRight (see the comment in Label>>adjust:).
-The placement of the contents within the label is controlled by
-the adjust attribute, it can be set with
- aLabel adjust:how
-, where how is one of the symbols left, #right, #center, #centerLeft or
-#centerRight (see the comment in Label>>adjust:).
+ example:
+ l := Label in:aView.
+ l label:'hello world'.
-example:
- l := Label in:aView.
- l label:'hello world'.
+ Instance variables:
-Instance variables:
+ logo <Object> the logo, can be a Form, String or Text
+ labelWidth <Integer> the width of the logo in device units
+ labelHeight <Integer> the height of the logo in device units
+ labelOriginX <Integer> the x-position of the logo withing the Label
+ labelOriginY <Integer> the y-position of the logo withing the Label
+ adjust <Symbol> controls how the logo is positioned within the
+ label. Can be one of:#left,#right,#center,
+ #centerLeft or #centerRight (see comment in adjust:)
+ hSpace <Integer> number of horizontal pixels around logo
+ vSpace <Integer> number of vertical pixels around logo
- logo <Object> the logo, can be a Form, String or Text
- labelWidth <Integer> the width of the logo in device units
- labelHeight <Integer> the height of the logo in device units
- labelOriginX <Integer> the x-position of the logo withing the Label
- labelOriginY <Integer> the y-position of the logo withing the Label
- adjust <Symbol> controls how the logo is positioned within the
- label. Can be one of:#left,#right,#center,
- #centerLeft or #centerRight (see comment in adjust:)
- hSpace <Integer> number of horizontal pixels around logo
- vSpace <Integer> number of vertical pixels around logo
+ bgColor <Color> background color
+ fgColor <Color> foreground color
+
+ fixSize <Boolean> if true, a change of the logo change will not
+ resize the label; otherwise, its size is adjusted.
+ default:false.
"
! !
@@ -118,8 +142,13 @@
initStyle
super initStyle.
- fgColor := Black.
- bgColor := viewBackground.
+ ((style == #motif) and:[device hasGreyscales]) ifTrue:[
+ fgColor := White on:device.
+ bgColor := viewBackground.
+ ] ifFalse:[
+ fgColor := Black on:device.
+ bgColor := viewBackground.
+ ]
!
realize
@@ -180,6 +209,12 @@
fixSize := aBoolean
!
+sizeFixed
+ "return the fix-size attribute"
+
+ ^ fixSize
+!
+
label:aString
"set the label-string; adjust extent if not already realized"
@@ -241,6 +276,21 @@
]
! !
+!Label methodsFor:'queries'!
+
+preferredExtent
+ "return my preferred extent - this is the minimum size I would like to have"
+
+ |extra|
+
+ logo notNil ifTrue:[
+ extra := margin * 2.
+ ^ (labelWidth + extra) @ (labelHeight + extra)
+ ].
+
+ ^ super preferredExtent
+! !
+
!Label methodsFor:'private'!
newLayout
@@ -286,7 +336,7 @@
].
"must be a String or Text"
- (logo isKindOf:String) ifTrue:[
+ (logo isString) ifTrue:[
numberOfLines := 1 + (logo occurrencesOf:(Character cr)).
(numberOfLines ~~ 1) ifTrue:[
logo := logo asText
@@ -395,7 +445,7 @@
x := labelOriginX + hSpace.
y := labelOriginY + (font ascent) + vSpace.
- (logo isKindOf:String) ifTrue:[
+ (logo isString) ifTrue:[
self displayString:logo x:x y:y
] ifFalse:[
logo do:[ :line |
--- a/ListSelectionBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ListSelectionBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,20 +14,54 @@
instanceVariableNames:'selectionList'
classVariableNames:''
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
ListSelectionBox comment:'
-
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-this class implements boxes for selection from a list
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.5 1994-08-07 13:22:42 claus Exp $
+'!
+
+!ListSelectionBox class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1990 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.
+"
+!
-$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.4 1993-12-16 11:03:01 claus Exp $
+version
+"
+$Header: /cvs/stx/stx/libwidg/ListSelectionBox.st,v 1.5 1994-08-07 13:22:42 claus Exp $
+"
+!
-written Jan 90 by claus
-'!
+documentation
+"
+ this class implements boxes for selection from a list. It offers
+ both an ok- and abort-buttons. The ok-button, if pressed will
+ evaluate the okAction (see EnterBox>>action).
+ typical use is:
+
+ |box|
+
+ box := ListSelectionBox new.
+ box title:'select something:'.
+ box list:#('foo' 'bar' 'baz').
+ box okAction:[:sel | Transcript showCr:'the selection was:' , sel].
+ box showAtPointer
+"
+! !
!ListSelectionBox class methodsFor:'defaults'!
@@ -100,7 +134,15 @@
selectionList action:[:lineNr |
enterField contents:(selectionList selectionValue)
].
- selectionList keyboardHandler:enterField
+ selectionList doubleClickAction:[:lineNr |
+ enterField contents:(selectionList selectionValue).
+ self okPressed
+ ].
+ "
+ mhm: the lists keyboard functions are disabled,
+ and input passed to the enterfield
+ "
+ selectionList keyboardHandler:self
!
updateList
--- a/ListView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ListView.st Sun Aug 07 15:23:42 1994 +0200
@@ -24,63 +24,86 @@
fontIsFixedWidth fontWidth
normalFont boldFont italicFont
autoScrollBlock autoScrollDeltaT
- searchPattern'
+ searchPattern wordCheck'
classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
ListView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.7 1994-01-13 00:17:08 claus Exp $
-
-written spring 89 by claus
+$Header: /cvs/stx/stx/libwidg/ListView.st,v 1.8 1994-08-07 13:22:46 claus Exp $
'!
!ListView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/ListView.st,v 1.8 1994-08-07 13:22:46 claus Exp $
+"
+!
+
documentation
"
-a simple View for lists - the elements must understand printString
-the list is changed - the elements are replaced by their printStrings
-(if this leads to problems - I will change it later)
+ a View for (string-)lists.
+
+ This class can only passively display collections of strings-
+ selections, editing, cursors etc. must be done in subclasses.
+ see SelectionInListView, TextView etc.
+
+ This code currently handles only fixed-height fonts correctly -
+ should be rewritten in some places ...
-This class can only passively display -
-selections, editing, cursors etc. must be done in subclasses.
-see SelectionInListView, TextView etc.
+ It can only scroll by full lines vertically (i.e. setting firstLineShown to ~~ 1)
+ which should be changed to have this behavior optionally for smooth scroll.
+
+ This is being totally rewritten ... so dont depend on the internals.
+
-This code currently handles only fixed-height fonts correctly -
-should be rewritten in some places ...
+ Instance variables:
-Instance variables:
+ list <aCollection> the text strings
+ attributes <aCollection> corresponding attributes (if any)
+ firstLineShown <Number> the index of the 1st visible line (1 ..)
+ leftOffset <Number> left offset for horizontal scroll
-list <aCollection> the text strings
-attributes <aCollection> corresponding attributes
-firstLineShown <Number> the index of the 1st visible line (1 ..)
-leftOffset <Number> left offset for horizontal scroll
-nFullLinesShown <Number> the number of unclipped lines in visible
-nLinesShown <Number> the number of lines in visible
-fgColor <Color> color to draw characters
-bgColor <Color> the background
-partialLines <Boolean> allow last line to be partial displayed
-leftMargin <Number> margin at left in pixels
-topMargin <Number> margin at top in pixels
-textStartLeft <Number> margin + leftMargin
-textStartTop <Number> margin + topMargin
-innerWidth <Number> width - margins
-tabPositions <aCollection> tab stops (cols)
-fontHeight <Number> font height in pixels
-fontAscent <Number> font ascent in pixels
-fontIsFixed <Boolean> true if its a fixed font
-fontWidth <Number> width of space
-lineSpacing <Number> pixels between lines
-normalFont <Font> font for normal characters
-boldFont <Font> font for bold characters
-italicFont <Font> font for italic characters
-searchPattern <String> last pattern for searching
+ nFullLinesShown <Number> the number of unclipped lines in visible
+ nLinesShown <Number> the number of lines in visible
+ fgColor <Color> color to draw characters
+ bgColor <Color> the background
+ partialLines <Boolean> allow last line to be partial displayed
+ leftMargin <Number> margin at left in pixels
+ topMargin <Number> margin at top in pixels
+ textStartLeft <Number> margin + leftMargin
+ textStartTop <Number> margin + topMargin
+ innerWidth <Number> width - margins
+ tabPositions <aCollection> tab stops (cols)
+ fontHeight <Number> font height in pixels
+ fontAscent <Number> font ascent in pixels
+ fontIsFixed <Boolean> true if its a fixed font
+ fontWidth <Number> width of space
+ lineSpacing <Number> pixels between lines
+ normalFont <Font> font for normal characters
+ boldFont <Font> font for bold characters
+ italicFont <Font> font for italic characters
+ searchPattern <String> last pattern for searching
+ wordCheck <Block> rule used for check in word select
"
! !
@@ -102,31 +125,35 @@
!ListView methodsFor:'initialization'!
initialize
+ leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
+
super initialize.
bitGravity := #NorthWest.
list := nil.
firstLineShown := 1.
+ nFullLinesShown := 1. "just any value ..."
+ nLinesShown := 1. "just any value"
leftOffset := 0.
partialLines := true.
tabPositions := self class defaultTabPositions.
- leftMargin := (self horizontalPixelPerMillimeter:0.5) rounded.
topMargin := (self verticalPixelPerMillimeter:0.5) rounded.
textStartLeft := leftMargin + margin.
textStartTop := topMargin + margin.
- innerWidth := width - textStartLeft - margin.
- self getFontParameters
+ innerWidth := width - textStartLeft - (margin * 2).
+ self getFontParameters.
+ wordCheck := [:char | char isNationalAlphaNumeric]
!
initStyle
super initStyle.
- fgColor := Black.
- bgColor := White.
+
+ fgColor := resources at:'FOREGROUND_COLOR' default:Black.
+ bgColor := resources at:'BACKGROUND_COLOR' default:White.
lineSpacing := 0.
-!
-initEvents
- self enableKeyEvents
+ "Transcript class classResources at:'FOREGROUND_COLOR' put:Color red.
+ Transcript class classResources at:'BACKGROUND_COLOR' put:Color white"
!
create
@@ -160,28 +187,34 @@
backgroundColor:aColor
"set the background color"
- bgColor := aColor.
- shown ifTrue:[
- self redraw
+ bgColor ~~ aColor ifTrue:[
+ bgColor := aColor.
+ shown ifTrue:[
+ self redraw
+ ]
]
!
foregroundColor:aColor
"set the foreground color"
- fgColor := aColor.
- shown ifTrue:[
- self redraw
+ fgColor ~~ aColor ifTrue:[
+ fgColor := aColor.
+ shown ifTrue:[
+ self redraw
+ ]
]
!
foregroundColor:color1 backgroundColor:color2
"set both foreground and background colors"
- fgColor := color1.
- bgColor := color2.
- shown ifTrue:[
- self redraw
+ ((fgColor ~~ color1) or:[bgColor ~~ color2]) ifTrue:[
+ fgColor := color1.
+ bgColor := color2.
+ shown ifTrue:[
+ self redraw
+ ]
]
!
@@ -207,7 +240,10 @@
!
setList:aCollection
- "set the contents (a collection of strings) keep position unchanged"
+ "set the contents (a collection of strings);
+ dont change position (i.e. do not scroll).
+ This can be used to update a self-changing list
+ (for example: a file list being shown, without disturbing user too much)"
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
@@ -225,13 +261,14 @@
!
list:aCollection
- "set the contents (a collection of strings) and scroll to top"
+ "set the contents (a collection of strings) and scroll to top-left"
- |oldFirst|
+ |oldFirst oldLeft|
(aCollection isNil and:[list isNil]) ifTrue:[
"no change"
self scrollToTop.
+ self scrollToLeft.
^ self
].
list := aCollection.
@@ -239,13 +276,19 @@
list notNil ifTrue:[
self expandTabs
].
- self contentsChanged.
- "dont use scroll here to avoid the redraw"
oldFirst := firstLineShown.
+ oldLeft := leftOffset.
firstLineShown := 1.
- self originChanged:(oldFirst - 1) negated.
- shown ifTrue:[
- self redrawFromVisibleLine:1 to:nLinesShown
+ leftOffset := 0.
+ realized ifTrue:[
+ self contentsChanged.
+ "
+ dont use scroll here to avoid the redraw
+ "
+ self originChanged:(oldFirst - 1) negated.
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
]
!
@@ -257,7 +300,9 @@
setContents:something
"set the contents (either a string or a Collection of strings)
- dont change position"
+ dont change position (i.e. do not scroll).
+ This can be used to update a self-changing list
+ (for example: a file list being shown, without disturbing user too much)."
something isNil ifTrue:[
self setList:nil
@@ -268,7 +313,7 @@
contents:something
"set the contents (either a string or a Collection of strings)
- also scroll to top"
+ also scroll to top-left"
something isNil ifTrue:[
self list:nil
@@ -306,6 +351,8 @@
(list isNil or:[lineNr > list size]) ifTrue:[^ false].
list removeIndex:lineNr.
+ (attributes notNil and:[lineNr <= attributes size]) ifTrue:[attributes removeIndex:lineNr].
+
lineNr < firstLineShown ifTrue:[
firstLineShown := firstLineShown - 1
].
@@ -319,11 +366,13 @@
|visLine w
srcY "{ Class: SmallInteger }" |
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
(self removeIndexWithoutRedraw:lineNr) ifFalse:[^ self].
+ "
+ is there a need to redraw ?
+ "
visLine := self listLineToVisibleLine:lineNr.
visLine notNil ifTrue:[
+ w := self widthForScrollBetween:lineNr and:(firstLineShown + nLinesShown).
srcY := topMargin + (visLine * fontHeight).
self catchExpose.
self copyFrom:self x:textStartLeft y:srcY
@@ -343,20 +392,24 @@
aFont isNil ifTrue:[
^ self error:'nil font'
].
- super font:aFont.
- (font device == device) ifTrue:[
- self getFontParameters.
- self computeNumberOfLinesShown.
- shown ifTrue:[
- self redrawFromVisibleLine:1 to:nLinesShown
+ font ~~ aFont ifTrue:[
+ super font:aFont.
+ realized ifTrue:[
+ (font device == device) ifTrue:[
+ self getFontParameters.
+ self computeNumberOfLinesShown.
+ shown ifTrue:[
+ self redrawFromVisibleLine:1 to:nLinesShown
+ ]
+ ].
+ self contentsChanged
]
- ].
- self contentsChanged
+ ]
!
level:aNumber
"set the level - cought here to update text-position variables
- (which avoid many computations later)"
+ (which avoids many computations later)"
super level:aNumber.
@@ -382,8 +435,7 @@
!
lastLineShown
- "return the index of the last (possibly partial)
- visible line"
+ "return the index of the last (possibly partial) visible line"
^ firstLineShown + nLinesShown
!
@@ -397,21 +449,7 @@
lengthOfLongestLine
"return the length (in characters) of the longest line"
- |max "{ Class: SmallInteger }"
- thisLen "{ Class: SmallInteger }" |
-
- max := 0.
- list notNil ifTrue:[
- list do:[:lineString |
- lineString notNil ifTrue:[
- thisLen := lineString size.
- (thisLen > max) ifTrue:[
- max := thisLen
- ]
- ]
- ]
- ].
- ^ max
+ ^ self lengthOfLongestLineBetween:1 and:list size
!
lengthOfLongestLineBetween:firstLine and:lastLine
@@ -423,6 +461,8 @@
first "{ Class: SmallInteger }"
last "{ Class: SmallInteger }" |
+ list isNil ifTrue:[^ 0].
+
listSize := list size.
max := 0.
first := firstLine.
@@ -450,31 +490,42 @@
| numLines |
numLines := self numberOfLines.
- ^ numLines * fontHeight + textStartTop.
+ numLines == 0 ifTrue:[^ 0].
+ "
+ need device-font for query
+ "
+ font := font on:device.
+ ^ numLines * fontHeight + textStartTop
+ + (font descent) "makes it look better".
+"/ + (font descent * 2) "makes it look better".
- "it used to be that code - which is wrong"
- (nLinesShown == nFullLinesShown) ifTrue:[
- ^ numLines * fontHeight
- ].
- "add one - otherwise we cannot make last line
- fully visible since scrolling is done by full lines only"
-
- ^ (numLines + 1) * fontHeight
+"/ "it used to be that code - which is wrong"
+"/ (nLinesShown == nFullLinesShown) ifTrue:[
+"/ ^ numLines * fontHeight
+"/ ].
+"/ "add one - otherwise we cannot make last line
+"/ fully visible since scrolling is done by full lines only"
+"/
+"/ ^ (numLines + 1) * fontHeight
!
widthOfContents
- "return the width of the contents in pixels"
+ "return the width of the contents in pixels
+ - used for scrollbar interface"
|max|
+ list isNil ifTrue:[^ 0].
+
fontIsFixedWidth ifTrue:[
- ^ self lengthOfLongestLine * fontWidth
+ max := self lengthOfLongestLine * fontWidth
+ ] ifFalse:[
+ max := 0.
+ list notNil ifTrue:[
+ max := max max:(font widthOf:list)
+ ].
].
- max := 0.
- list notNil ifTrue:[
- max := max max:(font widthOf:list)
- ].
- ^ max
+ ^ max + (leftMargin * 2)
!
yOriginOfContents
@@ -488,7 +539,7 @@
"return the horizontal origin of the contents in pixels
- used for scrollbar interface"
- ^leftOffset
+ ^ leftOffset
!
leftIndentOfLine:lineNr
@@ -621,7 +672,8 @@
!
widthOfWidestLineBetween:firstLine and:lastLine
- "return the width in pixels of the widest line in a range"
+ "return the width in pixels of the widest line in a range
+ - used to optimize scrolling, by limiting the scrolled area"
|max "{ Class: SmallInteger }"
first "{ Class: SmallInteger }"
@@ -654,7 +706,10 @@
!
widthForScrollBetween:firstLine and:lastLine
- "return the width in pixels for a scroll between firstLine and lastLine"
+ "return the width in pixels for a scroll between firstLine and lastLine.
+ - used to optimize scrolling, by limiting the scrolled area.
+ Subclasses with selections or other additional visible stuff should redefine
+ this method."
|w|
@@ -663,8 +718,11 @@
(width < 300) ifTrue:[^ innerWidth].
- w := self widthOfWidestLineBetween:firstLine
- and:lastLine.
+ "for large lists, search is longer than scrolling full"
+
+ list size > 2000 ifTrue:[^ innerWidth].
+
+ w := self widthOfWidestLineBetween:firstLine and:lastLine.
(w > innerWidth) ifTrue:[^ innerWidth].
^ w
!
@@ -699,7 +757,7 @@
line := self listAt:lineNr.
line isNil ifTrue:[^ nil].
(startCol > line size) ifTrue:[^ nil].
- ^ line copyFrom:startCol to:(line size)
+ ^ line copyFrom:startCol
!
listAt:lineNr to:endCol
@@ -711,7 +769,7 @@
line isNil ifTrue:[^ nil].
stop := endCol.
(stop > line size) ifTrue:[stop := line size].
- ^ line copyFrom:1 to:stop
+ ^ line copyTo:stop
!
listLineToVisibleLine:listLineNr
@@ -796,7 +854,7 @@
|lineString linePixelWidth xRel runCol posLeft posRight done|
- xRel := x - textStartLeft.
+ xRel := x - textStartLeft + leftOffset.
fontIsFixedWidth ifTrue:[
^ (xRel // fontWidth) + 1
].
@@ -910,10 +968,14 @@
!ListView methodsFor:'tabulators'!
setTab4
+ "set 4-character tab stops"
+
tabPositions := self class tab4Positions.
!
setTab8
+ "set 8-character tab stops"
+
tabPositions := self class tab8Positions.
!
@@ -927,7 +989,7 @@
1 to:nLines do:[:index |
line := list at:index.
line notNil ifTrue:[
- (line class == String) ifFalse:[
+ line isString ifFalse:[
newLine := line printString
] ifTrue:[
newLine := line
@@ -987,13 +1049,19 @@
!
withTabsExpanded:line
- "good idea, to make this one a primitive"
+ "expand tabs into spaces, return a new line string,
+ or original line, if no tabs are included.
+ good idea, to make this one a primitive"
- |tmpString nString
+ |tmpString nString nTabs
currentMax "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
nextTab "{ Class: SmallInteger }" |
+ line isNil ifTrue:[^ line].
+ nTabs := line occurrencesOf:(Character tab).
+ nTabs == 0 ifTrue:[^ line].
+
currentMax := 200.
tmpString := String new:currentMax.
dstIndex := 1.
@@ -1021,7 +1089,25 @@
- no need to return value of ifTrue:/ifFalse above"
0
].
- ^ tmpString copyFrom:1 to:(dstIndex - 1)
+ ^ tmpString copyTo:(dstIndex - 1)
+!
+
+withTabs:line
+ "Assuming an 8-character tab,
+ compress multiple spaces to tabs, return a new line string
+ or original line, if no tabs where created.
+ good idea, to make this one a primitive"
+
+ |newLine|
+
+ line isNil ifTrue:[^ line].
+ (line startsWith:' ') ifFalse:[^ line].
+
+ newLine := line copyFrom:9.
+ [newLine startsWith:' '] whileTrue:[
+ newLine := Character tab asString , (newLine copyFrom:9)
+ ].
+ ^ newLine
! !
!ListView methodsFor:'searching'!
@@ -1034,7 +1120,8 @@
searchForwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 else:block2
"search for a pattern, if found evaluate block1 with row/col as arguments, if not
- found evaluate block2"
+ found evaluate block2.
+ Sorry, but pattern is no regular expression pattern (yet)"
|lineString col savedCursor patternSize|
@@ -1064,7 +1151,8 @@
searchBackwardFor:pattern startingAtLine:startLine col:startCol ifFound:block1 else:block2
"search for a pattern, if found evaluate block1 with row/col as arguments, if not
- found evaluate block2"
+ found evaluate block2.
+ Sorry, but pattern is no regular expression pattern (yet)"
|lineString col cc found firstChar savedCursor patternSize|
@@ -1115,6 +1203,86 @@
self cursor:savedCursor.
^ block2 value
+!
+
+findBeginOfWordAtLine:selectLine col:selectCol
+ "return the col of first character of the word at given line/col.
+ If the character under the initial col is a space character, return
+ the first col of the blank-block."
+
+ |beginCol thisCharacter|
+
+ beginCol := selectCol.
+ thisCharacter := self characterAtLine:selectLine col:beginCol.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ [wordCheck value:thisCharacter] whileTrue:[
+ beginCol := beginCol - 1.
+ beginCol < 1 ifTrue:[
+ thisCharacter := Character space
+ ] ifFalse:[
+ thisCharacter := self characterAtLine:selectLine col:beginCol
+ ]
+ ].
+ beginCol := beginCol + 1.
+ ] ifFalse:[
+ "nope - maybe its a space"
+ thisCharacter == Character space ifTrue:[
+ [beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
+ beginCol := beginCol - 1.
+ thisCharacter := self characterAtLine:selectLine col:beginCol
+ ].
+ thisCharacter ~~ Character space ifTrue:[
+ beginCol := beginCol + 1.
+ ].
+ ] ifFalse:[
+ "select single character"
+ ]
+ ].
+ ^ beginCol
+!
+
+findEndOfWordAtLine:selectLine col:selectCol
+ "return the col of last character of the word at given line/col.
+ If the character under the initial col is a space character, return
+ the last col of the blank-block.
+ Return 0 if we should wrap to next line (for spaces)"
+
+ |endCol thisCharacter len|
+
+ endCol := selectCol.
+ endCol == 0 ifTrue:[endCol := 1].
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+
+ "is this acharacter within a word ?"
+ (wordCheck value:thisCharacter) ifTrue:[
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+ [wordCheck value:thisCharacter] whileTrue:[
+ endCol := endCol + 1.
+ thisCharacter := self characterAtLine:selectLine col:endCol
+ ].
+ endCol := endCol - 1.
+ ] ifFalse:[
+ "nope - maybe its a space"
+ thisCharacter == Character space ifTrue:[
+ len := (self listAt:selectLine) size.
+ endCol > len ifTrue:[
+ "select rest to end"
+ endCol := 0
+ ] ifFalse:[
+ thisCharacter := self characterAtLine:selectLine col:endCol.
+ [endCol <= len and:[thisCharacter == Character space]] whileTrue:[
+ endCol := endCol + 1.
+ thisCharacter := self characterAtLine:selectLine col:endCol
+ ].
+ endCol := endCol - 1.
+ ]
+ ] ifFalse:[
+ "select single character"
+ ]
+ ].
+ ^ endCol.
! !
!ListView methodsFor:'scrolling'!
@@ -1129,9 +1297,17 @@
pageDown
"change origin to display next page"
+ |nLines|
+
+ nLines := nFullLinesShown.
+ (firstLineShown + nLines + nFullLinesShown > list size) ifTrue:[
+ nLines := list size - firstLineShown - nFullLinesShown + 1
+ ].
+ nLines <= 0 ifTrue:[^ self].
+
self originWillChange.
- firstLineShown := firstLineShown + nFullLinesShown.
- self originChanged:nFullLinesShown.
+ firstLineShown := firstLineShown + nLines.
+ self originChanged:nLines.
self redrawFromVisibleLine:1 to:nLinesShown
!
@@ -1164,6 +1340,58 @@
self scrollUp:(nFullLinesShown // 2)
!
+makeLineVisible:aListLineNr
+ "if aListLineNr is not visible, scroll to make it visible.
+ Numbering starts with 1 for the very first line of the text."
+
+ |bott|
+
+ (aListLineNr isNil "or:[shown not]") ifTrue:[^ self].
+
+ (aListLineNr >= firstLineShown) ifTrue:[
+ (aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
+ ^ self
+ ]
+ ].
+ (aListLineNr < nFullLinesShown) ifTrue:[
+ ^ self scrollToLine:1
+ ].
+ (nFullLinesShown < 3) ifTrue:[
+ ^ self scrollToLine:aListLineNr
+ ].
+ bott := self numberOfLines - (nFullLinesShown - 1).
+ (aListLineNr > bott) ifTrue:[
+ ^ self scrollToLine:bott
+ ].
+ self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
+!
+
+makeColVisible:aCol inLine:aLineNr
+ "if column aCol is not visible, scroll horizontal to make it visible"
+
+ |xWant xVis visLnr oldLeft|
+
+ (aCol isNil or:[shown not]) ifTrue:[^ self].
+
+ visLnr := self absoluteLineToVisibleLine:aLineNr.
+ visLnr isNil ifTrue:[^ self].
+
+ xWant := self xOfCol:aCol inLine:visLnr.
+ "
+ dont scroll, if already visible
+ (but scroll, if not in inner 20%..80% of visible area)
+ "
+ xVis := xWant - leftOffset.
+
+ ((xVis >= (width // 5)) and:[xVis <= (width * 4 // 5)]) ifTrue:[
+ ^ self
+ ].
+
+ oldLeft := leftOffset.
+ self scrollHorizontalTo:(xWant - (width // 2)).
+ self originChanged:((oldLeft - leftOffset) @ 0)
+!
+
scrollDown:nLines
"change origin to scroll down some lines"
@@ -1255,6 +1483,15 @@
self scrollToLine:1
!
+scrollToBottom
+ "change origin to show end of text"
+
+ "scrolling to the end is not really correct (i.e. should scroll to list size - nFullLinesShown),
+ but scrollDown: will adjust it ..."
+
+ self scrollToLine:(list size)
+!
+
scrollToLine:aLineNr
"change origin to make aLineNr be the top line"
@@ -1267,6 +1504,37 @@
]
!
+scrollToLeft
+ "change origin to start (left) of text"
+
+ leftOffset ~~ 0 ifTrue:[
+ self scrollToCol:1
+ ]
+!
+
+scrollToCol:aColNr
+ "change origin to make aColNr be the left col"
+
+ |pxlOffset|
+
+ aColNr == 1 ifTrue:[
+ leftOffset ~~ 0 ifTrue:[
+ self scrollLeft:leftOffset.
+ ].
+ ^ self
+ ].
+
+ pxlOffset := font width * (aColNr - 1).
+
+ pxlOffset < leftOffset ifTrue:[
+ self scrollLeft:(leftOffset - pxlOffset)
+ ] ifFalse:[
+ pxlOffset > leftOffset ifTrue:[
+ self scrollRight:(pxlOffset - leftOffset)
+ ]
+ ]
+!
+
scrollVerticalToPercent:percent
"scroll to a position given in percent of total"
@@ -1276,31 +1544,6 @@
self scrollToLine:lineNr
!
-makeLineVisible:aListLineNr
- "if aListLineNr is not visible, scroll to make it visible"
-
- |bott|
-
- (aListLineNr isNil or:[shown not]) ifTrue:[^ self].
-
- (aListLineNr >= firstLineShown) ifTrue:[
- (aListLineNr < (firstLineShown + nFullLinesShown)) ifTrue:[
- ^ self
- ]
- ].
- (aListLineNr < nFullLinesShown) ifTrue:[
- ^ self scrollToLine:1
- ].
- (nFullLinesShown < 3) ifTrue:[
- ^ self scrollToLine:aListLineNr
- ].
- bott := self numberOfLines - (nFullLinesShown - 1).
- (aListLineNr > bott) ifTrue:[
- ^ self scrollToLine:bott
- ].
- self scrollToLine:(aListLineNr - (nFullLinesShown // 2) + 1)
-!
-
scrollSelectUp
"just a template - I do not know anything about selections"
@@ -1326,7 +1569,7 @@
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectDown].
- Processor addTimedBlock:autoScrollBlock after:deltaT
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
]
]
!
@@ -1344,7 +1587,7 @@
autoScrollDeltaT := deltaT.
autoScrollBlock isNil ifTrue:[
autoScrollBlock := [self scrollSelectUp].
- Processor addTimedBlock:autoScrollBlock after:deltaT
+ Processor addTimedBlock:autoScrollBlock afterSeconds:deltaT
]
]
!
@@ -1358,6 +1601,83 @@
autoScrollBlock := nil.
autoScrollDeltaT := nil
].
+!
+
+scrollRight
+ "scroll right by one character
+ - question is how much is a good for variable fonts"
+
+ self scrollRight:font width
+!
+
+scrollRight:nPixel
+ "change origin to scroll right some cols"
+
+ |wMax cnt|
+
+
+ cnt := nPixel.
+
+"
+ commenting out the block below allows scrolling to the right of
+ the widest line
+"
+" "
+ "
+ the 10 below allows scrolling somewhat behind the end of the line
+ "
+ wMax := self widthOfContents + 10.
+ (leftOffset + nPixel + width > wMax) ifTrue:[
+ cnt := wMax - leftOffset - width
+ ].
+ cnt <= 0 ifTrue:[^ self].
+" "
+ self originWillChange.
+ leftOffset:= leftOffset + cnt.
+ self redrawFromVisibleLine:1 to:nLinesShown.
+ self originChanged:(cnt @ 0)
+!
+
+scrollLeft
+ "scroll left by one character
+ - question is how much is a good for variable fonts"
+
+ self scrollLeft:font width
+!
+
+scrollLeft:nPixel
+ "change origin to scroll left some cols"
+
+ |newLeftOffset|
+
+ nPixel <= 0 ifTrue:[^ self].
+
+ newLeftOffset := leftOffset - nPixel.
+ newLeftOffset <= 0 ifTrue:[
+ leftOffset == 0 ifTrue:[^ self].
+ newLeftOffset := 0
+ ].
+
+ self originWillChange.
+ leftOffset := newLeftOffset.
+ self redrawFromVisibleLine:1 to:nLinesShown.
+ self originChanged:(0 @ nPixel)
+!
+
+scrollHorizontalTo:aPixelOffset
+ "change origin to make aPixelOffset be the left col"
+
+ |orgX|
+
+ orgX := leftOffset.
+
+ (aPixelOffset < orgX) ifTrue:[
+ self scrollLeft:(orgX - aPixelOffset)
+ ] ifFalse:[
+ (aPixelOffset > orgX) ifTrue:[
+ self scrollRight:(aPixelOffset - orgX)
+ ]
+ ]
! !
!ListView methodsFor:'drawing'!
@@ -1460,6 +1780,7 @@
self fillRectangleX:margin y:y
width:(width - (margin * 2))
height:(endVisLineNr - startVisLineNr + 1) * fontHeight.
+ list isNil ifTrue:[^ self].
y := y + fontAscent.
listSize := list size.
@@ -1703,15 +2024,23 @@
startLine to:stopLine do:[:i |
startCol := self colOfX:x inVisibleLine:i.
endCol := self colOfX:(x + w) inVisibleLine:i.
- self redrawVisibleLine:i from:startCol to:endCol
+ startCol > 0 ifTrue:[
+ endCol > 0 ifTrue:[
+ self redrawVisibleLine:i from:startCol to:endCol
+ ]
+ ]
]
] ifTrue:[
"start/end col is the same for all lines"
startCol := self colOfX:x inVisibleLine:startLine.
endCol := self colOfX:(x + w) inVisibleLine:startLine.
- startLine to:stopLine do:[:i |
- self redrawVisibleLine:i from:startCol to:endCol
+ startCol > 0 ifTrue:[
+ endCol > 0 ifTrue:[
+ startLine to:stopLine do:[:i |
+ self redrawVisibleLine:i from:startCol to:endCol
+ ]
+ ]
]
]
]
--- a/MenuView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/MenuView.st Sun Aug 07 15:23:42 1994 +0200
@@ -13,41 +13,61 @@
SelectionInListView subclass:#MenuView
instanceVariableNames:'selectors args receiver enableFlags
disabledFgColor onOffFlags subMenus
- subMenuShown superMenu checkColor'
+ subMenuShown superMenu checkColor
+ lineLevel lineInset'
classVariableNames:''
poolDictionaries:''
category:'Views-Menus'
!
MenuView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.7 1994-01-08 17:27:32 claus Exp $
+$Header: /cvs/stx/stx/libwidg/MenuView.st,v 1.8 1994-08-07 13:22:51 claus Exp $
'!
!MenuView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/MenuView.st,v 1.8 1994-08-07 13:22:51 claus Exp $
+"
+!
+
documentation
"
-a menu view used for both pull-down-menus and pop-up-menus
-the action to be performed can be defined either as:
+ a menu view used for both pull-down-menus and pop-up-menus
+ the action to be performed can be defined either as:
-1) action:aBlockWithOneArg
- which defines a block to be called with the line number (1..n)
- of the selected line.
+ 1) action:aBlockWithOneArg
+ which defines a block to be called with the line number (1..n)
+ of the selected line.
-2) selectors:selectorArray [args: argarray] receiver:anObject
- which defines the messages to be sent to receiver for each
- line.
+ 2) selectors:selectorArray [args: argarray] receiver:anObject
+ which defines the messages to be sent to receiver for each
+ line.
-It is also possible to define both actionBlock and selectorArray.
+ It is also possible to define both actionBlock and selectorArray.
-menu entries starting with '\c' are check-entries.
-menu entries conisting of '-' alone, are separating lines.
+ menu entries starting with '\c' are check-entries.
+ menu entries conisting of '-' alone, are separating lines.
-written summer 89 by claus
+ written summer 89 by claus
"
! !
@@ -117,6 +137,36 @@
selectors:selArray
args:nil
receiver:anObject
+!
+
+labels:labels selectors:selArray receiver:anObject
+ "create and return a new MenuView. The parent view
+ should be set later."
+
+ ^ (self new) labels:labels
+ selectors:selArray
+ args:nil
+ receiver:anObject
+!
+
+labels:labels selectors:selArray
+ "create and return a new MenuView. The parent veiw
+ and receiver should be set later."
+
+ ^ (self new) labels:labels
+ selectors:selArray
+ args:nil
+ receiver:nil
+!
+
+labels:labels
+ "create and return a new MenuView. The parent view,
+ selectors and receiver should be set later."
+
+ ^ (self new) labels:labels
+ selectors:nil
+ args:nil
+ receiver:nil
! !
!MenuView methodsFor:'initialization'!
@@ -125,7 +175,7 @@
super initialize.
disabledFgColor := Color darkGrey.
- self is3D ifTrue:[
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 1.
self level:1
]
@@ -144,16 +194,47 @@
super initStyle.
checkColor := fgColor.
+ (style == #normal) ifTrue:[
+ lineLevel := 0
+ ] ifFalse:[
+ lineLevel := -1.
+ "the inset on each side"
+ style == #motif ifTrue:[
+ lineInset := 0
+ ] ifFalse:[
+ lineInset := (device horizontalPixelPerMillimeter * 0.8) rounded.
+ ]
+ ].
(style == #iris) ifTrue:[
device hasGreyscales ifTrue:[
hilightFgColor := fgColor.
- hilightBgColor := bgColor.
- hilightLevel := 2.
+ hilightBgColor := White "bgColor".
+ hilightLevel := 1 "2".
+ lineSpacing := 3
].
device hasColors ifTrue:[
checkColor := Color red.
].
- ]
+ ].
+ (style == #motif) ifTrue:[
+ hilightFgColor := fgColor.
+ hilightBgColor := bgColor.
+ hilightLevel := 2.
+ lineSpacing := (2 * hilightLevel)
+ ].
+ style == #openwin ifTrue:[
+ "add some space for rounded-hilight area"
+ self leftMargin:10.
+ lineLevel := 1.
+ ].
+ (style == #st80) ifTrue:[
+ viewBackground := White.
+ fgColor := Black.
+ bgColor := White.
+ level := 0.
+ lineLevel := 0.
+ lineInset := 0
+ ].
!
initEvents
@@ -170,6 +251,9 @@
recreate
super recreate.
+ style == #openwin ifTrue:[
+ self leftMargin:10.
+ ].
self recomputeSize
! !
@@ -204,7 +288,7 @@
labels:text
"set the labels to the argument, text"
- (text isKindOf:String) ifTrue:[
+ (text isString) ifTrue:[
self list:(text asText)
] ifFalse:[
self list:text
@@ -270,16 +354,75 @@
self recomputeSize
!
+addLabel:aLabel selector:aSelector after:aLabelOrSelectorOrNumber
+ "insert another label/selector pair at some place.
+ Being very friendly here, allowing label-string, selector or numeric
+ index for the argument aLabelOrSelectorOrNumber"
+
+ |idx|
+
+ list isNil ifTrue:[
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+ "
+ be user friendly - allow both label or selector
+ to be passed
+ "
+ aLabelOrSelectorOrNumber isInteger ifTrue:[
+ idx := aLabelOrSelectorOrNumber
+ ] ifFalse:[
+ idx := list indexOf:aLabelOrSelectorOrNumber ifAbsent:[selectors indexOf:aLabelOrSelectorOrNumber].
+ ].
+ (idx between:1 and:list size) ifFalse:[
+ "add to end"
+ ^ self addLabel:aLabel selector:aSelector
+ ].
+
+ list := list asOrderedCollection add:aLabel beforeIndex:(idx + 1).
+ selectors := selectors asOrderedCollection add:aSelector beforeIndex:(idx + 1).
+ enableFlags := enableFlags asOrderedCollection add:true beforeIndex:(idx + 1).
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection add:nil beforeIndex:(idx + 1).
+ ].
+ args notNil ifTrue:[
+ args := args asOrderedCollection add:nil beforeIndex:(idx + 1).
+ ].
+ self recomputeSize
+
+ "
+ |v|
+ CodeView new realize.
+ v := CodeView new realize.
+ v middleButtonMenu menuView addLabel:'new entry' selector:#foo after:'paste'.
+ "
+!
+
+remove:indexOrName
+ "remove the label at index"
+
+ |i|
+
+ i := self indexOf:indexOrName.
+ i == 0 ifTrue:[^ self].
+ list := list asOrderedCollection removeIndex:i.
+ selectors := selectors asOrderedCollection removeIndex:i.
+ enableFlags := enableFlags asOrderedCollection removeIndex:i.
+ subMenus notNil ifTrue:[
+ subMenus := subMenus asOrderedCollection removeIndex:i.
+ ].
+ self recomputeSize
+!
+
indexOf:indexOrName
"return the index of the label named:aName or , if its a symbol
the index in the selector list"
- (indexOrName isMemberOf:String) ifTrue:[
- ^ list indexOf:indexOrName
- ].
(indexOrName isMemberOf:Symbol) ifTrue:[
^ selectors indexOf:indexOrName
].
+ (indexOrName isString) ifTrue:[
+ ^ list indexOf:indexOrName
+ ].
^ indexOrName
!
@@ -486,13 +629,25 @@
setSelectionForX:x y:y
|newSelection org mx my|
+ (x < 0
+ or:[x >= width
+ or:[y < 0
+ or:[y >= height]]]) ifTrue:[
+ "
+ moved outside submenu, but not within self
+ "
+ subMenuShown notNil ifTrue:[
+ ^ self
+ ].
+ ].
+
newSelection := self positionToSelectionX:x y:y.
newSelection ~= selection ifTrue:[
self selection:newSelection.
subMenuShown notNil ifTrue:[
- subMenuShown hide.
- subMenuShown := nil
+ self hideSubmenu.
].
+"/ windowGroup notNil ifTrue:[windowGroup sensor flushUserEvents].
newSelection notNil ifTrue:[
(enableFlags at:newSelection) ifFalse:[
newSelection := nil
@@ -514,12 +669,23 @@
from:(self id)
to:(DisplayRootView new id).
- ActiveGrab == self ifTrue:[
- device ungrabPointer.
- ActiveGrab := nil
- ].
+"/ ActiveGrab == self ifTrue:[
+"/ device ungrabPointer.
+"/ ActiveGrab := nil
+"/ ].
+windowGroup notNil ifTrue:[windowGroup processExposeEvents].
subMenuShown superMenu:self.
- subMenuShown showAt:org.
+"/ subMenuShown showAt:org.
+"
+ realize the submenu in MY windowgroup
+"
+subMenuShown windowGroup:windowGroup.
+subMenuShown windowGroup addTopView:subMenuShown.
+subMenuShown fixSize.
+subMenuShown origin:org.
+subMenuShown makeFullyVisible.
+subMenuShown realize.
+device synchronizeOutput.
^ self
]
] ifFalse:[
@@ -596,6 +762,88 @@
]
!
+drawVisibleLineSelected:visLineNr
+ "redraw a single line as selected."
+
+ |listLine fg bg
+ y "{ Class: SmallInteger }"
+ y2 "{ Class: SmallInteger }"
+ r2 radius topLeftColor botRightColor |
+
+ style ~~ #openwin ifTrue:[
+ ^ super drawVisibleLineSelected:visLineNr.
+ ].
+ "
+ openwin draws selections in a menu as (edged) rounded rectangles
+ "
+
+ bg := hilightBgColor.
+ fg := hilightFgColor.
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine notNil ifTrue:[
+
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ y := self yOfLine:visLineNr.
+ y2 := y + fontHeight - 1.
+ r2 := font height.
+ radius := r2 // 2.
+
+ "
+ refill with normal bg, where arcs will be drawn below
+ "
+ self paint:bgColor.
+ self fillRectangleX:margin y:y width:radius height:fontHeight.
+ self fillRectangleX:width-radius-margin y:y width:radius height:fontHeight.
+
+ "
+ fill the arcs
+ "
+ self paint:hilightBgColor.
+ self fillArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:180.
+ self fillArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:180.
+
+ "
+ a highlight-border around
+ "
+ hilightFrameColor notNil ifTrue:[
+ self paint:hilightFrameColor.
+ self displayLineFromX:radius+2 y:y toX:width-radius-3 y:y.
+ self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.
+
+ self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:180.
+ self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:180.
+ ^ self
+ ].
+
+ "
+ an edge around
+ "
+ (hilightLevel ~~ 0) ifTrue:[
+ (hilightLevel < 0) ifTrue:[
+ topLeftColor := shadowColor.
+ botRightColor := lightColor.
+ ] ifFalse:[
+ topLeftColor := lightColor.
+ botRightColor := shadowColor.
+ ].
+
+ self paint:topLeftColor.
+ self displayLineFromX:radius+2 y:y toX:width-radius-3 y:y.
+
+ self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90 angle:125.
+ self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270+125 angle:55.
+
+ self paint:botRightColor.
+
+ self displayLineFromX:radius+2 y:y2 toX:width-radius-3 y:y2.
+ self displayArcX:1+margin+1 y:y w:r2 h:r2+1+1 from:90+125 angle:55.
+ self displayArcX:width-r2-1-1-margin-1 y:y w:r2 h:r2+1+1 from:270 angle:125.
+ ^ self
+ ]
+ ].
+ ^ super drawVisibleLine:visLineNr with:fg and:bg
+!
+
redrawVisibleLine:visLine col:col
self redrawVisibleLine:visLine
!
@@ -609,7 +857,7 @@
!
redrawVisibleLine:visLineNr
- |line lineNr y isSpecial isSeparatingLine mm right|
+ |line lineNr y isSpecial isSeparatingLine right clr1 clr2|
line := self visibleAt:visLineNr.
@@ -640,25 +888,31 @@
"handle separating lines"
y := self yOfLine:visLineNr.
- self is3D ifFalse:[
- self paint:bgColor.
- self fillRectangleX:0 y:y
- width:width height:fontHeight
- ].
+
+ self paint:bgColor.
+ self fillRectangleX:0 y:y width:width height:fontHeight.
+
isSeparatingLine ifTrue:[
y := y + (fontHeight // 2).
- self is3D ifFalse:[
+ lineLevel == 0 ifTrue:[
self paint:fgColor.
self displayLineFromX:0 y:y toX:width y:y
- ] ifTrue:[
+ ] ifFalse:[
"the inset on each side"
- mm := (device horizontalPixelPerMillimeter * 0.8) rounded.
- right := width - 1 - mm.
- self paint:shadowColor.
- self displayLineFromX:mm y:y toX:right y:y.
- self paint:lightColor.
+
+ lineLevel < 0 ifTrue:[
+ clr1 := shadowColor.
+ clr2 := lightColor.
+ ] ifFalse:[
+ clr1 := lightColor.
+ clr2 := shadowColor.
+ ].
+ self paint:clr1.
+ right := width - 1 - lineInset.
+ self displayLineFromX:lineInset y:y toX:right y:y.
+ self paint:clr2.
y := y + 1.
- self displayLineFromX:mm y:y toX:right y:y
+ self displayLineFromX:lineInset y:y toX:right y:y
]
]
!
@@ -730,7 +984,7 @@
].
!
-regainControl
+XXregainControl
"take over pointer control from a submenu"
^ self
@@ -762,13 +1016,13 @@
subMenuShown notNil ifTrue:[
^ self
].
- self setSelectionForX:-1 y:-1. "force deselect"
+"/ self setSelectionForX:-1 y:-1. "force deselect"
subMenuShown isNil ifTrue:[
self selection:nil
].
- superMenu notNil ifTrue:[
- superMenu regainControl.
- ]
+"/ superMenu notNil ifTrue:[
+"/ superMenu regainControl.
+"/ ]
!
buttonRelease:button x:x y:y
@@ -786,40 +1040,48 @@
superMenu notNil ifTrue:[
superMenu showActive
].
+ "
+ either action-block or selectors-array-style
+ "
actionBlock notNil ifTrue:[
- actionBlock value:(self selection)
- ].
- selectors notNil ifTrue: [
- ActiveGrab == self ifTrue:[
- device ungrabPointer.
- ActiveGrab := nil.
- ].
- (selectors isKindOf:Symbol) ifFalse:[
- selection <= (selectors size) ifTrue:[
- theSelector := selectors at:selection
- ]
- ] ifTrue:[
- theSelector := selectors
- ].
- theSelector notNil ifTrue:[
- isCheck := false.
- onOffFlags notNil ifTrue:[
- onOffFlags size >= selection ifTrue:[
- isCheck := (onOffFlags at:selection) notNil
+ Object abortSignal catch:[
+ actionBlock value:(self selection)
+ ]
+ ] ifFalse:[
+ selectors notNil ifTrue: [
+ ActiveGrab == self ifTrue:[
+ device ungrabPointer.
+ ActiveGrab := nil.
+ ].
+ (selectors isKindOf:Symbol) ifFalse:[
+ selection <= (selectors size) ifTrue:[
+ theSelector := selectors at:selection
]
+ ] ifTrue:[
+ theSelector := selectors
].
- isCheck ifTrue:[
- onOffFlags at:selection
- put:(onOffFlags at:selection) not.
- self redrawLine:selection.
- receiver perform:theSelector
- with:(onOffFlags at:selection)
- ] ifFalse:[
- args isNil ifTrue:[
- receiver perform:theSelector
- ] ifFalse:[
- receiver perform:theSelector
- with:(args at:selection)
+ theSelector notNil ifTrue:[
+ isCheck := false.
+ onOffFlags notNil ifTrue:[
+ onOffFlags size >= selection ifTrue:[
+ isCheck := (onOffFlags at:selection) notNil
+ ]
+ ].
+ Object abortSignal catch:[
+ isCheck ifTrue:[
+ onOffFlags at:selection
+ put:(onOffFlags at:selection) not.
+ self redrawLine:selection.
+ receiver perform:theSelector
+ with:(onOffFlags at:selection)
+ ] ifFalse:[
+ args isNil ifTrue:[
+ receiver perform:theSelector
+ ] ifFalse:[
+ receiver perform:theSelector
+ with:(args at:selection)
+ ]
+ ]
]
]
]
--- a/ObjView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ObjView.st Sun Aug 07 15:23:42 1994 +0200
@@ -42,7 +42,7 @@
this is an abstract class providing common mechanisms - actual instances are
DrawView, DirectoryView, LogicView or DocumentView.
-$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.7 1994-01-13 00:17:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.8 1994-08-07 13:22:59 claus Exp $
written spring/summer 89 by claus
'!
@@ -170,6 +170,7 @@
"redraw the grid"
gridPixmap notNil ifTrue:[
+ self paint:Black on:White.
self displayOpaqueForm:gridPixmap x:0 y:0
]
!
@@ -733,19 +734,20 @@
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
- vx vy oldLeft oldTop w h newLeft newTop|
+ vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
+ griddedNewOrigin := self alignToGrid:newOrigin.
oldOrigin := anObject origin.
- (oldOrigin = newOrigin) ifTrue:[^ self].
+ (oldOrigin = griddedNewOrigin) ifTrue:[^ self].
oldFrame := self frameOf:anObject.
objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
wasObscured := self isObscured:anObject.
- anObject moveTo:newOrigin.
+ anObject moveTo:griddedNewOrigin.
newFrame := self frameOf:anObject.
objectsIntersectingNewFrame := self objectsIntersecting:newFrame.
@@ -1422,7 +1424,7 @@
gridH := (self heightOfContentsInMM * mmV + 1) asInteger.
gridPixmap := Form width:gridW height:gridH depth:(device depth).
gridPixmap fill:viewBackground.
- gridPixmap paint:paint.
+ gridPixmap paint:Black.
"draw first row point-by-point"
yp := 0.0.
@@ -1651,32 +1653,36 @@
doObjectMove:aPoint
"do an object move"
- |dragger offs2 newPoint|
+ |dragger offs2|
canDragOutOfView ifTrue:[
dragger := rootView.
offs2 := viewOrigin.
- newPoint := aPoint
] ifFalse:[
dragger := self.
offs2 := 0@0.
- newPoint := self alignToGrid:aPoint.
].
movedObject isNil ifTrue:[
movedObject := selection.
+ "
+ draw first outline
+ "
movedObject notNil ifTrue:[
moveDelta := 0@0.
dragger xoring:[
- self showDragging:movedObject
- offset:(moveDelta - offs2)
+ self showDragging:movedObject offset:(self alignToGrid:(moveDelta - offs2))
]
]
].
movedObject notNil ifTrue:[
+ "
+ clear prev outline,
+ draw new outline
+ "
dragger xoring:[
- self showDragging:movedObject offset:(moveDelta - offs2).
- moveDelta := newPoint - moveStartPoint.
- self showDragging:movedObject offset:(moveDelta - offs2)
+ self showDragging:movedObject offset:(self alignToGrid:(moveDelta - offs2)).
+ moveDelta := aPoint - moveStartPoint.
+ self showDragging:movedObject offset:(self alignToGrid:(moveDelta - offs2))
]
]
!
@@ -1695,8 +1701,10 @@
dragger := self.
offs2 := 0@0
].
- dragger xoring:[self showDragging:movedObject
- offset:(moveDelta - offs2)].
+ dragger xoring:[
+ self showDragging:movedObject
+ offset:(self alignToGrid:(moveDelta - offs2))
+ ].
dragger device synchronizeOutput.
"check if object is to be put into another view"
@@ -1726,12 +1734,15 @@
from:(rootView id)
to:destinationId.
destinationView notNil ifTrue:[
- "move into another smalltalk view"
- self move:movedObject to:destinationPoint
- in:destinationView
+ "
+ move into another smalltalk view
+ "
+ self move:movedObject to:destinationPoint in:destinationView
] ifFalse:[
- self move:movedObject to:destinationPoint
- inAlienViewId:destinationId
+ "
+ not one of my views
+ "
+ self move:movedObject to:destinationPoint inAlienViewId:destinationId
]
].
self setDefaultActions.
@@ -1744,7 +1755,7 @@
buttonPress:button x:x y:y
"user pressed left button"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
pressAction notNil ifTrue:[
lastButt := x @ y.
pressAction value:lastButt
@@ -1757,7 +1768,7 @@
buttonShiftPress:button x:x y:y
"user pressed left button with shift"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
shiftPressAction notNil ifTrue:[
lastButt := x @ y.
shiftPressAction value:lastButt
@@ -1770,7 +1781,7 @@
buttonMultiPress:button x:x y:y
"user pressed left button twice (or more)"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
doublePressAction notNil ifTrue:[
doublePressAction value:(x @ y)
]
@@ -1817,7 +1828,7 @@
!
buttonRelease:button x:x y:y
- (button == 1) ifTrue: [
+ ((button == 1) or:[button == #select]) ifTrue:[
releaseAction notNil ifTrue:[releaseAction value]
] ifFalse:[
super buttonRelease:button x:x y:y
@@ -1875,7 +1886,7 @@
!
initializeFileInObject:anObject
- "each object may be processed here after its beeing filed-in
+ "each object may be processed here after its being filed-in
- subclasses may do whatever they want here ...
(see LogicView for example)"
--- a/ObjectView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ObjectView.st Sun Aug 07 15:23:42 1994 +0200
@@ -42,7 +42,7 @@
this is an abstract class providing common mechanisms - actual instances are
DrawView, DirectoryView, LogicView or DocumentView.
-$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.7 1994-01-13 00:17:22 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.8 1994-08-07 13:22:59 claus Exp $
written spring/summer 89 by claus
'!
@@ -170,6 +170,7 @@
"redraw the grid"
gridPixmap notNil ifTrue:[
+ self paint:Black on:White.
self displayOpaqueForm:gridPixmap x:0 y:0
]
!
@@ -733,19 +734,20 @@
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
- vx vy oldLeft oldTop w h newLeft newTop|
+ vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
+ griddedNewOrigin := self alignToGrid:newOrigin.
oldOrigin := anObject origin.
- (oldOrigin = newOrigin) ifTrue:[^ self].
+ (oldOrigin = griddedNewOrigin) ifTrue:[^ self].
oldFrame := self frameOf:anObject.
objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
wasObscured := self isObscured:anObject.
- anObject moveTo:newOrigin.
+ anObject moveTo:griddedNewOrigin.
newFrame := self frameOf:anObject.
objectsIntersectingNewFrame := self objectsIntersecting:newFrame.
@@ -1422,7 +1424,7 @@
gridH := (self heightOfContentsInMM * mmV + 1) asInteger.
gridPixmap := Form width:gridW height:gridH depth:(device depth).
gridPixmap fill:viewBackground.
- gridPixmap paint:paint.
+ gridPixmap paint:Black.
"draw first row point-by-point"
yp := 0.0.
@@ -1651,32 +1653,36 @@
doObjectMove:aPoint
"do an object move"
- |dragger offs2 newPoint|
+ |dragger offs2|
canDragOutOfView ifTrue:[
dragger := rootView.
offs2 := viewOrigin.
- newPoint := aPoint
] ifFalse:[
dragger := self.
offs2 := 0@0.
- newPoint := self alignToGrid:aPoint.
].
movedObject isNil ifTrue:[
movedObject := selection.
+ "
+ draw first outline
+ "
movedObject notNil ifTrue:[
moveDelta := 0@0.
dragger xoring:[
- self showDragging:movedObject
- offset:(moveDelta - offs2)
+ self showDragging:movedObject offset:(self alignToGrid:(moveDelta - offs2))
]
]
].
movedObject notNil ifTrue:[
+ "
+ clear prev outline,
+ draw new outline
+ "
dragger xoring:[
- self showDragging:movedObject offset:(moveDelta - offs2).
- moveDelta := newPoint - moveStartPoint.
- self showDragging:movedObject offset:(moveDelta - offs2)
+ self showDragging:movedObject offset:(self alignToGrid:(moveDelta - offs2)).
+ moveDelta := aPoint - moveStartPoint.
+ self showDragging:movedObject offset:(self alignToGrid:(moveDelta - offs2))
]
]
!
@@ -1695,8 +1701,10 @@
dragger := self.
offs2 := 0@0
].
- dragger xoring:[self showDragging:movedObject
- offset:(moveDelta - offs2)].
+ dragger xoring:[
+ self showDragging:movedObject
+ offset:(self alignToGrid:(moveDelta - offs2))
+ ].
dragger device synchronizeOutput.
"check if object is to be put into another view"
@@ -1726,12 +1734,15 @@
from:(rootView id)
to:destinationId.
destinationView notNil ifTrue:[
- "move into another smalltalk view"
- self move:movedObject to:destinationPoint
- in:destinationView
+ "
+ move into another smalltalk view
+ "
+ self move:movedObject to:destinationPoint in:destinationView
] ifFalse:[
- self move:movedObject to:destinationPoint
- inAlienViewId:destinationId
+ "
+ not one of my views
+ "
+ self move:movedObject to:destinationPoint inAlienViewId:destinationId
]
].
self setDefaultActions.
@@ -1744,7 +1755,7 @@
buttonPress:button x:x y:y
"user pressed left button"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
pressAction notNil ifTrue:[
lastButt := x @ y.
pressAction value:lastButt
@@ -1757,7 +1768,7 @@
buttonShiftPress:button x:x y:y
"user pressed left button with shift"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
shiftPressAction notNil ifTrue:[
lastButt := x @ y.
shiftPressAction value:lastButt
@@ -1770,7 +1781,7 @@
buttonMultiPress:button x:x y:y
"user pressed left button twice (or more)"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
doublePressAction notNil ifTrue:[
doublePressAction value:(x @ y)
]
@@ -1817,7 +1828,7 @@
!
buttonRelease:button x:x y:y
- (button == 1) ifTrue: [
+ ((button == 1) or:[button == #select]) ifTrue:[
releaseAction notNil ifTrue:[releaseAction value]
] ifFalse:[
super buttonRelease:button x:x y:y
@@ -1875,7 +1886,7 @@
!
initializeFileInObject:anObject
- "each object may be processed here after its beeing filed-in
+ "each object may be processed here after its being filed-in
- subclasses may do whatever they want here ...
(see LogicView for example)"
--- a/OptBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/OptBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,27 +14,44 @@
instanceVariableNames:'formLabel textLabel buttons actions'
classVariableNames:'WarnBitmap'
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
OptionBox comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.6 1994-01-08 17:27:37 claus Exp $
-
-written Nov 91 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.7 1994-08-07 13:23:03 claus Exp $
'!
!OptionBox 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.7 1994-08-07 13:23:03 claus Exp $
+"
+!
+
documentation
"
-OptionBoxes are like YesNoBoxes but with as many as you like buttons in it;
-will finally be a superclass of WarnBox and YesNoBox - or maybe merged
-all into DialogBox..
-Used for multiway questions.
+ OptionBoxes are like YesNoBoxes but with as many buttons as you like;
+ will finally be a superclass of WarnBox and YesNoBox - or maybe merged
+ all into DialogBox..
+ Used for multiway questions.
"
! !
@@ -46,7 +63,7 @@
|box|
box := (self basicNew) numberOfOptions:nOptions.
- box device:ModalDisplay.
+ box device:Display.
box initialize.
box title:titleString.
^ box
@@ -129,11 +146,8 @@
super initialize.
- WarnBitmap isNil ifTrue:[
- WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:device
- ].
-
- formLabel := Label form:WarnBitmap in:self.
+ formLabel := Label in:self.
+ self initFormBitmap.
formLabel borderWidth:0.
formLabel origin:(ViewSpacing @ ViewSpacing).
@@ -150,7 +164,7 @@
action:[
|action|
- (buttons at:index) turnOff.
+ (buttons at:index) turnOffWithoutRedraw.
self hide.
action := actions at:index.
action notNil ifTrue:[
@@ -164,8 +178,16 @@
(height - ViewSpacing - (buttons at:index) height)].
button extent:[(width // nButt - ViewSpacing)
@
- (buttons at:index) height]
+ (buttons at:index) height
+ ]
]
+!
+
+initFormBitmap
+ WarnBitmap isNil ifTrue:[
+ WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:Display
+ ].
+ formLabel form:WarnBitmap
! !
!OptionBox methodsFor:'private'!
@@ -181,24 +203,30 @@
resize
"resize myself to make everything fit into myself"
- |w w1 w2 h extra|
+ |w w1 w2 h maxH|
w1 := ViewSpacing + formLabel width + ViewSpacing + textLabel width + ViewSpacing.
+ w2 := buttons inject:0 into:[:sum :butt | sum + butt width + ViewSpacing].
- w2 := 0.
- buttons do:[:butt |
- w2 := w2 + butt width "labelWidth".
- w2 := w2 + ViewSpacing
+"/ w2 := 0.
+"/ buttons do:[:butt |
+"/ w2 := w2 + butt width "labelWidth".
+"/ w2 := w2 + ViewSpacing
+"/ ].
+"/ w2 := w2 + (4 * ViewSpacing).
+
+ w := w1 max:w2.
+
+ maxH := 0.
+ buttons do:[:button |
+ maxH := maxH max:(button heightIncludingBorder)
].
- w2 := w2 + (4 * ViewSpacing).
- w := w1 max:w2.
h := ViewSpacing
+ ((formLabel height) max:(textLabel height))
+ ViewSpacing + ViewSpacing
- + (buttons at:1) height
+ + maxH
+ ViewSpacing.
- "extra := margin * 2."
- super extent:(w "+ extra") @ (h "+ extra")
+ super extent:(w @ h)
! !
--- a/OptionBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/OptionBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,27 +14,44 @@
instanceVariableNames:'formLabel textLabel buttons actions'
classVariableNames:'WarnBitmap'
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
OptionBox comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.6 1994-01-08 17:27:37 claus Exp $
-
-written Nov 91 by claus
+$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.7 1994-08-07 13:23:03 claus Exp $
'!
!OptionBox 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/OptionBox.st,v 1.7 1994-08-07 13:23:03 claus Exp $
+"
+!
+
documentation
"
-OptionBoxes are like YesNoBoxes but with as many as you like buttons in it;
-will finally be a superclass of WarnBox and YesNoBox - or maybe merged
-all into DialogBox..
-Used for multiway questions.
+ OptionBoxes are like YesNoBoxes but with as many buttons as you like;
+ will finally be a superclass of WarnBox and YesNoBox - or maybe merged
+ all into DialogBox..
+ Used for multiway questions.
"
! !
@@ -46,7 +63,7 @@
|box|
box := (self basicNew) numberOfOptions:nOptions.
- box device:ModalDisplay.
+ box device:Display.
box initialize.
box title:titleString.
^ box
@@ -129,11 +146,8 @@
super initialize.
- WarnBitmap isNil ifTrue:[
- WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:device
- ].
-
- formLabel := Label form:WarnBitmap in:self.
+ formLabel := Label in:self.
+ self initFormBitmap.
formLabel borderWidth:0.
formLabel origin:(ViewSpacing @ ViewSpacing).
@@ -150,7 +164,7 @@
action:[
|action|
- (buttons at:index) turnOff.
+ (buttons at:index) turnOffWithoutRedraw.
self hide.
action := actions at:index.
action notNil ifTrue:[
@@ -164,8 +178,16 @@
(height - ViewSpacing - (buttons at:index) height)].
button extent:[(width // nButt - ViewSpacing)
@
- (buttons at:index) height]
+ (buttons at:index) height
+ ]
]
+!
+
+initFormBitmap
+ WarnBitmap isNil ifTrue:[
+ WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:Display
+ ].
+ formLabel form:WarnBitmap
! !
!OptionBox methodsFor:'private'!
@@ -181,24 +203,30 @@
resize
"resize myself to make everything fit into myself"
- |w w1 w2 h extra|
+ |w w1 w2 h maxH|
w1 := ViewSpacing + formLabel width + ViewSpacing + textLabel width + ViewSpacing.
+ w2 := buttons inject:0 into:[:sum :butt | sum + butt width + ViewSpacing].
- w2 := 0.
- buttons do:[:butt |
- w2 := w2 + butt width "labelWidth".
- w2 := w2 + ViewSpacing
+"/ w2 := 0.
+"/ buttons do:[:butt |
+"/ w2 := w2 + butt width "labelWidth".
+"/ w2 := w2 + ViewSpacing
+"/ ].
+"/ w2 := w2 + (4 * ViewSpacing).
+
+ w := w1 max:w2.
+
+ maxH := 0.
+ buttons do:[:button |
+ maxH := maxH max:(button heightIncludingBorder)
].
- w2 := w2 + (4 * ViewSpacing).
- w := w1 max:w2.
h := ViewSpacing
+ ((formLabel height) max:(textLabel height))
+ ViewSpacing + ViewSpacing
- + (buttons at:1) height
+ + maxH
+ ViewSpacing.
- "extra := margin * 2."
- super extent:(w "+ extra") @ (h "+ extra")
+ super extent:(w @ h)
! !
--- a/PanelView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/PanelView.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,21 +18,45 @@
!
PanelView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-this is a view for holding subviews. (layout-widget ?!!)
+$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.5 1994-08-07 13:23:05 claus Exp $
+'!
+
+!PanelView class methodsFor:'documentation'!
-this one just tries to get everything into its space -
-if you dont like its layout, define a subclass ...
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
-HorizontalPanelView and VerticalPanelView are two of them.
+ 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.
+"
+!
-$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.4 1993-12-20 17:24:18 claus Exp $
+version
+"
+$Header: /cvs/stx/stx/libwidg/PanelView.st,v 1.5 1994-08-07 13:23:05 claus Exp $
+"
+!
-written spring/summer 89 by claus
-'!
+documentation
+"
+ this is a view for holding subviews. (layout-widget ?!!)
+
+ Instances of PanelView try to get all their subviews into them,
+ arranging subviews left-to-right, top-to-bottom.
+
+ If you dont like its layout, define a new subclass or use one of
+ the existing subclasses: HorizontalPanelView and VerticalPanelView.
+"
+! !
!PanelView methodsFor:'initialization'!
@@ -73,6 +97,13 @@
verticalSpace := numberOfPixels
!
+layout
+ "return the layout as symbol.
+ the returned value is #left / #top; #spread; #center or #right / #bottom"
+
+ ^ layout
+!
+
layout:aSymbol
"change the layout - the argument, aSymbol is interpreted in subclasses
HorizontalPanelView and VerticalPanelView;
@@ -85,8 +116,24 @@
!
addSubView:aView
+ "redefined to recompute layout when a subview is added"
+
super addSubView:aView.
self layoutChanged
+!
+
+addSubView:newView after:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:newView after:aView.
+ self layoutChanged
+!
+
+addSubView:newView before:aView
+ "redefined to recompute layout when a subview is added"
+
+ super addSubView:newView before:aView.
+ self layoutChanged
! !
!PanelView methodsFor:'event processing'!
@@ -109,7 +156,7 @@
setChildPositions
"(re)compute position of every child"
- |first xpos ypos maxHeightInRow|
+ |first xpos ypos maxHeightInRow thisRow fixRow|
subViews notNil ifTrue:[
xpos := horizontalSpace.
@@ -117,23 +164,40 @@
maxHeightInRow := 0.
first := true.
+ thisRow := OrderedCollection new.
subViews do:[:child |
"go to next row, if this subview won't fit"
first ifFalse: [
(xpos + child widthIncludingBorder + horizontalSpace) > width
ifTrue: [
+ thisRow notEmpty ifTrue:[
+ thisRow do:[:rowElement |
+ rowElement heightIncludingBorder < maxHeightInRow ifTrue:[
+ rowElement top:(rowElement top + (maxHeightInRow - rowElement heightIncludingBorder))
+ ]
+ ]
+ ].
ypos := ypos + verticalSpace + maxHeightInRow.
xpos := horizontalSpace.
- maxHeightInRow := 0
+ maxHeightInRow := 0.
+ thisRow := OrderedCollection new.
]
].
+ thisRow add:child.
child origin:(xpos@ypos).
xpos := xpos + (child widthIncludingBorder) + horizontalSpace.
(maxHeightInRow < (child heightIncludingBorder)) ifTrue:[
maxHeightInRow := child heightIncludingBorder
].
first := false
- ]
+ ].
+ thisRow notEmpty ifTrue:[
+ thisRow do:[:rowElement |
+ rowElement heightIncludingBorder < maxHeightInRow ifTrue:[
+ rowElement top:(rowElement top + (maxHeightInRow - rowElement heightIncludingBorder))
+ ]
+ ]
+ ].
].
mustRearrange := false
! !
--- a/PopUpList.st Sun Aug 07 15:22:53 1994 +0200
+++ b/PopUpList.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,14 +18,67 @@
!
PopUpList comment:'
-
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.1 1994-01-08 17:27:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/PopUpList.st,v 1.2 1994-08-07 13:23:07 claus Exp $
+'!
+
+!PopUpList 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/libwidg/PopUpList.st,v 1.2 1994-08-07 13:23:07 claus Exp $
+"
+!
-written jan 94 by claus
-'!
+documentation
+"
+ a PopUpList is basically a button with a popup menu.
+ The PopUpLists label is showing the current selection from the
+ list.
+
+ example use:
+
+ |p|
+ p := PopUpList label:'healthy fruit'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
+
+ p open
+
+
+ with an initial selection:
+
+ |p|
+ p := PopUpList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
+ p selection:'apples'.
+ p open
+
+
+ with separating lines:
+
+ |p|
+ p := PopUpList label:'dummy'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' '-' 'margarithas').
+ p selection:'apples'.
+ p open
+"
+! !
!PopUpList methodsFor:'drawing'!
@@ -49,16 +102,22 @@
!PopUpList methodsFor:'events'!
buttonPress:button x:x y:y
- |org|
+ |org mv|
- button == 1 ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
menu notNil ifTrue:[
menu font:font.
- menu width:self width.
- menu menuView width:(menu width - menu margin - (menu borderWidth*2)).
+"
+ menu width:self width + (margin * 2).
+"
+ mv := menu menuView.
+ mv width:(self width - (2 * menu margin) - (menu borderWidth*2)).
+ mv level:0; borderWidth:0.
+ mv fixSize.
org := device translatePoint:0@0
from:(self id)
to:(DisplayRootView new id).
+
menu showAt:org "resizing:false"
]
].
@@ -73,24 +132,45 @@
!PopUpList methodsFor:'accessing'!
-action:aBlock
- menuAction := aBlock
+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
!
list
+ "return the list - i.e. the values shown in the pop-up list"
+
^ menu labels
!
list:aList
+ "set the list - i.e. the values shown in the pop-up list"
+
menu := PopUpMenu
labels:aList
selectors:(Array new:(aList size) withAll:#select:)
args:aList
receiver:self
- for:self
+ for:self.
+ realized ifTrue:[
+ self computeLabelSize
+ ]
+
+ "
+ |p|
+ p := PopUpList label:'fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
+ p open
+ "
!
selection:indexOrString
+ "set (force) a selection - usually done to set
+ an initial selection"
+
|index|
index := menu labels indexOf:indexOrString.
@@ -102,6 +182,14 @@
]
].
self label:(menu labels at:index)
+
+ "
+ |p|
+ p := PopUpList label:'what fruit ?'.
+ p list:#('apples' 'bananas' 'grape' 'lemon' 'margarithas').
+ p selection:'apples'.
+ p open
+ "
! !
!PopUpList methodsFor:'private'!
@@ -117,8 +205,8 @@
"hack: simulate logo change to longest menu entry"
font := font on:device.
- longest := nil.
- longestWidth := 0.
+ longest := logo.
+ longestWidth := font widthOf:logo.
menu labels do:[:entry |
|this|
@@ -132,6 +220,7 @@
logo := longest.
super computeLabelSize.
logo := savedLogo.
+"self halt. "
].
mmH := device horizontalPixelPerMillimeter.
mmV := device verticalPixelPerMillimeter.
@@ -142,10 +231,13 @@
!PopUpList methodsFor:'user actions'!
select:anEntry
-'selected:' print. anEntry printNewline.
+"/ 'selected:' print. anEntry printNewline.
menuAction notNil ifTrue:[
menuAction value:anEntry.
].
self sizeFixed:true.
self label:anEntry printString.
+ (model notNil and:[changeSymbol notNil]) ifTrue:[
+ model perform:changeSymbol with:anEntry
+ ].
! !
--- a/PopUpMenu.st Sun Aug 07 15:22:53 1994 +0200
+++ b/PopUpMenu.st Sun Aug 07 15:23:42 1994 +0200
@@ -19,51 +19,240 @@
!
PopUpMenu comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.6 1994-01-08 17:27:41 claus Exp $
-
-written summer 89 by claus;
-ST-80 compatibility added Dec 92;
+$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.7 1994-08-07 13:23:09 claus Exp $
'!
+!PopUpMenu class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/PopUpMenu.st,v 1.7 1994-08-07 13:23:09 claus Exp $
+"
+!
+
+documentation
+"
+ This class provides PopUpMenu functionality; Actually, this class
+ only provides the popup and shadow functionality and wraps another
+ view, which is the actual menu-list (usually an instance of MenuView).
+
+ PopUpMenus are usually created with a list of labels, selectors and a
+ receivier. Once activated, the specified receiver will be sent a
+ 'selector'-message.
+
+ Examples:
+
+ |p|
+ p := PopUpMenu
+ labels:#('foo'
+ 'bar'
+ 'baz')
+ selectors:#(
+ #foo
+ #bar
+ #baz)
+ receiver:nil.
+ p showAtPointer
+
+
+ sometimes, you want to specify both selectors and some arguments
+ to be sent; this is done by:
+
+ |p|
+ p := PopUpMenu
+ labels:#('foo' 'bar' 'baz')
+ selectors:#(#foo: #bar: #foo:)
+ args:#(1 2 3)
+ receiver:nil.
+ p showAtPointer
+
+ or, the same selector but different arguments:
+
+ |p|
+ p := PopUpMenu
+ labels:#('foo' 'bar' 'baz')
+ selectors:#foo:
+ args:#(1 2 3)
+ receiver:nil.
+ p showAtPointer
+
+ Normally, you do not show the menu explicitely, but install
+ it as a middleButtonMenu of some view. (Views button-event handler
+ will show it when the button is pressed ...)
+
+ |v m|
+
+ v := View new.
+ m := PopUpMenu
+ labels:#('lower'
+ 'raise'
+ '-'
+ 'destroy')
+ selectors:#(#lower #raise nil #destroy)
+ receiver:v.
+ v middleButtonMenu:m.
+ v open
+
+ It is also possible, to add check-mark entries, with an entry string
+ starting with the special sequence '\c' (for check-mark). The value
+ passed will be the truth-state of the check-mark.
+
+ |m v|
+
+ v := View new.
+ m := PopUpMenu
+ labels:#('\c foo'
+ '\c bar')
+ selectors:#(#value: #value:)
+ receiver:[:v | Transcript show:'arg: '; showCr:v].
+ v middleButtonMenu:m.
+ v open
+
+
+ Finally, you can wrap other views into a popup menu (for example,
+ to implement menus with icons or other components).
+ The view should respond to some messages sent from here (for
+ example: #hideSubmenus, #deselectWithoutRedraw and others).
+ Currently there is only one class in the system, which can be used
+ this way (PatternMenu in the DrawTool demo):
+
+ |v p|
+
+ v := View new.
+ p := PatternMenu new.
+ p patterns:(Array with:Color red
+ with:Color green
+ with:Color blue).
+ v middleButtonMenu:(PopUpMenu forMenu:p).
+ v open
+
+ or try:
+
+ |v p|
+
+ v := View new.
+ p := PatternMenu new.
+ p patterns:(Array with:Color red
+ with:Color green
+ with:Color blue).
+ p selectors:#value:.
+ p receiver:[:val | v viewBackground:val. v clear].
+ p args:(Array with:Color red
+ with:Color green
+ with:Color blue).
+ v middleButtonMenu:(PopUpMenu forMenu:p).
+ v open
+
+
+ ST-80 style:
+
+ The above menus all did some message send on selection; it is
+ also possible, to use Smalltalk-80 style menus (which return some value
+ from their startup method):
+
+ |m selection|
+
+ m := PopUpMenu
+ labels:#('one' 'two' 'three').
+ selection := m startUp.
+ Transcript show:'the selection was: '; showCr:selection
+
+ startUp will return the entries index, or 0 if there was no selection.
+ You can also specify an array of values to be returned instead of the
+ index:
+
+ |m selection|
+
+ m := PopUpMenu
+ labels:#('one' 'two' 'three')
+ values:#(10 20 30).
+ selection := m startUp.
+ Transcript show:'the value was: '; showCr:selection
+
+ In ST/X style menus, separating lines between entries are created
+ by a '-'-string as its label text (and corresponding nil-entries in the
+ selectors- and args-arrays).
+ In ST-80, you have to pass the indices of the lines in an extra array:
+
+ |m selection|
+
+ m := PopUpMenu
+ labels:#('one' 'two' 'three' 'four' 'five')
+ lines:#(2 4).
+ selection := m startUp.
+ Transcript show:'the value was: '; showCr:selection
+
+ or:
+ |m selection|
+
+ m := PopUpMenu
+ labels:#('one' 'two' 'three')
+ lines:#(2)
+ values:#(10 20 30).
+ selection := m startUp.
+ Transcript show:'the value was: '; showCr:selection
+
+ Use whichever interface you prefer.
+"
+! !
+
!PopUpMenu class methodsFor:'instance creation'!
+onSameDeviceAs:aView
+ "this takes care of the device on which the view (for which
+ the popup-menu is to be created) is located."
+
+ aView isNil ifTrue:[
+ ^ self on:Display
+ ].
+ ^ self on:(aView device)
+!
+
+forMenu:aMenuView
+ "this wraps an already existing menu - allowing to put any
+ view (not just MenuViews) into popups (for example, menus
+ with icons, or other components).
+ Currently, there is only one example of different menus in
+ the system (PatternMenu in the DrawTool) which could be used
+ this way.
+ The view should respond to some of the menuView messages
+ (such as hideSubmenu, deselectWithoutRedraw etc.)"
+
+ |newMenu|
+
+ newMenu := self onSameDeviceAs:aMenuView.
+ newMenu addSubView:aMenuView.
+ newMenu menu:aMenuView.
+ ^ newMenu
+!
+
labels:labels selectors:selectors receiver:anObject for:aView
|newMenu|
- aView isNil ifTrue:[
- newMenu := self on:Display
- ] ifFalse:[
- newMenu := self on:(aView device)
- ].
- ^ newMenu menu:(MenuView
+ newMenu := self onSameDeviceAs:aView.
+ newMenu menu:(MenuView
labels:labels
- selectors:selectors
- receiver:anObject
- in:newMenu)
-!
-
-labels:labels selectors:selectors receiver:anObject
- ^ self labels:labels selectors:selectors receiver:anObject for:nil
-!
-
-labels:labels selectors:selectors args:args receiver:anObject for:aView
- |newMenu|
-
- aView isNil ifTrue:[
- newMenu := self on:Display
- ] ifFalse:[
- newMenu := self on:(aView device)
- ].
- ^ newMenu menu:(MenuView
- labels:labels
- selectors:selectors
- args:args
- receiver:anObject
- in:newMenu)
+ selectors:selectors
+ receiver:anObject
+ in:newMenu).
+ ^ newMenu
!
labels:labels selectors:selectors args:args receiver:anObject
@@ -72,6 +261,44 @@
args:args
receiver:anObject
for:nil
+!
+
+labels:labels selectors:selectors args:args receiver:anObject for:aView
+ |newMenu|
+
+ newMenu := self onSameDeviceAs:aView.
+ newMenu menu:(MenuView
+ labels:labels
+ selectors:selectors
+ args:args
+ receiver:anObject
+ in:newMenu).
+ ^ newMenu
+!
+
+labels:labels selector:aSelector args:args receiver:anObject
+ ^ self labels:labels
+ selector:aSelector
+ args:args
+ receiver:anObject
+ for:nil
+!
+
+labels:labels selectors:selectors receiver:anObject
+ ^ self labels:labels selectors:selectors receiver:anObject for:nil
+!
+
+labels:labels selector:aSelector args:args receiver:anObject for:aView
+ |newMenu|
+
+ newMenu := self onSameDeviceAs:aView.
+ newMenu menu:(MenuView
+ labels:labels
+ selector:aSelector
+ args:args
+ receiver:anObject
+ in:newMenu).
+ ^ newMenu
! !
!PopUpMenu class methodsFor:'ST-80 instance creation'!
@@ -109,6 +336,13 @@
style == #iris ifTrue:[
borderWidth := 1
].
+ (style == #st80) ifTrue:[
+ viewBackground := White.
+ borderWidth := 1.
+ level := 0.
+ margin := 0.
+ shadowView := nil
+ ].
!
initEvents
@@ -136,14 +370,18 @@
!
realize
+"/ windowGroup notNil ifTrue:[
+"/ windowGroup sensor compressMotionEvents:true
+"/ ].
+
menuView deselectWithoutRedraw.
- self enableEnterLeaveEvents.
+"/ self enableEnterLeaveEvents.
super realize.
- menuView disableButtonMotionEvents.
- menuView disableMotionEvents.
- menuView disableButtonEvents.
- menuView disableEnterLeaveEvents
+"/ menuView disableButtonMotionEvents.
+"/ menuView disableMotionEvents.
+"/ menuView disableButtonEvents.
+"/ menuView disableEnterLeaveEvents
! !
!PopUpMenu methodsFor:'private accessing'!
@@ -214,6 +452,18 @@
^ menuView list
!
+indexOf:indexOrName
+ "return the index of a submenu - or 0 if there is none"
+
+ ^ menuView indexOf:indexOrName
+!
+
+remove:indexOrName
+ "remove a menu entry"
+
+ menuView remove:indexOrName
+!
+
addLabel:aLabel selector:aSelector
"add a new menu entry to the end"
@@ -226,6 +476,12 @@
menuView addLabel:aLabel selector:aSelector arg:anArg
!
+addLabel:aLabel selector:aSelector after:indexOrName
+ "add a new menu entry somewhere"
+
+ menuView addLabel:aLabel selector:aSelector after:indexOrName
+!
+
labelAt:index put:aString
"change a menu entry"
@@ -354,13 +610,8 @@
self fixSize.
].
self origin:aPoint.
- ((top + height) > (device height)) ifTrue:[
- self top:(device height - height)
- ].
- ((left + width) > (device width)) ifTrue:[
- self left:(device width - width)
- ].
- self realize
+ self makeFullyVisible.
+ self openModal:[true] "realize "
!
showAt:aPoint
@@ -379,34 +630,39 @@
"realize the menu at its last position"
self fixSize.
- self realize
+ self openModal:[true] "realize "
!
hide
"hide the menu - if there are any pop-up-submenus, hide them also"
menuView hideSubmenu.
- ^ self unrealize
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self.
+ windowGroup := nil.
+ ].
+ self unrealize.
!
-regainControl
-"
+XXregainControl
+" "
device ungrabPointer.
device grabPointerIn:drawableId
-"
+" "
! !
!PopUpMenu methodsFor:'ST-80 activation'!
startUp
- "start the menu modal - return the selected selector,
- or - if no selectors where specified - the index.
+ "start the menu modal - return the selected value,
+ or - if no values where specified - return the index.
If nothing was selected, return 0.
- Modal - i.e. stay in the menu until finished"
-
- |actionIndex value|
+ Modal - i.e. stay in the menu until finished.
+ This is the ST-80 way of launching a menu."
menuView action:[:selected |
+ |actionIndex value|
+
menuView args isNil ifTrue:[
menuView selectors isNil ifTrue:[
^ 0
@@ -423,8 +679,13 @@
^ value
].
self showAtPointer.
- self modalLoop.
^ 0
+
+ "
+ Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp
+ Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')
+ values:#(foo bar baz)) startUp
+ "
! !
!PopUpMenu methodsFor:'events'!
@@ -432,21 +693,17 @@
buttonMotion:button x:x y:y
|p|
- (x >= 0) ifTrue:[
- (x < width) ifTrue:[
- (y >= 0) ifTrue:[
- (y < height) ifTrue:[
- menuView buttonMotion:button x:x y:y.
- ^ self
- ]
- ]
+ ((x >= 0) and:[x < width]) ifTrue:[
+ ((y >= 0) and:[y < height]) ifTrue:[
+ menuView buttonMotion:button x:x y:y.
+ ^ self
]
].
"outside of myself"
menuView superMenu notNil ifTrue:[
p := device translatePoint:(x @ y)
- from:(self id)
+ from:drawableId
to:(menuView superMenu id).
menuView superMenu buttonMotion:button x:p x y:p y
].
@@ -457,7 +714,11 @@
hideOnLeave ifTrue:[
self hide
- ]
+ ].
+
+"/ menuView superMenu notNil ifTrue:[
+"/ menuView superMenu regainControl.
+"/ ].
!
pointerEnter:state x:x y:y
@@ -467,13 +728,13 @@
!
pointerLeave:state
- menuView pointerLeave:state.
- hideOnLeave ifTrue:[
- self hide
- ].
- menuView superMenu notNil ifTrue:[
- menuView superMenu regainControl
- ]
+"/ menuView pointerLeave:state.
+"/ hideOnLeave ifTrue:[
+"/ self hide
+"/ ].
+"/ menuView superMenu notNil ifTrue:[
+"/ menuView superMenu regainControl
+"/ ]
!
buttonRelease:button x:x y:y
--- a/PullDMenu.st Sun Aug 07 15:22:53 1994 +0200
+++ b/PullDMenu.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,43 +14,63 @@
instanceVariableNames:'menus titles activeMenuNumber
showSeparatingLines topMargin
fgColor bgColor activeFgColor activeBgColor
- onLevel offLevel'
+ onLevel offLevel
+ keepMenu'
classVariableNames:''
poolDictionaries:''
category:'Views-Menus'
!
PullDownMenu comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.4 1994-01-08 17:27:45 claus Exp $
-
-written summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.5 1994-08-07 13:23:11 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Attic/PullDMenu.st,v 1.5 1994-08-07 13:23:11 claus Exp $
+"
+!
+
documentation
"
-PullDown menu provides the top (always visible) part of these menus. It controls
-display of its menus, which become visible when one of the PullDownMenus entries
-is pressed.
+ PullDown menu provides the top (always visible) part of these menus.
+ It controls display of its menus, which become visible when one of the
+ PullDownMenus entries is pressed.
-Instance variables:
+ Instance variables:
-menus <aCollection> the sub menus
-titles <aCollection> the strings in the menu
-activeMenuNumber <Number> the index of the currently active menu
-showSeparatingLines <Boolean> show separating lines between my menu-strings
-topMargin <Number> number of pixels at top
-fgColor <Color> color to draw passive menu-titles
-bgColor <Color> color to draw passive menu-titles
-activeFgColor <Color> color to draw activated menu-titles
-activeBgColor <Color> color to draw activated menu-titles
-onLevel <Integer> level of entry-buttons when pressed
-offLevel <Integer> level of entry-buttons when released
+ menus <aCollection> the sub menus
+ titles <aCollection> the strings in the menu
+ activeMenuNumber <Number> the index of the currently active menu
+ showSeparatingLines <Boolean> show separating lines between my menu-strings
+ topMargin <Number> number of pixels at top
+ fgColor <Color> color to draw passive menu-titles
+ bgColor <Color> color to draw passive menu-titles
+ activeFgColor <Color> color to draw activated menu-titles
+ activeBgColor <Color> color to draw activated menu-titles
+ onLevel <Integer> level of entry-buttons when pressed
+ offLevel <Integer> level of entry-buttons when released
+ keepmenu <Boolean> if on, pulled menu stays on click,
+ till clicked again (motif & windows behavior)
"
! !
@@ -94,7 +114,7 @@
].
topMargin := 2.
- style == #iris ifTrue:[
+ ((style == #iris) or:[style == #motif]) ifTrue:[
self level:2.
softEdge := true.
onLevel := 2.
@@ -106,6 +126,7 @@
activeBgColor := fgColor.
topMargin := 0
].
+ keepMenu := (style == #motif) or:[(style == #iris) or:[style == #mswindows]].
!
initEvents
@@ -329,20 +350,25 @@
]
!
-hideActiveMenu
+hideActiveMenuRelease:aBoolean
activeMenuNumber notNil ifTrue:[
(menus at:activeMenuNumber) unrealize.
self unHighlightActiveTitle.
+ aBoolean ifTrue:[device ungrabPointer. self cursor:Cursor normal].
activeMenuNumber := nil
]
!
+hideActiveMenu
+ ^ self hideActiveMenuRelease:true
+!
+
pullMenu:aNumber
"activate a menu"
|subMenu|
- activeMenuNumber notNil ifTrue:[self hideActiveMenu].
+ activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
subMenu := menus at:aNumber.
subMenu notNil ifTrue:[
activeMenuNumber := aNumber.
@@ -413,11 +439,43 @@
!
buttonPress:button x:x y:y
- |titleIndex|
+ |titleIndex activeMenu activeLeft activeTop|
+
+ (y between:0 and:height) ifTrue:[
+ titleIndex := self titleIndexForX:x.
+ ].
- titleIndex := self titleIndexForX:x.
- titleIndex notNil ifTrue:[
- self pullMenu:titleIndex
+ "
+ now, titleIndex is non-nil if pressed within myself
+ "
+ (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
+ self pullMenu:titleIndex.
+ keepMenu ifTrue:[
+ device grabPointerIn:self id.
+ self cursor:Cursor upRightArrow
+ ]
+ ] ifFalse:[
+ keepMenu ifTrue:[
+ titleIndex == activeMenuNumber ifTrue:[
+ "same pressed again ... stay"
+ ^ self
+ ].
+ "moving around below"
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
+ activeLeft := activeMenu left.
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "moving around in menu"
+ activeMenu buttonPress:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ ].
+ self hideActiveMenu
]
!
@@ -432,7 +490,6 @@
titleIndex := self titleIndexForX:x.
titleIndex notNil ifTrue:[
(titleIndex ~~ activeMenuNumber) ifTrue:[
- self hideActiveMenu.
self pullMenu:titleIndex
]
]
@@ -457,24 +514,39 @@
!
buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop|
+ |activeMenu activeLeft activeTop hideMenu|
+ hideMenu := false.
(y >= height) ifTrue:[
"release below title-line"
activeMenuNumber isNil ifTrue:[^self].
activeMenu := menus at:activeMenuNumber.
activeLeft := activeMenu left.
+ "
+ released in a submenu ?
+ "
(x between:activeLeft and:(activeMenu right)) ifTrue:[
activeTop := activeMenu top.
(y between:activeTop and:(activeMenu bottom)) ifTrue:[
"release in menu"
- self hideActiveMenu.
+ self hideActiveMenu.
activeMenu buttonRelease:button
x:(x - activeLeft)
y:(y - activeTop).
^ self
]
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ y < 0 ifTrue:[
+ hideMenu := true
+ ] ifFalse:[
+ keepMenu ifFalse:[
+ hideMenu := true
+ ]
]
- ].
- self hideActiveMenu
+ ].
+ hideMenu ifTrue:[
+ self hideActiveMenu.
+ ]
! !
--- a/PullDownMenu.st Sun Aug 07 15:22:53 1994 +0200
+++ b/PullDownMenu.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,43 +14,63 @@
instanceVariableNames:'menus titles activeMenuNumber
showSeparatingLines topMargin
fgColor bgColor activeFgColor activeBgColor
- onLevel offLevel'
+ onLevel offLevel
+ keepMenu'
classVariableNames:''
poolDictionaries:''
category:'Views-Menus'
!
PullDownMenu comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.4 1994-01-08 17:27:45 claus Exp $
-
-written summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.5 1994-08-07 13:23:11 claus Exp $
'!
!PullDownMenu class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/PullDownMenu.st,v 1.5 1994-08-07 13:23:11 claus Exp $
+"
+!
+
documentation
"
-PullDown menu provides the top (always visible) part of these menus. It controls
-display of its menus, which become visible when one of the PullDownMenus entries
-is pressed.
+ PullDown menu provides the top (always visible) part of these menus.
+ It controls display of its menus, which become visible when one of the
+ PullDownMenus entries is pressed.
-Instance variables:
+ Instance variables:
-menus <aCollection> the sub menus
-titles <aCollection> the strings in the menu
-activeMenuNumber <Number> the index of the currently active menu
-showSeparatingLines <Boolean> show separating lines between my menu-strings
-topMargin <Number> number of pixels at top
-fgColor <Color> color to draw passive menu-titles
-bgColor <Color> color to draw passive menu-titles
-activeFgColor <Color> color to draw activated menu-titles
-activeBgColor <Color> color to draw activated menu-titles
-onLevel <Integer> level of entry-buttons when pressed
-offLevel <Integer> level of entry-buttons when released
+ menus <aCollection> the sub menus
+ titles <aCollection> the strings in the menu
+ activeMenuNumber <Number> the index of the currently active menu
+ showSeparatingLines <Boolean> show separating lines between my menu-strings
+ topMargin <Number> number of pixels at top
+ fgColor <Color> color to draw passive menu-titles
+ bgColor <Color> color to draw passive menu-titles
+ activeFgColor <Color> color to draw activated menu-titles
+ activeBgColor <Color> color to draw activated menu-titles
+ onLevel <Integer> level of entry-buttons when pressed
+ offLevel <Integer> level of entry-buttons when released
+ keepmenu <Boolean> if on, pulled menu stays on click,
+ till clicked again (motif & windows behavior)
"
! !
@@ -94,7 +114,7 @@
].
topMargin := 2.
- style == #iris ifTrue:[
+ ((style == #iris) or:[style == #motif]) ifTrue:[
self level:2.
softEdge := true.
onLevel := 2.
@@ -106,6 +126,7 @@
activeBgColor := fgColor.
topMargin := 0
].
+ keepMenu := (style == #motif) or:[(style == #iris) or:[style == #mswindows]].
!
initEvents
@@ -329,20 +350,25 @@
]
!
-hideActiveMenu
+hideActiveMenuRelease:aBoolean
activeMenuNumber notNil ifTrue:[
(menus at:activeMenuNumber) unrealize.
self unHighlightActiveTitle.
+ aBoolean ifTrue:[device ungrabPointer. self cursor:Cursor normal].
activeMenuNumber := nil
]
!
+hideActiveMenu
+ ^ self hideActiveMenuRelease:true
+!
+
pullMenu:aNumber
"activate a menu"
|subMenu|
- activeMenuNumber notNil ifTrue:[self hideActiveMenu].
+ activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
subMenu := menus at:aNumber.
subMenu notNil ifTrue:[
activeMenuNumber := aNumber.
@@ -413,11 +439,43 @@
!
buttonPress:button x:x y:y
- |titleIndex|
+ |titleIndex activeMenu activeLeft activeTop|
+
+ (y between:0 and:height) ifTrue:[
+ titleIndex := self titleIndexForX:x.
+ ].
- titleIndex := self titleIndexForX:x.
- titleIndex notNil ifTrue:[
- self pullMenu:titleIndex
+ "
+ now, titleIndex is non-nil if pressed within myself
+ "
+ (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
+ self pullMenu:titleIndex.
+ keepMenu ifTrue:[
+ device grabPointerIn:self id.
+ self cursor:Cursor upRightArrow
+ ]
+ ] ifFalse:[
+ keepMenu ifTrue:[
+ titleIndex == activeMenuNumber ifTrue:[
+ "same pressed again ... stay"
+ ^ self
+ ].
+ "moving around below"
+ activeMenuNumber isNil ifTrue:[^self].
+ activeMenu := menus at:activeMenuNumber.
+ activeLeft := activeMenu left.
+ (x between:activeLeft and:(activeMenu right)) ifTrue:[
+ activeTop := activeMenu top.
+ (y between:activeTop and:(activeMenu bottom)) ifTrue:[
+ "moving around in menu"
+ activeMenu buttonPress:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ].
+ ].
+ self hideActiveMenu
]
!
@@ -432,7 +490,6 @@
titleIndex := self titleIndexForX:x.
titleIndex notNil ifTrue:[
(titleIndex ~~ activeMenuNumber) ifTrue:[
- self hideActiveMenu.
self pullMenu:titleIndex
]
]
@@ -457,24 +514,39 @@
!
buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop|
+ |activeMenu activeLeft activeTop hideMenu|
+ hideMenu := false.
(y >= height) ifTrue:[
"release below title-line"
activeMenuNumber isNil ifTrue:[^self].
activeMenu := menus at:activeMenuNumber.
activeLeft := activeMenu left.
+ "
+ released in a submenu ?
+ "
(x between:activeLeft and:(activeMenu right)) ifTrue:[
activeTop := activeMenu top.
(y between:activeTop and:(activeMenu bottom)) ifTrue:[
"release in menu"
- self hideActiveMenu.
+ self hideActiveMenu.
activeMenu buttonRelease:button
x:(x - activeLeft)
y:(y - activeTop).
^ self
]
+ ].
+ hideMenu := true.
+ ] ifFalse:[
+ y < 0 ifTrue:[
+ hideMenu := true
+ ] ifFalse:[
+ keepMenu ifFalse:[
+ hideMenu := true
+ ]
]
- ].
- self hideActiveMenu
+ ].
+ hideMenu ifTrue:[
+ self hideActiveMenu.
+ ]
! !
--- a/RButtGrp.st Sun Aug 07 15:22:53 1994 +0200
+++ b/RButtGrp.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,16 +18,40 @@
!
RadioButtonGroup comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-RadioButtonGroups controll the interaction between RadioButtons
-turning off other button(s) when one of the group is pressed.
+$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.5 1994-08-07 13:23:13 claus Exp $
+'!
+
+!RadioButtonGroup class methodsFor:'documentation '!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.4 1993-12-11 01:48:03 claus Exp $
-written nov 91 by claus
-'!
+ 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/libwidg/Attic/RButtGrp.st,v 1.5 1994-08-07 13:23:13 claus Exp $
+"
+!
+
+documentation
+"
+ RadioButtonGroups control the interaction between RadioButtons
+ turning off other button(s) when one of the group is pressed.
+"
+! !
!RadioButtonGroup methodsFor:'adding / removing'!
@@ -41,6 +65,13 @@
update:changedButton
"a RadioButton in this group has changed - notify the others"
+ "in case we have a toggle in the group,
+ and it has been turned off - turn it on again
+ "
+ changedButton isOn ifFalse:[
+ changedButton toggleNoAction.
+ ^ self
+ ].
self do:[:aButton |
(aButton == changedButton) ifFalse:[
aButton isOn ifTrue:[
--- a/RButton.st Sun Aug 07 15:22:53 1994 +0200
+++ b/RButton.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,16 +18,42 @@
!
RadioButton comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-like a Toggle, but do not turn off when pressed again, instead only
-turn off when another RadioButton is pressed (see RadioButtonGroup).
+$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.4 1994-08-07 13:23:14 claus Exp $
+'!
+
+!RadioButton class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/RButton.st,v 1.3 1993-10-13 02:48:52 claus Exp $
-written fall 91 by claus
-'!
+ 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/libwidg/Attic/RButton.st,v 1.4 1994-08-07 13:23:14 claus Exp $
+"
+!
+
+documentation
+"
+ like a Toggle, but do not turn off when pressed again, instead only
+ turn off when another RadioButton is pressed (see RadioButtonGroup).
+
+ written fall 91 by claus
+"
+! !
!RadioButton methodsFor:'destroying'!
--- a/RadioButton.st Sun Aug 07 15:22:53 1994 +0200
+++ b/RadioButton.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,16 +18,42 @@
!
RadioButton comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-like a Toggle, but do not turn off when pressed again, instead only
-turn off when another RadioButton is pressed (see RadioButtonGroup).
+$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.4 1994-08-07 13:23:14 claus Exp $
+'!
+
+!RadioButton class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/RadioButton.st,v 1.3 1993-10-13 02:48:52 claus Exp $
-written fall 91 by claus
-'!
+ 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/libwidg/RadioButton.st,v 1.4 1994-08-07 13:23:14 claus Exp $
+"
+!
+
+documentation
+"
+ like a Toggle, but do not turn off when pressed again, instead only
+ turn off when another RadioButton is pressed (see RadioButtonGroup).
+
+ written fall 91 by claus
+"
+! !
!RadioButton methodsFor:'destroying'!
--- a/RadioButtonGroup.st Sun Aug 07 15:22:53 1994 +0200
+++ b/RadioButtonGroup.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,16 +18,40 @@
!
RadioButtonGroup comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-RadioButtonGroups controll the interaction between RadioButtons
-turning off other button(s) when one of the group is pressed.
+$Header: /cvs/stx/stx/libwidg/RadioButtonGroup.st,v 1.5 1994-08-07 13:23:13 claus Exp $
+'!
+
+!RadioButtonGroup class methodsFor:'documentation '!
+
+copyright
+"
+ COPYRIGHT (c) 1991 by Claus Gittinger
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/RadioButtonGroup.st,v 1.4 1993-12-11 01:48:03 claus Exp $
-written nov 91 by claus
-'!
+ 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/libwidg/RadioButtonGroup.st,v 1.5 1994-08-07 13:23:13 claus Exp $
+"
+!
+
+documentation
+"
+ RadioButtonGroups control the interaction between RadioButtons
+ turning off other button(s) when one of the group is pressed.
+"
+! !
!RadioButtonGroup methodsFor:'adding / removing'!
@@ -41,6 +65,13 @@
update:changedButton
"a RadioButton in this group has changed - notify the others"
+ "in case we have a toggle in the group,
+ and it has been turned off - turn it on again
+ "
+ changedButton isOn ifFalse:[
+ changedButton toggleNoAction.
+ ^ self
+ ].
self do:[:aButton |
(aButton == changedButton) ifFalse:[
aButton isOn ifTrue:[
--- a/ScrView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ScrView.st Sun Aug 07 15:23:42 1994 +0200
@@ -19,93 +19,228 @@
!
ScrollableView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-a view containing a scrollbar and some other (slave-)view
+
+$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.5 1994-08-07 13:23:16 claus Exp $
+'!
+
+!ScrollableView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Attic/ScrView.st,v 1.5 1994-08-07 13:23:16 claus Exp $
+"
+!
+
+documentation
+"
+ a view containing a scrollbar and some other (slave-)view.
+ There are two ways to create a ScrollableView:
+ if the type of the view to be scrolled is known in advance,
+ use:
+ v := ScrollableView for:<ViewClass> in:someSuperView.
+ otherwise, create the scrollableView empty with:
+ v := ScrollableView in:someSuperView.
+ ...
+ v scrolledView:aViewToBeScrolled
+
+ example1:
+
+ |top scr txt|
-$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.4 1993-12-11 01:48:54 claus Exp $
+ top := StandardSystemView label:'example'.
+ scr := ScrollableView for:EditTextView in:top.
+ scr origin:0.0@0.0 corner:1.0@1.0.
+ txt := scr scrolledView.
+
+ txt list:#('line1'
+ 'line2'
+ 'line3'
+ 'line4'
+ 'line5'
+ 'line6').
+ top open
+
+ example2:
+
+ |top scr txt1 txt2|
+
+ top := StandardSystemView label:'example'.
+ scr := ScrollableView in:top.
+ scr origin:0.0@0.0 corner:1.0@1.0.
+ top open.
-written spring 89 by claus
-'!
+ (Delay forSeconds:5) wait.
+
+ txt1 := EditTextView new.
+ txt1 list:#('line1'
+ 'line2'
+ 'line3'
+ 'line4'
+ 'line5'
+ 'line6').
+ scr scrolledView:txt1.
+
+ (Delay forSeconds:5) wait.
+
+ txt2 := EditTextView new.
+ txt2 list:#('alternative line1'
+ 'alternative line2'
+ 'alternative line3'
+ 'alternative line4'
+ 'alternative line5'
+ 'alternative line6').
+ scr scrolledView:txt2.
+"
+! !
!ScrollableView class methodsFor:'instance creation'!
in:aView
- ^ self for:nil in:aView
+ "return a new scrolling view to be contained in aView.
+ There is no slave view now - this has to be set later via
+ the scrolledView: method.
+ The view will have full scrollbars."
+
+ ^ self for:nil miniScrollerH:false miniScrollerV:false in:aView
!
for:aViewClass
- ^ self for:aViewClass in:nil
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars."
+
+ ^ self for:aViewClass miniScrollerH:false miniScrollerV:false in:nil
!
for:aViewClass in:aView
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars."
+
+ ^ self for:aViewClass miniScrollerH:false miniScrollerV:false in:aView
+!
+
+for:aViewClass miniScroller:mini in:aView
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars if mini is false, miniscrollers
+ if true."
+
+ ^ self for:aViewClass miniScrollerH:mini miniScrollerV:mini in:aView
+!
+
+for:aViewClass miniScrollerH:miniH miniScrollerV:miniV in:aView
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars if the corresponding miniH/miniV
+ is false, miniscrollers if false."
+
|newView|
- newView := self basicNew.
aView notNil ifTrue:[
+ newView := self basicNew.
newView device:(aView device).
aView addSubView:newView
] ifFalse:[
- newView device:Display
+ "create on Display by default"
+ newView := self new.
].
- newView initializeFor:aViewClass.
+ newView initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV.
^ newView
! !
!ScrollableView methodsFor:'initialization'!
initialize
- ^ self initializeFor:nil
+ "default setup: full scrollers"
+
+ ^ self initializeFor:nil miniScrollerH:false miniScrollerV:false
!
-initializeFor:aViewClass
- |negativeOffset twoMargins halfMargin|
+initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV
+ |negativeOffset twoMargins halfMargin cls|
super initialize.
- innerMargin := ViewSpacing.
+ style == #openwin ifTrue:[self level:0].
+ style == #st80 ifTrue:[
+ innerMargin := 0
+ ] ifFalse:[
+ innerMargin := ViewSpacing.
+ ].
negativeOffset := borderWidth negated.
"create the scrollbar"
- scrollBar := ScrollBar in:self.
+ cls := miniV ifTrue:[MiniScroller] ifFalse:[ScrollBar].
+ style == #st80 ifTrue:[cls := ScrollBar].
+
+ scrollBar := cls in:self.
scrollBar thumbOrigin:0 thumbHeight:100.
"create the subview"
- self is3D ifTrue:[
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
twoMargins := innerMargin * 2.
halfMargin := innerMargin // 2.
+ aViewClass notNil ifTrue:[
+ scrolledView := aViewClass in:self.
+ style == #openwin ifTrue:[
+ scrolledView level:0.
+ scrolledView borderWidth:1
+ ] ifFalse:[
+ style == #st80 ifTrue:[
+ scrolledView level:1.
+ ] ifFalse:[
+ scrolledView level:-1
+ ]
+ ].
+ ].
(scrollBarPosition == #right) ifTrue:[
scrollBar origin:[width - scrollBar extent x
- - scrollBar borderWidth
+ - (scrollBar borderWidth * 2)
- halfMargin
@
halfMargin]
extent:[scrollBar extent x @ (height - innerMargin)].
- helpView := View in:self.
- helpView origin:halfMargin asPoint
- extent:[(width - scrollBar width - twoMargins) @ (height - innerMargin)].
+
+ scrolledView notNil ifTrue:[
+ scrolledView origin:halfMargin asPoint
+ extent:[(width -
+ scrollBar width -
+ twoMargins)
+ @
+ (height - innerMargin)].
+ ]
] ifFalse:[
scrollBar origin:halfMargin asPoint
extent:[scrollBar extent x @ (height - innerMargin)].
- helpView := View in:self.
- helpView origin:((scrollBar origin x + scrollBar width + innerMargin)
- @
- halfMargin)
- extent:[(width - scrollBar width - twoMargins) @ (height - innerMargin)].
+
+ scrolledView notNil ifTrue:[
+ scrolledView origin:((scrollBar origin x + scrollBar width + innerMargin)
+ @
+ halfMargin)
+ extent:[(width - scrollBar width - twoMargins)
+ @
+ (height - innerMargin)].
+ ]
].
-
- aViewClass notNil ifTrue:[
- scrolledView := aViewClass in:helpView.
- scrolledView origin:helpView level abs asPoint
- extent:[(helpView width - helpView level abs - helpView level abs)
- @
- (helpView height - helpView level abs - helpView level abs)].
- helpView viewBackground:(scrolledView viewBackground).
- scrolledView level:-1
- ]
] ifFalse:[
(scrollBarPosition == #right) ifTrue:[
scrollBar origin:[width - scrollBar extent x
@@ -122,39 +257,50 @@
(scrollBarPosition == #right) ifTrue:[
scrolledView origin:scrolledView borderWidth negated asPoint
] ifFalse:[
- scrolledView origin:((scrollBar width + scrollBar borderWidth
- - scrolledView borderWidth)
+ scrolledView origin:((scrollBar width +
+ scrollBar borderWidth -
+ scrolledView borderWidth)
@
scrolledView borderWidth negated)
].
- scrolledView extent:[(width - scrollBar width
- - scrolledView borderWidth)
+ scrolledView extent:[(width - scrollBar width - scrolledView borderWidth)
@
(height + (scrollBar borderWidth))
]
].
].
scrolledView notNil ifTrue:[
- self setScrollActions
+ self setScrollActions.
+ "
+ pass input to myself (and other subviews) to
+ the scrolled view
+ "
+ self keyboardHandler:scrolledView.
]
!
initStyle
super initStyle.
- scrollBarPosition := #left.
- ((style == #motif) or:[style == #mswindows]) ifTrue:[
+ ((style == #motif)
+ or:[(style == #mswindows)
+ or:[style == #openwin]]) ifTrue:[
scrollBarPosition := #right
+ ] ifFalse:[
+ scrollBarPosition := #left.
].
!
realize
super realize.
+
"since scrolledview may have done something to its contents
during init-time we had no chance yet to catch contents-
changes; do it now
"
- scrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ scrollBar setThumbFor:scrolledView
+ ]
! !
!ScrollableView methodsFor:'private'!
@@ -168,7 +314,7 @@
(this avoids run-away scroller when scrolling
textviews, when the text is aligned line-wise).
- Cosnider it as a kludge."
+ Consider this as a kludge."
lock := false.
@@ -205,41 +351,88 @@
!
scrolledView:aView
- |m m2 b|
+ "set the view to scroll"
+
+ |halfMargin twoMargins|
scrolledView notNil ifTrue:[
- self error:'can only scroll one view'
+ scrolledView destroy.
+ scrolledView := nil.
].
scrolledView := aView.
- b := scrolledView borderWidth.
- self is3D ifTrue:[
- m := helpView margin.
- m2 := m * 2.
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
+ "3D look"
+
+ twoMargins := innerMargin * 2.
+ halfMargin := innerMargin // 2.
- helpView addSubView:scrolledView.
- scrolledView origin:(m @ m)
- extent:[(helpView width - m2) @ (helpView height - m2)].
- scrolledView superViewChangedSize.
- helpView viewBackground:(scrolledView viewBackground).
- scrolledView level:-1
- ] ifFalse:[
- self addSubView:scrolledView.
+ style == #openwin ifTrue:[
+ scrolledView level:0.
+ scrolledView borderWidth:1
+ ] ifFalse:[
+ scrolledView level:-1
+ ].
+
(scrollBarPosition == #right) ifTrue:[
- scrolledView origin:scrolledView borderWidth negated asPoint
+ scrolledView
+ origin:halfMargin asPoint
+ extent:[(width -
+ scrollBar width -
+ twoMargins)
+ @
+ (height - innerMargin)
+ ].
] ifFalse:[
- scrolledView origin:((scrollBar width + scrollBar borderWidth - b) @ b negated)
- extent:[(width - scrollBar width - b) @ (height + scrollBar borderWidth)
- ].
+ scrolledView
+ origin:((scrollBar origin x
+ + scrollBar width
+ + innerMargin)
+ @
+ halfMargin)
+ extent:[(width
+ - scrollBar width
+ - twoMargins)
+ @
+ (height - innerMargin)
+ ].
+ ]
+ ] ifFalse:[
+ "non 3D look"
+ (scrollBarPosition == #right) ifTrue:[
+ scrolledView
+ origin:scrolledView borderWidth negated asPoint
+ ] ifFalse:[
+ scrolledView
+ origin:((scrollBar width
+ + scrollBar borderWidth
+ - scrolledView borderWidth)
+ @
+ scrolledView borderWidth negated)
].
- scrolledView superViewChangedSize.
+ scrolledView
+ extent:[
+ (width
+ - scrollBar width
+ - scrolledView borderWidth)
+ @
+ (height
+ + (scrollBar borderWidth))
+ ]
].
- scrolledView
- originChangeAction:[:aView | scrollBar setThumbOriginFor:aView].
- scrolledView
- contentsChangeAction:[:aView | scrollBar setThumbFor:aView].
- realized ifTrue:[scrolledView realize]
+ super addSubView:scrolledView.
+ self setScrollActions.
+ "
+ pass input to myself (and other subviews) to
+ the scrolled view
+ "
+ self keyboardHandler:scrolledView.
+
+ realized ifTrue:[
+ self sizeChanged:nil.
+ scrolledView realize
+ ].
! !
!ScrollableView methodsFor:'slave-view messages'!
@@ -254,11 +447,16 @@
cursor:aCursor
"I have the same cursor as my scrolledView"
- scrolledView cursor:aCursor.
+ scrolledView notNil ifTrue:[
+ scrolledView cursor:aCursor
+ ].
super cursor:aCursor
!
leftButtonMenu
+ "return scrolledViews leftbuttonmenu"
+
+ scrolledView isNil ifTrue:[^ nil].
^ scrolledView leftButtonMenu
!
@@ -269,6 +467,9 @@
!
middleButtonMenu
+ "return scrolledViews middlebuttonmenu"
+
+ scrolledView isNil ifTrue:[^ nil].
^ scrolledView middleButtonMenu
!
@@ -279,6 +480,9 @@
!
rightButtonMenu
+ "return scrolledViews rightbuttonmenu"
+
+ scrolledView isNil ifTrue:[^ nil].
^ scrolledView rightButtonMenu
!
@@ -299,9 +503,34 @@
]
! !
+!ScrollableView methodsFor:'forced scroll'!
+
+pageUp
+ "page up"
+
+ scrollBar pageUp
+!
+
+pageDown
+ "page down"
+
+ scrollBar pageDown
+! !
+
!ScrollableView methodsFor:'event processing'!
+keyPress:key x:x y:y
+ "a key was pressed - handle page-keys here"
+
+ (key == #Prior) ifTrue: [^ self pageUp].
+ (key == #Next) ifTrue: [^ self pageDown].
+
+ super keyPress:key x:x y:y
+!
+
sizeChanged:how
super sizeChanged:how.
- scrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ scrollBar setThumbFor:scrolledView
+ ]
! !
--- a/ScrollBar.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ScrollBar.st Sun Aug 07 15:23:42 1994 +0200
@@ -12,92 +12,64 @@
View subclass:#ScrollBar
instanceVariableNames:'thumb button1 button2 layout'
- classVariableNames:'DefaultScrollUpForm
- DefaultScrollDownForm'
+ classVariableNames:''
poolDictionaries:''
category:'Views-Interactors'
!
ScrollBar comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-this class implements vertical scrollbars with scroller and
-2 step-scroll buttons. when moved or stepped, it performs a
-predefined action.
-
-$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.5 1994-01-08 17:27:56 claus Exp $
-
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.6 1994-08-07 13:23:18 claus Exp $
'!
-!ScrollBar class methodsFor:'defaults'!
+!ScrollBar class methodsFor:'documentation'!
-scrollUpButtonForm:style
- "return the form used for the scrollUp Button"
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
- DefaultScrollUpForm isNil ifTrue:[
- DefaultScrollUpForm := Form fromFile:(self classResources at:'SCROLL_UP_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollUp_win.xbm']
- ifFalse:['ScrollUp.xbm'])
- )
- resolution:100
- ].
- DefaultScrollUpForm isNil ifTrue:[
- DefaultScrollUpForm := Form width:16 height:16
- fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r01000000
- 2r00000100 2r00100000
- 2r00001000 2r00010000
- 2r00010000 2r00001000
- 2r00100000 2r00000100
- 2r01000000 2r00000010
- 2r01111000 2r00011110
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001111 2r11110000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollUpForm
+ 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/libwidg/ScrollBar.st,v 1.6 1994-08-07 13:23:18 claus Exp $
+"
!
-scrollDownButtonForm:style
- "retun the form used for the scrollDown Button"
+documentation
+"
+ this class implements vertical scrollbars with scroller and
+ 2 step-scroll buttons. when moved or stepped, it performs a
+ predefined action.
+
+ The action is specified by: the block to be evaluated for step-up
+ aScrollBar scrollUpAction:aBlock
+ (scrollLeftAction for hor-Scrollbars)
- DefaultScrollDownForm isNil ifTrue:[
- DefaultScrollDownForm := Form fromFile:(self classResources at:'SCROLL_DOWN_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollDn_win.xbm']
- ifFalse:['ScrollDn.xbm'])
- )
- resolution:100
- ].
- DefaultScrollDownForm isNil ifTrue:[
- DefaultScrollDownForm := Form width:16 height:16
- fromArray:#(2r00000000 2r00000000
- 2r00001111 2r11110000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r00001000 2r00010000
- 2r01111000 2r00011110
- 2r01000000 2r00000010
- 2r00100000 2r00000100
- 2r00010000 2r00001000
- 2r00001000 2r00010000
- 2r00000100 2r00100000
- 2r00000010 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollDownForm
+ aScrollBar scrollDownAction:aBlock the block to be evaluated for step-down
+ (scrollRightAction for hor-Scrollbars)
+
+ aScrollbar scrollAction:aBlock the block to be evaluated for scroll
+ passing percentage as argument.
+
+ Scrollbars can scroll syncronous (i.e. every movement is notified immediately via the
+ scrollAction) or asynchronous (i.e. only one notification takes place at the end of the movement).
+ The choice is up to the user of the scrollbar (typically, views which are complicated to redraw,
+ will set it to asynchronous.)
+
+ Most often scrollbars are used hidden with ScrollableView or HVScrollableView (i.e. you
+ dont have to care for all the details).
+"
! !
!ScrollBar class methodsFor:'style changes'!
@@ -114,46 +86,21 @@
initialize
"setup; create the 2 buttons and a scroller"
- |bwn sep w h upForm downForm clr|
+ |w h upForm downForm clr|
super initialize.
- button1 := ArrowButton upIn:self.
- button1 name:'UpButton'.
+
+ self createElements.
+
button1 autoRepeat.
-
- button2 := ArrowButton downIn:self.
- button2 name:'DownButton'.
button2 autoRepeat.
- thumb := Scroller in:self.
-
- "compute my extent from sub-components"
-
- upForm := self class scrollUpButtonForm:style.
- downForm := self class scrollDownButtonForm:style.
-
- h := upForm height + downForm height +
- (1 "self defaultBorderWidth" * 2) + (Scroller defaultExtent y).
- w := (upForm width) max:(downForm width).
- self is3D ifTrue:[
- h := h + 4.
- w := w + 4
- ].
- self extent:w @ h.
-
- bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
+ self computeInitialExtent.
button1 borderWidth:borderWidth.
-
style ~~ #next ifTrue:[
thumb borderWidth:borderWidth.
].
-
button2 borderWidth:borderWidth.
((style == #iris) and:[Display hasGreyscales])ifTrue:[
@@ -169,25 +116,23 @@
button2 enteredForegroundColor:clr.
].
- (layout == #top) ifTrue:[
- button1 origin:(bwn @ bwn).
- button1 viewGravity:#North.
- button2 origin:(bwn @ (button1 height)).
- button2 viewGravity:#North.
- thumb origin:(bwn @ (button1 height + borderWidth + button2 height + sep + sep)).
- thumb viewGravity:#North
- ] ifFalse:[
- (layout == #bottom) ifTrue:[
- button1 viewGravity:#North.
- button2 viewGravity:#North.
- thumb origin:(bwn @ bwn).
- thumb viewGravity:#North
- ] ifFalse:[
- button1 origin:(bwn @ bwn).
- button1 viewGravity:#North.
- button2 viewGravity:#North.
- thumb origin:(bwn @ (button1 height + sep)).
- thumb viewGravity:#North
+ self setElementPositions.
+
+ style == #motif ifTrue:[
+ clr := thumb thumbColor.
+ button1 foregroundColor:clr.
+ button2 foregroundColor:clr.
+
+ clr := thumb viewBackground.
+ button1 viewBackground:clr.
+ button2 viewBackground:clr.
+ button1 backgroundColor:clr.
+ button2 backgroundColor:clr.
+ button1 activeBackgroundColor:clr.
+ button2 activeBackgroundColor:clr.
+ device hasGreyscales ifFalse:[
+ button1 activeForegroundColor:Black.
+ button2 activeForegroundColor:Black.
]
]
!
@@ -198,14 +143,110 @@
super initStyle.
default := #bottom.
- ((style == #mswindows) or:[style == #motif]) ifTrue:[
+ (style == #mswindows) ifTrue:[
default := #around.
- style == #motif ifTrue:[
+ ] ifFalse:[
+ (style == #motif) ifTrue:[
+ default := #around.
self level:-2
+ ] ifFalse:[
+ (style == #st80) ifTrue:[
+ default := #around.
+ self level:0
+ ]
]
].
layout := resources at:'SCROLLBAR_LAYOUT' default:default.
+!
+
+createElements
+ button1 := ArrowButton upIn:self.
+ button1 name:'UpButton'.
+ button2 := ArrowButton downIn:self.
+ button2 name:'DownButton'.
+ thumb := Scroller in:self.
+!
+
+spaceBetweenElements
+ ((style ~~ #normal)
+ and:[(style ~~ #mswindows)
+ and:[style ~~ #st80]]) ifTrue:[
+ ^ 1
+ ].
+ ^ 0
+!
+
+setElementPositions
+ "position sub-components"
+
+ |bwn sep|
+
+ bwn := borderWidth negated + margin.
+ sep := self spaceBetweenElements.
+
+ (layout == #top) ifTrue:[
+ button1 origin:(bwn @ bwn).
+ button1 viewGravity:#North.
+ button2 origin:(bwn @ (button1 height)).
+ button2 viewGravity:#North.
+ thumb origin:(bwn @ (button1 height + borderWidth + button2 height + sep + sep)).
+ thumb viewGravity:#North.
+ ^ self
+ ].
+ (layout == #bottom) ifTrue:[
+ button1 viewGravity:#North.
+ button2 viewGravity:#North.
+ thumb origin:(bwn @ bwn).
+ thumb viewGravity:#North.
+ ^ self
+ ].
+
+ "layout == #around"
+ button1 origin:(bwn @ bwn).
+ button1 viewGravity:#North.
+ button2 viewGravity:#North.
+ thumb origin:(bwn @ (button1 height + sep)).
+ thumb viewGravity:#North
+!
+
+computeInitialExtent
+ "compute my extent from sub-components"
+
+ |w h upForm downForm
+ upHeight "{ Class: SmallInteger }"
+ downHeight "{ Class: SmallInteger }"
+ upWidth downWidth|
+
+ "need fix - this is a kludge;
+ the if should not be needed ..."
+ style == #mswindows ifTrue:[
+ w := button1 width max:button2 width.
+ h := button1 height + button2 height + (Scroller defaultExtent y).
+ ] ifFalse:[
+ upForm := ArrowButton upArrowButtonForm:style on:device.
+ downForm := ArrowButton downArrowButtonForm:style on:device.
+ upForm isNil ifTrue:[
+ upHeight := upWidth := 16.
+ ] ifFalse:[
+ upHeight := upForm height.
+ upWidth := upForm width
+ ].
+ downForm isNil ifTrue:[
+ downHeight := downWidth := 16
+ ] ifFalse:[
+ downHeight := downForm height.
+ downWidth := downForm width
+ ].
+ h := upHeight + downHeight + (1 * 2) + (Scroller defaultExtent y).
+ w := upWidth max:downWidth.
+ style ~~ #normal ifTrue:[
+ h := h + 4.
+ w := w + 4
+ ].
+ ].
+
+ self extent:w @ h.
! !
!ScrollBar methodsFor:'accessing'!
@@ -296,6 +337,21 @@
thumb synchronousOperation
! !
+!ScrollBar methodsFor:'forced scroll'!
+
+pageUp
+ "page up/left"
+
+ thumb pageUp
+!
+
+pageDown
+ "page down/right"
+
+ thumb pageDown
+! !
+
+
!ScrollBar methodsFor:'events'!
sizeChanged:how
@@ -312,11 +368,7 @@
downHeight := button2 height + borderWidth.
upAndDownHeight := upHeight + downHeight.
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
+ sep := self spaceBetweenElements.
thumbHeight := height - upAndDownHeight - borderWidth - (sep * 3).
"
@@ -332,28 +384,28 @@
height < (upHeight + downHeight) ifTrue:[
button1 shown ifTrue:[
- button1 hidden.
- button2 hidden.
- thumb hidden
+ button1 unrealize.
+ button2 unrealize.
+ thumb unrealize
]
] ifFalse:[
shown ifTrue:[
button1 shown ifFalse:[
- button1 show.
- button2 show.
- thumb show
+ button1 realize.
+ button2 realize.
+ thumb realize
]
]
].
(thumbHeight < 10) ifTrue:[
thumb shown ifTrue:[
- thumb hidden
+ thumb unrealize
]
] ifFalse:[
thumb shown ifFalse:[
button1 shown ifTrue:[
- thumb show
+ thumb realize
]
]
].
@@ -372,6 +424,14 @@
thumbHeight := thumbHeight - 1
].
+ "
+ a kludge: views with width or height of 0 are illegal
+ avoid error from view-creation (it will be hidden anyway)
+ "
+ thumbHeight <= 0 ifTrue:[
+ thumbHeight := 1
+ ].
+
(layout == #top) ifTrue:[
"buttons at top"
thumb extent:(thumbWidth @ thumbHeight).
@@ -396,7 +456,7 @@
"buttons around thumb"
button1 origin:(bwn @ bwn).
- button2 origin:(bwn @ (upHeight + thumbHeight + sep2 "+ borderWidth")).
- thumb extent:(thumbWidth @ (thumbHeight + margin)).
+ button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - (margin // 2) "+ borderWidth")).
+ thumb extent:(thumbWidth @ (thumbHeight + margin - (margin // 2))).
thumb origin:(bwn @ (upHeight - borderWidth + sep))
! !
--- a/ScrollableView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/ScrollableView.st Sun Aug 07 15:23:42 1994 +0200
@@ -19,93 +19,228 @@
!
ScrollableView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-a view containing a scrollbar and some other (slave-)view
+
+$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.5 1994-08-07 13:23:16 claus Exp $
+'!
+
+!ScrollableView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/ScrollableView.st,v 1.5 1994-08-07 13:23:16 claus Exp $
+"
+!
+
+documentation
+"
+ a view containing a scrollbar and some other (slave-)view.
+ There are two ways to create a ScrollableView:
+ if the type of the view to be scrolled is known in advance,
+ use:
+ v := ScrollableView for:<ViewClass> in:someSuperView.
+ otherwise, create the scrollableView empty with:
+ v := ScrollableView in:someSuperView.
+ ...
+ v scrolledView:aViewToBeScrolled
+
+ example1:
+
+ |top scr txt|
-$Header: /cvs/stx/stx/libwidg/ScrollableView.st,v 1.4 1993-12-11 01:48:54 claus Exp $
+ top := StandardSystemView label:'example'.
+ scr := ScrollableView for:EditTextView in:top.
+ scr origin:0.0@0.0 corner:1.0@1.0.
+ txt := scr scrolledView.
+
+ txt list:#('line1'
+ 'line2'
+ 'line3'
+ 'line4'
+ 'line5'
+ 'line6').
+ top open
+
+ example2:
+
+ |top scr txt1 txt2|
+
+ top := StandardSystemView label:'example'.
+ scr := ScrollableView in:top.
+ scr origin:0.0@0.0 corner:1.0@1.0.
+ top open.
-written spring 89 by claus
-'!
+ (Delay forSeconds:5) wait.
+
+ txt1 := EditTextView new.
+ txt1 list:#('line1'
+ 'line2'
+ 'line3'
+ 'line4'
+ 'line5'
+ 'line6').
+ scr scrolledView:txt1.
+
+ (Delay forSeconds:5) wait.
+
+ txt2 := EditTextView new.
+ txt2 list:#('alternative line1'
+ 'alternative line2'
+ 'alternative line3'
+ 'alternative line4'
+ 'alternative line5'
+ 'alternative line6').
+ scr scrolledView:txt2.
+"
+! !
!ScrollableView class methodsFor:'instance creation'!
in:aView
- ^ self for:nil in:aView
+ "return a new scrolling view to be contained in aView.
+ There is no slave view now - this has to be set later via
+ the scrolledView: method.
+ The view will have full scrollbars."
+
+ ^ self for:nil miniScrollerH:false miniScrollerV:false in:aView
!
for:aViewClass
- ^ self for:aViewClass in:nil
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars."
+
+ ^ self for:aViewClass miniScrollerH:false miniScrollerV:false in:nil
!
for:aViewClass in:aView
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars."
+
+ ^ self for:aViewClass miniScrollerH:false miniScrollerV:false in:aView
+!
+
+for:aViewClass miniScroller:mini in:aView
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars if mini is false, miniscrollers
+ if true."
+
+ ^ self for:aViewClass miniScrollerH:mini miniScrollerV:mini in:aView
+!
+
+for:aViewClass miniScrollerH:miniH miniScrollerV:miniV in:aView
+ "return a new scrolling view scrolling an instance of aViewClass.
+ The subview is created here.
+ The view will have full scrollbars if the corresponding miniH/miniV
+ is false, miniscrollers if false."
+
|newView|
- newView := self basicNew.
aView notNil ifTrue:[
+ newView := self basicNew.
newView device:(aView device).
aView addSubView:newView
] ifFalse:[
- newView device:Display
+ "create on Display by default"
+ newView := self new.
].
- newView initializeFor:aViewClass.
+ newView initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV.
^ newView
! !
!ScrollableView methodsFor:'initialization'!
initialize
- ^ self initializeFor:nil
+ "default setup: full scrollers"
+
+ ^ self initializeFor:nil miniScrollerH:false miniScrollerV:false
!
-initializeFor:aViewClass
- |negativeOffset twoMargins halfMargin|
+initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV
+ |negativeOffset twoMargins halfMargin cls|
super initialize.
- innerMargin := ViewSpacing.
+ style == #openwin ifTrue:[self level:0].
+ style == #st80 ifTrue:[
+ innerMargin := 0
+ ] ifFalse:[
+ innerMargin := ViewSpacing.
+ ].
negativeOffset := borderWidth negated.
"create the scrollbar"
- scrollBar := ScrollBar in:self.
+ cls := miniV ifTrue:[MiniScroller] ifFalse:[ScrollBar].
+ style == #st80 ifTrue:[cls := ScrollBar].
+
+ scrollBar := cls in:self.
scrollBar thumbOrigin:0 thumbHeight:100.
"create the subview"
- self is3D ifTrue:[
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
twoMargins := innerMargin * 2.
halfMargin := innerMargin // 2.
+ aViewClass notNil ifTrue:[
+ scrolledView := aViewClass in:self.
+ style == #openwin ifTrue:[
+ scrolledView level:0.
+ scrolledView borderWidth:1
+ ] ifFalse:[
+ style == #st80 ifTrue:[
+ scrolledView level:1.
+ ] ifFalse:[
+ scrolledView level:-1
+ ]
+ ].
+ ].
(scrollBarPosition == #right) ifTrue:[
scrollBar origin:[width - scrollBar extent x
- - scrollBar borderWidth
+ - (scrollBar borderWidth * 2)
- halfMargin
@
halfMargin]
extent:[scrollBar extent x @ (height - innerMargin)].
- helpView := View in:self.
- helpView origin:halfMargin asPoint
- extent:[(width - scrollBar width - twoMargins) @ (height - innerMargin)].
+
+ scrolledView notNil ifTrue:[
+ scrolledView origin:halfMargin asPoint
+ extent:[(width -
+ scrollBar width -
+ twoMargins)
+ @
+ (height - innerMargin)].
+ ]
] ifFalse:[
scrollBar origin:halfMargin asPoint
extent:[scrollBar extent x @ (height - innerMargin)].
- helpView := View in:self.
- helpView origin:((scrollBar origin x + scrollBar width + innerMargin)
- @
- halfMargin)
- extent:[(width - scrollBar width - twoMargins) @ (height - innerMargin)].
+
+ scrolledView notNil ifTrue:[
+ scrolledView origin:((scrollBar origin x + scrollBar width + innerMargin)
+ @
+ halfMargin)
+ extent:[(width - scrollBar width - twoMargins)
+ @
+ (height - innerMargin)].
+ ]
].
-
- aViewClass notNil ifTrue:[
- scrolledView := aViewClass in:helpView.
- scrolledView origin:helpView level abs asPoint
- extent:[(helpView width - helpView level abs - helpView level abs)
- @
- (helpView height - helpView level abs - helpView level abs)].
- helpView viewBackground:(scrolledView viewBackground).
- scrolledView level:-1
- ]
] ifFalse:[
(scrollBarPosition == #right) ifTrue:[
scrollBar origin:[width - scrollBar extent x
@@ -122,39 +257,50 @@
(scrollBarPosition == #right) ifTrue:[
scrolledView origin:scrolledView borderWidth negated asPoint
] ifFalse:[
- scrolledView origin:((scrollBar width + scrollBar borderWidth
- - scrolledView borderWidth)
+ scrolledView origin:((scrollBar width +
+ scrollBar borderWidth -
+ scrolledView borderWidth)
@
scrolledView borderWidth negated)
].
- scrolledView extent:[(width - scrollBar width
- - scrolledView borderWidth)
+ scrolledView extent:[(width - scrollBar width - scrolledView borderWidth)
@
(height + (scrollBar borderWidth))
]
].
].
scrolledView notNil ifTrue:[
- self setScrollActions
+ self setScrollActions.
+ "
+ pass input to myself (and other subviews) to
+ the scrolled view
+ "
+ self keyboardHandler:scrolledView.
]
!
initStyle
super initStyle.
- scrollBarPosition := #left.
- ((style == #motif) or:[style == #mswindows]) ifTrue:[
+ ((style == #motif)
+ or:[(style == #mswindows)
+ or:[style == #openwin]]) ifTrue:[
scrollBarPosition := #right
+ ] ifFalse:[
+ scrollBarPosition := #left.
].
!
realize
super realize.
+
"since scrolledview may have done something to its contents
during init-time we had no chance yet to catch contents-
changes; do it now
"
- scrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ scrollBar setThumbFor:scrolledView
+ ]
! !
!ScrollableView methodsFor:'private'!
@@ -168,7 +314,7 @@
(this avoids run-away scroller when scrolling
textviews, when the text is aligned line-wise).
- Cosnider it as a kludge."
+ Consider this as a kludge."
lock := false.
@@ -205,41 +351,88 @@
!
scrolledView:aView
- |m m2 b|
+ "set the view to scroll"
+
+ |halfMargin twoMargins|
scrolledView notNil ifTrue:[
- self error:'can only scroll one view'
+ scrolledView destroy.
+ scrolledView := nil.
].
scrolledView := aView.
- b := scrolledView borderWidth.
- self is3D ifTrue:[
- m := helpView margin.
- m2 := m * 2.
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
+ "3D look"
+
+ twoMargins := innerMargin * 2.
+ halfMargin := innerMargin // 2.
- helpView addSubView:scrolledView.
- scrolledView origin:(m @ m)
- extent:[(helpView width - m2) @ (helpView height - m2)].
- scrolledView superViewChangedSize.
- helpView viewBackground:(scrolledView viewBackground).
- scrolledView level:-1
- ] ifFalse:[
- self addSubView:scrolledView.
+ style == #openwin ifTrue:[
+ scrolledView level:0.
+ scrolledView borderWidth:1
+ ] ifFalse:[
+ scrolledView level:-1
+ ].
+
(scrollBarPosition == #right) ifTrue:[
- scrolledView origin:scrolledView borderWidth negated asPoint
+ scrolledView
+ origin:halfMargin asPoint
+ extent:[(width -
+ scrollBar width -
+ twoMargins)
+ @
+ (height - innerMargin)
+ ].
] ifFalse:[
- scrolledView origin:((scrollBar width + scrollBar borderWidth - b) @ b negated)
- extent:[(width - scrollBar width - b) @ (height + scrollBar borderWidth)
- ].
+ scrolledView
+ origin:((scrollBar origin x
+ + scrollBar width
+ + innerMargin)
+ @
+ halfMargin)
+ extent:[(width
+ - scrollBar width
+ - twoMargins)
+ @
+ (height - innerMargin)
+ ].
+ ]
+ ] ifFalse:[
+ "non 3D look"
+ (scrollBarPosition == #right) ifTrue:[
+ scrolledView
+ origin:scrolledView borderWidth negated asPoint
+ ] ifFalse:[
+ scrolledView
+ origin:((scrollBar width
+ + scrollBar borderWidth
+ - scrolledView borderWidth)
+ @
+ scrolledView borderWidth negated)
].
- scrolledView superViewChangedSize.
+ scrolledView
+ extent:[
+ (width
+ - scrollBar width
+ - scrolledView borderWidth)
+ @
+ (height
+ + (scrollBar borderWidth))
+ ]
].
- scrolledView
- originChangeAction:[:aView | scrollBar setThumbOriginFor:aView].
- scrolledView
- contentsChangeAction:[:aView | scrollBar setThumbFor:aView].
- realized ifTrue:[scrolledView realize]
+ super addSubView:scrolledView.
+ self setScrollActions.
+ "
+ pass input to myself (and other subviews) to
+ the scrolled view
+ "
+ self keyboardHandler:scrolledView.
+
+ realized ifTrue:[
+ self sizeChanged:nil.
+ scrolledView realize
+ ].
! !
!ScrollableView methodsFor:'slave-view messages'!
@@ -254,11 +447,16 @@
cursor:aCursor
"I have the same cursor as my scrolledView"
- scrolledView cursor:aCursor.
+ scrolledView notNil ifTrue:[
+ scrolledView cursor:aCursor
+ ].
super cursor:aCursor
!
leftButtonMenu
+ "return scrolledViews leftbuttonmenu"
+
+ scrolledView isNil ifTrue:[^ nil].
^ scrolledView leftButtonMenu
!
@@ -269,6 +467,9 @@
!
middleButtonMenu
+ "return scrolledViews middlebuttonmenu"
+
+ scrolledView isNil ifTrue:[^ nil].
^ scrolledView middleButtonMenu
!
@@ -279,6 +480,9 @@
!
rightButtonMenu
+ "return scrolledViews rightbuttonmenu"
+
+ scrolledView isNil ifTrue:[^ nil].
^ scrolledView rightButtonMenu
!
@@ -299,9 +503,34 @@
]
! !
+!ScrollableView methodsFor:'forced scroll'!
+
+pageUp
+ "page up"
+
+ scrollBar pageUp
+!
+
+pageDown
+ "page down"
+
+ scrollBar pageDown
+! !
+
!ScrollableView methodsFor:'event processing'!
+keyPress:key x:x y:y
+ "a key was pressed - handle page-keys here"
+
+ (key == #Prior) ifTrue: [^ self pageUp].
+ (key == #Next) ifTrue: [^ self pageDown].
+
+ super keyPress:key x:x y:y
+!
+
sizeChanged:how
super sizeChanged:how.
- scrollBar setThumbFor:scrolledView
+ scrolledView notNil ifTrue:[
+ scrollBar setThumbFor:scrolledView
+ ]
! !
--- a/Scroller.st Sun Aug 07 15:22:53 1994 +0200
+++ b/Scroller.st Sun Aug 07 15:23:42 1994 +0200
@@ -21,63 +21,90 @@
thumbSoftEdge
thumbHalfShadowColor thumbHalfLightColor
thumbFrameSizeDifference
- tallyLevel tallyMarks'
+ tallyLevel tallyMarks
+ fixThumbHeight'
classVariableNames: 'HandleShadowForm HandleLightForm'
poolDictionaries:''
category:'Views-Interactors'
!
Scroller comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.6 1994-01-13 00:18:10 claus Exp $
-
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.7 1994-08-07 13:23:20 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Scroller.st,v 1.7 1994-08-07 13:23:20 claus Exp $
+"
+!
+
documentation
"
-this class implements the scroller for scrollbars.
-it can also be used by itself for scrollbars without step-buttons.
-When moved, a predefined action is performed.
-Beside the obvious 3D rectangle, a scroller may draw a know-form
-(as in NeXT) or little tally marks (as on SGI) in itself.
-These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
-instance variables.
+ this class implements the scroller for scrollbars.
+ it can also be used by itself for scrollbars without step-buttons.
+ When moved, a predefined action is performed.
+ Beside the obvious 3D rectangle, a scroller may draw a know-form
+ (as in NeXT) or little tally marks (as on SGI) in itself.
+ These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
+ instance variables.
+ The scroller can work synchronous (i.e. every move leads to an immediate evaluation
+ of the action, or asynchronous (i.e. perform action on end-of move).
+ By default, scrollers are synchronous - asynchronous makes sense, if the scroll
+ operation (redraw) is expensive.
-Instance variables:
+ Instance variables:
-thumbOrigin <Number> origin of thumb (in percent)
-thumbHeight <Number> height of thumb (in percent)
-thumbColor <Color> color of thumb
-thumbFrameColor <Color> color of the frame around the thumb
-scrollAction <Block> 1 arg block to be evaluated when scrolled
- (arg is position in percent)
-moveDirection <Symbol> #x or #y
-thumbFrame <Rectangle> frame of thumb in pixels (cached)
-thumbLevel <Number> level of thumb if 3d
-scrolling <Boolean> true during scroll
-pressOffset <Number> temporary (offset into frame when move started)
-synchronousOperation <Boolean> true if synchronous (i.e. dont wait till release
- to perform action)
-shadowForm <Form> bitmap of knob if any (shadow part)
-lightForm <Form> bitmap of knob if any (light part)
-inset <Integer> number of pixels to inset thumb from view borders
-thumbShadowColor <Color> color do draw dark parts of thumb
-thumblightColor <Color> color to draw light parts of thumb
-thumbSoftEdge <Boolean> true if edges of thumb are to appear smooth
-thumbHalfShadowColor <Color> used to draw smooth edges
-thumbHalfLightColor <Color> used to draw smooth edges
-thumbFrameSizeDifference <Integer> number of pixels the thumb is larger than
- it should be
-tallyLevel <Integer> if not zero, specifies if tally-marks should
- go into or out of the display (actually only <0/>0 is checked)
- I dont know of a better word for these ...
-tallyMarks <Integer> number of tally marks
+ thumbOrigin <Number> origin of thumb (in percent)
+ thumbHeight <Number> height of thumb (in percent)
+ thumbColor <Color> color of thumb
+ thumbFrameColor <Color> color of the frame around the thumb
+ scrollAction <Block> 1 arg block to be evaluated when scrolled
+ (arg is position in percent)
+ moveDirection <Symbol> #x or #y
+ thumbFrame <Rectangle> frame of thumb in pixels (cached)
+ thumbLevel <Number> level of thumb if 3d
+ scrolling <Boolean> true during scroll
+ pressOffset <Number> temporary (offset into frame when move started)
+ synchronousOperation <Boolean> true if synchronous (i.e. dont wait till release
+ to perform action)
+ shadowForm <Form> bitmap of knob if any (shadow part)
+ lightForm <Form> bitmap of knob if any (light part)
+ inset <Integer> number of pixels to inset thumb from view borders
+ thumbShadowColor <Color> color do draw dark parts of thumb
+ thumblightColor <Color> color to draw light parts of thumb
+ thumbSoftEdge <Boolean> true if edges of thumb are to appear smooth
+ thumbHalfShadowColor <Color> used to draw smooth edges
+ thumbHalfLightColor <Color> used to draw smooth edges
+ thumbFrameSizeDifference <Integer> number of pixels the thumb is larger than
+ it should be (can be negative for mswin-style)
+ tallyLevel <Integer> if not zero, specifies if tally-marks should
+ go into or out of the display (actually only <0/>0 is checked)
+ I dont know of a better word for these ...
+ tallyMarks <Integer> number of tally marks
+ fixThumbHeight <Boolean> perform 'wrong' height computation a la mswindows
+
+ notice: for mswindows style, we force a WRONG thumb-frame
+ computation, to make the thumb have constant size;
+ if you dont like that (I do not :-), set fixThumbHeight to false (in initStyle).
"
! !
@@ -143,6 +170,7 @@
"initialize - setup instvars from defaults"
super initialize.
+ self computeInitialExtent.
moveDirection := #y.
scrolling := false.
@@ -150,10 +178,15 @@
thumbOrigin := 0.
thumbHeight := 100.
+ thumbFrameSizeDifference := 0.
- inset := 1.
+"/ inset := 1.
- self computeThumbFrame
+"/ self computeThumbFrame
+!
+
+computeInitialExtent
+ ^ self
!
initStyle
@@ -166,55 +199,69 @@
thumbSoftEdge := false.
tallyLevel := 0.
tallyMarks := 0.
+ fixThumbHeight := false.
+ inset := 0.
- self is3D ifTrue:[
- thumbSoftEdge := false.
- inset := 0.
-
- style == #next ifTrue:[
+ style == #next ifTrue:[
+ self level:0.
+ self borderWidth:1.
+ inset := 1.
+ thumbSoftEdge := true.
+ thumbLevel := 2.
+ thumbColor := Color lightGrey
+ ] ifFalse:[
+ style == #motif ifTrue:[
self level:0.
- self borderWidth:1.
inset := 1.
- thumbSoftEdge := true.
thumbLevel := 2.
- thumbColor := Color lightGrey
+"/ viewBackground := Color lightGrey.
+"/ thumbColor := viewBackground.
+
+ viewBackground := Color darkGrey "grey".
+ thumbColor := Grey "Color lightGrey".
] ifFalse:[
- style == #motif ifTrue:[
- self level:0.
- inset := 1.
- thumbLevel := 2.
- viewBackground := Color lightGrey.
+ style == #iris ifTrue:[
+ self level:-1.
+ thumbLevel := 3.
+ thumbSoftEdge := true.
thumbColor := viewBackground.
+ tallyLevel := 1.
+ tallyMarks := 3.
] ifFalse:[
- style == #iris ifTrue:[
- self level:-1.
- thumbLevel := 3.
+ style == #mswindows ifTrue:[
+ inset := 0.
+ self level:0.
+ self borderWidth:1.
+ thumbLevel := 2.
+ thumbColor := Color lightGrey.
thumbSoftEdge := true.
- thumbColor := viewBackground.
- tallyLevel := 1.
- tallyMarks := 3.
+ viewBackground := Color grey:80.
+ fixThumbHeight := true.
] ifFalse:[
- style == #mswindows ifTrue:[
- self level:0.
- self borderWidth:1.
- thumbLevel := 2.
- thumbColor := Color lightGrey.
- thumbSoftEdge := true.
- viewBackground := Color grey:80.
+ (style == #st80) ifTrue:[
+ self level:1.
+ thumbLevel := 0.
+ thumbColor := Black.
+ viewBackground := Grey.
+ inset := 3.
] ifFalse:[
- self level:-1.
- thumbLevel := 2.
- thumbColor := Color lightGrey
+ (style ~~ #normal) ifTrue:[
+ self level:-1.
+ thumbLevel := 2.
+ thumbColor := Color lightGrey
+ ] ifFalse:[
+ thumbColor := White.
+ inset := 1
+ ]
]
]
]
- ].
+ ]
+ ].
+ style ~~ #normal ifTrue:[
device hasGreyscales ifFalse:[
thumbColor := Color grey
].
- ] ifFalse:[
- thumbColor := White.
- inset := 1
].
thumbShadowColor := shadowColor.
@@ -231,7 +278,12 @@
device hasGreyscales ifFalse:[
thumbShadowColor := Black.
thumbLightColor := White.
- viewBackground := Color veryLightGrey "White"
+ style == #motif ifTrue:[
+ thumbColor := White "Color grey".
+ viewBackground := Color veryLightGrey
+ ] ifFalse:[
+ viewBackground := Color veryLightGrey "White"
+ ]
].
thumbFrameColor := Black.
@@ -292,6 +344,16 @@
^ scrollAction
!
+scrollDownAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
+!
+
+scrollUpAction:aBlock
+ "ignored -
+ but implemented, so that scroller can be used in place of a scrollbar"
+!
+
thumbOrigin
"answer the thumbs origin (in percent)"
@@ -317,14 +379,19 @@
realNewOrigin := 0
]
].
- (realNewOrigin = thumbOrigin) ifFalse:[
- oldFrame := thumbFrame.
+ ((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
thumbOrigin := realNewOrigin.
- self computeThumbFrame.
- (thumbHeight = 100) ifTrue:[^ self].
shown ifTrue:[
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (thumbHeight = 100) ifTrue:[^ self].
+
(thumbFrame ~~ oldFrame) ifTrue:[
+ oldFrame isNil ifTrue:[
+ self drawThumb.
+ ^ self
+ ].
tH := thumbFrame height.
tW := thumbFrame width.
oldTop := oldFrame top.
@@ -343,11 +410,12 @@
^ self
].
+ self catchExpose.
self copyFrom:self x:left y:oldTop
toX:left y:thumbTop
width:tW height:tH.
- self catchExpose.
+"/ self catchExpose.
oldTop > thumbTop ifTrue:[
delta := oldTop - thumbTop.
@@ -390,16 +458,18 @@
] ifFalse:[
realNewHeight := newHeight
].
- (realNewHeight = thumbHeight) ifFalse:[
- oldFrame := thumbFrame.
+ ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
thumbHeight := realNewHeight.
- self computeThumbFrame.
shown ifTrue:[
- (oldFrame ~~ thumbFrame) ifTrue:[
- self drawThumbBackgroundInX:(oldFrame left)
- y:(oldFrame top)
- width:(oldFrame width)
- height:(oldFrame height).
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (fixThumbHeight or:[oldFrame ~~ thumbFrame]) ifTrue:[
+ oldFrame notNil ifTrue:[
+ self drawThumbBackgroundInX:(oldFrame left)
+ y:(oldFrame top)
+ width:(oldFrame width)
+ height:(oldFrame height).
+ ].
self drawThumb
]
]
@@ -409,7 +479,7 @@
thumbOrigin:newOrigin thumbHeight:newHeight
"set both thumbs height and origin (in percent)"
- |realNewOrigin realNewHeight old new same|
+ |realNewOrigin realNewHeight old new changed|
(newHeight > 100) ifTrue:[
realNewHeight := 100
@@ -425,31 +495,29 @@
realNewOrigin := 0
].
- same := (realNewHeight = thumbHeight).
- same ifTrue:[
- same := (realNewOrigin = thumbOrigin)
- ].
-
- same ifFalse:[
+ changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
+ (changed or:[thumbFrame isNil]) ifTrue:[
old := self absFromPercent:thumbOrigin.
new := self absFromPercent:realNewOrigin.
- (old == new) ifTrue:[
+ changed := old ~~ new.
+ changed ifFalse:[
old := self absFromPercent:thumbHeight.
new := self absFromPercent:realNewHeight.
- (old == new) ifTrue:[^ self]
+ changed := (old ~~ new)
].
-
- shown ifTrue:[
- self drawThumbBackgroundInX:(thumbFrame left)
- y:(thumbFrame top)
- width:(thumbFrame width)
- height:(thumbFrame height).
- ].
- thumbOrigin := realNewOrigin.
- thumbHeight := realNewHeight.
- self computeThumbFrame.
- shown ifTrue:[
- self drawThumb
+ (changed or:[thumbFrame isNil]) ifTrue:[
+ thumbOrigin := realNewOrigin.
+ thumbHeight := realNewHeight.
+ shown ifTrue:[
+ thumbFrame notNil ifTrue:[
+ self drawThumbBackgroundInX:(thumbFrame left)
+ y:(thumbFrame top)
+ width:(thumbFrame width)
+ height:(thumbFrame height).
+ ].
+ self computeThumbFrame.
+ self drawThumb
+ ]
]
]
!
@@ -457,25 +525,37 @@
setThumbFor:aView
"get contents and size info from aView and adjust thumb"
- |percentSize percentOrigin totalHeight|
+ |percentSize percentOrigin contentsSize contentsPosition viewsSize|
+ "
+ get the content's size
+ "
aView isNil ifTrue:[
- totalHeight := 0
+ contentsSize := 0
] ifFalse:[
- totalHeight := aView heightOfContents
+ moveDirection == #y ifTrue:[
+ contentsSize := aView heightOfContents
+ ] ifFalse:[
+ contentsSize := aView widthOfContents
+ ]
].
- (totalHeight = 0) ifTrue:[
+
+ (contentsSize = 0) ifTrue:[
percentSize := 100.
percentOrigin := 100
] ifFalse:[
- percentSize := (aView innerHeight) * 100.0 / totalHeight.
- percentOrigin := (aView yOriginOfContents) * 100.0 / totalHeight.
+ viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight] ifFalse:[aView innerWidth].
+ contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents] ifFalse:[aView xOriginOfContents].
+
+
+ percentSize := viewsSize * 100.0 / contentsSize.
+ percentOrigin := contentsPosition * 100.0 / contentsSize.
percentOrigin + percentSize > 100.0 ifTrue:[
"actually showing stuff below contents of view"
"
- totalHeight := aView yOriginOfContents + aView innerHeight.
- percentSize := (aView innerHeight) * 100.0 / totalHeight.
- percentOrigin := (aView yOriginOfContents) * 100.0 / totalHeight
+ contentsSize := contentsPosition + aView innerHeight.
+ percentSize := viewsSize * 100.0 / contentsSize.
+ percentOrigin := contentsPosition * 100.0 / contentsSize
"
]
].
@@ -493,13 +573,16 @@
setThumbHeightFor:aView
"get contents and size info from aView and adjust thumb height"
- |percent totalHeight|
+ |percent totalHeight viewsSize|
- totalHeight := aView heightOfContents.
+ totalHeight := (moveDirection == #y) ifTrue:[aView heightOfContents]
+ ifFalse:[aView widthOfContents].
(totalHeight = 0) ifTrue:[
percent := 100
] ifFalse:[
- percent := (aView innerHeight) * 100.0 / totalHeight
+ viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
+ ifFalse:[aView innerWidth].
+ percent := viewsSize * 100.0 / totalHeight
].
self thumbHeight:percent
!
@@ -507,13 +590,16 @@
setThumbOriginFor:aView
"get contents and size info from aView and adjust thumb origin"
- |percent totalHeight|
+ |percent totalHeight contentsPosition|
- totalHeight := aView heightOfContents.
+ totalHeight := (moveDirection == #y) ifTrue:[aView heightOfContents]
+ ifFalse:[aView widthOfContents].
(totalHeight = 0) ifTrue:[
percent := 100
] ifFalse:[
- percent := (aView yOriginOfContents) * 100.0 / totalHeight
+ contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
+ ifFalse:[aView xOriginOfContents].
+ percent := contentsPosition * 100.0 / totalHeight
].
self thumbOrigin:percent
!
@@ -522,7 +608,7 @@
"change the color of the thumb"
thumbColor := aColor on:device.
- self is3D ifTrue:[
+ (style ~~ #normal) ifTrue:[
thumbShadowColor := aColor darkened on:device.
thumbLightColor := aColor lightened on:device.
thumbHalfShadowColor := thumbShadowColor darkened on:device.
@@ -533,6 +619,12 @@
]
!
+thumbColor
+ "return the thumbs color"
+
+ ^ thumbColor
+!
+
thumbFrame
"return the area used by the thumbFrame (in device coordinates).
Allows access to the thumbs physical screen position, for
@@ -553,7 +645,9 @@
] ifFalse:[
fullSize := width
].
- ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
+"/ ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
+"/ 20-apr-94
+ ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
!
percentFromAbs:absValue
@@ -574,14 +668,18 @@
!
computeThumbFrame
- "compute the thumbs frame (a rectangle) whenever thumb is moved, changed
- height or the scrollers size has changed"
+ "compute the thumbs frame (a rectangle) whenever thumb is moved,
+ changed height or the scrollers size has changed.
+ We take care, that the thumb will not become too small (i.e.
+ invisible or uncatchable).
+ Also, for mswindows style, its height/width is constant."
- |np1 np2 ns1 ns2 nh nw ny nx t sz1 sz2|
+ |newPos1 newPos2 newSize1 newSize2 nh nw ny nx
+ computedSize minSz sz1 sz2|
- np1 := (self absFromPercent:thumbOrigin) + margin.
- ns1 := self absFromPercent:thumbHeight.
- thumbFrameSizeDifference := 0.
+ "compute position & size"
+ newPos1 := (self absFromPercent:thumbOrigin) + margin.
+ newSize1 := computedSize := self absFromPercent:thumbHeight.
(moveDirection == #y) ifTrue:[
sz1 := height.
sz2 := width
@@ -589,51 +687,59 @@
sz1 := width.
sz2 := height
].
- self is3D ifTrue:[
- np2 := margin + inset.
- ns2 := sz2 - (margin * 2) - (inset * 2).
- "
- do not make thumb too small (for handle)
+
+ "
+ do we have to adjust the computed size ?
+ "
+ newPos2 := margin + inset.
+ newSize2 := sz2 - (2 * newPos2).
+ (style ~~ #normal) ifTrue:[
"
- (ns1 < (10 + (2 * thumbLevel))) ifTrue:[
- t := ns1.
- ns1 := 10 + (2 * thumbLevel).
- thumbFrameSizeDifference := ns1 - t
- ]
+ do not make thumb too small (for handle & to be catchable)
+ "
+ minSz := 10 + (2 * thumbLevel)
] ifFalse:[
- np2 := inset.
- ns2 := sz2 - (inset * 2).
-
"
do not make thumb too small (uncatchable)
"
- (ns1 < 4) ifTrue:[
- t := ns1.
- ns1 := 4.
- thumbFrameSizeDifference := ns1 - t
- ]
+ minSz := 4
+ ].
+
+ (newSize1 < minSz) ifTrue:[
+ newSize1 := minSz.
+ thumbFrameSizeDifference := newSize1 - computedSize
+ ] ifFalse:[
+ thumbFrameSizeDifference := 0.
].
+
+ fixThumbHeight ifTrue:[
+ "have a fix-size thumb (i.e. mswindows style)"
+
+ newSize1 := sz2 - (2 * inset). "make it square"
+ thumbFrameSizeDifference := newSize1 - computedSize.
+ ].
+
"
- oops - if height has been increased, we have to adjust
- the origin
+ oops - if height does not relect real visibible area, we have to adjust the origin
"
(thumbFrameSizeDifference == 0) ifFalse:[
- np1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
+ newPos1 := (self absFromPercent:thumbOrigin) + margin.
+"/ newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
].
(moveDirection == #y) ifTrue:[
- ny := np1.
- nx := np2.
- nh := ns1.
- nw := ns2.
+ ny := newPos1.
+ nx := newPos2.
+ nh := newSize1.
+ nw := newSize2.
ny + nh + margin > height ifTrue:[
ny := height - margin - nh
]
] ifFalse:[
- nx := np1.
- ny := np2.
- nw := ns1.
- nh := ns2.
+ nx := newPos1.
+ ny := newPos2.
+ nw := newSize1.
+ nh := newSize2.
nx + nw + margin > width ifTrue:[
nx := width - margin - nw
]
@@ -705,7 +811,7 @@
drawThumbBackgroundInX:x y:y width:w height:h
"draw part of the thumbs background; defined as a separate
- method, to allow drawing of arbitrary patterns under thumb."
+ method, to allow drawing of arbitrary patterns under thumb (see ColorSlider)."
self clearRectangleX:x y:y width:w height:h.
!
@@ -720,16 +826,21 @@
y "{ Class: SmallInteger }"
mm xL xR yT yB color1 color2 savEdge|
- ((thumbHeight >= 100) or:[thumbFrame height >= height]) ifTrue:[^ self].
+ (thumbHeight >= 100) ifTrue:[^ self].
+ moveDirection == #y ifTrue:[
+ thumbFrame height >= height ifTrue:[^ self].
+ ] ifFalse:[
+ thumbFrame width >= width ifTrue:[^ self].
+ ].
l := thumbFrame left.
t := thumbFrame top.
w := thumbFrame width.
h := thumbFrame height.
self paint:thumbColor.
- self fillRectangleX:l y:t width:w height:h.
+ self fillRectangleX:l y:t width:w-1 height:h.
- self is3D ifFalse:[
+ (style == #normal) ifTrue:[
self paint:thumbFrameColor.
self displayRectangle:thumbFrame.
^ self
@@ -743,6 +854,15 @@
halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor.
softEdge := savEdge.
+ style == #mswindows ifTrue:[
+ self paint:thumbFrameColor.
+ moveDirection == #y ifTrue:[
+ self displayRectangleX:l y:t width:w"-1" height:h.
+ ] ifFalse:[
+ self displayRectangleX:l y:t width:w height:h"-1".
+ ]
+ ].
+
(tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
shadowForm notNil ifTrue:[
handleX := l + ((w - 8) // 2).
@@ -827,9 +947,30 @@
]
! !
+!Scroller methodsFor:'forced scroll'!
+
+pageUp
+ "page up/left"
+
+ self thumbOrigin:(thumbOrigin - thumbHeight).
+ scrollAction notNil ifTrue:[
+ scrollAction value:thumbOrigin
+ ]
+!
+
+pageDown
+ "page down/right"
+
+ self thumbOrigin:(thumbOrigin + thumbHeight).
+ scrollAction notNil ifTrue:[
+ scrollAction value:thumbOrigin
+ ]
+! !
+
!Scroller methodsFor:'events'!
redrawX:x y:y width:w height:h
+ thumbFrame isNil ifTrue:[self computeThumbFrame].
(y > thumbFrame bottom) ifTrue:[
self drawThumbBackgroundInX:x y:y width:w height:h.
^ self
@@ -846,6 +987,7 @@
"redraw"
shown ifTrue:[
+ thumbFrame isNil ifTrue:[self computeThumbFrame].
self drawThumbBackgroundInX:0 y:0 width:width height:height.
self drawThumb
]
@@ -854,8 +996,10 @@
sizeChanged:how
"size of scroller changed - recompute thumbs frame and redraw it"
- self computeThumbFrame.
- self redraw
+ shown ifTrue:[
+ self computeThumbFrame.
+ self redraw
+ ]
!
buttonPress:button x:x y:y
@@ -876,17 +1020,11 @@
(curr < limit1) ifTrue:[
"page up/left"
- self thumbOrigin:(thumbOrigin - thumbHeight).
- scrollAction notNil ifTrue:[
- scrollAction value:thumbOrigin
- ]
+ self pageUp
] ifFalse:[
(curr > limit2) ifTrue:[
"page down/right"
- self thumbOrigin:(thumbOrigin + thumbHeight).
- scrollAction notNil ifTrue:[
- scrollAction value:thumbOrigin
- ]
+ self pageDown
] ifFalse:[
pressOffset := curr - limit1.
scrolling := true
--- a/SelListV.st Sun Aug 07 15:22:53 1994 +0200
+++ b/SelListV.st Sun Aug 07 15:23:42 1994 +0200
@@ -19,7 +19,7 @@
listAttributes multipleSelectOk clickLine
listSymbol initialSelectionSymbol printItems oneItem
hilightLevel hilightFrameColor ignoreReselect
- arrowLevel smallArrow'
+ arrowLevel smallArrow keyActionStyle'
classVariableNames: 'RightArrowShadowForm RightArrowLightForm RightArrowForm
SmallRightArrowShadowForm SmallRightArrowLightForm'
poolDictionaries:''
@@ -27,25 +27,56 @@
!
SelectionInListView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
+
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.9 1994-08-07 13:23:23 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Attic/SelListV.st,v 1.9 1994-08-07 13:23:23 claus Exp $
+"
+!
+
documentation
"
this one is a ListView with a selected line (which is shown highlighted)
- If multipleSelectionsOk is true, it is also allowed to shift-click multiple entries.
+ If multipleSelectionsOk is true, it is also allowed to shift-click multiple
+ entries.
- Whenever the selection changes, an action-block is called for,
- passing the current selection as argument.
- Currently, the selection can be nil, aNumber or a collection of
- numbers; this will change to be either nil or a collection, making
- selection handling easier in the future.
+ Whenever the selection changes, an action-block is evaluated, passing the
+ current selection as argument.
+ Currently, the selection can be nil, aNumber or a collection of numbers;
+ this will change to be either nil or a collection, making selection handling
+ easier in the future.
The actionBlock is called with the current selection as argument.
+ It is also possible to select entries with the keyboard; use the cursor up/
+ down keys to select prev/next, Home- and End-keys to select first/last.
+ Use the return key to apply the double-click-action to the current selection.
+ Also, alphabetic keys will select the next entry starting with that key.
+
+ The keyboard behavior can be further controlled with the keyActionStyle
+ instance variable (see SelectionInListView>>keyActionStyle:).
+
+
InstanceVariables:
selection <misc> the current selection. nil, a number or collection of numbers
@@ -79,12 +110,12 @@
printItems
oneItem
-
- $Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.8 1994-06-02 18:30:26 claus Exp $
+ keyActionStyle <Symbol> controls how to respond to keyboard selects
written spring/summer 89 by claus
3D Jan 90 by claus
- multiselect Jun 92 my claus
+ multiselect Jun 92 by claus
+ keyboard-select jun 94 by claus
"
! !
@@ -268,6 +299,7 @@
multipleSelectOk := false.
enabled := true.
ignoreReselect := true.
+ keyActionStyle := #select.
!
initStyle
@@ -396,6 +428,22 @@
ignoreReselect := aBoolean
!
+keyActionStyle:aSymbol
+ "defines how the view should respond to alpha-keys pressed.
+ Possible values are:
+ #select -> will select next entry starting with that
+ character and perform the click-action
+
+ #selectAndDoubleclick -> will select next & perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+ "
+
+ keyActionStyle := aSymbol
+!
+
setList:aCollection
"set the list - redefined, since setting the list implies unselecting"
@@ -820,15 +868,15 @@
scrollSelectDown
"auto scroll action; scroll and reinstall timed-block"
- Processor addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
- self scrollDown
+ self scrollDown.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
!
scrollSelectUp
"auto scroll action; scroll and reinstall timed-block"
- Processor addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
- self scrollUp
+ self scrollUp.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
! !
!SelectionInListView methodsFor:'redrawing'!
@@ -838,7 +886,7 @@
This method is not used here, but provided for subclasses such
as menus or file-lists."
- |w h y x l form form2 topLeftColor botRightColor t|
+ |y x form form2 topLeftColor botRightColor t|
x := width - 16.
y := (self yOfLine:visLineNr).
@@ -1065,42 +1113,102 @@
]
!
+key:key select:selectAction x:x y:y
+ "perform keyaction after a key-select"
+
+ keyActionStyle notNil ifTrue:[
+ keyActionStyle == #pass ifTrue:[
+ ^ super keyPress:key x:x y:y
+ ].
+ selectAction value.
+ actionBlock notNil ifTrue:[actionBlock value:selection].
+ keyActionStyle == #selectAndDoubleClick ifTrue:[
+ doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
+ ]
+ ].
+!
+
keyPress:key x:x y:y
"handle keyboard input"
+ |index startSearch|
+
(keyboardHandler notNil
and:[keyboardHandler canHandle:key]) ifTrue:[
keyboardHandler keyPress:key x:x y:y.
^ self
].
- (selection isKindOf:Collection) ifFalse:[
- (key == #CursorUp) ifTrue:[
+ (selection size == 0) ifTrue:[
+ "/ not a multi-selection
+ (key == #CursorUp) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ self key:key select:[self selectPrevious] x:x y:y
+ ].
+ ^ self
+ ].
+ (key == #CursorDown) ifTrue:[
(selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selectPrevious.
- actionBlock notNil ifTrue:[actionBlock value:selection].
+ self key:key select:[self selectNext] x:x y:y
+ ].
+ ^ self
+ ].
+ (key == #Home) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ self key:key select:[self selection:1] x:x y:y
+ ].
+ ^ self
+ ].
+ (key == #End) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ self key:key select:[self selection:list size] x:x y:y
].
^ self
].
- (key == #CursorDown) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selectNext.
- actionBlock notNil ifTrue:[actionBlock value:selection].
+ ].
+ key == #Return ifTrue:[
+ selection notNil ifTrue:[
+ doubleClickActionBlock notNil ifTrue:[
+ doubleClickActionBlock value:selection
].
^ self
- ].
- (key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selection:1.
- actionBlock notNil ifTrue:[actionBlock value:selection].
- ].
- ^ self
- ].
- (key == #End) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selection:list size.
- actionBlock notNil ifTrue:[actionBlock value:selection].
- ].
- ^ self
+ ]
+ ].
+ "
+ alphabetic keys: search for next entry
+ starting with keys character
+ "
+ list size > 0 ifTrue:[
+ key isCharacter ifTrue:[
+ key isLetter ifTrue:[
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection last + 1
+ ] ifFalse:[
+ startSearch := selection + 1
+ ]
+ ] ifFalse:[
+ startSearch := 1
+ ].
+ startSearch > list size ifTrue:[
+ startSearch := 1.
+ ].
+ index := startSearch.
+ [true] whileTrue:[
+ (((list at:index) at:1) asLowercase == key asLowercase) ifTrue:[
+ ^ self key:key select:[self selection:index] x:x y:y
+ ].
+ index := index + 1.
+ index > list size ifTrue:[
+ index := 1
+ ].
+ index == startSearch ifTrue:[
+ ^ self
+ ]
+ ]
+ ]
+ ]
].
].
^ super keyPress:key x:x y:y
--- a/SelectionInListView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/SelectionInListView.st Sun Aug 07 15:23:42 1994 +0200
@@ -19,7 +19,7 @@
listAttributes multipleSelectOk clickLine
listSymbol initialSelectionSymbol printItems oneItem
hilightLevel hilightFrameColor ignoreReselect
- arrowLevel smallArrow'
+ arrowLevel smallArrow keyActionStyle'
classVariableNames: 'RightArrowShadowForm RightArrowLightForm RightArrowForm
SmallRightArrowShadowForm SmallRightArrowLightForm'
poolDictionaries:''
@@ -27,25 +27,56 @@
!
SelectionInListView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
+
+$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.9 1994-08-07 13:23:23 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/SelectionInListView.st,v 1.9 1994-08-07 13:23:23 claus Exp $
+"
+!
+
documentation
"
this one is a ListView with a selected line (which is shown highlighted)
- If multipleSelectionsOk is true, it is also allowed to shift-click multiple entries.
+ If multipleSelectionsOk is true, it is also allowed to shift-click multiple
+ entries.
- Whenever the selection changes, an action-block is called for,
- passing the current selection as argument.
- Currently, the selection can be nil, aNumber or a collection of
- numbers; this will change to be either nil or a collection, making
- selection handling easier in the future.
+ Whenever the selection changes, an action-block is evaluated, passing the
+ current selection as argument.
+ Currently, the selection can be nil, aNumber or a collection of numbers;
+ this will change to be either nil or a collection, making selection handling
+ easier in the future.
The actionBlock is called with the current selection as argument.
+ It is also possible to select entries with the keyboard; use the cursor up/
+ down keys to select prev/next, Home- and End-keys to select first/last.
+ Use the return key to apply the double-click-action to the current selection.
+ Also, alphabetic keys will select the next entry starting with that key.
+
+ The keyboard behavior can be further controlled with the keyActionStyle
+ instance variable (see SelectionInListView>>keyActionStyle:).
+
+
InstanceVariables:
selection <misc> the current selection. nil, a number or collection of numbers
@@ -79,12 +110,12 @@
printItems
oneItem
-
- $Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.8 1994-06-02 18:30:26 claus Exp $
+ keyActionStyle <Symbol> controls how to respond to keyboard selects
written spring/summer 89 by claus
3D Jan 90 by claus
- multiselect Jun 92 my claus
+ multiselect Jun 92 by claus
+ keyboard-select jun 94 by claus
"
! !
@@ -268,6 +299,7 @@
multipleSelectOk := false.
enabled := true.
ignoreReselect := true.
+ keyActionStyle := #select.
!
initStyle
@@ -396,6 +428,22 @@
ignoreReselect := aBoolean
!
+keyActionStyle:aSymbol
+ "defines how the view should respond to alpha-keys pressed.
+ Possible values are:
+ #select -> will select next entry starting with that
+ character and perform the click-action
+
+ #selectAndDoubleclick -> will select next & perform double-click action
+
+ #pass -> will pass key to superclass (i.e. no special treatment)
+
+ nil -> will ignore key
+ "
+
+ keyActionStyle := aSymbol
+!
+
setList:aCollection
"set the list - redefined, since setting the list implies unselecting"
@@ -820,15 +868,15 @@
scrollSelectDown
"auto scroll action; scroll and reinstall timed-block"
- Processor addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
- self scrollDown
+ self scrollDown.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
!
scrollSelectUp
"auto scroll action; scroll and reinstall timed-block"
- Processor addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
- self scrollUp
+ self scrollUp.
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
! !
!SelectionInListView methodsFor:'redrawing'!
@@ -838,7 +886,7 @@
This method is not used here, but provided for subclasses such
as menus or file-lists."
- |w h y x l form form2 topLeftColor botRightColor t|
+ |y x form form2 topLeftColor botRightColor t|
x := width - 16.
y := (self yOfLine:visLineNr).
@@ -1065,42 +1113,102 @@
]
!
+key:key select:selectAction x:x y:y
+ "perform keyaction after a key-select"
+
+ keyActionStyle notNil ifTrue:[
+ keyActionStyle == #pass ifTrue:[
+ ^ super keyPress:key x:x y:y
+ ].
+ selectAction value.
+ actionBlock notNil ifTrue:[actionBlock value:selection].
+ keyActionStyle == #selectAndDoubleClick ifTrue:[
+ doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
+ ]
+ ].
+!
+
keyPress:key x:x y:y
"handle keyboard input"
+ |index startSearch|
+
(keyboardHandler notNil
and:[keyboardHandler canHandle:key]) ifTrue:[
keyboardHandler keyPress:key x:x y:y.
^ self
].
- (selection isKindOf:Collection) ifFalse:[
- (key == #CursorUp) ifTrue:[
+ (selection size == 0) ifTrue:[
+ "/ not a multi-selection
+ (key == #CursorUp) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ self key:key select:[self selectPrevious] x:x y:y
+ ].
+ ^ self
+ ].
+ (key == #CursorDown) ifTrue:[
(selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selectPrevious.
- actionBlock notNil ifTrue:[actionBlock value:selection].
+ self key:key select:[self selectNext] x:x y:y
+ ].
+ ^ self
+ ].
+ (key == #Home) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ self key:key select:[self selection:1] x:x y:y
+ ].
+ ^ self
+ ].
+ (key == #End) ifTrue:[
+ (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
+ self key:key select:[self selection:list size] x:x y:y
].
^ self
].
- (key == #CursorDown) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selectNext.
- actionBlock notNil ifTrue:[actionBlock value:selection].
+ ].
+ key == #Return ifTrue:[
+ selection notNil ifTrue:[
+ doubleClickActionBlock notNil ifTrue:[
+ doubleClickActionBlock value:selection
].
^ self
- ].
- (key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selection:1.
- actionBlock notNil ifTrue:[actionBlock value:selection].
- ].
- ^ self
- ].
- (key == #End) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value]) ifTrue:[
- self selection:list size.
- actionBlock notNil ifTrue:[actionBlock value:selection].
- ].
- ^ self
+ ]
+ ].
+ "
+ alphabetic keys: search for next entry
+ starting with keys character
+ "
+ list size > 0 ifTrue:[
+ key isCharacter ifTrue:[
+ key isLetter ifTrue:[
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection last + 1
+ ] ifFalse:[
+ startSearch := selection + 1
+ ]
+ ] ifFalse:[
+ startSearch := 1
+ ].
+ startSearch > list size ifTrue:[
+ startSearch := 1.
+ ].
+ index := startSearch.
+ [true] whileTrue:[
+ (((list at:index) at:1) asLowercase == key asLowercase) ifTrue:[
+ ^ self key:key select:[self selection:index] x:x y:y
+ ].
+ index := index + 1.
+ index > list size ifTrue:[
+ index := 1
+ ].
+ index == startSearch ifTrue:[
+ ^ self
+ ]
+ ]
+ ]
+ ]
].
].
^ super keyPress:key x:x y:y
--- a/TextView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/TextView.st Sun Aug 07 15:23:42 1994 +0200
@@ -15,53 +15,71 @@
selectionEndLine selectionEndCol
clickStartLine clickStartCol
clickLine clickCol clickCount
+ wordStartCol wordStartLine wordEndCol wordEndLine
selectionFgColor selectionBgColor
fileBox searchBox lineNumberBox
- wordSelectStyle wordCheck
+ selectStyle
directoryForFileDialog
contentsWasSaved'
- classVariableNames:'MyFontPanel'
+ classVariableNames:'MyFontPanel
+ DefaultSelectionForegroundColor
+ DefaultSelectionBackgroundColor'
poolDictionaries:''
category:'Views-Text'
!
TextView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.6 1994-01-08 17:30:00 claus Exp $
-
-written jun-89 by claus
-autoscroll added spring 92 by claus
+$Header: /cvs/stx/stx/libwidg/TextView.st,v 1.7 1994-08-07 13:23:28 claus Exp $
'!
!TextView class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/TextView.st,v 1.7 1994-08-07 13:23:28 claus Exp $
+"
+!
+
documentation
"
-a view for text - this class adds selections to a simple list.
-The text is not editable and there is no cursor.
-Use TextViews for readonly text.
+ a view for text - this class adds selections to a simple list.
+ The text is not editable and there is no cursor.
+ Use TextViews for readonly text.
-Instance variables:
+ Instance variables:
-selectionStartLine <Number> the line of the selection start (or nil)
-selectionStartCol <Number> the col of the selection start
-selectionEndLine <Number> the line of the selection end
-selectionEndCol <Number> the col of the selection end
-clickStartLine <Number> temporary
-clickStartCol <Number> temporary
-clickLine <Number> temporary
-clickCol <Number> temporary
-clickCount <Number> temporary
-selectionFgColor <Color> color used to draw selections
-selectionBgColor <Color> color used to draw selections
-fileBox <FileSelectionBox> box for save
-searchBox <EnterBox2> box to enter searchpattern
-lineNumberBox <EnterBox> box to enter linenumber
-wordSelectStyle <Symbol> how words are selected
-wordCheck <Block> rule used for check in word select
+ selectionStartLine <Number> the line of the selection start (or nil)
+ selectionStartCol <Number> the col of the selection start
+ selectionEndLine <Number> the line of the selection end
+ selectionEndCol <Number> the col of the selection end
+ clickStartLine <Number> temporary
+ clickStartCol <Number> temporary
+ clickLine <Number> temporary
+ clickCol <Number> temporary
+ clickCount <Number> temporary
+ selectionFgColor <Color> color used to draw selections
+ selectionBgColor <Color> color used to draw selections
+ fileBox <FileSelectionBox> box for save
+ searchBox <EnterBox2> box to enter searchpattern
+ lineNumberBox <EnterBox> box to enter linenumber
+ selectStyle <Symbol> how words are selected
"
! !
@@ -81,13 +99,13 @@
^ frame scrolledView
!
-start
+open
"start an empty TextView"
- ^ self startWith:nil
+ ^ self openWith:nil
!
-startWith:aString
+openWith:aString
"start a textView with aString as initial contents"
|top textView|
@@ -101,11 +119,11 @@
top open.
^ textView
- "TextView startWith:'some text'"
- "EditTextView startWith:'some text'"
+ "TextView openWith:'some text'"
+ "EditTextView openWith:'some text'"
!
-startOn:aFileName
+openOn:aFileName
"start a textView on a file"
|top textView|
@@ -120,8 +138,17 @@
top open.
^ textView
- "TextView startOn:'../doc/info.doc'"
- "EditTextView startOn:'../doc/info.doc'"
+ "TextView openOn:'../doc/info.doc'"
+ "EditTextView openOn:'../doc/info.doc'"
+! !
+
+!TextView class methodsFor:'flushing cached resources'!
+
+updateClassResources
+ "sent on style changes ..."
+
+ DefaultSelectionForegroundColor := nil.
+ super updateClassResources.
! !
!TextView methodsFor:'initialize & release'!
@@ -129,28 +156,38 @@
initialize
super initialize.
contentsWasSaved := false.
- wordCheck := [:char | char isNationalAlphaNumeric]
!
initStyle
+ |defFg defBg|
+
super initStyle.
viewBackground := White.
- "if running on a color display, we hilight by drawing black on green
- (looks like a text-marker) otherwise, we draw reverse"
- device hasColors ifTrue:[
- selectionFgColor := fgColor.
- selectionBgColor := Color red:0 green:100 blue:0
- ] ifFalse:[
- device hasGreyscales ifTrue:[
- selectionFgColor := fgColor.
- selectionBgColor := Color lightGrey
+ DefaultSelectionForegroundColor isNil ifTrue:[
+ "
+ if running on a color display, we hilight by drawing black on green
+ (looks like a text-marker) otherwise, we draw reverse.
+ "
+
+ device hasColors ifTrue:[
+ defFg := fgColor.
+ defBg := Color red:0 green:100 blue:0
] ifFalse:[
- selectionFgColor := bgColor.
- selectionBgColor := fgColor
- ]
- ]
+ device hasGreyscales ifTrue:[
+ defFg := fgColor.
+ defBg := Color lightGrey
+ ] ifFalse:[
+ defFg := bgColor.
+ defBg := fgColor
+ ]
+ ].
+ DefaultSelectionForegroundColor := resources at:'SELECTION_FOREGROUND_COLOR' default:defFg.
+ DefaultSelectionBackgroundColor := resources at:'SELECTION_BACKGROUND_COLOR' default:defBg.
+ ].
+ selectionFgColor := DefaultSelectionForegroundColor.
+ selectionBgColor := DefaultSelectionBackgroundColor.
!
initEvents
@@ -171,10 +208,10 @@
labels := resources array:#(
'copy'
'-'
- 'font'
+ 'font ...'
'-'
- 'search'
- 'goto'
+ 'search ...'
+ 'goto ...'
'-'
'save as ...'
'print').
@@ -292,12 +329,26 @@
fileOutContentsOn:aStream
"save contents on a stream"
- list do:[:aLine |
- aLine notNil ifTrue:[
- aStream nextPutAll:aLine
- ].
- aStream cr
- ]
+ |startNr nLines string|
+
+ "on some systems, writing linewise is very slow (via NFS)
+ therefore we convert to a string and write it in chunks
+ to avoid creating huge strings, we do it in blocks of 1000 lines
+ "
+ startNr := 1.
+ nLines := list size.
+ [startNr <= nLines] whileTrue:[
+ string := list asStringFrom:startNr to:((startNr + 1000) min:nLines).
+ aStream nextPutAll:string.
+ startNr := startNr + 1000 + 1.
+ ].
+
+"/ list do:[:aLine |
+"/ aLine notNil ifTrue:[
+"/ aStream nextPutAll:aLine.
+"/ ].
+"/ aStream cr
+"/ ]
!
widthForScrollBetween:firstLine and:lastLine
@@ -318,7 +369,9 @@
|prevStartLine|
- Processor addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
+ "just to make certain ..."
+ selectionStartLine isNil ifTrue:[^ self].
+
self scrollUp.
"make new selection immediately visible"
@@ -328,6 +381,7 @@
selectionStartLine to:prevStartLine do:[:lineNr |
self redrawLine:lineNr
].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
!
scrollSelectDown
@@ -335,7 +389,9 @@
|prevEndLine|
- Processor addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
+ "just to make certain ..."
+ selectionEndLine isNil ifTrue:[^ self].
+
self scrollDown.
"make new selection immediately visible"
@@ -345,14 +401,15 @@
prevEndLine to:selectionEndLine do:[:lineNr |
self redrawLine:lineNr
].
+ Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
!
stopScrollSelect
"stop auto scroll; deinstall timed-block"
autoScrollBlock notNil ifTrue:[
+ Processor removeTimedBlock:autoScrollBlock.
self compressMotionEvents:true.
- Processor removeTimedBlock:autoScrollBlock.
autoScrollBlock := nil.
autoScrollDeltaT := nil
]
@@ -389,16 +446,33 @@
]
!
+appendTo:fileName
+ "append contents to a file named fileName"
+
+ |aStream msg|
+
+ aStream := FileStream appendingOldFileNamed:fileName.
+ aStream isNil ifTrue:[
+ msg := resources string:'cannot append to file %1 !!' with:fileName.
+ self warn:(msg , '\\(' , OperatingSystem lastErrorString , ')' ) withCRs
+ ] ifFalse:[
+ self fileOutContentsOn:aStream.
+ aStream close.
+ contentsWasSaved := true
+ ]
+!
+
save
"save contents into a file
- ask user for filename using a fileSelectionBox."
fileBox isNil ifTrue:[
- fileBox := FileSelectionBox
+ fileBox := FileSaveBox
title:(resources string:'save contents in:')
okText:(resources string:'save')
abortText:(resources string:'cancel')
- action:[:fileName | self saveAs:fileName]
+ action:[:fileName | self saveAs:fileName].
+ fileBox appendAction:[:fileName | self appendTo:fileName].
].
directoryForFileDialog notNil ifTrue:[
fileBox directory:directoryForFileDialog
@@ -492,7 +566,7 @@
!
unselect
- "unselect - if there was a selection redraw"
+ "unselect - if there was a selection redraw that area"
|startLine endLine startVisLine endVisLine|
@@ -523,11 +597,11 @@
].
self unselectWithoutRedraw
].
- wordSelectStyle := nil
+ selectStyle := nil
!
selectFromLine:startLine col:startCol toLine:endLine col:endCol
- "select a piece of text"
+ "select a piece of text and redraw that area"
self unselect.
startLine notNil ifTrue:[
@@ -554,20 +628,27 @@
self redrawLine:lineNr
]
].
- wordSelectStyle := nil.
+ selectStyle := nil.
self enableSelectionMenuEntries
]
!
selectLine:selectLine
- "select one line"
+ "select one line and redraw it"
- self selectFromLine:selectLine col:1 toLine:(selectLine + 1) col:0
+ self selectFromLine:selectLine col:1 toLine:(selectLine + 1) col:0.
+ wordStartCol := selectionStartCol.
+ wordEndCol := selectionEndCol.
+ wordStartLine := selectionStartLine.
+ wordEndLine := selectionEndLine.
+ selectStyle := #line
!
selectLineWhereCharacterPosition:pos
"select the line, where characterPosition pos is living.
- The argument pos starts at 1 from the start of the text."
+ The argument pos starts at 1 from the start of the text
+ and counts characters (i.e. can be used to convert from
+ character position within a string to line-position in view)."
self selectLine:(self lineOfCharacterPosition:pos)
!
@@ -587,76 +668,40 @@
selectWordAtLine:selectLine col:selectCol
"select the word at given line/col"
- |beginCol endCol thisCharacter flag len|
+ |beginCol endCol endLine thisCharacter flag len|
- flag := nil.
+ flag := #word.
beginCol := selectCol.
endCol := selectCol.
+ endLine := selectLine.
thisCharacter := self characterAtLine:selectLine col:beginCol.
- "is this acharacter within a word ?"
+ beginCol := self findBeginOfWordAtLine:selectLine col:selectCol.
+ endCol := self findEndOfWordAtLine:selectLine col:selectCol.
+ endCol == 0 ifTrue:[
+ endLine := selectLine + 1
+ ].
+
+ "is the initial acharacter within a word ?"
(wordCheck value:thisCharacter) ifTrue:[
- [wordCheck value:thisCharacter] whileTrue:[
- beginCol := beginCol - 1.
- beginCol < 1 ifTrue:[
- thisCharacter := Character space
- ] ifFalse:[
- thisCharacter := self characterAtLine:selectLine col:beginCol
- ]
- ].
- beginCol := beginCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol.
- [wordCheck value:thisCharacter] whileTrue:[
- endCol := endCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol
- ].
- endCol := endCol - 1.
-
- "now, we have the word at beginCol..endCol try to catch a blank ..."
+ "
+ try to catch a blank ...
+ "
((beginCol == 1)
or:[(self characterAtLine:selectLine col:(beginCol - 1))
~~ Character space]) ifTrue:[
((self characterAtLine:selectLine col:(endCol + 1))
== Character space) ifTrue:[
endCol := endCol + 1.
- flag := #right
+ flag := #wordRight
]
] ifFalse:[
beginCol := beginCol - 1.
- flag := #left
+ flag := #wordLeft
].
- self selectFromLine:selectLine col:beginCol toLine:selectLine col:endCol.
- ] ifFalse:[
- "nope - maybe its a space"
- thisCharacter == Character space ifTrue:[
- [beginCol > 1 and:[thisCharacter == Character space]] whileTrue:[
- beginCol := beginCol - 1.
- thisCharacter := self characterAtLine:selectLine col:beginCol
- ].
- thisCharacter ~~ Character space ifTrue:[
- beginCol := beginCol + 1.
- ].
-
- len := (self listAt:selectLine) size.
- endCol > len ifTrue:[
- "select rest to end"
- self selectFromLine:selectLine col:beginCol
- toLine:selectLine+1 col:0.
- ] ifFalse:[
- thisCharacter := self characterAtLine:selectLine col:endCol.
- [endCol <= len and:[thisCharacter == Character space]] whileTrue:[
- endCol := endCol + 1.
- thisCharacter := self characterAtLine:selectLine col:endCol
- ].
- endCol := endCol - 1.
- self selectFromLine:selectLine col:beginCol toLine:selectLine col:endCol.
- ]
- ] ifFalse:[
- "select single character"
- self selectFromLine:selectLine col:beginCol toLine:selectLine col:endCol.
- ]
].
- wordSelectStyle := flag
+ self selectFromLine:selectLine col:beginCol toLine:endLine col:endCol.
+ selectStyle := flag
!
selectWordAtX:x y:y
@@ -664,7 +709,7 @@
|selectVisibleLine selectLine selectCol|
- wordSelectStyle := nil.
+ selectStyle := nil.
selectVisibleLine := self visibleLineOfY:y.
selectLine := self visibleLineToListLine:selectVisibleLine.
selectLine notNil ifTrue:[
@@ -691,8 +736,14 @@
self selectFromLine:1 col:1 toLine:(list size + 1) col:0
!
+hasSelection
+ "return true, if there is a selection"
+
+ ^ selectionStartLine notNil
+!
+
selection
- "return the selection as a Text-Collection"
+ "return the selection as a collection of (line-)strings"
|text sz index|
@@ -1163,7 +1214,13 @@
(key == #SelectAll) ifTrue:[self selectAll. ^self].
- "Fn + shift defines a key-sequence (see EditTextView ...)"
+ "
+ shift-Fn defines a key-sequence
+ Fn pastes that sequence
+ cmd-Fn performs a 'doIt' on the sequence (Workspaces only)
+
+ (see EditTextView>>keyPress:x:y and Workspace>>keyPress:x:y)
+ "
(#(F1 F2 F3 F4 F5 F6 F7 F8 F9) includes:key) ifTrue:[
device shiftDown ifTrue:[
(Smalltalk at:#FunctionKeySequences) isNil ifTrue:[
@@ -1182,7 +1239,7 @@
|clickVisibleLine|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
clickVisibleLine := self visibleLineOfY:y.
clickCol := self colOfX:x inVisibleLine:clickVisibleLine.
clickLine := self visibleLineToAbsoluteLine:clickVisibleLine.
@@ -1205,14 +1262,30 @@
buttonMultiPress:button x:x y:y
"multi-mouse-click - select word under pointer"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
clickCount notNil ifTrue:[
clickCount := clickCount + 1.
(clickCount == 2) ifTrue:[
- self selectWordAtX:x y:y
+ self selectWordAtX:x y:y.
+ "
+ remember words position in case of a drag following
+ "
+ wordStartLine := selectionStartLine.
+ wordEndLine := selectionEndLine.
+ selectStyle == #wordLeft ifTrue:[
+ wordStartCol := selectionStartCol + 1
+ ] ifFalse:[
+ wordStartCol := selectionStartCol.
+ ].
+ selectStyle == #wordRight ifTrue:[
+ wordEndCol := selectionEndCol - 1
+ ] ifFalse:[
+ wordEndCol := selectionEndCol
+ ]
] ifFalse:[
(clickCount == 3) ifTrue:[
- self selectLineAtY:y
+ self selectLineAtY:y.
+ selectStyle := #line
] ifFalse:[
(clickCount == 4) ifTrue:[
self selectAll
@@ -1289,19 +1362,50 @@
selectionStartCol := movedCol.
selectionStartLine := movedLine.
selectionEndCol := clickStartCol.
- selectionEndLine := clickStartLine
+ selectionEndLine := clickStartLine.
+ selectStyle notNil ifTrue:[
+ selectionEndCol := wordEndCol.
+ selectionEndLine := wordEndLine.
+ ]
] ifFalse:[
"change selectionEnd"
selectionEndCol := movedCol.
selectionEndLine := movedLine.
selectionStartCol := clickStartCol.
- selectionStartLine := clickStartLine
+ selectionStartLine := clickStartLine.
+ selectStyle notNil ifTrue:[
+ selectionStartCol := wordStartCol.
+ selectionStartLine := wordStartLine.
+ ]
].
(selectionStartCol == 0) ifTrue:[
selectionStartCol := 1
].
+ "
+ if in word-select, just catch the rest of the word
+ "
+ (selectStyle notNil and:[selectStyle startsWith:'word']) ifTrue:[
+ movedUp ifTrue:[
+ selectionStartCol := self findBeginOfWordAtLine:selectionStartLine col:selectionStartCol
+ ] ifFalse:[
+ selectionEndCol := self findEndOfWordAtLine:selectionEndLine col:selectionEndCol.
+ selectionEndCol == 0 ifTrue:[
+ selectionEndLine := selectionEndLine + 1
+ ]
+ ].
+ ].
+
+ selectStyle == #line ifTrue:[
+ movedUp ifTrue:[
+ selectionStartCol := 1.
+ ] ifFalse:[
+ selectionEndCol := 0.
+ selectionEndLine := selectionEndLine + 1
+ ]
+ ].
+
(oldStartLine == selectionStartLine) ifTrue:[
(oldStartCol ~~ selectionStartCol) ifTrue:[
self redrawLine:oldStartLine
@@ -1330,20 +1434,11 @@
buttonRelease:button x:x y:y
"mouse- button release - turn off autoScroll if any"
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
autoScrollBlock notNil ifTrue:[
self stopScrollSelect
].
- selectionStartLine notNil ifTrue:[
- middleButtonMenu enable:#cut.
- middleButtonMenu enable:#copySelection.
- middleButtonMenu enable:#replace.
- middleButtonMenu enable:#indent.
- middleButtonMenu enable:#explain.
- middleButtonMenu enable:#doIt.
- middleButtonMenu enable:#printIt.
- middleButtonMenu enable:#inspectIt
- ]
+ self enableOrDisableSelectionMenuEntries.
] ifFalse:[
super buttonRelease:button x:x y:y
]
--- a/Toggle.st Sun Aug 07 15:22:53 1994 +0200
+++ b/Toggle.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,29 +18,196 @@
!
Toggle comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.5 1994-01-08 17:30:02 claus Exp $
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.6 1994-08-07 13:23:31 claus Exp $
'!
!Toggle class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Toggle.st,v 1.6 1994-08-07 13:23:31 claus Exp $
+"
+!
+
documentation
"
-this button changes state whenever pressed and stays pressed until pressed
-again. All the main action is in Button, Toggle just redefines buttonpress/
-release behavior.
-The toggle may optionally display a little kind-of-lamp (or LED), which
-is turned on when the toggle is pressed. (i.e. as in the Interviews toolkit).
+ this button changes state whenever pressed and stays pressed until pressed
+ again. All the main action is in Button, Toggle just redefines buttonpress/
+ release behavior.
+
+ The toggle may optionally display a little kind-of-lamp (or LED), which
+ is turned on when the toggle is pressed. (i.e. as in the Interviews toolkit).
+
+ whenever the Toggle changes its change, it will evaluate one of
+ pressAction or releaseAction.
+
+ For ST-80 compatibility, if the model is nonNil, this one gets a new
+ value and is sent a changed message.
+ If nonNil, the model is supposed to be a ValueHolder holding true or false.
+
+
+ instance variables:
+ showLamp <Boolean> true if a lamp should be displayed
+ lampColor <Color> color of the lamp
+ lampWidth <Integer> width of the lamp in pixel
+ lampHeight <Integer> height of the lamp in pixel
+
+ Examples:
+ Try these, to see what is possible.
+
+ (notice, that these examples are meant to show what can be done;
+ usually, all style-related stuff id preinitialized - you should not
+ normally play around with onLevel, offLevel, showLamp: etc)
+
+ simple:
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'press here' in:v.
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'toggle pressed'.].
+ t releaseAction:[Transcript showCr:'toggle released'.].
+ v realize
+
+ changing logo:
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'eat me' in:v.
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'smaller'. t label:'drink me'].
+ t releaseAction:[Transcript showCr:'larger'. t label:'eat me'].
+ v realize
+
+ changing logo and freezing size (looks better):
+
+ |v t|
+
+ v := View new.
+ 'create with large logo; freeze; change to small logo'.
+ t := Toggle label:'drink me' in:v.
+ t sizeFixed:true.
+ t label:'eat me'.
+
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'smaller'. t label:'drink me'].
+ t releaseAction:[Transcript showCr:'larger'. t label:'eat me'].
+ v realize
+
+ adding lamp (on by default in some view styles):
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t showLamp:true.
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'. t label:'on'].
+ t releaseAction:[Transcript showCr:'off'. t label:'off'].
+ v realize
+
+ lamp only - no 'going-in'
-instance variables:
- showLamp <Boolean> true if a lamp should be displayed
- lampColor <Color> color of the lamp
- lampWidth <Integer> width of the lamp in pixel
- lampHeight <Integer> height of the lamp in pixel
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t showLamp:true.
+ t onLevel:(t offLevel).
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'. t label:'on'].
+ t releaseAction:[Transcript showCr:'off'. t label:'off'].
+ v realize
+
+ lamp and freezing size of the label (looks better):
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t showLamp:true.
+ t sizeFixed:true.
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'. t label:'on'].
+ t releaseAction:[Transcript showCr:'off'. t label:'off'].
+ v realize
+
+ another variation:
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t showLamp:true.
+ t sizeFixed:true.
+ t onLevel:(t offLevel).
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'. t label:'on'].
+ t releaseAction:[Transcript showCr:'off'. t label:'off'].
+ v realize
+
+ and another one:
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t showLamp:true.
+ t sizeFixed:true.
+
+ t showLamp:false.
+ t offLevel:3.
+ t onLevel:3.
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'. t showLamp:true. t label:'on'].
+ t releaseAction:[Transcript showCr:'off'. t showLamp:false. t label:'off'].
+ v realize
+
+ another font:
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t font:(Font family:'times' face:'bold' style:'roman' size:24).
+ t label:'hello'.
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'.].
+ t releaseAction:[Transcript showCr:'off'.].
+ v realize
+
+ another font (no, I dont know what it means :-):
+
+ |v t|
+
+ v := View new.
+ t := Toggle label:'off' in:v.
+ t font:(Font family:'k14' face:nil style:nil size:nil).
+ t label:(TwoByteString with:(Character value:16r3021)).
+
+ t origin:10 @ 10.
+ t pressAction:[Transcript showCr:'on'.].
+ t releaseAction:[Transcript showCr:'off'.].
+ v realize
"
! !
@@ -52,20 +219,33 @@
showLamp := resources name:'SHOW_LAMP' default:false.
showLamp ifTrue:[
onLevel := offLevel.
- lampColor := resources name:'LAMP_COLOR'
- default:(Color red:100 green:100 blue:0). "yellow"
- lampWidth := (device horizontalPixelPerMillimeter * 1.8) rounded.
- lampHeight := (device verticalPixelPerMillimeter * 3.5) rounded.
"dont know, if I like this ..."
"
activeBgColor := bgColor
"
].
+
+ lampColor := resources name:'LAMP_COLOR' default:(Color yellow).
+ lampWidth := (device horizontalPixelPerMillimeter * 1.8) rounded.
+ lampHeight := (device verticalPixelPerMillimeter * 3.5) rounded.
+
! !
!Toggle methodsFor:'accessing'!
+showLamp:aBoolean
+ "enable/disable drawing of the lamp"
+
+ showLamp ~~ aBoolean ifTrue:[
+ showLamp := aBoolean.
+ self computeLabelSize.
+ fixSize ifFalse:[
+ self resize
+ ]
+ ]
+!
+
lampColor:aColor
"change the color of the toggle-lamp"
@@ -104,14 +284,21 @@
"toggle, but do NOT perform any action - can be used to change a toggle
under program control (i.e. turn one toggle off from another one)"
+ |newLevel|
+
pressed := pressed not.
pressed ifTrue:[
- self level:onLevel.
+ newLevel := onLevel.
] ifFalse:[
- self level:offLevel.
+ newLevel := offLevel.
].
+ self level:newLevel.
+
shown ifTrue:[
self redraw
+ ].
+ model notNil ifTrue:[
+ model value:pressed
]
!
@@ -127,21 +314,27 @@
] ifFalse:[
action := releaseActionBlock
].
- action notNil ifTrue:[action value]
+ action notNil ifTrue:[action value].
+ model notNil ifTrue:[
+ model value:pressed.
+ model changed
+ ].
+ self changed
]
! !
!Toggle methodsFor:'events'!
buttonPress:button x:x y:y
- button == 1 ifFalse:[
+ ((button == 1) or:[button == #select]) ifTrue:[
+ self toggle
+ ] ifFalse:[
^ super buttonPress:button x:x y:y
].
- self toggle
!
buttonRelease:button x:x y:y
- button == 1 ifFalse:[
+ ((button == 1) or:[button == #select]) ifFalse:[
^ super buttonRelease:button x:x y:y
].
"ignore"
@@ -151,7 +344,7 @@
drawWith:fg and:bg
"redraw myself with fg/bg. Use super to draw the label,
- drawing of the lamp here."
+ drawing of the lamp is done here."
|x y|
--- a/VPanelV.st Sun Aug 07 15:22:53 1994 +0200
+++ b/VPanelV.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,17 +18,99 @@
!
VerticalPanelView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-a View for childViews oriented vertical
-all real work is done in PanelView - just redefine layout
+$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.4 1994-08-07 13:23:33 claus Exp $
+'!
+
+!VerticalPanelView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Attic/VPanelV.st,v 1.4 1994-08-07 13:23:33 claus Exp $
+"
+!
+
+documentation
+"
+ a View which arranges its child-views in a vertical column.
+ All real work is done in PanelView - only the layout computation is
+ redefined here.
+
+ example: default layout (centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
-$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.3 1993-10-13 02:49:47 claus Exp $
+ example: left-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p layout:#top.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: right-layout
+
+ |v p b1 b2 b3|
-written spring/summer 89 by claus
-'!
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p layout:#bottom.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: spread-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p layout:#spread.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+"
+! !
!VerticalPanelView methodsFor:'queries'!
@@ -70,13 +152,9 @@
"compute net height needed"
- sumOfHeights := 0.
+ sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
numChilds := subViews size.
- subViews do:[:child |
- sumOfHeights := sumOfHeights + child heightIncludingBorder.
- ].
-
l := layout.
((l == #center) and:[numChilds == 1]) ifTrue:[
l := #spread
@@ -85,16 +163,21 @@
"compute position of topmost subview and space between them;
if they do hardly fit, leave no space between them "
- (sumOfHeights >= height) ifTrue:[
+ (sumOfHeights >= (height - (margin * 2))) ifTrue:[
ypos := 0.
space := 0
] ifFalse:[
(l == #bottom) ifTrue:[
- ypos := height - (horizontalSpace * numChilds)
- - sumOfHeights.
+ ypos := height - (space * numChilds) - sumOfHeights.
+"
borderWidth == 0 ifTrue:[
- ypos := ypos + horizontalSpace
+ ypos := ypos + space
].
+"
+ ypos < 0 ifTrue:[
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ ypos := height - (space * numChilds) - sumOfHeights.
+ ]
] ifFalse: [
(l == #spread) ifTrue:[
space := (height - sumOfHeights) // (numChilds + 1).
@@ -105,18 +188,28 @@
] ifFalse: [
(l == #center) ifTrue:[
ypos := (height - (sumOfHeights
- + ((numChilds - 1) * space))) // 2
+ + ((numChilds - 1) * space))) // 2.
+ ypos < 0 ifTrue:[
+ space := (height - sumOfHeights) // (numChilds + 1).
+ ypos := (height - (sumOfHeights
+ + ((numChilds - 1) * space))) // 2.
+ ]
] ifFalse:[
+"
borderWidth == 0 ifTrue:[
ypos := 0
] ifFalse:[
ypos := verticalSpace
- ]
+ ].
+"
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ ypos := space.
]
]
]
].
+
"now set positions"
subViews do:[:childView |
--- a/VarHPanel.st Sun Aug 07 15:22:53 1994 +0200
+++ b/VarHPanel.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,28 +18,100 @@
!
VariableHorizontalPanel comment:'
-
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-a View to separate its subviews horizontally by a movable bar
-to adjust the size-ratios.
-The bar-handle is either an exposed knob (knobStyle == #motif)
-or the forms defined in Scroller (knobStyle ~~ #motif)
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.6 1994-08-07 13:23:35 claus Exp $
+'!
+
+!VariableHorizontalPanel class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 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/libwidg/Attic/VarHPanel.st,v 1.6 1994-08-07 13:23:35 claus Exp $
+"
+!
+
+documentation
+"
+ a View to separate its subviews horizontally by a movable bar
+ to adjust the size-ratios.
+ The bar-handle is either an exposed knob (knobStyle == #motif)
+ or the forms defined in Scroller (knobStyle ~~ #motif)
+ or nothing.
+
+ The subvies dimensions MUST be given as relative sizes;
+ typically creation is done as:
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.5 1994-01-08 17:31:27 claus Exp $
+ p := VariableHorizontalPanel in:superView.
+ v1 := <someViewClass> origin:0.0 @ 0.0
+ corner:0.5 @ 1.0
+ in:p.
+ v2 := <someViewClass> origin:0.5 @ 0.0
+ corner:0.8 @ 1.0
+ in:p.
+ v3 := <someViewClass> origin:0.8 @ 0.0
+ corner:1.0 @ 1.0
+ in:p.
+
+ example:
+ |top p v1 v2 v3|
+
+ top := StandardSystemView new.
+ top extent:300@200.
-written summer 92 by claus
-'!
+ p := VariableHorizontalPanel
+ origin:0.0 @ 0.0
+ corner:1.0 @ 1.0
+ in:top.
+ v1 := SelectionInListView
+ origin:0.0 @ 0.0
+ corner:0.5 @ 1.0
+ in:p.
+ v2 := EditTextView
+ origin:0.5 @ 0.0
+ corner:0.8 @ 1.0
+ in:p.
+ v3 := ScrollableView
+ for:TextView
+ in:p.
+ v3 origin:0.8 @ 0.0
+ corner:1.0 @ 1.0.
+ top open
+"
+! !
!VariableHorizontalPanel methodsFor:'initializing'!
initCursor
"set the cursor - a horizontal double arrow"
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
+ cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
+ maskForm:(Form fromFile:'VHPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor leftRightArrow
+ "cursor := Cursor leftLimitArrow"
+ ]
! !
!VariableHorizontalPanel methodsFor:'private'!
@@ -161,7 +233,7 @@
|handle|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
handle := 1.
self handleOriginsDo:[:hPoint |
|hx|
@@ -232,7 +304,7 @@
|aboveView belowView aboveIndex belowIndex newX|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
movedHandle isNil ifTrue:[^ self].
"undo the last xor"
@@ -296,13 +368,25 @@
self fillRectangleX:hx y:(hy - barWidth)
width:w height:(barWidth + barWidth).
- self drawEdgesForX:(hx + m)
+ "/ x := hx. "old"
+ x := hx - 1. "2.10.3"
+ self drawEdgesForX:(x + m)
y:(hy - barWidth)
width:w height:(barWidth + barWidth)
level:2
] ifFalse:[
- self drawHandleFormAtX:(hx + m) y:hy
- ]
+ "/ x := hx. "old"
+ x := hx - 1. "2.10.3"
+ self drawHandleFormAtX:(x + m) y:hy
+ ].
+ style == #st80 ifTrue:[
+ x := hx - 1.
+ self paint:lightColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ x := hx + barHeight - 2.
+ self paint:shadowColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ ].
] ifFalse:[
x := hx + barHeight - 2.
self paint:handleColor.
--- a/VarVPanel.st Sun Aug 07 15:22:53 1994 +0200
+++ b/VarVPanel.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,28 +14,103 @@
instanceVariableNames:'movedHandle prev start
barHeight barWidth separatingLine
shadowForm lightForm
- handlePosition
- handleColor noColor'
+ showHandle handlePosition
+ handleColor noColor
+ trackLine'
classVariableNames:''
poolDictionaries:''
category:'Views-Layout'
!
VariableVerticalPanel comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-a View to separate its subviews vertically by a movable bar;
-the size-ratios of the subviews can be changed by moving this bar.
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.7 1994-08-07 13:23:37 claus Exp $
+'!
+
+!VariableVerticalPanel 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.7 1994-08-07 13:23:37 claus Exp $
+"
+!
+
+documentation
+"
+ a View to separate its subviews vertically by a movable bar;
+ the size-ratios of the subviews can be changed by moving this bar.
+
+ The bar-handle is either an exposed knob (style == #motif)
+ or the forms defined in Scroller (style ~~ #motif)
+ or nothing.
+
+ The subvies dimensions MUST be given as relative sizes;
+ typically creation is done as:
-The bar-handle is either an exposed knob (style == #motif)
-or the forms defined in Scroller (style ~~ #motif)
+ p := VariableVerticalPanel in:superView.
+ v1 := <someViewClass> origin:0.0 @ 0.0
+ corner:1.0 @ 0.5
+ in:p.
+ v2 := <someViewClass> origin:0.0 @ 0.5
+ corner:1.0 @ 0.8
+ in:p.
+ v3 := <someViewClass> origin:0.0 @ 0.8
+ corner:1.0 @ 1.0
+ in:p.
+
+ example:
+ |top p v1 v2 v3|
+
+ top := StandardSystemView new.
+ top extent:300@300.
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.6 1994-01-13 00:18:51 claus Exp $
+ p := VariableVerticalPanel
+ origin:0.0 @ 0.0
+ corner:1.0 @ 1.0
+ in:top.
+ v1 := ScrollableView for:SelectionInListView in:p.
+ v1 origin:0.0 @ 0.0
+ corner:1.0 @ 0.5.
+ v1 list:(FileDirectory directoryNamed:'/etc') contents.
+ v1 action:[:selNr |
+ |fullName stream text|
+ fullName := '/etc/' , v1 selectionValue.
+ stream := fullName asFilename readStream.
+ stream notNil ifTrue:[
+ text := stream contents.
+ v2 contents:text.
+ v3 contents:text
+ ]
+ ].
-written summer 91 by claus
-'!
+ v2 := TextView
+ origin:0.0 @ 0.5
+ corner:1.0 @ 0.8
+ in:p.
+ v3 := ScrollableView
+ for:EditTextView
+ in:p.
+ v3 origin:0.0 @ 0.8
+ corner:1.0 @ 1.0.
+ top open
+"
+! !
!VariableVerticalPanel class methodsFor:'defaults'!
@@ -60,22 +135,29 @@
!
initStyle
- |defaultPosition|
+ super initStyle.
- super initStyle.
+ showHandle := style ~~ #mswindows.
(style == #next) ifTrue:[
shadowForm := self class shadowFormOn:device.
lightForm := self class lightFormOn:device.
- defaultPosition := #center.
-
self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
+ barWidth := shadowForm width.
+ handlePosition := #center.
] ifFalse:[
- defaultPosition := #right
+ shadowForm := lightForm := nil.
+ handlePosition := #right
].
- handlePosition := resources at:'HANDLE_POSITION' default:defaultPosition.
- separatingLine := resources at:'SEPARATING_LINE' default:false. "its so ugly"
+
+ style == #motif ifTrue:[
+ trackLine := true.
+ separatingLine := "true" false. "its so ugly"
+ ] ifFalse:[
+ trackLine := false.
+ separatingLine := false
+ ].
+
self is3D ifTrue:[
self barHeight:(3 * ViewSpacing)
] ifFalse:[
@@ -87,9 +169,18 @@
initCursor
"set the cursor - a double arrow"
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
+ cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
+ maskForm:(Form fromFile:'VVPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor upDownArrow
+ "cursor := Cursor upLimitArrow"
+ ]
!
initEvents
@@ -168,10 +259,15 @@
(styleSymbol ~~ style) ifTrue:[
style := styleSymbol.
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
- (self is3D and:[style ~~ #motif]) ifTrue:[
- shadowForm notNil ifTrue:[
+ style == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ shadowForm notNil ifTrue:[
+ (self is3D and:[style ~~ #motif]) ifTrue:[
self barHeight:(shadowForm height + 2).
barWidth := shadowForm width
]
@@ -236,13 +332,25 @@
width:(barWidth + barWidth)
height:h.
+ "/ y := hy. "old"
+ y := hy - 1. "2.10.3"
self drawEdgesForX:(hx - barWidth)
- y:(hy + m)
+ y:(y + m)
width:(barWidth + barWidth)
height:h level:2
] ifFalse:[
- self drawHandleFormAtX:hx y:(hy + m)
- ]
+ "/ y := hy. "old"
+ y := hy - 1. "2.10.3"
+ self drawHandleFormAtX:hx y:(y + m)
+ ].
+ style == #st80 ifTrue:[
+ y := hy - 1.
+ self paint:lightColor.
+ self displayLineFromX:margin y:y toX:(width - margin) y:y.
+ y := hy + barHeight - 2.
+ self paint:shadowColor.
+ self displayLineFromX:margin y:y toX:(width - margin) y:y.
+ ].
] ifFalse:[
y := hy + barHeight - 1.
self paint:handleColor.
@@ -258,15 +366,22 @@
"redraw some handles"
subViews notNil ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- movedHandle notNil ifTrue:[
- self noClipByChildren.
- self xoring:[
- self fillRectangleX:0 y:prev width:width height:barHeight
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
].
- self clipByChildren
+ movedHandle notNil ifTrue:[
+ self noClipByChildren.
+ self xoring:[
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:prev+(barHeight // 2)
+ toX:width y:prev+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:prev width:width height:barHeight
+ ]
+ ].
+ self clipByChildren
+ ]
]
]
!
@@ -296,7 +411,7 @@
|handle|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
handle := 1.
self handleOriginsDo:[:hPoint |
|hy|
@@ -308,7 +423,12 @@
start := by - hy.
self noClipByChildren.
self xoring:[
- self fillRectangleX:0 y:hy width:width height:barHeight
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:hy+(barHeight // 2)
+ toX:width y:hy+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:hy width:width height:barHeight
+ ]
].
self clipByChildren.
^ self
@@ -355,8 +475,15 @@
self noClipByChildren.
self xoring:[
- self fillRectangleX:0 y:prev width:width height:barHeight.
- self fillRectangleX:0 y:ypos width:width height:barHeight
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:prev+(barHeight // 2)
+ toX:width y:prev+(barHeight // 2).
+ self displayLineFromX:0 y:ypos+(barHeight // 2)
+ toX:width y:ypos+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:prev width:width height:barHeight.
+ self fillRectangleX:0 y:ypos width:width height:barHeight
+ ]
].
self clipByChildren.
prev := ypos
@@ -367,14 +494,19 @@
|aboveView belowView aboveIndex belowIndex newY|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
movedHandle isNil ifTrue:[^ self].
"undo the last xor"
self noClipByChildren.
self xoring:[
- self fillRectangleX:0 y:prev width:width height:barHeight
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:prev+(barHeight // 2)
+ toX:width y:prev+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:prev width:width height:barHeight
+ ].
].
self clipByChildren.
@@ -508,7 +640,7 @@
x := hw * 2
] ifFalse:[
(handlePosition == #right) ifTrue:[
- x := width - (2 * hw) - margin
+ x := width - (1 "2" * hw) - margin
] ifFalse:[
x := width // 2
]
--- a/VariableHorizontalPanel.st Sun Aug 07 15:22:53 1994 +0200
+++ b/VariableHorizontalPanel.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,28 +18,100 @@
!
VariableHorizontalPanel comment:'
-
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-a View to separate its subviews horizontally by a movable bar
-to adjust the size-ratios.
-The bar-handle is either an exposed knob (knobStyle == #motif)
-or the forms defined in Scroller (knobStyle ~~ #motif)
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.6 1994-08-07 13:23:35 claus Exp $
+'!
+
+!VariableHorizontalPanel class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 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/libwidg/VariableHorizontalPanel.st,v 1.6 1994-08-07 13:23:35 claus Exp $
+"
+!
+
+documentation
+"
+ a View to separate its subviews horizontally by a movable bar
+ to adjust the size-ratios.
+ The bar-handle is either an exposed knob (knobStyle == #motif)
+ or the forms defined in Scroller (knobStyle ~~ #motif)
+ or nothing.
+
+ The subvies dimensions MUST be given as relative sizes;
+ typically creation is done as:
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.5 1994-01-08 17:31:27 claus Exp $
+ p := VariableHorizontalPanel in:superView.
+ v1 := <someViewClass> origin:0.0 @ 0.0
+ corner:0.5 @ 1.0
+ in:p.
+ v2 := <someViewClass> origin:0.5 @ 0.0
+ corner:0.8 @ 1.0
+ in:p.
+ v3 := <someViewClass> origin:0.8 @ 0.0
+ corner:1.0 @ 1.0
+ in:p.
+
+ example:
+ |top p v1 v2 v3|
+
+ top := StandardSystemView new.
+ top extent:300@200.
-written summer 92 by claus
-'!
+ p := VariableHorizontalPanel
+ origin:0.0 @ 0.0
+ corner:1.0 @ 1.0
+ in:top.
+ v1 := SelectionInListView
+ origin:0.0 @ 0.0
+ corner:0.5 @ 1.0
+ in:p.
+ v2 := EditTextView
+ origin:0.5 @ 0.0
+ corner:0.8 @ 1.0
+ in:p.
+ v3 := ScrollableView
+ for:TextView
+ in:p.
+ v3 origin:0.8 @ 0.0
+ corner:1.0 @ 1.0.
+ top open
+"
+! !
!VariableHorizontalPanel methodsFor:'initializing'!
initCursor
"set the cursor - a horizontal double arrow"
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
+ cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
+ maskForm:(Form fromFile:'VHPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor leftRightArrow
+ "cursor := Cursor leftLimitArrow"
+ ]
! !
!VariableHorizontalPanel methodsFor:'private'!
@@ -161,7 +233,7 @@
|handle|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
handle := 1.
self handleOriginsDo:[:hPoint |
|hx|
@@ -232,7 +304,7 @@
|aboveView belowView aboveIndex belowIndex newX|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
movedHandle isNil ifTrue:[^ self].
"undo the last xor"
@@ -296,13 +368,25 @@
self fillRectangleX:hx y:(hy - barWidth)
width:w height:(barWidth + barWidth).
- self drawEdgesForX:(hx + m)
+ "/ x := hx. "old"
+ x := hx - 1. "2.10.3"
+ self drawEdgesForX:(x + m)
y:(hy - barWidth)
width:w height:(barWidth + barWidth)
level:2
] ifFalse:[
- self drawHandleFormAtX:(hx + m) y:hy
- ]
+ "/ x := hx. "old"
+ x := hx - 1. "2.10.3"
+ self drawHandleFormAtX:(x + m) y:hy
+ ].
+ style == #st80 ifTrue:[
+ x := hx - 1.
+ self paint:lightColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ x := hx + barHeight - 2.
+ self paint:shadowColor.
+ self displayLineFromX:x y:margin toX:x y:(height - margin).
+ ].
] ifFalse:[
x := hx + barHeight - 2.
self paint:handleColor.
--- a/VariableVerticalPanel.st Sun Aug 07 15:22:53 1994 +0200
+++ b/VariableVerticalPanel.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,28 +14,103 @@
instanceVariableNames:'movedHandle prev start
barHeight barWidth separatingLine
shadowForm lightForm
- handlePosition
- handleColor noColor'
+ showHandle handlePosition
+ handleColor noColor
+ trackLine'
classVariableNames:''
poolDictionaries:''
category:'Views-Layout'
!
VariableVerticalPanel comment:'
-
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-a View to separate its subviews vertically by a movable bar;
-the size-ratios of the subviews can be changed by moving this bar.
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.7 1994-08-07 13:23:37 claus Exp $
+'!
+
+!VariableVerticalPanel 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.7 1994-08-07 13:23:37 claus Exp $
+"
+!
+
+documentation
+"
+ a View to separate its subviews vertically by a movable bar;
+ the size-ratios of the subviews can be changed by moving this bar.
+
+ The bar-handle is either an exposed knob (style == #motif)
+ or the forms defined in Scroller (style ~~ #motif)
+ or nothing.
+
+ The subvies dimensions MUST be given as relative sizes;
+ typically creation is done as:
-The bar-handle is either an exposed knob (style == #motif)
-or the forms defined in Scroller (style ~~ #motif)
+ p := VariableVerticalPanel in:superView.
+ v1 := <someViewClass> origin:0.0 @ 0.0
+ corner:1.0 @ 0.5
+ in:p.
+ v2 := <someViewClass> origin:0.0 @ 0.5
+ corner:1.0 @ 0.8
+ in:p.
+ v3 := <someViewClass> origin:0.0 @ 0.8
+ corner:1.0 @ 1.0
+ in:p.
+
+ example:
+ |top p v1 v2 v3|
+
+ top := StandardSystemView new.
+ top extent:300@300.
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.6 1994-01-13 00:18:51 claus Exp $
+ p := VariableVerticalPanel
+ origin:0.0 @ 0.0
+ corner:1.0 @ 1.0
+ in:top.
+ v1 := ScrollableView for:SelectionInListView in:p.
+ v1 origin:0.0 @ 0.0
+ corner:1.0 @ 0.5.
+ v1 list:(FileDirectory directoryNamed:'/etc') contents.
+ v1 action:[:selNr |
+ |fullName stream text|
+ fullName := '/etc/' , v1 selectionValue.
+ stream := fullName asFilename readStream.
+ stream notNil ifTrue:[
+ text := stream contents.
+ v2 contents:text.
+ v3 contents:text
+ ]
+ ].
-written summer 91 by claus
-'!
+ v2 := TextView
+ origin:0.0 @ 0.5
+ corner:1.0 @ 0.8
+ in:p.
+ v3 := ScrollableView
+ for:EditTextView
+ in:p.
+ v3 origin:0.0 @ 0.8
+ corner:1.0 @ 1.0.
+ top open
+"
+! !
!VariableVerticalPanel class methodsFor:'defaults'!
@@ -60,22 +135,29 @@
!
initStyle
- |defaultPosition|
+ super initStyle.
- super initStyle.
+ showHandle := style ~~ #mswindows.
(style == #next) ifTrue:[
shadowForm := self class shadowFormOn:device.
lightForm := self class lightFormOn:device.
- defaultPosition := #center.
-
self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
+ barWidth := shadowForm width.
+ handlePosition := #center.
] ifFalse:[
- defaultPosition := #right
+ shadowForm := lightForm := nil.
+ handlePosition := #right
].
- handlePosition := resources at:'HANDLE_POSITION' default:defaultPosition.
- separatingLine := resources at:'SEPARATING_LINE' default:false. "its so ugly"
+
+ style == #motif ifTrue:[
+ trackLine := true.
+ separatingLine := "true" false. "its so ugly"
+ ] ifFalse:[
+ trackLine := false.
+ separatingLine := false
+ ].
+
self is3D ifTrue:[
self barHeight:(3 * ViewSpacing)
] ifFalse:[
@@ -87,9 +169,18 @@
initCursor
"set the cursor - a double arrow"
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
+ cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
+ maskForm:(Form fromFile:'VVPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor upDownArrow
+ "cursor := Cursor upLimitArrow"
+ ]
!
initEvents
@@ -168,10 +259,15 @@
(styleSymbol ~~ style) ifTrue:[
style := styleSymbol.
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
- (self is3D and:[style ~~ #motif]) ifTrue:[
- shadowForm notNil ifTrue:[
+ style == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ shadowForm notNil ifTrue:[
+ (self is3D and:[style ~~ #motif]) ifTrue:[
self barHeight:(shadowForm height + 2).
barWidth := shadowForm width
]
@@ -236,13 +332,25 @@
width:(barWidth + barWidth)
height:h.
+ "/ y := hy. "old"
+ y := hy - 1. "2.10.3"
self drawEdgesForX:(hx - barWidth)
- y:(hy + m)
+ y:(y + m)
width:(barWidth + barWidth)
height:h level:2
] ifFalse:[
- self drawHandleFormAtX:hx y:(hy + m)
- ]
+ "/ y := hy. "old"
+ y := hy - 1. "2.10.3"
+ self drawHandleFormAtX:hx y:(y + m)
+ ].
+ style == #st80 ifTrue:[
+ y := hy - 1.
+ self paint:lightColor.
+ self displayLineFromX:margin y:y toX:(width - margin) y:y.
+ y := hy + barHeight - 2.
+ self paint:shadowColor.
+ self displayLineFromX:margin y:y toX:(width - margin) y:y.
+ ].
] ifFalse:[
y := hy + barHeight - 1.
self paint:handleColor.
@@ -258,15 +366,22 @@
"redraw some handles"
subViews notNil ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- movedHandle notNil ifTrue:[
- self noClipByChildren.
- self xoring:[
- self fillRectangleX:0 y:prev width:width height:barHeight
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
].
- self clipByChildren
+ movedHandle notNil ifTrue:[
+ self noClipByChildren.
+ self xoring:[
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:prev+(barHeight // 2)
+ toX:width y:prev+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:prev width:width height:barHeight
+ ]
+ ].
+ self clipByChildren
+ ]
]
]
!
@@ -296,7 +411,7 @@
|handle|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
handle := 1.
self handleOriginsDo:[:hPoint |
|hy|
@@ -308,7 +423,12 @@
start := by - hy.
self noClipByChildren.
self xoring:[
- self fillRectangleX:0 y:hy width:width height:barHeight
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:hy+(barHeight // 2)
+ toX:width y:hy+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:hy width:width height:barHeight
+ ]
].
self clipByChildren.
^ self
@@ -355,8 +475,15 @@
self noClipByChildren.
self xoring:[
- self fillRectangleX:0 y:prev width:width height:barHeight.
- self fillRectangleX:0 y:ypos width:width height:barHeight
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:prev+(barHeight // 2)
+ toX:width y:prev+(barHeight // 2).
+ self displayLineFromX:0 y:ypos+(barHeight // 2)
+ toX:width y:ypos+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:prev width:width height:barHeight.
+ self fillRectangleX:0 y:ypos width:width height:barHeight
+ ]
].
self clipByChildren.
prev := ypos
@@ -367,14 +494,19 @@
|aboveView belowView aboveIndex belowIndex newY|
- (button == 1) ifTrue:[
+ ((button == 1) or:[button == #select]) ifTrue:[
movedHandle isNil ifTrue:[^ self].
"undo the last xor"
self noClipByChildren.
self xoring:[
- self fillRectangleX:0 y:prev width:width height:barHeight
+ trackLine ifTrue:[
+ self displayLineFromX:0 y:prev+(barHeight // 2)
+ toX:width y:prev+(barHeight // 2).
+ ] ifFalse:[
+ self fillRectangleX:0 y:prev width:width height:barHeight
+ ].
].
self clipByChildren.
@@ -508,7 +640,7 @@
x := hw * 2
] ifFalse:[
(handlePosition == #right) ifTrue:[
- x := width - (2 * hw) - margin
+ x := width - (1 "2" * hw) - margin
] ifFalse:[
x := width // 2
]
--- a/VerticalPanelView.st Sun Aug 07 15:22:53 1994 +0200
+++ b/VerticalPanelView.st Sun Aug 07 15:23:42 1994 +0200
@@ -18,17 +18,99 @@
!
VerticalPanelView comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-a View for childViews oriented vertical
-all real work is done in PanelView - just redefine layout
+$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.4 1994-08-07 13:23:33 claus Exp $
+'!
+
+!VerticalPanelView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/VerticalPanelView.st,v 1.4 1994-08-07 13:23:33 claus Exp $
+"
+!
+
+documentation
+"
+ a View which arranges its child-views in a vertical column.
+ All real work is done in PanelView - only the layout computation is
+ redefined here.
+
+ example: default layout (centered)
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
-$Header: /cvs/stx/stx/libwidg/VerticalPanelView.st,v 1.3 1993-10-13 02:49:47 claus Exp $
+ example: left-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p layout:#top.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: right-layout
+
+ |v p b1 b2 b3|
-written spring/summer 89 by claus
-'!
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p layout:#bottom.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+
+
+ example: spread-layout
+
+ |v p b1 b2 b3|
+
+ v := StandardSystemView new.
+ p := VerticalPanelView in:v.
+ p layout:#spread.
+ p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ b1 := Button label:'button1' in:p.
+ b2 := Button label:'button2' in:p.
+ b3 := Button label:'button3' in:p.
+ v extent:100 @ 300.
+ v open
+"
+! !
!VerticalPanelView methodsFor:'queries'!
@@ -70,13 +152,9 @@
"compute net height needed"
- sumOfHeights := 0.
+ sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
numChilds := subViews size.
- subViews do:[:child |
- sumOfHeights := sumOfHeights + child heightIncludingBorder.
- ].
-
l := layout.
((l == #center) and:[numChilds == 1]) ifTrue:[
l := #spread
@@ -85,16 +163,21 @@
"compute position of topmost subview and space between them;
if they do hardly fit, leave no space between them "
- (sumOfHeights >= height) ifTrue:[
+ (sumOfHeights >= (height - (margin * 2))) ifTrue:[
ypos := 0.
space := 0
] ifFalse:[
(l == #bottom) ifTrue:[
- ypos := height - (horizontalSpace * numChilds)
- - sumOfHeights.
+ ypos := height - (space * numChilds) - sumOfHeights.
+"
borderWidth == 0 ifTrue:[
- ypos := ypos + horizontalSpace
+ ypos := ypos + space
].
+"
+ ypos < 0 ifTrue:[
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ ypos := height - (space * numChilds) - sumOfHeights.
+ ]
] ifFalse: [
(l == #spread) ifTrue:[
space := (height - sumOfHeights) // (numChilds + 1).
@@ -105,18 +188,28 @@
] ifFalse: [
(l == #center) ifTrue:[
ypos := (height - (sumOfHeights
- + ((numChilds - 1) * space))) // 2
+ + ((numChilds - 1) * space))) // 2.
+ ypos < 0 ifTrue:[
+ space := (height - sumOfHeights) // (numChilds + 1).
+ ypos := (height - (sumOfHeights
+ + ((numChilds - 1) * space))) // 2.
+ ]
] ifFalse:[
+"
borderWidth == 0 ifTrue:[
ypos := 0
] ifFalse:[
ypos := verticalSpace
- ]
+ ].
+"
+ space := space min:(height - sumOfHeights) // (numChilds + 1).
+ ypos := space.
]
]
]
].
+
"now set positions"
subViews do:[:childView |
--- a/WarnBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/WarnBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,31 +14,74 @@
instanceVariableNames:''
classVariableNames:'WarnBitmap'
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
WarningBox comment:'
-
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-this class implements a pop-up box to show an information message
+$Header: /cvs/stx/stx/libwidg/Attic/WarnBox.st,v 1.4 1994-08-07 13:23:39 claus Exp $
+'!
+
+!WarningBox class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1993 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/libwidg/Attic/WarnBox.st,v 1.4 1994-08-07 13:23:39 claus Exp $
+"
+!
-$Header: /cvs/stx/stx/libwidg/Attic/WarnBox.st,v 1.3 1994-01-16 04:03:30 claus Exp $
-written Summer 93 by claus
-'!
+documentation
+"
+ this class implements a pop-up box to show an information message.
+ WarningBoxes are basically InfoBoxes with a different bitmap-image.
+ (also, they add a beep when popping up)
+
+ They are created with:
+
+ aBox := WarningBox title:'some title'.
+
+ and shown with:
+
+ aBox showAtPointer
+
+ The default box shows 'yes' in its button; this can be changed with:
+
+ aBox okText:'some string'.
+
+
+ Examples:
+
+ |aBox|
+
+ aBox := WarningBox title:'Press ''OK'' to continue'.
+ aBox okText:'OK'.
+ aBox showAtPointer.
+
+"
+! !
!WarningBox methodsFor:'initialization'!
-initialize
+initFormBitmap
WarnBitmap isNil ifTrue:[
- WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:device
+ WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:Display
].
-
- super initialize.
-!
-
-initFormBitmap
formLabel form:WarnBitmap
! !
--- a/WarningBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/WarningBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,31 +14,74 @@
instanceVariableNames:''
classVariableNames:'WarnBitmap'
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
WarningBox comment:'
-
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-this class implements a pop-up box to show an information message
+$Header: /cvs/stx/stx/libwidg/WarningBox.st,v 1.4 1994-08-07 13:23:39 claus Exp $
+'!
+
+!WarningBox class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1993 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/libwidg/WarningBox.st,v 1.4 1994-08-07 13:23:39 claus Exp $
+"
+!
-$Header: /cvs/stx/stx/libwidg/WarningBox.st,v 1.3 1994-01-16 04:03:30 claus Exp $
-written Summer 93 by claus
-'!
+documentation
+"
+ this class implements a pop-up box to show an information message.
+ WarningBoxes are basically InfoBoxes with a different bitmap-image.
+ (also, they add a beep when popping up)
+
+ They are created with:
+
+ aBox := WarningBox title:'some title'.
+
+ and shown with:
+
+ aBox showAtPointer
+
+ The default box shows 'yes' in its button; this can be changed with:
+
+ aBox okText:'some string'.
+
+
+ Examples:
+
+ |aBox|
+
+ aBox := WarningBox title:'Press ''OK'' to continue'.
+ aBox okText:'OK'.
+ aBox showAtPointer.
+
+"
+! !
!WarningBox methodsFor:'initialization'!
-initialize
+initFormBitmap
WarnBitmap isNil ifTrue:[
- WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:device
+ WarnBitmap := Form fromFile:'Warning.xbm' resolution:100 on:Display
].
-
- super initialize.
-!
-
-initFormBitmap
formLabel form:WarnBitmap
! !
--- a/Workspace.st Sun Aug 07 15:22:53 1994 +0200
+++ b/Workspace.st Sun Aug 07 15:23:42 1994 +0200
@@ -21,19 +21,44 @@
!
Workspace comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.7 1994-06-03 14:51:17 claus Exp $
-written winter-89 by claus
+$Header: /cvs/stx/stx/libwidg/Workspace.st,v 1.8 1994-08-07 13:23:40 claus Exp $
'!
!Workspace class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/Workspace.st,v 1.8 1994-08-07 13:23:40 claus Exp $
+"
+!
+
documentation
"
a view for editable text which can evaluate expressions.
+ I.e. its basically a view for editable text, with added
+ 'doIt', 'printIt' and 'inspectIt' functions on the popup-menu.
+ The action to be performed on doIt is defined by a block,
+ which can be defined in the owner of this view.
+ A useful default action is setup, which simply evaluates the
+ selection as a smalltalk expression. (but, a lisp or prolog
+ view could define its own action ...)
instance variables:
@@ -96,71 +121,38 @@
!
initializeMiddleButtonMenu
- |labels|
+ |idx|
+
+ super initializeMiddleButtonMenu.
- labels := resources array:#(
-"
- 'undo'
-"
- 'again'
- '-'
- 'copy'
- 'cut'
- 'paste'
- '-'
- 'doIt'
- 'printIt'
- 'inspectIt'
- '-'
- 'others'
- ).
+ "
+ workspaces do not support #accept
+ "
+ idx := middleButtonMenu indexOf:#accept.
+ idx ~~ 0 ifTrue:[
+ middleButtonMenu remove:idx.
+ (middleButtonMenu labels at:(idx - 1)) = '-' ifTrue:[
+ middleButtonMenu remove:idx - 1
+ ].
+ ].
- self middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(
-"
- undo
-"
- again
- nil
- copySelection
- cut
- paste
- nil
- doIt
- printIt
- inspectIt
- nil
- others
- )
- receiver:self
- for:self).
+ idx := middleButtonMenu indexOf:#paste.
- middleButtonMenu subMenuAt:#others put:(PopUpMenu
- labels:(resources array:#(
- 'search ...'
- 'goto ...'
- '-'
- 'font ...'
- '-'
- 'indent'
- '-'
- 'save as ...'
- 'print'
- ))
- selectors:#(
- search
- gotoLine
- nil
- changeFont
- nil
- indent
- nil
- save
- print
- )
- receiver:self
- for:self).
+ "
+ but they do support #doIt, #printIt and #inspectIt
+ "
+ middleButtonMenu addLabel:'-'
+ selector:nil
+ after:idx.
+ middleButtonMenu addLabel:(resources string:'doIt')
+ selector:#doIt
+ after:idx + 1.
+ middleButtonMenu addLabel:(resources string:'printIt')
+ selector:#printIt
+ after:idx + 2.
+ middleButtonMenu addLabel:(resources string:'inspectIt')
+ selector:#inspectIt
+ after:idx + 3.
self enableOrDisableSelectionMenuEntries
!
@@ -394,5 +386,72 @@
(key == #DoIt) ifTrue:[^ self doIt].
(key == #InspectIt) ifTrue:[^ self inspectIt].
(key == #PrintIt) ifTrue:[^ self printIt].
+
+ "
+ Cmd-Fn evaluates a key-sequence
+
+ see TextView>>keyPress:x:y:
+ "
+ (#(F1 F2 F3 F4 F5 F6 F7 F8 F9) includes:key) ifTrue:[
+ device metaDown ifTrue:[
+ (Smalltalk at:#FunctionKeySequences) notNil ifTrue:[
+ Parser evaluate:((Smalltalk at:#FunctionKeySequences) at:key) asString
+ receiver:self
+ notifying:nil.
+ ^ self
+ ]
+ ]
+ ].
+
super keyPress:key x:x y:y
+
+ "
+ example uses of funtion keys:
+
+ to set tab-distance to 4-cols,
+ select the following:
+
+ self setTab4
+
+ then, press shift-F2 to define the sequence;
+ press cmd-F2 to execute it.
+ voila: you have set 4-tabs.
+
+ to switch back, perform the same procedure with:
+
+ self setTab8
+
+
+ if you like a browser to come up on the selection when pressing F3:
+ select:
+
+ |sel|
+ sel := self selection asString withoutSeparators.
+ (Smalltalk includesKey:sel asSymbol) ifTrue:[
+ (Smalltalk at:sel asSymbol) isClass ifTrue:[
+ SystemBrowser browseClass:(Smalltalk at:sel asSymbol)
+ ]
+ ]
+
+ then, press shift-F3 to define the command.
+ press cmd-F3 to execute it (select some classname before).
+ (notice: on the Indy, Cmd-F3 is already handled by the window manager)
+
+ if you like a file-include command on F4:
+ select:
+
+ |sel|
+ sel := self selection.
+ sel notNil ifTrue:[
+ sel := sel asString withoutSeparators.
+ s := FileStream readonlyFileNamed:sel.
+ s notNil ifTrue:[
+ self paste:(s contents asString).
+ s close
+ ]
+ ]
+
+ this will paste the contents of the file at the current cusor position.
+
+ "
! !
--- a/YesNoBox.st Sun Aug 07 15:22:53 1994 +0200
+++ b/YesNoBox.st Sun Aug 07 15:23:42 1994 +0200
@@ -14,30 +14,90 @@
instanceVariableNames:'noButton noAction'
classVariableNames:'RequestBitmap'
poolDictionaries:''
- category:'Views-Interactors'
+ category:'Views-DialogBoxes'
!
YesNoBox comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-this class implements yes-no boxes by adding another (no-)
-Button to the View.
+$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.5 1994-08-07 13:23:42 claus Exp $
+'!
+
+!YesNoBox class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 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/libwidg/YesNoBox.st,v 1.5 1994-08-07 13:23:42 claus Exp $
+"
+!
+
+documentation
+"
+ this class implements yes-no boxes by adding another (no-) Button to the WarnBox-View.
+ They are created with:
+
+ aBox := YesNoBox title:'some title'.
+ aBox okAction:[ .. some action to be performed when ok is pressed ].
+
+ and finally shown with:
-$Header: /cvs/stx/stx/libwidg/YesNoBox.st,v 1.4 1993-12-13 17:07:34 claus Exp $
-written spring/summer 89 by claus
-'!
+ aBox showAtPointer
+
+ The default box shows 'yes' and 'no' in its buttons; this can be changed with:
+
+ aBox yesText:'some string'.
+ aBox noText:'some string'.
+
+ There is also protocol to set both button titles in one message.
+ Also, the action associated to the noButton can be changed.
+
+ Examples:
+
+ |aBox|
+
+ aBox := YesNoBox title:'Coffee or tee ?'.
+ aBox noText:'tee'.
+ aBox yesText:'coffee'.
+ aBox yesAction:[Transcript showCr:'make coffee'].
+ aBox noAction:[Transcript showCr:'make tee'].
+ aBox showAtPointer.
+
+ or, shorter:
+
+ |aBox|
+
+ aBox := YesNoBox new.
+ aBox title:'Coffee or Tee ?'
+ yesAction:[Transcript showCr:'make coffee']
+ noAction:[Transcript showCr:'make tee'].
+ aBox yesText:'Coffee' noText:'Tee'.
+ aBox showAtPointer
+
+ Also, have a look at the inherited protocol; for example, this allows changing
+ the bitmap (default: a question mark) and other properties.
+"
+! !
!YesNoBox methodsFor:'initialization'!
initialize
|space3|
- RequestBitmap isNil ifTrue:[
- RequestBitmap := Form fromFile:'Request.xbm' resolution:100 on:device
- ].
-
super initialize.
textLabel label:'Confirm'.
@@ -51,15 +111,25 @@
in:self.
space3 := 3 * ViewSpacing.
- noButton origin:[ViewSpacing @ (height - ViewSpacing - noButton height)]
+
+ noButton origin:[ViewSpacing - noButton borderWidth
+ @
+ (height - ViewSpacing - noButton height - noButton borderWidth)]
extent:[((width - space3) // 2) @ noButton height].
+
okButton origin:[((width + ViewSpacing) // 2)
@
- (height - ViewSpacing - okButton height)]
- extent:[((width - space3) // 2) @ okButton height]
+ (height - ViewSpacing - okButton height - okButton borderWidth)]
+ extent:[((width - space3) // 2) @ okButton height].
+
+ self resize.
!
initFormBitmap
+ RequestBitmap isNil ifTrue:[
+ RequestBitmap := Form fromFile:'Request.xbm' resolution:100 on:Display
+ ].
+
formLabel form:RequestBitmap
! !
@@ -107,6 +177,7 @@
aString ~= noButton label ifTrue:[
noButton label:aString.
+ noButton resize.
self resize
]
!
@@ -117,6 +188,8 @@
((yesString ~= okButton label) or:[noString ~= noButton label]) ifTrue:[
okButton label:yesString.
noButton label:noString.
+ okButton resize.
+ noButton resize.
self resize
]
!
@@ -143,18 +216,21 @@
resize
"resize myself to make everything fit into myself"
- |w h extra|
+ |w h|
+"
w := (formLabel width + textLabel width) max:(okButton width + noButton width).
+"
+ w := (formLabel width + textLabel width) max:(okButton preferredExtent x max:noButton preferredExtent x) * 2.
w := w + (3 * ViewSpacing).
h := (3 * ViewSpacing)
+ ((formLabel height) max:(textLabel height))
- + okButton height.
+ + okButton heightIncludingBorder.
- extra := 0 "margin * 2".
- super extent:(w + extra) @ (h + extra).
+ super extent:(w @ h).
formLabel origin:(ViewSpacing @ ViewSpacing).
textLabel origin:(ViewSpacing + formLabel width + ViewSpacing) @ ViewSpacing.
noButton origin:((width // 4) - (noButton width // 2)) @ (height - ViewSpacing - noButton height).
- okButton origin:((width // 4) * 3 - (okButton width // 2)) @ (height - ViewSpacing - okButton height)
+ okButton origin:((width // 4) * 3 - (okButton widthIncludingBorder // 2) "- okButton borderWidth")
+ @ (height - ViewSpacing - okButton height - okButton borderWidth)
! !