--- a/ArrButton.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,990 +0,0 @@
-"
- 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.
-"
-
-Button subclass:#ArrowButton
- instanceVariableNames:'arrowStyle direction'
- classVariableNames:'DownArrowForm UpArrowForm LeftArrowForm RightArrowForm
- CachedStyle DefaultArrowStyle DefaultBackgroundColor
- DefaultForegroundColor DefaultActiveBackgroundColor
- DefaultActiveForegroundColor DefaultEnteredBackgroundColor
- DefaultEnteredForegroundColor DefaultDisabledForegroundColor
- DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel
- DownArrowFormFile UpArrowFormFile LeftArrowFormFile
- RightArrowFormFile'
- poolDictionaries:''
- category:'Views-Interactors'
-!
-
-!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.
-"
-!
-
-documentation
-"
- ArrowButtons display an arrow as their label; they are mainly
- used for scrollbars, but can be useful on their own in some applications.
- Beside the contents, their default behavior is to perform their action
- when pressed - not (as is the default for normal buttons) when released.
-
- Indivdual ArrowButtons can be created by sending one of:
- ArrowButton upIn:aView /downIn: / leftIn: or rightIn:
- passing the parent view as argument.
-
- See examples.
-
-
- [styleSheet parameters:]
-
- arrowButtonStyle <Symbol> the style of the button;
- #motif, #st80 or nil (default)
- arrowButtonForegroundColor <nil | Color> foregroundColor
- arrowButtonBackgroundColor <nil | Color> backgroundColor
-
- arrowButtonActiveForegroundColor foregroundColor when pressed
- arrowButtonActiveBackgroundColor backgroundColor when pressed
-
- arrowButtonEnteredForegroundColor foregroundColor when mouse pointer entered
- arrowButtonEnteredBackgroundColor backgroundColor when mouse pointer entered
-
- [author:]
- Claus Gittinger
-
- [See also:]
- Button Toggle CheckToggle CheckBox
- ScrollBar
-
-"
-!
-
-examples
-"
- example1:
- [exBegin]
- |v p b1 b2 b3 b4|
-
- v := StandardSystemView extent:200@200.
- 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
- [exEnd]
-
-
- example2:
- [exBegin]
- |v p b1 b2 b3 b4|
-
- v := StandardSystemView extent:200@200.
- 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
- [exEnd]
-
-
- example3:
- [exBegin]
- |v p b1 b2 b3 b4|
-
- v := StandardSystemView extent:200@200.
- p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
- b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).
- b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).
- b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).
- b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).
-
- 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
- [exEnd]
-
-
- example4 (not good coding style, to explicitely use a particular style,
- just a demonstration how it looks ..):
- [exBegin]
- |v p b1 b2 b3 b4 oldStyle|
-
- oldStyle := View defaultStyle.
- View defaultStyle:#motif.
-
- v := StandardSystemView extent:100@100.
- p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
-
- b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).
- b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).
- b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).
- b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).
-
- b1 action:['whatEver you like here ...'].
- b2 action:['whatEver you like here ...'].
- b3 action:['whatEver you like here ...'].
- b4 action:['whatEver you like here ...'].
-
- View defaultStyle:oldStyle.
- v open
- [exEnd]
-"
-! !
-
-!ArrowButton class methodsFor:'instance creation'!
-
-downIn:aView
- "create and return a new down-button in aView"
-
- ^ (super in:aView) direction:#down
-
- "Modified: 22.1.1997 / 11:59:08 / cg"
-!
-
-leftIn:aView
- "create and return a new left-button in aView"
-
- ^ (super in:aView) direction:#left
-
- "Modified: 22.1.1997 / 11:59:14 / cg"
-!
-
-new
- "return a new arrowButton - direction defaults to #up"
-
- ^ super new direction:#up
-!
-
-rightIn:aView
- "create and return a new right-button in aView"
-
- ^ (super in:aView) direction:#right
-
- "Modified: 22.1.1997 / 11:59:21 / cg"
-!
-
-upIn:aView
- "create and return a new up-button in aView"
-
- ^ (super in:aView) direction:#up
-
- "Modified: 22.1.1997 / 11:59:27 / cg"
-! !
-
-!ArrowButton class methodsFor:'defaults'!
-
-DownArrowForm
-
- ^DownArrowForm
-!
-
-LeftArrowForm
-
- ^LeftArrowForm
-!
-
-RightArrowForm
-
- ^RightArrowForm
-!
-
-UpArrowForm
-
- ^UpArrowForm
-!
-
-defaultDownArrowButtonForm
- "return the default form used for the scrollDown Button
- (if no styleSheet value is defined, and no form can be constructed)"
-
- <resource: #image>
-
- StyleSheet name == #win95 ifTrue:[
- ^ Form
- width:11 height:11
- fromArray:#[
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00111111 2r10000000
- 2r00011111 2r00000000
- 2r00001110 2r00000000
- 2r00000100 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- ]
- ].
-
- ^ 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]
-
- "
- self defaultDownArrowButtonForm
- "
-
- "Modified: / 26.3.1999 / 15:16:07 / cg"
-!
-
-defaultLeftArrowButtonForm
- "return the default form used for the scrollLeft Button
- (if no styleSheet value is defined, and no form can be constructed)"
-
- <resource: #image>
-
- StyleSheet name == #win95 ifTrue:[
- ^ Form
- width:11 height:11
- fromArray:#[
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000010 2r00000000
- 2r00000110 2r00000000
- 2r00001110 2r10000000
- 2r00011110 2r00000000
- 2r00001110 2r00000000
- 2r00000110 2r00000000
- 2r00000010 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- ]
- ].
-
- ^ 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]
-
- "
- self defaultLeftArrowButtonForm
- "
-
- "Modified: / 26.3.1999 / 15:17:38 / cg"
-!
-
-defaultRightArrowButtonForm
- "return the default form used for the scrollRight Button
- (if no styleSheet value is defined, and no form can be constructed)"
-
- <resource: #image>
-
- StyleSheet name == #win95 ifTrue:[
- ^ Form
- width:11 height:11
- fromArray:#[
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00001000 2r00000000
- 2r00001100 2r00000000
- 2r00001110 2r10000000
- 2r00001111 2r00000000
- 2r00001110 2r00000000
- 2r00001100 2r00000000
- 2r00001000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- ]
- ].
- ^ 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]
-
- "
- self defaultRightArrowButtonForm
- "
-
- "Modified: / 26.3.1999 / 15:18:29 / cg"
-!
-
-defaultUpArrowButtonForm
- "return the default form used for the scrollUp Button
- (if no styleSheet value is defined, and no form can be constructed)"
-
- <resource: #image>
-
- StyleSheet name == #win95 ifTrue:[
- ^ Form
- width:11 height:11
- fromArray:#[
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000100 2r00000000
- 2r00001110 2r00000000
- 2r00011111 2r00000000
- 2r00111111 2r10000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- ]
- ].
-
- ^ 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]
-
- "
- self defaultUpArrowButtonForm
- "
-
- "Modified: / 26.3.1999 / 15:19:11 / cg"
-!
-
-downArrowButtonForm:styleSymbol on:aDevice
- "return the form used for the scrollDown Button"
-
- <resource: #style (#'arrowButton.downForm')>
-
- |form|
-
- "
- use cached form, if device is appropriate
- "
- CachedStyle ~~ styleSymbol ifTrue:[
- DownArrowForm := nil
- ].
-
- ((form := DownArrowForm) notNil and:[form device == aDevice]) ifTrue:[
- ^ form
- ].
-
- form := DownArrowForm := StyleSheet at:#'arrowButton.downForm' default:nil.
- form notNil ifTrue:[^ form].
-
- "
- special treatment for st80 arrows
- - they do not really fit into the general (bitmap) scheme ...
- (i.e. they are computed instead of drawn from a bitmap)
- "
- styleSymbol ~~ #st80 ifTrue:[
- DownArrowFormFile notNil ifTrue:[
- form := Image fromFile:DownArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- form := Image fromFile:('bitmaps/' , DownArrowFormFile) resolution:100 on:aDevice.
- form isNil ifTrue:[
- 'ArrowButton [info]: no bitmapFile: ' infoPrint. DownArrowFormFile infoPrintCR.
- ]
- ]
- ]
- ].
-
- "
- 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:[
- styleSymbol == #st80 ifTrue:[
- form := Form width:9 height:9 depth:1 on:Display.
- form isNil ifTrue:[^ nil].
- 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.
- form beImmediateForm.
- ] ifFalse:[
- form := self defaultDownArrowButtonForm onDevice:aDevice.
- form isNil ifTrue:[^ nil].
- ].
- ].
-
- "
- remember form for next use
- "
- CachedStyle := styleSymbol.
- DownArrowForm := form.
-
- ^ form
-
- "Modified: / 26.10.1997 / 17:01:54 / cg"
-!
-
-leftArrowButtonForm:styleSymbol on:aDevice
- "return the form used for the scrollLeft Button"
-
- <resource: #style (#'arrowButton.leftForm')>
-
- |form|
-
- "
- use cached form, if device is appropriate
- "
- CachedStyle ~~ styleSymbol ifTrue:[
- LeftArrowForm := nil
- ].
-
- ((form := LeftArrowForm) notNil and:[form device == aDevice]) ifTrue:[
- ^ form
- ].
-
- form := LeftArrowForm := StyleSheet at:#'arrowButton.leftForm' default:nil.
- form notNil ifTrue:[^ form].
-
- "
- special treatment for st80 arrows
- - they do not really fit into the general (bitmap) scheme ...
- (i.e. they are computed instead of drawn from a bitmap)
- "
- styleSymbol ~~ #st80 ifTrue:[
- LeftArrowFormFile notNil ifTrue:[
- form := Image fromFile:LeftArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- form := Image fromFile:'bitmaps/' , LeftArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- 'ArrowButton [info]: no bitmapFile: ' infoPrint. LeftArrowFormFile infoPrintCR.
- ]
- ]
- ]
- ].
-
- "
- 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:[
- styleSymbol == #st80 ifTrue:[
- form := Form width:9 height:9 depth:1 on:Display.
- form isNil ifTrue:[^ nil].
- 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.
- form beImmediateForm.
- ] ifFalse:[
- form := self defaultLeftArrowButtonForm onDevice:aDevice.
- form isNil ifTrue:[^ nil].
- ].
- ].
-
- "
- remember form for next use
- "
- CachedStyle := styleSymbol.
- LeftArrowForm := form.
-
- ^ form
-
- "Modified: / 26.10.1997 / 17:01:47 / cg"
-!
-
-rightArrowButtonForm:styleSymbol on:aDevice
- "return the form used for the scrollRight Button"
-
- <resource: #style (#'arrowButton.rightForm')>
-
- |form|
-
- "
- use cached form, if device is appropriate
- "
- CachedStyle ~~ styleSymbol ifTrue:[
- RightArrowForm := nil
- ].
-
- ((form := RightArrowForm) notNil and:[form device == aDevice]) ifTrue:[
- ^ form
- ].
-
- form := RightArrowForm := StyleSheet at:#'arrowButton.rightForm' default:nil.
- form notNil ifTrue:[^ form].
-
- "
- special treatment for st80 arrows
- - they do not really fit into the general (bitmap) scheme ...
- (i.e. they are computed instead of drawn from a bitmap)
- "
- styleSymbol ~~ #st80 ifTrue:[
- RightArrowFormFile notNil ifTrue:[
- form := Image fromFile:RightArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- form := Image fromFile:'bitmaps/' , RightArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- 'ArrowButton [info]: no bitmapFile: ' infoPrint. RightArrowFormFile infoPrintCR.
- ]
- ]
- ]
- ].
-
- "
- 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:[
- styleSymbol == #st80 ifTrue:[
- form := Form width:9 height:9 depth:1 on:Display.
- form isNil ifTrue:[^ nil].
- 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.
- form beImmediateForm.
- ] ifFalse:[
- form := self defaultRightArrowButtonForm onDevice:aDevice.
- form isNil ifTrue:[^ nil].
- ].
- ].
-
- "
- remember form for next use
- "
- CachedStyle := styleSymbol.
- RightArrowForm := form.
-
- ^ form
-
- "Modified: / 26.10.1997 / 17:01:40 / cg"
-!
-
-upArrowButtonForm:styleSymbol on:aDevice
- "return the form used for the scrollUp Button"
-
- <resource: #style (#'arrowButton.upForm')>
-
- |form|
-
- "
- use cached form, if device is appropriate
- "
- CachedStyle ~~ styleSymbol ifTrue:[
- UpArrowForm := nil
- ].
-
- ((form := UpArrowForm) notNil and:[form device == aDevice]) ifTrue:[
- ^ form
- ].
-
- form := UpArrowForm := StyleSheet at:#'arrowButton.upForm' default:nil.
- form notNil ifTrue:[^ form].
-
- "
- special treatment for st80 arrows
- - they do not really fit into the general (bitmap) scheme ...
- (i.e. they are computed instead of drawn from a bitmap)
- "
- styleSymbol ~~ #st80 ifTrue:[
- UpArrowFormFile notNil ifTrue:[
- form := Image fromFile:UpArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- form := Image fromFile:'bitmaps/' , UpArrowFormFile resolution:100 on:aDevice.
- form isNil ifTrue:[
- 'ArrowButton [info]: no bitmapFile: ' infoPrint. UpArrowFormFile infoPrintCR.
- ]
- ]
- ]
- ].
-
- "
- 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:[
- styleSymbol == #st80 ifTrue:[
- form := Form width:9 height:9 depth:1 on:aDevice.
- form isNil ifTrue:[^ nil].
- 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.
- form beImmediateForm.
- ] ifFalse:[
- form := self defaultUpArrowButtonForm onDevice:aDevice.
- form isNil ifTrue:[^ nil].
- ].
- ].
-
- "
- remember form for next use
- "
- CachedStyle := styleSymbol.
- UpArrowForm := form.
-
- ^ form
-
- "Modified: / 26.10.1997 / 17:01:32 / cg"
-!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'arrowButton.style'
- #'arrowButton.activeLevel' #'arrowButton.passiveLevel'
- #'arrowButton.backgroundColor' #'arrowButton.foregroundColor'
- #'arrowButton.activeBackgroundColor' #'arrowButton.activeForegroundColor'
- #'arrowButton.enteredBackgroundColor' #'arrowButton.enteredForegroundColor'
- #'arrowButton.disabledForegroundColor'
- #'arrowButton.downForm' #'arrowButton.upForm'
- #'arrowButton.leftForm' #'arrowButton.rightForm'
- #'arrowButton.downFormFile' #'arrowButton.upFormFile'
- #'arrowButton.leftFormFile' #'arrowButton.rightFormFile')>
-
- |styleSheet|
-
- styleSheet := StyleSheet.
-
- DefaultArrowStyle := styleSheet at:#'arrowButton.style' default:styleSheet name.
- DefaultArrowStyle := DefaultArrowStyle asSymbol.
-
- DefaultArrowButtonActiveLevel := styleSheet at:#'arrowButton.activeLevel' default:nil.
- DefaultArrowButtonPassiveLevel := styleSheet at:#'arrowButton.passiveLevel' default:nil.
-
- DefaultBackgroundColor := styleSheet colorAt:#'arrowButton.backgroundColor'.
- DefaultForegroundColor := styleSheet colorAt:#'arrowButton.foregroundColor'.
- DefaultActiveBackgroundColor := styleSheet colorAt:#'arrowButton.activeBackgroundColor'.
- DefaultActiveForegroundColor := styleSheet colorAt:#'arrowButton.activeForegroundColor'.
- DefaultEnteredBackgroundColor := styleSheet colorAt:#'arrowButton.enteredBackgroundColor'.
- DefaultEnteredForegroundColor := styleSheet colorAt:#'arrowButton.enteredForegroundColor'.
- DefaultDisabledForegroundColor := styleSheet colorAt:#'arrowButton.disabledForegroundColor'.
-
- DownArrowForm := styleSheet at:#'arrowButton.downForm' default:nil.
- UpArrowForm := styleSheet at:#'arrowButton.upForm' default:nil.
- LeftArrowForm := styleSheet at:#'arrowButton.leftForm' default:nil.
- RightArrowForm := styleSheet at:#'arrowButton.rightForm' default:nil.
-
- UpArrowFormFile := DownArrowFormFile := LeftArrowFormFile := RightArrowFormFile := nil.
- UpArrowForm isNil ifTrue:[
- UpArrowFormFile := styleSheet at:#'arrowButton.upFormFile' default:'ScrollUp.xbm'.
- ].
- DownArrowForm isNil ifTrue:[
- DownArrowFormFile := styleSheet at:#'arrowButton.downFormFile' default:'ScrollDn.xbm'.
- ].
- LeftArrowForm isNil ifTrue:[
- LeftArrowFormFile := styleSheet at:#'arrowButton.leftFormFile' default:'ScrollLt.xbm'.
- ].
- RightArrowForm isNil ifTrue:[
- RightArrowFormFile := styleSheet at:#'arrowButton.rightFormFile' default:'ScrollRt.xbm'.
- ].
-
- "
- self updateStyleCache
- "
-
- "Modified: 31.8.1995 / 03:01:14 / claus"
- "Modified: 20.10.1997 / 13:50:57 / cg"
-! !
-
-!ArrowButton methodsFor:'accessing'!
-
-direction
- "return the buttons direction - a symbol"
-
- ^ direction
-!
-
-direction:aDirectionSymbol
- "create and return a new arrow button in aView"
-
- |form|
-
- aDirectionSymbol == #up ifTrue:[
- form := (self class upArrowButtonForm:arrowStyle on:device).
- ].
- aDirectionSymbol == #down ifTrue:[
- form := (self class downArrowButtonForm:arrowStyle on:device).
- ].
- aDirectionSymbol == #left ifTrue:[
- form := (self class leftArrowButtonForm:arrowStyle on:device).
- ].
- aDirectionSymbol == #right ifTrue:[
- form := (self class rightArrowButtonForm:arrowStyle on:device).
- ].
- direction := aDirectionSymbol.
- self form:form
-
- "Modified: 24.2.1997 / 21:19:59 / cg"
-! !
-
-!ArrowButton methodsFor:'accessing-look'!
-
-allViewBackground:something
- super viewBackground:something.
- bgColor := activeBgColor := enteredBgColor := something
-! !
-
-!ArrowButton methodsFor:'focus handling'!
-
-wantsFocusWithButtonPress
- "no, do not catch the keyboard focus on button click"
-
- ^ false
-
-
-
-
-! !
-
-!ArrowButton methodsFor:'initialization'!
-
-initStyle
- "setup viewStyle specifics"
-
- super initStyle.
-
- DefaultBackgroundColor notNil ifTrue:[
- bgColor := DefaultBackgroundColor onDevice:device
- ].
- DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor onDevice:device
- ].
- DefaultActiveForegroundColor notNil ifTrue:[
- activeFgColor := DefaultActiveForegroundColor onDevice:device
- ].
- DefaultActiveBackgroundColor notNil ifTrue:[
- activeBgColor := DefaultActiveBackgroundColor onDevice:device
- ].
- DefaultEnteredForegroundColor notNil ifTrue:[
- enteredFgColor := DefaultEnteredForegroundColor onDevice:device
- ].
- DefaultEnteredBackgroundColor notNil ifTrue:[
- enteredBgColor := DefaultEnteredBackgroundColor onDevice:device
- ].
- DefaultDisabledForegroundColor notNil ifTrue:[
- disabledFgColor := DefaultDisabledForegroundColor onDevice:device
- ].
-
- arrowStyle := DefaultArrowStyle.
-
- DefaultArrowButtonActiveLevel notNil ifTrue:[onLevel := DefaultArrowButtonActiveLevel].
- DefaultArrowButtonPassiveLevel notNil ifTrue:[offLevel := DefaultArrowButtonPassiveLevel].
- offLevel ~~ level ifTrue:[self level:offLevel].
-
-"/ "
-"/ special treatment for motif arrows
-"/ - they do not really fit into the general (bitmap) scheme ...
-"/ "
-"/ arrowStyle == #motif ifTrue:[
-"/ onLevel := 0.
-"/ offLevel := 0.
-"/ self level:0.
-"/ ]
-
- "Modified: 22.1.1997 / 11:57:00 / cg"
-!
-
-initialize
-
- super initialize.
- hSpace := vSpace := 0.
- controller beTriggerOnDown.
-
- "Modified: 6.3.1997 / 20:58:49 / cg"
-! !
-
-!ArrowButton methodsFor:'redrawing'!
-
-drawWith:fg and:bg
- "this is a q&d hack for motif ..."
-
- |topLeft botRight isString orgX orgY r colors|
-
- arrowStyle ~~ #motif ifTrue:[
- ^ super drawWith:fg and:bg.
- ].
-
- "
- the code below does a lot of bitmap drawing, but allows
- to 3D-ify any logo (it draws it displaced by some pixels
- to the upper left in one-color and displaced to the
- lower right in the other color). It should be rewritten to
- cache the result for later drawing operations.
- "
- logo notNil ifTrue:[
- self paint:bg.
- self fillRectangleX:0 y:0 width:width height:height.
-
- shadowColor := shadowColor onDevice:device.
- lightColor := lightColor onDevice:device.
-
- controller pressed ifTrue:[
- topLeft := shadowColor.
- botRight := lightColor
- ] ifFalse:[
- topLeft := lightColor.
- botRight := shadowColor
- ].
-
- isString := logo isString.
-
- isString ifFalse:[
- logo depth ~~ 1 ifTrue:[
- "/ allow for deep logos (for motif)
- "/ one catch: if the view background is a complex pixmap
- "/ we cannot use this as colorMap entry.
- "/ therefore, compute the average colors and take these
- "/ (this looks ok for buttons ...)
-
- r := (0@0 corner:10@10).
-
- colors := (Array with:(bg averageColorIn:r)
- with:(topLeft averageColorIn:r)
- with:(botRight averageColorIn:r)
- with:(fg averageColorIn:r)).
- colors ~= logo colorMap ifTrue:[
- logo release.
- logo colorMap:colors.
- ].
- logo photometric:#palette.
- logo := logo on:device.
-
- self displayForm:logo x:labelOriginX y:labelOriginY.
- ^ self
- ].
- logo := logo onDevice:device.
- orgX := labelOriginX.
- orgY := labelOriginY.
- ] ifTrue:[
- orgY := height - font height // 2 + font ascent.
- orgX := width - labelOriginX // 4 - 1.
- ].
-
- self paint:topLeft.
- #(-1 0 -1) with:#(-1 -1 0) do:[:dX :dY |
- |x y|
-
- x := orgX + dX.
- y := orgY + dY.
-
- isString ifTrue:[
- self displayString:logo x:x y:y.
- ] ifFalse:[
- self displayForm:logo x:x y:y.
- ]
- ].
-
- self paint:botRight.
- #(1 1 0) with:#(0 1 1) do:[:dX :dY |
- |x y|
-
- x := orgX + dX.
- y := orgY + dY.
-
- isString ifTrue:[
- self displayString:logo x:x y:y.
- ] ifFalse:[
- self displayForm:logo x:x y:y.
- ]
- ].
-
- "
- finally, the form itself
- "
- self paint:fg.
- isString ifTrue:[
- self displayString:logo x:orgX y:orgY.
- ] ifFalse:[
- self displayForm:logo x:orgX y:orgY.
- ]
- ]
-
- "Modified: 31.8.1995 / 03:03:12 / claus"
- "Modified: 19.3.1997 / 17:11:22 / cg"
-! !
-
-!ArrowButton class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.55 1999-08-18 15:14:19 cg Exp $'
-! !
--- a/EFGroup.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,817 +0,0 @@
-"
- 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.
-"
-
-Object subclass:#EnterFieldGroup
- instanceVariableNames:'fields currentField leaveAction wrap leaveOnTabLast'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support'
-!
-
-!EnterFieldGroup 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.
-"
-!
-
-documentation
-"
- EnterFieldGroup controls the interaction between EnterFields
- enabling the 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) and forwards input
- to that one.
- This is done by arranging for all of my fields to delegate their
- input to me, which is then forwarded to the active field).
-
- 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 accept on the fields (if they did not already)
- and/or performs some followup processing and possibly closes the topview
- (for example: in a dialog).
-
- EnterFieldGroups can be used as a delegate (of the topView) to forward
- input (entered into the topView) to the currently active field.
-
- Stepping to previous field is via CursorUp/PreviousField,
- to next field via CursorDown/NextField/Tab.
- By default, tabbing via #Tab is disabled - to enable it, send the field
- a #makeTabable or #makeAllTabable to the group.
-
- All of this here is low level stuff, providing a lot of freedom in
- which keys are handled and how they perform.
- Normally, these are not required for most users - the DialogBox sets up
- things correctly for most cases.
-
-
- [Instance variables:]
-
- fields <Collection of EditField> the fields of the group
-
- currentField <EditField> the active field
-
- leaveAction <nil|Block> action to perform, when the
- last field is left by a non-wrap
-
- wrap <Boolean> if true, non-return next-keys wrap
- back to the first field.
- If false (the default), next in
- the last field is taken as return.
- This is ignored, if no leaveAction was
- defined.
-
- leaveOnTabLast <Boolean> if true, tabbing out of the last
- field leaves the group.
- The default is false.
-
- [author:]
- Claus Gittinger
-
-
- [see also:]
- DialogBox
- EditField
-"
-!
-
-examples
-"
- without a group - user has to enter mouse into the next field to activate it;
- Cursor-keys dont work:
- [exBegin]
- |top panel field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- top open
- [exEnd]
-
-
- with a group - Return-key or CursorKey enables next field:
- (but still, mouse pointer has to be moved into any of the fields,
- because the topView does not forward its input into the fields.
- Also, tabbing is not possible here)
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
-
- top open
- [exEnd]
-
-
-
- same, enables tabbing within the group via the Tab key
- (but still, the mouse pointer must be in one of the fields):
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
-
- field1 makeTabable.
- field2 makeTabable.
- field3 makeTabable.
- top open
- [exEnd]
- individual makeTabable messages to the fields allows single
- fields to be sticky (i.e. explicit click is needed to get out
- of it) - this is very seldom required.
- To make all fields tabable (the usual case), there is a shortCut:
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
- group makeAllTabable.
-
- top open
- [exEnd]
-
-
-
- use a delagation from the outerView to the group -
- Return-key or CursorKey enables next field:
- input for topView is delegated to the group, which also behaves
- as a unit w.r.t. keyboard focus (move pointer in and out).
- Again, without tabbing:
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
-
- top delegate:group.
- top open
- [exEnd]
-
-
- and, with tabbing:
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
- group makeAllTabable.
-
- top delegate:group.
- top open
- [exEnd]
-
-
-
- as above, but close the box when the last field is left
- via return - notice, that tabbing still wraps around:
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
- group leaveAction:[top destroy].
- group makeAllTabable.
-
- top delegate:group.
- top open
- [exEnd]
-
- in the next example, tabbing out of the last field
- closes the box as well:
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
- group leaveAction:[top destroy].
- group makeAllTabable.
- group leaveOnTabLast:true.
-
- top delegate:group.
- top open
- [exEnd]
-
-
- the next example shows that the input order is defined by the
- order in the group; NOT by the physical layout of the fields in the superview:
- (i.e. you can arrange your fields in multiple framedBoxes, panels or
- subviews - independent of the tab-stepping order)
- [exBegin]
- |top panel group field1 field2 field3|
-
- top := StandardSystemView label:'reverse'.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field3; add:field2; add:field1.
- group leaveAction:[top destroy].
- group makeAllTabable.
-
- top delegate:group.
- top open
- [exEnd]
-
-
-
- using a single model for all fields:
- (here, we use a Plug to simulate a more complex model):
- [exBegin]
- |top panel group field1 field2 field3 model
- value1 value2 value3|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- panel add:(field1 := EditField extent:(1.0 @ nil)).
- panel add:(field2 := EditField extent:(1.0 @ nil)).
- panel add:(field3 := EditField extent:(1.0 @ nil)).
-
- group := EnterFieldGroup new.
- group add:field1; add:field2; add:field3.
- group leaveAction:[top destroy].
- group makeAllTabable.
-
- value1 := 'one'. value2 := 'two'. value3 := 'three'.
-
- model := Plug new.
- model respondTo:#value1 with:[value1].
- model respondTo:#value1: with:[:arg | value1 := arg].
- model respondTo:#value2 with:[value2].
- model respondTo:#value2: with:[:arg | value2 := arg].
- model respondTo:#value3 with:[value3].
- model respondTo:#value3: with:[:arg | value3 := arg].
-
- field1 model:model; aspect:#value1; change:#value1:.
- field2 model:model; aspect:#value2; change:#value2:.
- field3 model:model; aspect:#value3; change:#value3:.
-
- top delegate:group.
- top openModal.
-
- Transcript showCR:'value1: ' , value1.
- Transcript showCR:'value2: ' , value2.
- Transcript showCR:'value3: ' , value3.
- [exEnd]
-
-
- all of the above is done automatically for you,
- if you add inputFields to a dialogBox.
- Here, all fields use the same model, but different aspects:
- [exBegin]
- |box model
- value1 value2 value3|
-
- box := DialogBox new.
- box extent:200@200.
-
- value1 := 'one'. value2 := 'two'. value3 := 'three'.
-
- model := Plug new.
- model respondTo:#value1 with:[value1].
- model respondTo:#value1: with:[:arg | value1 := arg].
- model respondTo:#value2 with:[value2].
- model respondTo:#value2: with:[:arg | value2 := arg].
- model respondTo:#value3 with:[value3].
- model respondTo:#value3: with:[:arg | value3 := arg].
-
- (box addInputFieldOn:model) aspect:#value1; change:#value1:.
- box addVerticalSpace.
- (box addInputFieldOn:model) aspect:#value2; change:#value2:.
- box addVerticalSpace.
- (box addInputFieldOn:model) aspect:#value3; change:#value3:.
-
- box addOkButton.
-
- box open.
-
- Transcript showCR:'value1: ' , value1.
- Transcript showCR:'value2: ' , value2.
- Transcript showCR:'value3: ' , value3.
- [exEnd]
-
- Here, the fields use different models, but the same aspect:
- [exBegin]
- |box model
- valueHolder1 valueHolder2 valueHolder3|
-
- box := DialogBox new.
- box extent:200@200.
-
- valueHolder1 := 'one' asValue.
- valueHolder2 := 'two' asValue.
- valueHolder3 := 'three' asValue.
-
- box addInputFieldOn:valueHolder1.
- box addVerticalSpace.
- box addInputFieldOn:valueHolder2.
- box addVerticalSpace.
- box addInputFieldOn:valueHolder3.
-
- box addOkButton.
-
- box open.
-
- Transcript showCR:'value1: ' , valueHolder1 value.
- Transcript showCR:'value2: ' , valueHolder2 value.
- Transcript showCR:'value3: ' , valueHolder3 value.
- [exEnd]
-"
-
- "Created: 27.4.1996 / 16:43:28 / cg"
-! !
-
-!EnterFieldGroup methodsFor:'accessing'!
-
-fields
- "return a collection of the inputFields contained in the group."
-
- ^ fields
-!
-
-leaveAction:aBlock
- "set the action to perform when the last field is left.
- Usually, this is to accept the values of all fields and perform
- some additional processing (such as closing a dialog)."
-
- leaveAction := aBlock
-!
-
-leaveOnTabLast:aBoolean
- "specifies if leaving the last field via Tab
- should leave the group or stay in the group.
- (if staying, either wrap or not, depending on the setting of wrap)
- The default is to stay in the group"
-
- leaveOnTabLast := aBoolean
-
- "Created: 27.4.1996 / 17:22:30 / cg"
- "Modified: 27.4.1996 / 17:22:44 / cg"
-!
-
-makeAllTabable
- "make all fields tabable"
-
- fields do:[:field |
- field makeTabable
- ]
-
- "Created: 27.4.1996 / 17:11:41 / cg"
-!
-
-wrap:aBoolean
- "specifies if leaving the last field via non-Return
- (i.e. Tab or Cursor-Down) should wrap back to the first,
- or leave the group.
- The default is to not leave the group and wrap back to the first field."
-
- wrap := aBoolean
-
- "Modified: 27.4.1996 / 17:19:50 / cg"
-! !
-
-!EnterFieldGroup methodsFor:'adding / removing'!
-
-add:aField
- "add another field to the group.
- Cursor motion out of the previous field will lead to the next
- one and vice versa."
-
- self add:aField before:nil
-
- "Modified: 18.10.1997 / 03:19:51 / cg"
-!
-
-add:aField before:anotherField
- "add another field to the group into a particular position
- within the tabbing order.
- Cursor motion out of the previous field will lead to the next
- one and vice versa."
-
- fields isNil ifTrue:[
- fields := OrderedCollection new
- ].
-
- anotherField isNil ifTrue:[
- fields add:aField.
- ] ifFalse:[
- fields add:aField before:anotherField
- ].
-
- aField delegate:self.
- aField hideCursor.
-"/ aField disable.
-
- "set the fields enableAction to disable active field"
-
- aField clickAction:[:field |
- self makeActive:field
- ].
-
- "set the fields leaveAction to enable next field"
-
- aField leaveAction:[:field :key |
- self fieldLeft:field withKey:key
- ].
-
- fields size == 1 ifTrue:[
- "the first one"
- self makeActive:aField
- ]
-
- "Created: 18.10.1997 / 03:06:00 / cg"
- "Modified: 18.10.1997 / 03:20:36 / cg"
-!
-
-remove:aField
- "remove a field from the group."
-
- fields isNil ifTrue:[^ self].
- (fields includesIdentical:aField) ifFalse:[^ self].
-
- fields removeIdentical:aField.
-
- "Created: 18.10.1997 / 02:53:29 / cg"
- "Modified: 18.10.1997 / 03:21:09 / cg"
-! !
-
-!EnterFieldGroup methodsFor:'event forwarding'!
-
-buttonPress:button x:x y:y view:aView
- "clicking on a field activates it and forwards the click to it"
-
- self makeActive:aView.
- aView buttonPress:button x:x y:y
-!
-
-handlesButtonPress:button inView:aView
- "query from event processor: am I interested in button-events ?
- yes I am (to activate the clicked-on field)."
-
- ^ true
-!
-
-handlesKeyPress:key inView:aView
- "query from event processor: am I interested in key-events ?
- yes I am (to forward it to the active field)."
-
- ^ true
-!
-
-handlesKeyRelease:key inView:aView
- "query from event processor: am I interested in key-events ?
- yes I am (to forward it to the active field)."
-
- ^ true
-!
-
-keyPress:key x:x y:y view:aView
- "key-press in any field - forward the key to the active field
- (with nil coordinates to indicate that the key was pressed
- outside. However, this info is not used by any view currently)"
-
- currentField notNil ifTrue:[
- currentField keyPress:key x:nil y:nil
- ]
-
- "Modified: / 18.9.1998 / 20:00:36 / cg"
-!
-
-keyRelease:key x:x y:y view:aView
- "key-release in any field - forward the key to the active field.
- (with -1/-1 as coordinate to indicate that the key was pressed
- outside. However, this info is not used by any view currently)"
-
- currentField notNil ifTrue:[
- currentField keyRelease:key x:-1 y:-1
- ]
-!
-
-showFocus:onOrOff
- "forward focus display to the active field "
-
- currentField notNil ifTrue:[
- currentField showFocus:onOrOff
- ]
-
- "Modified: 4.3.1996 / 22:18:22 / cg"
- "Created: 27.4.1996 / 16:41:38 / cg"
-!
-
-showNoFocus:onOrOff
- "forward nofocus display to the active field "
-
- currentField notNil ifTrue:[
- currentField showNoFocus:onOrOff
- ]
-
- "Modified: 4.3.1996 / 22:18:22 / cg"
- "Created: 27.4.1996 / 16:42:07 / cg"
-! !
-
-!EnterFieldGroup methodsFor:'group control'!
-
-fieldLeft:aField withKey:key
- "some of my fields was left using key.
- Figure out, which one to give the focus:
- If there are more fields, go to that one;
- otherwise, handle this like tabbing to the next component"
-
- |thisIndex action next wg explicit nFields nextField fs
- delta|
-
- action := key.
- nFields := fields size.
- thisIndex := fields indexOf:aField.
-
- "/ if there is a windowGroup, which has a focusSequence,
- "/ and the group is left, let it control who is going to get the
- "/ focus. Otherwise, stay within the group.
- "/ Q: is this a good idea (or should we always stay here) ?
-
- ((wg := aField windowGroup) notNil
- and:[(fs := wg focusSequence) notNil
- and:[fs includesIdentical:aField]]) ifTrue:[
- ((key == #CursorUp) or:[key == #PreviousField]) ifTrue:[
- (thisIndex == 1) ifTrue:[
- ^ wg focusPreviousFrom:aField
- ].
- ].
- ((key == #CursorDown)
- or:[key == #NextField
- or:[key == #Tab]]) ifTrue:[
- (thisIndex == nFields) ifTrue:[
- ^ wg focusNextFrom:aField
- ].
- ].
- ].
-
- ((key == #CursorUp) or:[key == #PreviousField]) ifTrue:[
- delta := -1.
- (thisIndex == 1) ifTrue:[
- next := nFields
- ] ifFalse:[
- next := thisIndex - 1
- ]
- ].
-
- ((key == #CursorDown)
- or:[key == #NextField
- or:[key == #Tab]]) ifTrue:[
- delta := 1.
- (thisIndex == nFields) ifTrue:[
- next := 1.
- wrap == false ifTrue:[
- action := #Return.
- ].
- ] ifFalse:[
- next := thisIndex + 1
- ]
- ].
- ((action == #Return)
- or:[key == #Tab and:[leaveOnTabLast == true]]) ifTrue:[
- delta := 1.
- (thisIndex == nFields) ifTrue:[
- leaveAction notNil ifTrue:[
- self makeInactive:aField.
- currentField := nil.
- leaveAction value.
- next := nil
- ] ifFalse:[
- next := 1
- ]
- ] ifFalse:[
- next := thisIndex + 1
- ]
- ].
-
- next notNil ifTrue:[
- "/ search for the next enabled field
-
- nextField := fields at:next.
- [nextField notNil
- and:[nextField enabled not
- or:[nextField realized not]]] whileTrue:[
- next := next + delta.
- next < 1 ifTrue:[
- next := fields size.
- ] ifFalse:[
- next > fields size ifTrue:[
- next := 1
- ]
- ].
- next == thisIndex ifTrue:[
- nextField := next := nil
- ] ifFalse:[
- nextField := fields at:next.
- ]
- ].
-
- next isNil ifTrue:[
- delta < 0 ifTrue:[
- ^ wg focusPreviousFrom:aField
- ].
- ^ wg focusNextFrom:aField.
- ].
-
- nextField := fields at:next.
- explicit := false.
- (wg := currentField windowGroup) notNil ifTrue:[
- wg focusView == currentField ifTrue:[
- explicit := true.
- ]
- ].
- explicit ifTrue:[
- wg focusView:nextField byTab:(wg focusCameByTab).
- ] ifFalse:[
- self makeActive:nextField
- ]
- ]
-
- "Created: / 18.10.1997 / 03:03:34 / cg"
- "Modified: / 18.9.1998 / 20:16:48 / cg"
-! !
-
-!EnterFieldGroup methodsFor:'misc'!
-
-activateFirst
- "pass controll to my first field"
-
- fields notNil ifTrue:[
- self makeActive:fields first
- ]
-
- "Modified: 7.2.1996 / 15:23:09 / cg"
-!
-
-activateFirstIfNoCurrent
- "pass controll to my first field, if there is no current field"
-
- currentField isNil ifTrue:[
- self activateFirst
- ] ifFalse:[
- currentField requestFocus
- ]
-
- "Created: / 13.8.1998 / 21:22:35 / cg"
- "Modified: / 15.3.1999 / 08:22:18 / cg"
-!
-
-activateLast
- "pass controll to my last field"
-
- fields notNil ifTrue:[
- self makeActive:fields last
- ]
-
- "Modified: 7.2.1996 / 15:23:09 / cg"
- "Created: 22.5.1996 / 19:04:05 / cg"
-!
-
-delegatesTo:aView
- ^ aView == currentField
-
- "Created: / 18.9.1998 / 19:57:49 / cg"
- "Modified: / 18.9.1998 / 19:58:23 / cg"
-!
-
-makeInactive
- "make the current field inActive (take its focus)"
-
- self makeInactive:currentField
-
- "Created: 22.5.1996 / 18:58:56 / cg"
- "Modified: 22.5.1996 / 19:03:44 / cg"
-! !
-
-!EnterFieldGroup methodsFor:'private'!
-
-makeActive:aField
- "make a specific field the active one"
-
- currentField == aField ifTrue:[^ self].
-
- currentField notNil ifTrue:[
- currentField hideCursor.
- currentField hasKeyboardFocus:false.
- ].
- currentField := aField.
- currentField showCursor.
- currentField hasKeyboardFocus:true.
-
- "Modified: 21.5.1996 / 21:21:07 / cg"
-!
-
-makeInactive:aField
- "make a specific field inActive"
-
- currentField == aField ifTrue:[currentField := nil].
-
- aField notNil ifTrue:[
- aField hideCursor.
- aField hasKeyboardFocus:false.
- ].
-
- "Created: 21.5.1996 / 21:20:57 / cg"
-! !
-
-!EnterFieldGroup class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.37 1999-03-16 14:13:29 cg Exp $'
-! !
--- a/ETxtView.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,4670 +0,0 @@
-"
- 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.
-"
-
-TextView subclass:#EditTextView
- instanceVariableNames:'cursorLine cursorVisibleLine cursorCol cursorShown
- prevCursorState readOnly modifiedChannel fixedSize exceptionBlock
- cursorFgColor cursorBgColor cursorNoFocusFgColor cursorType
- cursorTypeNoFocus undoAction typeOfSelection lastString
- lastReplacement lastAction replacing showMatchingParenthesis
- hasKeyboardFocus acceptAction lockUpdates tabMeansNextField
- autoIndent insertMode trimBlankLines wordWrap
- replacementWordSelectStyle acceptChannel acceptEnabled st80Mode'
- classVariableNames:'DefaultCursorForegroundColor DefaultCursorBackgroundColor
- DefaultCursorType DefaultCursorNoFocusForegroundColor ST80Mode
- DefaultCursorTypeNoFocus'
- poolDictionaries:''
- category:'Views-Text'
-!
-
-!EditTextView 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.
-"
-!
-
-documentation
-"
- a view for editable text - adds editing functionality to TextView
- Also, it adds accept functionality, and defines a new actionBlock:
- acceptAction to be performed for accept
-
- If used with a model, this is informed by sending it a changeMsg with
- the current contents as argument.
- (however, it is possible to define both changeMsg and acceptAction)
-
- Please read the historic notice in the ListView class.
-
- [Instance variables:]
-
- cursorLine <Number> line where cursor sits (1..)
-
- cursorVisibleLine <Number> visible line where cursor sits (1..nLinesShown)
-
- cursorCol <Number> col where cursor sits (1..)
-
- cursorShown <Boolean> true, if cursor is currently shown
-
- readOnly <Boolean> true, if text may not be edited
-
- modifiedChannel <ValueHolder> holding true, if text has been modified.
- cleared on accept.
-
- acceptChannel <ValueHolder> holding true, if text has been accepted.
-
- fixedSize <Boolean> true, if no lines may be added/removed
-
- exceptionBlock <Block> block to be evaluated when readonly text is about to be modified
- if it returns true, the modification will be done anyway.
- if it returns anything else, the modification is not done.
-
- cursorFgColor <Color> color used for cursor drawing
- cursorBgColor <Color> color used for cursor drawing
-
- cursorType <Symbol> how the cursor is drawn; currently implemented
- are #block (solid-block cursor), #ibeam
- (vertical bar at insertion point)
- and #caret (caret below insertion-point)
-
- cursorTypeNoFocus <Symbol> like above, if view has no focus
- nil means: hide the cursor.
-
- undoAction <Block> block which undoes last cut, paste or replace
- (not yet fully implemented)
-
- typeOfSelection <Symbol> #paste, if selection created by paste, nil otherwise
- this affects the next keyPress: if #paste it does not
- replace; otherwise it replaces the selection.
-
- lastCut <String> last cut or replaced string
-
- lastReplacement <String> last replacement
-
- replacing <Boolean> true if entered characters replace last selection
-
- showMatchingParenthesis <Boolean> if true, shows matching parenthesis
- when entering one; this is the default.
-
- hasKeyboardFocus <Boolean> true if this view has the focus
-
- acceptAction <Block> accept action - evaluated passing the contents as
- argument
-
- tabMeansNextField <Boolean> if true, Tab is ignored as input and shifts keyboard
- focus to the next field. For editTextViews, this is false
- by default (i.e. tabs can be entered into the text).
- For some subclasses (inputFields), this may be true.
-
- trimBlankLines <Boolean> if true, trailing blanks are
- removed when editing.
- Default is true.
-
- wordWrap <Boolean> Currently not used.
-
- lockUpdates <Boolean> internal, private
-
- prevCursorState <Boolean> temporary, private
-
-
- class variables:
- ST80Mode <Boolean> if true, cursor positioning is
- done as in vi or ST80; i.e.
- wysiwyg mode is somewhat relaxed,
- in that the cursor cannot be
- positioned behind a lines end.
- This is not yet completely implemented.
- used globals:
-
- DeleteHistory <Text> last 1000 lines of deleted text
- (but only if this variable exists already)
-
- [styleSheet parameters:]
-
- textCursorForegroundColor <Color> cursor fg color; default: text background
- textCursorBackgroundColor <Color> cursor bg color; default: text foreground
- textCursorNoFocusForegroundColor
- <Color> cursor fg color if no focus; default: cursor fg color
- textCursorType <Symbol> cursor type; default: #block
-
- [author:]
- Claus Gittinger
-
- [see also:]
- CodeView Workspace TextView ListView
- EditField
-"
-!
-
-examples
-"
- non MVC operation:
-
- basic setup:
- [exBegin]
- |top textView|
-
- top := StandardSystemView new.
- top extent:300@200.
-
- textView := EditTextView new.
- textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top addSubView:textView.
-
- textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
-
- top open.
- [exEnd]
-
-
- with vertical scrollbar:
- [exBegin]
- |top scrollView textView|
-
- top := StandardSystemView new.
- top extent:300@200.
-
- scrollView := ScrollableView for:EditTextView.
- textView := scrollView scrolledView.
- scrollView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top addSubView:scrollView.
-
- textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
-
- top open.
- [exEnd]
-
-
- with horizontal & vertical scrollbars:
- [exBegin]
- |top scrollView textView|
-
- top := StandardSystemView new.
- top extent:300@200.
-
- scrollView := HVScrollableView for:EditTextView.
- textView := scrollView scrolledView.
- scrollView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top addSubView:scrollView.
-
- textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
-
- top open.
- [exEnd]
-
-
- set the action for accept:
- [exBegin]
- |top textView|
-
- top := StandardSystemView new.
- top extent:300@200.
-
- textView := EditTextView new.
- textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top addSubView:textView.
-
- textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
- textView acceptAction:[:contents |
- Transcript showCR:'will not overwrite the file with:'.
- Transcript showCR:contents asString
- ].
- top open.
- [exEnd]
-
-
-
- non-string (text) items:
- [exBegin]
- |top textView list|
-
- list := '/etc/hosts' asFilename contentsOfEntireFile asStringCollection.
- 1 to:list size by:2 do:[:nr |
- list at:nr put:(Text string:(list at:nr)
- emphasis:(Array with:#bold with:(#color->Color red)))
- ].
-
- top := StandardSystemView new.
- top extent:300@200.
-
- textView := EditTextView new.
- textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top addSubView:textView.
-
- textView contents:list.
- top open.
- [exEnd]
-
-
-
- MVC operation:
- (the examples model here is a plug simulating a real model;
- real world applications would not use a plug ..)
- [exBegin]
- |top textView model|
-
- model := Plug new.
- model respondTo:#accepted:
- with:[:newContents |
- Transcript showCR:'will not overwrite the file with:'.
- Transcript showCR:newContents asString
- ].
- model respondTo:#getList
- with:['/etc/hosts' asFilename contentsOfEntireFile].
-
-
- top := StandardSystemView new.
- top extent:300@200.
-
- textView := EditTextView new.
- textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top addSubView:textView.
-
- textView listMessage:#getList;
- model:model;
- changeMessage:#accepted:;
- aspect:#list.
- top open.
- [exEnd]
-
-
- two textViews on the same model:
- [exBegin]
- |top1 textView1 top2 textView2 model currentContents|
-
- model := Plug new.
- model respondTo:#accepted:
- with:[:newContents |
- Transcript showCR:'accepted:'.
- Transcript showCR:newContents asString.
- currentContents := newContents.
- model changed:#contents
- ].
- model respondTo:#getList
- with:[Transcript showCR:'query'.
- currentContents].
-
-
- top1 := StandardSystemView new.
- top1 extent:300@200.
-
- textView1 := EditTextView new.
- textView1 origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top1 addSubView:textView1.
-
- textView1 listMessage:#getList;
- model:model;
- aspect:#contents;
- changeMessage:#accepted:.
- top1 open.
-
- top2 := StandardSystemView new.
- top2 extent:300@200.
-
- textView2 := EditTextView new.
- textView2 origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- top2 addSubView:textView2.
-
- textView2 listMessage:#getList;
- model:model;
- aspect:#contents;
- changeMessage:#accepted:.
- top2 open.
- [exEnd]
-"
-! !
-
-!EditTextView class methodsFor:'defaults'!
-
-st80Mode
- "return true, if the st80 editing mode is turned on.
- This setting affects the behavior of the cursor, when positioned
- behond the end of a line or the end of the text.
- The default is initialized from the viewStyle."
-
- ^ ST80Mode
-
- "
- EditTextView st80Mode:true
- EditTextView st80Mode:false
- "
-
- "Modified: / 16.1.1998 / 22:54:57 / cg"
-!
-
-st80Mode:aBoolean
- "turns on/off st80 behavior, where the cursor cannot be positioned
- behond the end of a line or the last line"
-
- ST80Mode := aBoolean.
-
- "
- EditTextView st80Mode:true
- EditTextView st80Mode:false
- "
-
- "Modified: / 16.1.1998 / 22:55:19 / cg"
-!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'textCursor.foregroundColor' #'textCursor.backgroundColor'
- #'textCursor.noFocusForegroundColor'
- #'textCursor.type' #'textCursor.typeNoFocus'
- #'editText.st80Mode')>
-
- DefaultCursorForegroundColor := StyleSheet colorAt:'textCursor.foregroundColor'.
- DefaultCursorBackgroundColor := StyleSheet colorAt:'textCursor.backgroundColor'.
- DefaultCursorNoFocusForegroundColor := StyleSheet colorAt:'textCursor.noFocusForegroundColor'.
- DefaultCursorType := StyleSheet at:'textCursor.type' default:#block.
- DefaultCursorTypeNoFocus := StyleSheet at:'textCursor.typeNoFocus'.
-
- ST80Mode := StyleSheet at:'editText.st80Mode' default:false.
-
- "
- self updateStyleCache
- "
-
- "Modified: / 20.5.1998 / 04:27:41 / cg"
-! !
-
-!EditTextView methodsFor:'ST-80 compatibility'!
-
-autoAccept:aBoolean
- "ignored for now"
-
- "Created: / 5.6.1998 / 15:30:32 / cg"
-!
-
-continuousAccept:aBoolean
- "ignored for now"
-
- "Created: / 19.6.1998 / 00:03:49 / cg"
-!
-
-enabled:aBoolean
-
- self readOnly:aBoolean not
-
- "Created: / 30.3.1999 / 15:10:23 / stefan"
- "Modified: / 30.3.1999 / 15:10:53 / stefan"
-!
-
-textHasChanged
- ^ self modified
-
- "Created: / 19.6.1998 / 00:09:43 / cg"
-! !
-
-!EditTextView methodsFor:'ST-80 compatibility editing'!
-
-cutSelection
- self cut
-
- "Created: / 31.10.1997 / 03:29:50 / cg"
-!
-
-deselect
- "remove the selection"
-
- ^ self unselect
-
- "Created: / 19.6.1998 / 02:41:54 / cg"
-!
-
-find:pattern
- self searchFwd:pattern ifAbsent:nil
-
- "Created: / 29.1.1999 / 19:09:42 / cg"
- "Modified: / 29.1.1999 / 19:10:12 / cg"
-!
-
-insert:aString at:aCharacterPosition
- "insert a string at aCharacterPosition."
-
- |line col|
-
- line := self lineOfCharacterPosition:aCharacterPosition.
- col := aCharacterPosition - (self characterPositionOfLine:line col:1) + 1.
- col < 1 ifTrue:[
- col := 1
- ].
- self insertString:aString atLine:line col:col.
-
- "
- |top v|
-
- top := StandardSystemView new.
- top extent:300@300.
- v := EditTextView origin:0.0@0.0 corner:1.0@1.0 in:top.
- top openAndWait.
- v contents:'1234567890\1234567890\1234567890\' withCRs.
- v insert:'<- hello there' at:5.
- "
-
- "Modified: / 5.4.1998 / 17:20:08 / cg"
-!
-
-insertAndSelect:aString at:aCharacterPosition
- "insert a selected string at aCharacterPosition."
-
- |line col|
-
- line := self lineOfCharacterPosition:aCharacterPosition.
- col := aCharacterPosition - (self characterPositionOfLine:line col:1) + 1.
- self insertString:aString atLine:line col:col.
- self selectFromLine:line col:col toLine:line col:col + aString size - 1
- "
- |v|
-
- v := EditTextView new openAndWait.
- v contents:'1234567890\1234567890\1234567890\' withCRs.
- v insertAndSelect:'<- hello there' at:5.
- "
-!
-
-pasteSelection
- self paste
-
- "Created: / 31.10.1997 / 03:28:53 / cg"
-!
-
-replaceSelectionWith:aString
- ^ self replaceSelectionBy:aString
-
- "Created: / 19.6.1998 / 02:42:32 / cg"
-!
-
-selectAt:pos
- "move the cursor before cursorPosition."
-
- self cursorToCharacterPosition:pos
-
- "Modified: / 19.6.1998 / 02:41:28 / cg"
- "Created: / 19.6.1998 / 02:43:39 / cg"
-!
-
-selectFrom:startPos to:endPos
- "change the selection given two aCharacterPositions."
-
- |line1 col1 line2 col2|
-
- startPos > endPos ifTrue:[
- ^ self unselect
- ].
-
- line1 := self lineOfCharacterPosition:startPos.
- col1 := startPos - (self characterPositionOfLine:line1 col:1) + 1.
- col1 < 1 ifTrue:[
- col1 := 1
- ].
- line2 := self lineOfCharacterPosition:endPos.
- col2 := startPos - (self characterPositionOfLine:line2 col:1) + 1.
- col2 < 1 ifTrue:[
- col2 := 1
- ].
- self selectFromLine:line1 col:col1 toLine:line2 col:col2
-
- "Modified: / 19.6.1998 / 02:41:28 / cg"
-! !
-
-!EditTextView methodsFor:'accessing-behavior'!
-
-acceptAction
- "return the action to be performed on accept (or nil)"
-
- ^ acceptAction
-!
-
-acceptAction:aBlock
- "set the action to be performed on accept"
-
- acceptAction := aBlock
-!
-
-acceptEnabled:aBoolean
- "enable/disable accept. This greys the corresponding item in the menu"
-
- acceptEnabled := aBoolean
-
- "Created: 7.3.1997 / 11:04:34 / cg"
-!
-
-autoIndent:aBoolean
- autoIndent := aBoolean
-
- "Created: 5.3.1996 / 14:37:50 / cg"
-!
-
-exceptionBlock:aBlock
- "define the action to be triggered when user tries to modify
- readonly text"
-
- exceptionBlock := aBlock
-!
-
-insertMode:aBoolean
- insertMode := aBoolean
-
- "Created: 6.3.1996 / 12:24:05 / cg"
-!
-
-tabMeansNextField:aBoolean
- "set/clear tabbing to the next field.
- If true, Tab is ignored and shifts the keyboard focus.
- If false, tabs can be entered into the text.
- The default is true for editTextView, false for single-line
- input fields."
-
- tabMeansNextField := aBoolean
-! !
-
-!EditTextView methodsFor:'accessing-contents'!
-
-acceptChannel
- "return the valueHolder holding true if text was accepted.
- By placing a true into this channel, an accept can also be forced."
-
- ^ acceptChannel
-
- "Modified: / 30.1.1998 / 14:17:11 / cg"
-!
-
-acceptChannel:aValueHolder
- "set the valueHolder holding true if text was accepted.
- By placing a true into this channel, an accept can also be forced."
-
- |prev|
-
- prev := acceptChannel.
- acceptChannel := aValueHolder.
- self setupChannel:aValueHolder for:nil withOld:prev
-
- "Created: / 30.1.1998 / 14:51:09 / cg"
-!
-
-accepted
- "return true if text was accepted"
-
- ^ acceptChannel value
-
- "Created: 14.2.1997 / 16:43:46 / cg"
-!
-
-accepted:aBoolean
- "set/clear the accepted flag.
- This may force my current contents to be placed into my model."
-
- acceptChannel value:aBoolean.
-
- "Created: / 14.2.1997 / 16:44:01 / cg"
- "Modified: / 30.1.1998 / 14:20:15 / cg"
-!
-
-at:lineNr basicPut:aLine
- "change a line without change notification"
-
- (self at:lineNr) = aLine ifFalse:[
- super at:lineNr put:aLine.
- ].
-!
-
-at:lineNr put:aLine
- (self at:lineNr) = aLine ifFalse:[
- super at:lineNr put:aLine.
- self textChanged
- ].
-!
-
-characterBeforeCursor
- "return the character under the cursor - space if behond line.
- For non-block cursors, this is the character immediately to the right
- of the insertion-bar or caret."
-
- cursorCol == 1 ifTrue:[^ nil].
-
- ^ self characterAtLine:cursorLine col:cursorCol-1
-
- "Created: / 17.6.1998 / 15:16:41 / cg"
-!
-
-characterUnderCursor
- "return the character under the cursor - space if behond line.
- For non-block cursors, this is the character immediately to the right
- of the insertion-bar or caret."
-
- ^ self characterAtLine:cursorLine col:cursorCol
-!
-
-contents
- "return the contents as a String"
-
- list isNil ifTrue:[^ ''].
- self removeTrailingBlankLines.
- ^ list asStringWithCRs
-!
-
-cursorCol
- "return the cursors col (1..).
- This is the absolute col; NOT the visible col"
-
- ^ cursorCol
-!
-
-cursorLine
- "return the cursors line (1..).
- This is the absolute line; NOT the visible line"
-
- ^ cursorLine
-!
-
-fixedSize
- "make the texts size fixed (no lines may be added).
- OBSOLETE: use readOnly"
-
- self obsoleteMethodWarning:'use #readOnly:'.
- readOnly == true ifFalse:[
- readOnly := true.
- middleButtonMenu notNil ifTrue:[
- middleButtonMenu disableAll:#(cut paste replace indent)
- ]
- ]
-
- "Modified: 14.2.1997 / 17:35:24 / cg"
-!
-
-isReadOnly
- "return true, if the text is readonly."
-
- ^ readOnly value
-
- "Modified: 14.2.1997 / 17:35:56 / cg"
-!
-
-list:something
- "position cursor home when setting contents"
-
- super list:something.
- self cursorHome
-!
-
-modified
- "return true if text was modified"
-
- ^ modifiedChannel value
-!
-
-modified:aBoolean
- "set/clear the modified flag"
-
- modifiedChannel value:aBoolean
-
- "Modified: 14.2.1997 / 16:44:05 / cg"
-!
-
-modifiedChannel
- "return the valueHolder holding true if text was modified"
-
- ^ modifiedChannel
-!
-
-modifiedChannel:aValueHolder
- "set the valueHolder holding true if text was modified"
-
- |prev|
-
- prev := modifiedChannel.
- modifiedChannel := aValueHolder.
- self setupChannel:aValueHolder for:nil withOld:prev
-
- "Created: / 30.1.1998 / 14:51:32 / cg"
-!
-
-readOnly
- "make the text readonly.
- Somewhat obsolete - use #readOnly:"
-
- self obsoleteMethodWarning:'use #readOnly:'.
- readOnly := true
-
- "Modified: 14.2.1997 / 17:35:56 / cg"
-!
-
-readOnly:aBoolean
- "make the text readonly (aBoolean == true) or writable (aBoolean == false).
- The argument may also be a valueHolder."
-
- readOnly := aBoolean
-
- "Created: 14.2.1997 / 17:35:39 / cg"
-!
-
-setContents:something
- |selType|
-
- selType := typeOfSelection.
- super setContents:something.
- typeOfSelection := selType.
-
- "Created: / 31.3.1998 / 23:35:06 / cg"
-! !
-
-!EditTextView methodsFor:'accessing-look'!
-
-cursorForegroundColor:color1 backgroundColor:color2
- "set both cursor foreground and cursor background colors"
-
- |wasOn|
-
- wasOn := self hideCursor.
- cursorFgColor := color1 onDevice:device.
- cursorBgColor := color2 onDevice:device.
- wasOn ifTrue:[self showCursor]
-!
-
-cursorType
- "return the style of the text cursor.
- Currently, supported are: #block, #frame, #ibeam, #caret, #solidCaret
- #bigCaret and #bigSolidCaret"
-
- ^ cursorType
-
- "Modified: / 5.5.1999 / 14:52:33 / cg"
-!
-
-cursorType:aCursorTypeSymbol
- "set the style of the text cursor.
- Currently, supported are: #block, #frame, #ibeam, #caret, #solidCaret
- #bigCaret and #bigSolidCaret"
-
- cursorType := aCursorTypeSymbol.
-
- "Created: 21.9.1997 / 13:42:23 / cg"
- "Modified: 21.9.1997 / 13:43:35 / cg"
-!
-
-cursorTypeNoFocus
- "return the style of the text cursor when the view has no focus.
- If left unspecified, this is the same as the regular cursorType."
-
- ^ cursorTypeNoFocus
-
- "Created: / 5.5.1999 / 14:52:46 / cg"
-!
-
-cursorTypeNoFocus:aCursorTypeSymbol
- "set the style of the text cursor when the view has no focus.
- If left unspecified, this is the same as the regular cursorType."
-
- cursorTypeNoFocus := aCursorTypeSymbol
-! !
-
-!EditTextView methodsFor:'change & update '!
-
-accept
- "accept the current contents by executing the accept-action and/or
- changeMessage."
-
- acceptEnabled == false ifTrue:[
- device beep.
- ^ self
- ].
-
- lockUpdates := true.
-
- "/
- "/ ST-80 way of doing it
- "/
- model notNil ifTrue:[
- self sendChangeMessageWith:self argForChangeMessage.
- ].
-
- "/
- "/ ST/X way of doing things
- "/ as a historic (and temporary) leftover,
- "/ the block is called with a stringCollection
- "/ - not with the actual string
- "/
- acceptAction notNil ifTrue:[
- acceptAction value:self list
- ].
-
- "/ NO - must be manually reset by application
- "/ self modified:false.
-
- "/ self accepted:true.
- "/ changed to:
- acceptChannel value:true withoutNotifying:self.
-
- lockUpdates := false.
-
- "Modified: / 30.1.1998 / 14:19:00 / cg"
-!
-
-argForChangeMessage
- "return the argument to be passed with the change notification.
- Defined as separate method for easier subclassability."
-
- ^ self contents
-
- "Modified: 29.4.1996 / 12:42:14 / cg"
-!
-
-getListFromModel
- "get my contents from the model.
- Redefined to ignore updates resulting from my own changes
- (i.e. if lockUpdates is true)."
-
- "
- ignore updates from my own change
- "
- lockUpdates ifTrue:[
- lockUpdates := false.
- ^ self
- ].
- ^ super getListFromModel
-
- "Modified: 29.4.1996 / 12:42:33 / cg"
-!
-
-update:something with:aParameter from:changedObject
- changedObject == acceptChannel ifTrue:[
- acceptChannel value == true ifTrue:[
- self accept.
- ].
- ^ self.
- ].
- super update:something with:aParameter from:changedObject
-
- "Created: / 30.1.1998 / 14:15:56 / cg"
- "Modified: / 1.2.1998 / 13:15:55 / cg"
-! !
-
-!EditTextView methodsFor:'cursor handling'!
-
-cursorBacktab
- "move cursor to prev tabstop"
-
- self cursorCol:(self prevTabBefore:cursorCol).
-!
-
-cursorCol:newCol
- "move cursor to some column in the current line"
-
- |wasOn|
-
- wasOn := self hideCursor.
- cursorCol := self validateCursorCol:newCol inLine:cursorLine.
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: 22.5.1996 / 14:25:53 / cg"
-!
-
-cursorDown
- "move cursor down; scroll if at end of visible text;
- beep if at end of physical text."
-
- |wasOn|
-
- self cursorDown:1.
-
- "/ cursor behond text ?
- cursorLine > list size ifTrue:[
- wasOn := self hideCursor.
- cursorLine := self validateCursorLine:(list size + 1).
- cursorCol := self validateCursorCol:cursorCol inLine:cursorLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- "/ wasOn ifTrue:[self showCursor].
- self makeCursorVisibleAndShowCursor:wasOn.
- self beep.
- ].
-
- "Modified: / 10.6.1998 / 17:00:23 / cg"
-!
-
-cursorDown:n
- "move cursor down by n lines; scroll if at end of visible text"
-
- |wasOn nv|
-
- cursorVisibleLine notNil ifTrue:[
- wasOn := self hideCursor.
- nv := cursorVisibleLine + n - 1.
- (nv >= nFullLinesShown) ifTrue:[
- self scrollDown:(nv - nFullLinesShown + 1)
- ].
- cursorLine := self validateCursorLine:(cursorLine + n).
- cursorCol := self validateCursorCol:cursorCol inLine:cursorLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- "/ wasOn ifTrue:[self showCursor].
- self makeCursorVisibleAndShowCursor:wasOn.
- ] ifFalse:[
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown
- ].
- cursorLine := self validateCursorLine:(cursorLine + n).
- cursorCol := self validateCursorCol:cursorCol inLine:cursorLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisible.
- ].
-
- "Modified: / 10.6.1998 / 16:59:17 / cg"
-!
-
-cursorHome
- "scroll to top AND move cursor to first line of text."
-
- self cursorLine:1 col:1
-
-"/ |wasOn|
-"/
-"/ wasOn := self hideCursor.
-"/ self scrollToTop.
-"/ cursorLine := cursorVisibleLine := 1.
-"/ cursorCol := self validateCursorCol:1 inLine:cursorLine.
-"/ self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: 22.5.1996 / 18:26:42 / cg"
-!
-
-cursorLeft
- "move cursor to left"
-
- (cursorCol ~~ 1) ifTrue:[
- self cursorCol:(cursorCol - 1)
- ] ifFalse:[
-"/ no, do not wrap back to previous line
-"/ cursorLine ~~ 1 ifTrue:[
-"/ ST80Mode == true ifTrue:[
-"/ self cursorUp.
-"/ self cursorToEndOfLine.
-"/ ]
-"/ ]
- ]
-
- "Modified: / 23.1.1998 / 12:37:13 / cg"
-!
-
-cursorLine:line col:col
- "this positions onto physical - not visible - line"
-
- |wasOn newCol|
-
- wasOn := self hideCursor.
- cursorLine := self validateCursorLine:line.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- (col < 1) ifTrue:[
- newCol := 1
- ] ifFalse:[
- newCol := col.
- ].
- st80Mode ifTrue:[
- (cursorLine == list size
- and:[cursorLine ~~ line]) ifTrue:[
- newCol := (self listAt:(list size)) size + 1.
- ]
- ].
- cursorCol := self validateCursorCol:newCol inLine:cursorLine.
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: / 20.6.1998 / 18:19:06 / cg"
-!
-
-cursorMovementAllowed
- "return true, if the user may move the cursor around
- (via button-click, or cursor-key with selection).
- By default, true is returned, but this may be redefined
- in special subclasses (such as a terminal view), where
- this is not wanted"
-
- ^ true
-
- "Created: / 18.6.1998 / 14:11:16 / cg"
-!
-
-cursorReturn
- "move cursor to start of next line; scroll if at end of visible text"
-
- |wasOn|
-
- self checkForExistingLine:(cursorLine + 1).
- cursorVisibleLine notNil ifTrue:[
- nFullLinesShown notNil ifTrue:[
- (cursorVisibleLine >= nFullLinesShown) ifTrue:[self scrollDown]
- ]
- ].
-
- wasOn := self hideCursor.
- cursorLine := self validateCursorLine:cursorLine + 1.
- cursorCol := self validateCursorCol:1 inLine:cursorLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: 22.5.1996 / 18:27:34 / cg"
-!
-
-cursorRight
- "move cursor to right"
-
- |l|
-
- st80Mode == true ifTrue:[
- l := (self listAt:cursorLine).
- cursorCol >= (l size + 1) ifTrue:[
-"/ no, do not wrap to next line
-"/ cursorLine < list size ifTrue:[
-"/ self cursorReturn.
-"/ ].
- ^ self
- ]
- ].
- self cursorCol:(cursorCol + 1)
-
- "Modified: / 20.6.1998 / 18:19:07 / cg"
-!
-
-cursorShown:aBoolean
- "change cursor visibility
- return true if cursor was visible before."
-
- |oldState|
-
- oldState := cursorShown.
-
- aBoolean ifTrue:[
- self drawCursor.
- ] ifFalse:[
- (cursorShown and:[shown]) ifTrue: [
- self undrawCursor.
- ].
- ].
- cursorShown := aBoolean.
-
- ^ oldState
-
- "Modified: / 30.3.1999 / 15:32:43 / stefan"
- "Created: / 30.3.1999 / 15:59:30 / stefan"
-!
-
-cursorTab
- "move cursor to next tabstop"
-
- self cursorCol:(self nextTabAfter:cursorCol).
-!
-
-cursorToBeginOfLine
- "move cursor to start of current line"
-
- self cursorCol:1
-!
-
-cursorToBottom
- "move cursor to last line of text"
-
- |wasOn newTop|
-
- wasOn := self hideCursor.
-
- newTop := list size - nFullLinesShown.
- (newTop < 1) ifTrue:[
- newTop := 1
- ].
- self scrollToLine:newTop.
- cursorLine := self validateCursorLine:list size.
- cursorCol := self validateCursorCol:1 inLine:cursorLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
-
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: 22.5.1996 / 18:27:45 / cg"
-!
-
-cursorToCharacterPosition:pos
- "compute line/col from character position (1..)
- and move the cursor onto that char"
-
- |line col|
-
- line := self lineOfCharacterPosition:pos.
- col := pos - (self characterPositionOfLine:line col:1) + 1.
- self cursorLine:line col:col
-
- "Created: / 15.1.1998 / 21:55:33 / cg"
-!
-
-cursorToEnd
- "move cursor down below last line of text"
-
- |wasOn newTop l line|
-
- l := list size.
-
- cursorLine >= l ifTrue:[
- line := self listAt:cursorLine.
- (line isNil or:[line isEmpty]) ifTrue:[
- ^ self
- ]
- ].
-
- wasOn := self hideCursor.
-
- l := l + 1.
- newTop := l - nFullLinesShown.
- (newTop < 1) ifTrue:[
- newTop := 1
- ].
- self scrollToLine:newTop.
- cursorLine := self validateCursorLine:l.
- cursorCol := self validateCursorCol:1 inLine:1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
-
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: 22.5.1996 / 18:27:53 / cg"
-!
-
-cursorToEndOfLine
- "move cursor to end of current line"
-
- |line|
-
- line := (self listAt:cursorLine).
- self cursorCol:(line size + 1)
-
- "Modified: 13.8.1997 / 15:34:02 / cg"
-!
-
-cursorToFirstVisibleLine
- "place cursor into the first visible line; do not scroll."
-
- self cursorLine:(self visibleLineToAbsoluteLine:1) col:1
-!
-
-cursorToLastVisibleLine
- "place cursor into the first visible line; do not scroll."
-
- self cursorLine:(self visibleLineToAbsoluteLine:nFullLinesShown) col:1
-!
-
-cursorToNextWord
- "move the cursor to the beginning of the next word"
-
- |col line searching|
-
- (cursorLine > list size) ifTrue:[^ self].
- self wordAtLine:cursorLine col:cursorCol do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- line := endLine.
- col := endCol + 1.
- searching := true.
- [searching
- and:[(self characterAtLine:line col:col) isSeparator]] whileTrue:[
- self wordAtLine:line col:col do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- (line > list size) ifTrue:[
- "break out"
- searching := false
- ] ifFalse:[
- line := endLine.
- col := endCol + 1.
- ]
- ]
- ].
- self cursorLine:line col:col
- ]
-!
-
-cursorToPreviousWord
- "move the cursor to the beginning of this or the previous word"
-
- |col line searching l|
-
- (cursorLine > list size) ifTrue:[^ self].
-
- self wordAtLine:cursorLine col:cursorCol do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- line := beginLine.
- col := beginCol.
- style == #wordLeft ifTrue:[
- col := col + 1
- ].
-
- (cursorLine == line
- and:[cursorCol == col]) ifTrue:[
- searching := true.
-
- col > 1 ifTrue:[
- col := col - 1.
- ].
-
- [searching] whileTrue:[
- (col == 1) ifTrue:[
- line == 1 ifTrue:[
- searching := false
- ] ifFalse:[
- line := line - 1.
- l := list at:line.
- col := l size + 1.
- ]
- ] ifFalse:[
- (self characterAtLine:line col:col) isSeparator ifFalse:[
- self wordAtLine:line col:col do:[
- :beginLine :beginCol :endLine :endCol :style |
-
- line := beginLine.
- col := beginCol.
- style == #wordLeft ifTrue:[
- col := col + 1
- ].
- searching := false.
- ]
- ] ifTrue:[
- col := col - 1
- ]
- ]
- ]
- ].
- self cursorLine:line col:col
- ]
-
- "Created: 8.3.1996 / 21:52:48 / cg"
- "Modified: 8.3.1996 / 22:12:45 / cg"
-!
-
-cursorToTop
- "move cursor to absolute home"
-
- self cursorLine:1 col:1
-!
-
-cursorUp
- "move cursor up; scroll if at start of visible text"
-
- self cursorUp:1
-!
-
-cursorUp:n
- "move cursor up n lines; scroll if at start of visible text"
-
- |wasOn nv nl|
-
- cursorLine isNil ifTrue:[
- cursorLine := firstLineShown + nFullLinesShown - 1.
- ].
- nl := cursorLine - n.
- nl < 1 ifTrue:[nl := 1].
-
- (nl ~~ cursorLine) ifTrue: [
- wasOn := self hideCursor.
- cursorVisibleLine notNil ifTrue:[
- nv := cursorVisibleLine - n.
- nv < 1 ifTrue:[
- self scrollUp:(nv negated + 1)
- ].
- ].
- cursorLine := self validateCursorLine:nl.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- cursorCol := self validateCursorCol:cursorCol inLine:cursorLine.
- wasOn ifTrue:[self showCursor].
-"/
-"/ to make cursor visible (even if below visible end):
-"/
-"/ self makeCursorVisibleAndShowCursor:wasOn.
- ]
-
- "Modified: 22.5.1996 / 18:28:11 / cg"
-!
-
-cursorVisibleLine:visibleLineNr col:colNr
- "put cursor to visibleline/col"
-
- |wasOn newCol|
-
- wasOn := self hideCursor.
- cursorLine := self validateCursorLine:(self visibleLineToAbsoluteLine:visibleLineNr).
- cursorVisibleLine := visibleLineNr.
- newCol := colNr.
- (newCol < 1) ifTrue:[
- newCol := 1
- ].
- cursorCol := self validateCursorCol:newCol inLine:cursorLine.
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: / 20.6.1998 / 18:40:28 / cg"
-!
-
-cursorX:x y:y
- "put cursor to position next to x/y coordinate in view"
-
- |line col|
-
- line := self visibleLineOfY:y.
- col := self colOfX:x inVisibleLine:line.
- self cursorVisibleLine:line col:col.
-!
-
-drawCursor
- "draw the cursor if shown and cursor is visible.
- (but not, if there is a selection - to avoid confusion)"
-
- shown ifTrue:[
- cursorVisibleLine notNil ifTrue:[
- self hasSelection ifFalse:[
- self drawCursorCharacter
- ]
- ]
- ]
-!
-
-drawCursor:cursorType with:fgColor and:bgColor
- "draw a cursor; the argument cursorType specifies what type
- of cursor should be drawn.
- Currently, supported are: #block, #frame, #ibeam, #caret, #solidCaret
- #bigCaret and #bigSolidCaret"
-
- |x y w char y2 x1 x2 oldPaint oldClip|
-
- self hasSelection ifTrue:[
- "
- hide cursor, if there is a selection
- "
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
-
- cursorType == #none ifTrue:[
- ^ self
- ].
-
- cursorType == #block ifTrue:[
- super drawVisibleLine:cursorVisibleLine
- col:cursorCol
- with:fgColor
- and:bgColor.
- ^ self
- ].
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
-
- oldPaint := self paint. "/ do not clobber GC
- cursorType == #frame ifTrue:[
- super redrawVisibleLine:cursorVisibleLine col:cursorCol.
-
- char := self characterUnderCursor asString.
- self paint:bgColor.
- self displayRectangleX:x y:y
- width:(font widthOf:char) height:fontHeight.
- ] ifFalse:[
- self paint:bgColor.
- cursorType == #ibeam ifTrue:[
- x1 := x - 1.
- y2 := y + fontHeight - 1.
- self displayLineFromX:x1 y:y toX:x1 y:y2.
- self displayLineFromX:x y:y toX:x y:y2.
- ^ self
- ].
-
- cursorType == #Ibeam ifTrue:[
- x1 := x - 1.
- y2 := y + fontHeight - 1.
- self displayLineFromX:x1 y:y toX:x1 y:y2.
- self displayLineFromX:x y:y toX:x y:y2.
- self displayLineFromX:x1-2 y:y toX:x+2 y:y.
- self displayLineFromX:x1-2 y:y2 toX:x+2 y:y2.
- ^ self
- ].
-
- y := y + fontHeight - 3.
- ((cursorType == #bigCaret) or:[cursorType == #bigSolidCaret]) ifTrue:[
- w := (fontWidth * 2 // 3) max:4.
- y2 := y + w + (w//2).
- ] ifFalse:[
- w := (fontWidth // 2) max:4.
- y2 := y + w.
- ].
- x1 := x - w.
- x2 := x + w.
-
- oldClip := self clippingRectangleOrNil.
- self clippingRectangle:(margin@margin extent:(width-margin) @ (height-margin)).
-
- cursorType == #caret ifTrue:[
- self lineWidth:2.
- self displayLineFromX:x1 y:y2 toX:x y:y.
- self displayLineFromX:x y:y toX:x2 y:y2.
- ] ifFalse:[
- "anything else: solidCaret"
-
- self fillPolygon:(Array with:(x1 @ y2)
- with:(x @ y)
- with:(x2 @ y2))
- ].
-
- self clippingRectangle:oldClip
- ].
- self paint:oldPaint.
-
- "Modified: 18.2.1997 / 15:19:03 / cg"
-!
-
-drawCursorCharacter
- "draw the cursor.
- (i.e. the cursor if no selection)
- - helper for many cursor methods"
-
- (hasKeyboardFocus
- and:[self enabled
- and:[readOnly not]]) ifTrue:[
- self drawFocusCursor
- ] ifFalse:[
- self drawNoFocusCursor
- ]
-
- "Modified: / 23.3.1999 / 13:52:48 / cg"
-!
-
-drawFocusCursor
- "draw the cursor when the focus is in the view."
-
- self hasSelection ifTrue:[
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
- cursorType == #none ifTrue:[
- ^ self undrawCursor
- ].
- self drawCursor:cursorType with:cursorFgColor and:cursorBgColor.
-
- "Modified: 22.9.1997 / 00:16:38 / cg"
-!
-
-drawNoFocusCursor
- "draw the cursor for the case when the view has no keyboard focus"
-
- |cType|
-
- self hasSelection ifTrue:[
- ^ super redrawVisibleLine:cursorVisibleLine col:cursorCol.
- ].
-
- cType := cursorTypeNoFocus ? cursorType.
- cType == #none ifTrue:[
- ^ self undrawCursor
- ].
-
- cType == #block ifTrue:[
- ^ self drawCursor:#frame with:cursorNoFocusFgColor and:cursorBgColor
- ].
-
- ^ self drawCursor:cType with:cursorNoFocusFgColor and:cursorNoFocusFgColor.
-
- "Modified: 22.9.1997 / 00:16:13 / cg"
-!
-
-gotoLine:aLineNumber
- "position cursor onto line, aLineNumber.
- Make certain that this line is visible"
-
- self makeLineVisible:aLineNumber.
- self cursorLine:aLineNumber col:1
-!
-
-hideCursor
- "make cursor invisible if currently invisible"
-
- ^ self cursorShown:false
-
- "Modified: / 30.3.1999 / 16:02:28 / stefan"
-!
-
-makeCursorVisible
- "scroll text to make cursorline visible
- (i.e. to have cursorLine in visible area)"
-
- |line col|
-
- cursorLine notNil ifTrue:[
- line := cursorLine.
- col := cursorCol.
- "
- if there is a selection, its better to
- have its start being visible, instead of the end
- "
- (selectionStartLine notNil
- and:[selectionEndLine notNil]) ifTrue:[
- expandingTop ~~ false ifTrue:[
- line := selectionStartLine.
- col := selectionStartCol.
- ] ifFalse:[
- line := selectionEndLine.
- col := selectionEndCol
- ]
- ].
- self makeLineVisible:line.
- self makeColVisible:col inLine:line
- ]
-
- "Modified: 6.3.1996 / 13:46:46 / cg"
-!
-
-makeCursorVisibleAndShowCursor:flag
- "scroll to make cursorLine visible;
- if flag is true, draw the cursor"
-
- self makeCursorVisible.
- flag ifTrue:[self showCursor]
-!
-
-showCursor
- "make cursor visible if currently invisible"
-
- ^ self cursorShown:true
-
- "Modified: / 30.3.1999 / 16:02:34 / stefan"
-!
-
-undrawCursor
- "undraw the cursor (i.e. redraw the character(s) under the cursor)"
-
- |prevCol line oldClip x y|
-
- cursorVisibleLine notNil ifTrue:[
- prevCol := cursorCol - 1.
-
- ((cursorType == #caret)
- or:[cursorType == #solidCaret
- or:[cursorType == #bigSolidCaret
- or:[cursorType == #bigCaret
- or:[cursorType == #Ibeam]]]]) ifTrue:[
- "caret-cursor touches 4 characters"
- ((cursorCol > 1) and:[fontIsFixedWidth]) ifTrue:[
- super redrawVisibleLine:cursorVisibleLine from:prevCol to:cursorCol.
- super redrawVisibleLine:cursorVisibleLine+1 from:prevCol to:cursorCol.
- ] ifFalse:[
- "care for left margin"
- super redrawVisibleLine:cursorVisibleLine; redrawVisibleLine:cursorVisibleLine+1.
- ].
- ^ self
- ].
-
- cursorType == #ibeam ifTrue:[
- "ibeam-cursor touches 2 characters"
- cursorCol > 1 ifTrue:[
- super redrawVisibleLine:cursorVisibleLine from:prevCol to:cursorCol.
- ] ifFalse:[
- "care for left margin"
- super redrawVisibleLine:cursorVisibleLine.
- ].
- ^ self
- ].
-
- "block cursor is simple - just one character under cursor"
-
- "/ however, if italic characters are involved, we must care
- "/ for the chars before/after the cursor.
- "/ We redraw the part of the previous character which got
- "/ detroyed by the block cursor.
- "/ (must change the clip, to avoid destroying the prev-prev character)
-
- line := self visibleAt:cursorVisibleLine.
- (line notNil and:[line isText]) ifTrue:[
- cursorCol > 1 ifTrue:[
- oldClip := self clippingRectangleOrNil.
- x := (self xOfCol:cursorCol inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
- self clippingRectangle:(x@y extent:((font width * 2) @ fontHeight)).
- super redrawVisibleLine:cursorVisibleLine from:cursorCol-1 to:cursorCol.
- self clippingRectangle:oldClip.
- ^ self.
- ].
- ].
- super redrawVisibleLine:cursorVisibleLine col:cursorCol
- ]
-
- "Modified: / 22.4.1998 / 09:13:07 / cg"
-!
-
-validateCursorCol:col inLine:line
- "check of col is a valid cursor position; return a new col-nr if not.
- Here, no limits are enforced (and col is returned),
- but it may be redefined in EditFields or views which dont like the
- cursor to be positioned behind the end of a textLine (vi/st-80 behavior)"
-
- |l max|
-
- "/ in ST80 mode,
- "/ the cursor may not be positioned behond the
- "/ end of a line or behond the last line of the text
- "/
- st80Mode == true ifTrue:[
- l := (self listAt:line).
- max := l size + 1.
- col > max ifTrue:[
- ^ max
- ]
- ].
- ^ col
-
- "Created: / 22.5.1996 / 14:25:30 / cg"
- "Modified: / 20.6.1998 / 18:19:24 / cg"
-!
-
-validateCursorLine:line
- "check of line is a valid cursor line; return a fixed line-nr if not.
- Here, no limits are enforced (and line is returned), but it may be
- redefined in views which dont like the cursor to be positioned
- behind the end of the text (vi/st-80 behavior), or want to
- skip reserved regions"
-
- "/
- "/ in st80Mode, the cursor may not be positioned
- "/ behond the last line
- "/
- st80Mode == true ifTrue:[
- ^ (line min:(list size)) max:1
- ].
- ^ line
-
- "Created: / 22.5.1996 / 18:22:23 / cg"
- "Modified: / 20.6.1998 / 18:19:26 / cg"
-!
-
-withCursorOffDo:aBlock
- "evaluate aBlock with cursor off; turn it on afterwards."
-
- (shown not or:[cursorShown not]) ifTrue:[
- ^ aBlock value
- ].
- self hideCursor.
- aBlock valueNowOrOnUnwindDo:[
- self showCursor
- ]
-! !
-
-!EditTextView methodsFor:'editing'!
-
-copyAndDeleteSelection
- "copy the selection into the pastBuffer and delete it"
-
- selectionStartLine notNil ifTrue:[
- self setTextSelection:(self selection).
- self deleteSelection.
- ].
-
- "Created: 27.1.1996 / 16:23:28 / cg"
-!
-
-deleteCharAtCursor
- "delete single character under cursor; does not merge lines"
-
- |wasOn|
-
- wasOn := self hideCursor.
- self deleteCharAtLine:cursorLine col:cursorCol.
- wasOn ifTrue:[self showCursor]
-!
-
-deleteCharAtLine:lineNr col:colNr
- "delete a single character at colNr in line lineNr"
-
- self deleteCharsAtLine:lineNr fromCol:colNr toCol:colNr
-!
-
-deleteCharBeforeCursor
- "delete single character to the left of cursor and move cursor to left"
-
- |soCol wasOn lineNrAboveCursor ln|
-
- wasOn := self hideCursor.
-
- (autoIndent
- and:[cursorCol ~~ 1
- and:[cursorLine <= (list size)]])
- ifTrue:[
- soCol := (self leftIndentForLine:cursorLine) + 1.
-
- (cursorCol == soCol and:[soCol > 1]) ifTrue:[
- ln := list at:cursorLine.
- (ln notNil and:[(ln indexOfNonSeparatorStartingAt:1) < soCol]) ifTrue:[
- soCol := 1
- ]
- ]
- ] ifFalse:[
- soCol := 1
- ].
-
- (cursorCol ~~ soCol and:[cursorCol ~~ 1]) ifTrue:[
- "
- somewhere in the middle of a line
- "
- self cursorLeft.
- self deleteCharAtLine:cursorLine col:cursorCol.
- ] ifFalse:[
- "
- at begin of line - merge with previous line;
- except for the very first line.
- "
- (cursorLine == 1) ifFalse:[
- lineNrAboveCursor := self validateCursorLine:(cursorLine - 1).
- lineNrAboveCursor < cursorLine ifTrue:[
- self mergeLine:lineNrAboveCursor removeBlanks:false.
- ]
- ]
- ].
- wasOn ifTrue:[ self showCursor ]
-
- "Modified: / 16.1.1998 / 22:33:04 / cg"
-!
-
-deleteCharsAtLine:lineNr fromCol:colNr
- "delete characters from colNr up to the end in line lineNr"
-
- |line|
-
- (line := self listAt:lineNr) notNil ifTrue:[
- self deleteCharsAtLine:lineNr fromCol:colNr toCol:(line size)
- ]
-
-!
-
-deleteCharsAtLine:lineNr toCol:colNr
- "delete characters from start up to colNr in line lineNr"
-
- self deleteCharsAtLine:lineNr fromCol:1 toCol:colNr
-
-
-!
-
-deleteCursorLine
- "delete the line where the cursor sits"
-
- self deleteLine:cursorLine
-!
-
-deleteLine:lineNr
- "delete line"
-
- self deleteFromLine:lineNr toLine:lineNr
-
-
-!
-
-deleteLinesWithoutRedrawFrom:startLine to:endLine
- "delete lines - no redraw;
- return true, if something was really deleted"
-
- |lastLine|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- (list isNil or:[startLine > list size]) ifTrue:[^ false].
- (endLine > list size) ifTrue:[
- lastLine := list size
- ] ifFalse:[
- lastLine := endLine
- ].
- list removeFromIndex:startLine toIndex:lastLine.
- "/ TODO: remember old maxwidth of linerange,
- "/ only clear widthOfWidestLine, if this max
- "/ length was (one of) the longest.
- "/ avoids slow delete with huge texts.
- widthOfWidestLine := nil. "/ i.e. unknown
- self textChanged.
- ^ true
-
- "Modified: / 10.11.1998 / 23:55:29 / cg"
-!
-
-deleteSelection
- "delete the selection"
-
- |wasOn startLine startCol endLine endCol|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- selectionStartLine notNil ifTrue:[
- wasOn := self hideCursor.
-
- startLine := selectionStartLine.
- startCol := selectionStartCol.
- endLine := selectionEndLine.
- endCol := selectionEndCol.
- self unselectWithoutRedraw.
- self deleteFromLine:startLine col:startCol
- toLine:endLine col:endCol.
- cursorCol := startCol.
- cursorLine := startLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- self makeCursorVisibleAndShowCursor:wasOn
- ]
-!
-
-insertCharAtCursor:aCharacter
- "insert a single character at cursor-position - advance cursor."
-
- |wasOn|
-
- wasOn := self hideCursor.
- aCharacter == Character tab ifTrue:[
- "/ needs special care to advance cursor correctly
- self insertTabAtCursor
- ] ifFalse:[
- self insert:aCharacter atLine:cursorLine col:cursorCol.
- aCharacter == (Character cr) ifTrue:[
- self cursorReturn
- ] ifFalse:[
- self cursorRight.
- ].
- ].
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Modified: / 12.6.1998 / 21:50:20 / cg"
-!
-
-insertLine:aString before:lineNr
- "insert the line aString before line lineNr"
-
- ^ self insertLines:(Array with:aString) from:1 to:1 before:lineNr.
-
- "Modified: 14.5.1996 / 13:42:54 / cg"
-!
-
-insertLines:aStringCollection before:lineNr
- "insert a bunch before line lineNr"
-
- self insertLines:aStringCollection from:1 to:aStringCollection size before:lineNr
-
- "Modified: 6.9.1995 / 20:51:03 / claus"
-!
-
-insertLines:lines withCR:withCr
- "insert a bunch of lines at cursor position.
- Cursor is moved behind insertion.
- If withCr is true, append cr after last line"
-
- |start end nLines wasOn|
-
- lines notNil ifTrue:[
- nLines := lines size.
- (nLines == 1) ifTrue:[
- self insertStringAtCursor:(lines at:1).
- withCr ifTrue:[
- self insertCharAtCursor:(Character cr)
- ]
- ] ifFalse:[
- (cursorCol ~~ 1) ifTrue:[
- self insertStringAtCursor:(lines at:1).
- self insertCharAtCursor:(Character cr).
- start := 2
- ] ifFalse:[
- start := 1
- ].
- withCr ifTrue:[
- end := nLines
- ] ifFalse:[
- end := nLines - 1
- ].
- (start < nLines) ifTrue:[
- (end >= start) ifTrue:[
- wasOn := self hideCursor.
- self insertLines:lines from:start to:end before:cursorLine.
- cursorLine := cursorLine + (end - start + 1).
- cursorVisibleLine := self absoluteLineToVisibleLine:cursorLine.
- wasOn ifTrue:[self showCursor].
- ]
- ].
- withCr ifFalse:[
- "last line without cr"
- self insertStringAtCursor:(lines at:nLines)
- ]
- ]
- ]
-
- "Created: / 18.5.1996 / 15:32:06 / cg"
- "Modified: / 12.6.1998 / 21:51:16 / cg"
-!
-
-insertLines:lines withCr:withCr
- "insert a bunch of lines at cursor position. Cursor
- is moved behind insertion.
- If withCr is true, append cr after last line"
-
- self obsoleteMethodWarning:'use #insertLines:withCR:'.
- self insertLines:lines withCR:withCr.
-
- "Modified: 31.7.1997 / 23:07:22 / cg"
-!
-
-insertSelectedStringAtCursor:aString
- "insert the argument, aString at cursor position and select it"
-
- |startLine startCol|
-
- startLine := cursorLine.
- startCol := cursorCol.
- self insertStringAtCursor:aString.
- self selectFromLine:startLine col:startCol
- toLine:cursorLine col:(cursorCol - 1)
-!
-
-insertString:aString atCharacterPosition:charPos
- "insert the argument, aString at a character position"
-
- |line col|
-
- line := self lineOfCharacterPosition:charPos.
- col := charPos - (self characterPositionOfLine:line col:1) + 1.
- self insertString:aString atLine:line col:col
-!
-
-insertString:aString atLine:lineNr col:colNr
- "insert the string, aString at line/col;
- handle cr's correctly"
-
- |start "{ Class: SmallInteger }"
- stop "{ Class: SmallInteger }"
- end "{ Class: SmallInteger }"
- subString c
- l "{ Class: SmallInteger }" |
-
- aString isNil ifTrue:[^ self].
- (aString includes:(Character cr)) ifFalse:[
- ^ self insertStringWithoutCRs:aString atLine:lineNr col:colNr
- ].
-
- l := lineNr.
- c := colNr.
- start := 1.
- end := aString size.
- [start <= end] whileTrue:[
- stop := aString indexOf:(Character cr) startingAt:start.
- stop == 0 ifTrue:[
- stop := end + 1
- ].
- subString := aString copyFrom:start to:(stop - 1).
- self insertStringWithoutCRs:subString atLine:l col:c.
- (stop <= end) ifTrue:[
- c := c + subString size.
- self insert:(Character cr) atLine:l col:c.
- l := l + 1.
- c := 1
- ].
- start := stop + 1
- ]
-
- "Modified: / 10.6.1998 / 19:03:59 / cg"
-!
-
-insertStringAtCursor:aString
- "insert the argument, aString at cursor position
- handle cr's correctly. A nil argument is interpreted as an empty line."
-
- aString isNil ifTrue:[
- "new:"
- self insertCharAtCursor:(Character cr).
- ^ self
- ].
- (aString includes:(Character cr)) ifFalse:[
- ^ self insertStringWithoutCRsAtCursor:aString
- ].
-
- self insertLines:aString asStringCollection withCR:false.
-
- "Modified: / 10.6.1998 / 19:03:21 / cg"
-!
-
-insertStringWithoutCRs:aString atLine:lineNr col:colNr
- "insert aString (which has no crs) at lineNr/colNr"
-
- self withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr.
- shown ifTrue:[self redrawLine:lineNr from:colNr]
-
- "Modified: / 5.4.1998 / 16:51:14 / cg"
-!
-
-insertStringWithoutCRsAtCursor:aString
- "insert a string (which has no crs) at cursor position
- - advance cursor"
-
- |wasOn oldLen newLen|
-
- aString notNil ifTrue:[
- wasOn := self hideCursor.
- (aString includes:Character tab) ifTrue:[
- self checkForExistingLine:cursorLine.
- oldLen := (list at:cursorLine) size.
- self insertString:aString atLine:cursorLine col:cursorCol.
- newLen := (list at:cursorLine) size.
- cursorCol := cursorCol + (newLen - oldLen).
- ] ifFalse:[
- self insertString:aString atLine:cursorLine col:cursorCol.
- cursorCol := cursorCol + aString size.
- ].
- wasOn ifTrue:[self showCursor]
- ]
-
- "Modified: / 10.6.1998 / 20:43:52 / cg"
-!
-
-insertTabAtCursor
- "insert spaces to next tab"
-
- |wasOn nextTab|
-
- wasOn := self hideCursor.
- nextTab := self nextTabAfter:cursorCol.
- self insertStringAtCursor:(String new:(nextTab - cursorCol)).
- self makeCursorVisibleAndShowCursor:wasOn.
-!
-
-removeTrailingBlankLines
- "remove all blank lines at end of text"
-
- |lastLine "{ Class: SmallInteger }"
- line finished|
-
- lastLine := list size.
- finished := false.
- [finished] whileFalse:[
- (lastLine <= 1) ifTrue:[
- finished := true
- ] ifFalse:[
- line := list at:lastLine.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- list at:lastLine put:nil.
- line := nil
- ]
- ].
- line notNil ifTrue:[
- finished := true
- ] ifFalse:[
- lastLine := lastLine - 1
- ]
- ]
- ].
- (lastLine ~~ list size) ifTrue:[
- list grow:lastLine.
-"/ self textChanged
- ]
-!
-
-replaceCharAtCursor:aCharacter
- "replace a single character at cursor-position - advance cursor"
-
- |wasOn|
-
- wasOn := self hideCursor.
- aCharacter == (Character cr) ifTrue:[
- self cursorReturn
- ] ifFalse:[
- self replace:aCharacter atLine:cursorLine col:cursorCol.
- self cursorRight.
- ].
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Created: 6.3.1996 / 12:27:42 / cg"
-!
-
-replaceLines:lines withCR:withCr
- "replace a bunch of lines at cursor position. Cursor
- is moved behind replacement.
- If withCr is true, move to the beginning of the next line
- after the last line"
-
- |line col nLines wasOn|
-
- lines notNil ifTrue:[
- wasOn := self hideCursor.
- nLines := lines size.
- line := cursorLine.
- col := cursorCol.
- lines keysAndValuesDo:[:i :l |
- self replaceString:l atLine:line col:col.
- (i ~~ nLines or:[withCr]) ifTrue:[
- line := line + 1.
- col := 1.
- ] ifFalse:[
- col := col + (l size).
- ]
- ].
- self cursorLine:line col:col.
- self makeCursorVisibleAndShowCursor:wasOn.
- "/ wasOn ifTrue:[self showCursor].
- ]
-
- "Created: / 18.5.1996 / 15:32:06 / cg"
- "Modified: / 12.6.1998 / 22:05:51 / cg"
-!
-
-replaceSelectionBy:something
- "delete the selection (if any) and insert something, a character or string;
- leave cursor after insertion"
-
- self replaceSelectionBy:something keepCursor:false
-!
-
-replaceSelectionBy:something keepCursor:keep
- "delete the selection (if any) and insert something, a character or string;
- leave cursor after insertion or leave it, depending on keep"
-
- |sel l c|
-
- l := cursorLine.
- c := cursorCol.
-
- sel := self selection.
- sel notNil ifTrue:[
- lastString := sel.
- self deleteSelection.
- replacing := true.
- lastReplacement := ''
- ].
-
- (something isMemberOf:Character) ifTrue:[
- lastReplacement notNil ifTrue:[
-"/ "XXX - replacing text with spaces ..."
-"/ (lastReplacement endsWith:Character space) ifTrue:[
-"/ lastReplacement := lastReplacement copyWithoutLast:1 "copyTo:(lastReplacement size - 1)".
-"/ lastReplacement := lastReplacement copyWith:something.
-"/ lastReplacement := lastReplacement copyWith:Character space
-"/ ] ifFalse:[
- lastReplacement := lastReplacement copyWith:something.
-"/ ]
- ].
- insertMode ifTrue:[
- self insertCharAtCursor:something
- ] ifFalse:[
- self replaceCharAtCursor:something
- ]
- ] ifFalse:[
- lastReplacement := something.
- insertMode ifTrue:[
- self insertStringAtCursor:something
- ] ifFalse:[
- self replaceStringAtCursor
- ]
- ].
- keep ifTrue:[
- self cursorLine:l col:c
- ]
-
- "Modified: 9.10.1996 / 16:14:35 / cg"
-!
-
-replaceStringAtCursor:aString
- "replace multiple characters at cursor-position - advance cursor"
-
- |wasOn i1 i2|
-
- wasOn := self hideCursor.
- (aString includes:Character tab) ifTrue:[
- "/ need special care for TAB (to move cursor correctly)
- i1 := 1.
- [i1 ~~ 0] whileTrue:[
- i2 := aString indexOf:Character tab startingAt:i1.
- i2 ~~ 0 ifTrue:[
- i1 ~~ i2 ifTrue:[
- self replaceString:(aString copyFrom:i1 to:i2-1) atLine:cursorLine col:cursorCol.
- self cursorCol:(cursorCol + (i2 - i1)).
- ].
- self replaceTABAtCursor.
- i2 := i2 + 1.
- ] ifFalse:[
- self replaceString:(aString copyFrom:i1) atLine:cursorLine col:cursorCol.
- self cursorCol:(cursorCol + (aString size - i1 + 1)).
- ].
- i1 := i2.
- ]
- ] ifFalse:[
- self replaceString:aString atLine:cursorLine col:cursorCol.
- self cursorCol:(cursorCol + aString size).
- ].
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Created: / 9.6.1998 / 20:33:20 / cg"
- "Modified: / 20.6.1998 / 19:41:02 / cg"
-!
-
-replaceTABAtCursor
- "replace a single character at cursor-position by a TAB character"
-
- |wasOn nextTab|
-
- wasOn := self hideCursor.
- nextTab := self nextTabAfter:cursorCol.
- self replaceStringAtCursor:(String new:(nextTab - cursorCol)).
- self makeCursorVisibleAndShowCursor:wasOn.
-
- "Created: / 12.6.1998 / 21:53:23 / cg"
-! !
-
-!EditTextView methodsFor:'editing - basic'!
-
-deleteCharsAtLine:lineNr fromCol:startCol toCol:endCol
- "delete characters from startCol to endCol in line lineNr
- "
- |line lineSize newLine start stop prevWidth newWidth|
-
- line := self listAt:lineNr.
-
- (self checkModificationsAllowed and:[line notNil]) ifTrue:[
- lineSize := line size.
-
- startCol == 0 ifFalse:[ start := startCol ]
- ifTrue:[ start := 1 ].
-
- endCol > lineSize ifFalse:[ stop := endCol ]
- ifTrue:[ stop := lineSize ].
-
- stop >= start ifTrue:[
- start ~~ 1 ifTrue:[ newLine := line copyFrom:1 to:(start-1) ]
- ifFalse:[ newLine := '' ].
-
- stop == lineSize ifFalse:[
- line bitsPerCharacter > newLine bitsPerCharacter ifTrue:[
- newLine := line string species fromString:newLine.
- ].
- newLine := newLine, (line copyFrom:(stop + 1) to:lineSize)
- ].
-
- (trimBlankLines and:[newLine isBlank]) ifTrue:[
- newLine := nil
- ].
-
- prevWidth := self widthOfLine:lineNr.
-
- list at:lineNr put:newLine.
-
- (prevWidth = widthOfWidestLine) ifTrue:[
- "/ remember old width of this line,
- "/ only clear widthOfWidestLine, if this lines
- "/ length was (one of) the longest.
- "/ avoids slow delete with huge texts.
- widthOfWidestLine := nil. "i.e. unknown"
-
- "/ scroll left if reqiured
- viewOrigin x > 0 ifTrue:[
- newWidth := self widthOfLine:lineNr.
- newWidth < (viewOrigin x + width) ifTrue:[
- self scrollHorizontalTo:(newWidth
- - width
- + margin + margin
- + (font widthOf:' '))
- ]
- ].
- ].
- self textChanged.
- self redrawLine:lineNr from:start.
-
- ]
- ]
-
- "Modified: / 11.11.1998 / 00:01:09 / cg"
-!
-
-deleteFromLine:startLine col:startCol toLine:endLine col:endCol
- "delete all text from startLine/startCol to endLine/endCol -
- joining lines if nescessary"
-
- |line newLine lineSize nMore|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
- list isNil ifTrue:[^ self].
- startLine > list size ifTrue:[ ^ self]. "/ deleted space below text
-
- (startLine == endLine) ifTrue:[
- "/ delete chars within a line
- self deleteCharsAtLine:startLine fromCol:startCol toCol:endCol.
- ^ self
- ].
-
- ((startCol == 1) and:[endCol == 0]) ifTrue:[
- "/ delete full lines only
- endLine > startLine ifTrue:[
- self deleteFromLine:startLine toLine:(endLine - 1)
- ].
- ^ self
- ].
-
- "/ delete right rest of 1st line
- self deleteCharsAtLine:startLine fromCol:startCol.
-
- "/ delete the inner lines ...
- endLine > (startLine + 1) ifTrue:[
- self deleteFromLine:(startLine + 1) toLine:(endLine - 1)
- ].
-
- (endCol ~~ 0) ifTrue:[
- "/ delete the left rest of the last line
-
- self deleteCharsAtLine:(startLine + 1) toCol:endCol.
-
- "/ must add blanks, if startCol lies behond end of startLine
-
- line := list at:startLine.
- lineSize := line size.
- (startCol > lineSize) ifTrue:[
- newLine := line.
- line isNil ifTrue:[
- newLine := String new:(startCol - 1)
- ] ifFalse:[
- nMore := startCol - 1 - lineSize.
- nMore > 0 ifTrue:[
- newLine := line , (line species new:nMore)
- ]
- ].
- newLine ~~ line ifTrue:[
- list at:startLine put:newLine.
- ].
- "/ TODO: remember old maxwidth of linerange,
- "/ only clear widthOfWidestLine, if this max
- "/ length was (one of) the longest.
- "/ avoids slow delete with huge texts.
- widthOfWidestLine := nil. "/ i.e. unknown
- self textChanged.
- ]
- ].
-
- "/ merge the left rest of 1st line with right rest of last line into one
- self mergeLine:startLine removeBlanks:false
-
- "Modified: / 10.11.1998 / 23:52:59 / cg"
-!
-
-deleteFromLine:startLineNr toLine:endLineNr
- "delete some lines"
-
- |wasOn nLines|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
- list isNil ifTrue:[^ self].
-
- wasOn := self hideCursor.
-
- "/ isnt this the same as:
- "/ self deleteLinesWithoutRedrawFrom:startLineNr to:endLineNr.
-
- list removeFromIndex:startLineNr toIndex:(endLineNr min:list size).
- "/ TODO: remember old maxwidth of linerange,
- "/ only clear widthOfWidestLine, if this max
- "/ length was (one of) the longest.
- "/ avoids slow delete with huge texts.
- widthOfWidestLine := nil. "/ i.e. unknown
- self textChanged.
-
- self redrawFromLine:startLineNr.
-
- nLines := list size.
- (firstLineShown >= nLines) ifTrue:[
- self makeLineVisible:nLines
- ].
- wasOn ifTrue:[self showCursor].
-
- "Modified: / 10.11.1998 / 23:55:05 / cg"
-!
-
-deleteLineWithoutRedraw:lineNr
- "delete line - no redraw;
- return true, if something was really deleted"
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- (list isNil or:[lineNr > list size]) ifTrue:[^ false].
- list removeIndex:lineNr.
- "/ TODO: remember old maxwidth of linerange,
- "/ only clear widthOfWidestLine, if this max
- "/ length was (one of) the longest.
- "/ avoids slow delete with huge texts.
- widthOfWidestLine := nil. "/ i.e. unknown
- self textChanged.
- ^ true
-
- "Modified: / 10.11.1998 / 23:53:24 / cg"
-!
-
-insert:aCharacter atLine:lineNr col:colNr
- "insert a single character at lineNr/colNr;
- set emphasis to character at current position"
-
- |line lineSize newLine drawCharacterOnly attribute oldClip x y|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- aCharacter == (Character cr) ifTrue:[
- self splitLine:lineNr before:colNr.
- ^ self
- ].
-
- drawCharacterOnly := false.
- self checkForExistingLine:lineNr.
- line := list at:lineNr.
- lineSize := line size.
-
- st80Mode ~~ true ifTrue:[
- (trimBlankLines
- and:[colNr > lineSize
- and:[aCharacter == Character space]]) ifTrue:[
- ^ self
- ]
- ].
-
- (lineSize == 0) ifTrue:[
- newLine := aCharacter asString species new:colNr.
- drawCharacterOnly := true
- ] ifFalse: [
- (colNr > lineSize) ifTrue: [
- colNr == (lineSize +1) ifTrue:[
- attribute := line emphasisAt:lineSize
- ].
- newLine := line species new:colNr.
- newLine replaceFrom:1 to:lineSize
- with:line startingAt:1.
- drawCharacterOnly := true
- ] ifFalse: [
- attribute := line emphasisAt:colNr.
- newLine := line species new:(lineSize + 1).
-
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:(colNr + 1) to:(lineSize + 1)
- with:line startingAt:colNr
- ]
- ].
-
- newLine at:colNr put:aCharacter.
-
- attribute notNil ifTrue:[
- newLine emphasisAt:colNr put:attribute
- ].
-
- aCharacter == (Character tab) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- drawCharacterOnly := false
- ].
-
- list at:lineNr put:newLine.
- widthOfWidestLine notNil ifTrue:[
- widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
- ].
- self textChanged.
- shown ifTrue:[
- "/ care for italic text - in this case, we must also
- "/ redraw the character before the insertion in order
- "/ to fix the slanted piece of the character.
- "/ (but we must clip, to avoid destoying the character before)
- (newLine notNil and:[newLine isText]) ifTrue:[
- colNr > 1 ifTrue:[
- oldClip := self clippingRectangleOrNil.
- x := (self xOfCol:colNr inVisibleLine:cursorVisibleLine) - leftOffset.
- y := self yOfVisibleLine:cursorVisibleLine.
- drawCharacterOnly ifTrue:[
- self clippingRectangle:(x@y extent:((font width * 2) @ fontHeight)).
- self redrawLine:lineNr from:colNr-1 to:colNr
- ] ifFalse:[
- self clippingRectangle:(x@y extent:((width - x) @ fontHeight)).
- self redrawLine:lineNr from:colNr-1
- ].
- self clippingRectangle:oldClip.
- ^ self.
- ].
- ].
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
- ]
-
- "Modified: / 20.6.1998 / 18:19:22 / cg"
-!
-
-insertLines:someText from:start to:end before:lineNr
- "insert a bunch of lines before line lineNr"
-
- |text indent visLine w nLines "{ Class: SmallInteger }"
- srcY "{ Class: SmallInteger }"
- dstY "{ Class: SmallInteger }" |
-
- self isReadOnly ifTrue:[
- ^ self
- ].
-
- autoIndent ifTrue:[
- indent := self leftIndentForLine:lineNr.
-
- text := someText collect:[:ln||line|
- ln notNil ifTrue:[
- line := ln withoutLeadingSeparators.
- (line isEmpty or:[indent == 0]) ifFalse:[
- line := (String new:indent), line
- ].
- line
- ] ifFalse:[
- nil
- ]
- ].
- ] ifFalse:[
- text := someText
- ].
-
- visLine := self listLineToVisibleLine:lineNr.
- (shown not or:[visLine isNil]) ifTrue:[
- self withoutRedrawInsertLines:text
- from:start to:end
- before:lineNr.
- ] ifFalse:[
- nLines := end - start + 1.
- ((visLine + nLines) >= nLinesShown) ifTrue:[
- self withoutRedrawInsertLines:text
- from:start to:end
- before:lineNr.
- self redrawFromVisibleLine:visLine to:nLinesShown
- ] ifFalse:[
- w := self widthForScrollBetween:(lineNr + nLines)
- and:(firstLineShown + nLines + nLinesShown).
- srcY := topMargin + ((visLine - 1) * fontHeight).
- dstY := srcY + (nLines * fontHeight).
-
- "/
- "/ scroll ...
- "/
- "
- stupid: must catchExpose before inserting new
- stuff - since catchExpose may perform redraws
- "
- self catchExpose.
- self withoutRedrawInsertLines:text
- from:start to:end
- before:lineNr.
- self
- copyFrom:self
- x:textStartLeft y:srcY
- toX:textStartLeft y:dstY
- width:w
- height:(height - dstY)
- async:true.
- self redrawFromVisibleLine:visLine to:(visLine + nLines - 1).
- self waitForExpose
- ].
- ].
- widthOfWidestLine notNil ifTrue:[
- text do:[:line |
- widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
- ]
- ].
- self textChanged.
-
- "Modified: 29.1.1997 / 13:02:39 / cg"
-!
-
-mergeLine:lineNr
- "merge line lineNr with line lineNr+1"
-
- self mergeLine:lineNr removeBlanks:true
-
- "Modified: 9.9.1997 / 09:28:03 / cg"
-!
-
-mergeLine:lineNr removeBlanks:removeBlanks
- "merge line lineNr with line lineNr+1"
-
- |leftPart rightPart bothParts nextLineNr i|
-
- (list notNil and:[(list size) > lineNr]) ifFalse:[
- ^ self
- ].
- leftPart := self listAt:lineNr.
-
- leftPart isNil ifTrue:[
- leftPart := ''.
- autoIndent ifTrue:[
- (i := self leftIndentForLine:cursorLine) == 0 ifFalse:[
- leftPart := String new:i
- ]
- ]
- ].
- self cursorLine:lineNr col:((leftPart size) + 1).
- nextLineNr := self validateCursorLine:(lineNr + 1).
-
- nextLineNr > (list size) ifFalse:[
- (rightPart := self listAt:nextLineNr) isNil ifTrue:[
- rightPart := ''
- ] ifFalse:[
- removeBlanks ifTrue:[
- rightPart := rightPart withoutLeadingSeparators.
- ]
- ].
-
- bothParts := leftPart , rightPart.
- (trimBlankLines and:[bothParts isBlank]) ifTrue:[bothParts := nil].
- list at:lineNr put:bothParts.
- self redrawLine:lineNr.
- self deleteLine:nextLineNr
- ]
-
- "Created: 9.9.1997 / 09:27:38 / cg"
- "Modified: 9.9.1997 / 09:28:27 / cg"
-!
-
-replace:aCharacter atLine:lineNr col:colNr
- "replace a single character at lineNr/colNr"
-
- |line lineSize newLine drawCharacterOnly|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- aCharacter == (Character cr) ifTrue:[
- ^ self
- ].
-
- drawCharacterOnly := true.
- self checkForExistingLine:lineNr.
- line := list at:lineNr.
- lineSize := line size.
-
- (trimBlankLines
- and:[colNr > lineSize
- and:[aCharacter == Character space]]) ifTrue:[
- ^ self
- ].
-
- (lineSize == 0) ifTrue:[
- newLine := aCharacter asString species new:colNr.
- ] ifFalse: [
- (colNr > lineSize) ifTrue: [
- newLine := line species new:colNr.
- newLine replaceFrom:1 to:lineSize with:line startingAt:1.
- ] ifFalse: [
- newLine := line copy.
- ]
- ].
- newLine at:colNr put:aCharacter.
- aCharacter == (Character tab) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- drawCharacterOnly := false
- ].
- list at:lineNr put:newLine.
- widthOfWidestLine notNil ifTrue:[
- widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
- ].
- self textChanged.
- shown ifTrue:[
- drawCharacterOnly ifTrue:[
- self redrawLine:lineNr col:colNr
- ] ifFalse:[
- self redrawLine:lineNr from:colNr
- ]
- ]
-
- "Created: / 6.3.1996 / 12:29:20 / cg"
- "Modified: / 10.6.1998 / 18:50:18 / cg"
-!
-
-replaceString:aString atLine:lineNr col:colNr
- "replace multiple characters starting at lineNr/colNr.
- This is not prepared to encounter special chars (except TAB)
- in the string."
-
- |line lineSize newLine endCol|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- self checkForExistingLine:lineNr.
- line := list at:lineNr.
- lineSize := line size.
-
- endCol := colNr + aString size - 1.
- (lineSize == 0) ifTrue:[
- newLine := aString species new:endCol.
- ] ifFalse: [
- (endCol > lineSize) ifTrue: [
- aString isText ifTrue:[
- newLine := aString species new:endCol.
- ] ifFalse:[
- newLine := line species new:endCol.
- ].
- newLine replaceFrom:1 to:lineSize with:line startingAt:1.
- ] ifFalse: [
- aString isText ifTrue:[
- newLine := aString species new:line size.
- newLine replaceFrom:1 to:lineSize with:line startingAt:1.
- ] ifFalse:[
- newLine := line copy.
- ]
- ]
- ].
- newLine replaceFrom:colNr with:aString.
- (aString includes:(Character tab)) ifTrue:[
- newLine := self withTabsExpanded:newLine.
- ].
- list at:lineNr put:newLine.
- widthOfWidestLine notNil ifTrue:[
- widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
- ].
- self textChanged.
- shown ifTrue:[
- self redrawLine:lineNr from:colNr
- ]
-
- "Created: / 11.6.1998 / 10:38:32 / cg"
- "Modified: / 20.6.1998 / 20:23:50 / cg"
-!
-
-splitLine:lineNr before:colNr
- "split the line linNr before colNr; the right part (from colNr)
- is cut off and inserted after lineNr; the view is redrawn"
-
- |line lineSize leftRest rightRest visLine w h mustWait
- srcY "{ Class: SmallInteger }" |
-
- list isNil ifFalse:[
- lineNr > (list size) ifFalse:[
- (colNr == 1) ifTrue:[
- self insertLine:nil before:lineNr.
- ^ self
- ].
- line := list at:lineNr.
- line isNil ifFalse:[
- lineSize := line size.
- (colNr <= lineSize) ifTrue:[
- rightRest := line copyFrom:colNr to:lineSize.
- (colNr > 1) ifTrue:[
- leftRest := line copyTo:(colNr - 1)
- ]
- ] ifFalse:[
- leftRest := line
- ]
- ].
- leftRest notNil ifTrue:[
- (trimBlankLines and:[leftRest isBlank]) ifTrue:[leftRest := nil]
- ].
- list at:lineNr put:leftRest.
- self withoutRedrawInsertLine:rightRest before:(lineNr + 1).
-
- visLine := self listLineToVisibleLine:(lineNr).
- visLine notNil ifTrue:[
- w := self widthForScrollBetween:lineNr
- and:(firstLineShown + nLinesShown).
- srcY := topMargin + (visLine * fontHeight).
- h := ((nLinesShown - visLine - 1) * fontHeight).
- (mustWait := (w > 0 and:[h > 0])) ifTrue:[
- self catchExpose.
- self
- copyFrom:self
- x:textStartLeft y:srcY
- toX:textStartLeft y:(srcY + fontHeight)
- width:w
- height:((nLinesShown - visLine - 1) * fontHeight)
- async:true.
- ].
- self redrawLine:lineNr.
- self redrawLine:(lineNr + 1).
- mustWait ifTrue:[self waitForExpose]
- ].
- widthOfWidestLine := nil. "/ unknown
- self textChanged.
- ]
- ]
-
- "Modified: 29.1.1997 / 13:03:22 / cg"
-!
-
-withoutRedrawInsertLine:aString before:lineNr
- "insert the argument, aString before line lineNr; the string
- becomes line nileNr; everything else is moved down; the view
- is not redrawn"
-
- |line|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- line := aString.
- line notNil ifTrue:[
- line isString ifTrue:[
- line isBlank ifTrue:[
- line := nil
- ] ifFalse:[
- (line includes:(Character tab)) ifTrue:[
- line := self withTabsExpanded:line
- ]
- ]
- ]
- ].
- list isNil ifTrue: [
- list := StringCollection new:lineNr
- ] ifFalse: [
- list grow:((list size + 1) max:lineNr)
- ].
-
- "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
- overlapping copy - if it didn't, we had to use:"
-"
- index := list size.
- [index > lineNr] whileTrue: [
- pIndex := index - 1.
- list at:index put:(list at:pIndex).
- index := pIndex
- ].
-"
- list replaceFrom:(lineNr + 1) to:(list size) with:list startingAt:lineNr.
- list at:lineNr put:line.
- self contentsChanged
-
- "Modified: / 10.6.1998 / 19:00:56 / cg"
-!
-
-withoutRedrawInsertLines:lines from:start to:end before:lineNr
- "insert a bunch of lines before line lineNr; the view is not redrawn"
-
- |newLine newLines nLines|
-
- self checkModificationsAllowed ifFalse:[ ^ self].
-
- nLines := end - start + 1.
- newLines := Array new:(lines size).
- start to:end do:[:index |
- newLine := lines at:index.
- newLine notNil ifTrue:[
- newLine isString ifTrue:[
- newLine isBlank ifTrue:[
- newLine := nil
- ] ifFalse:[
- (newLine includes:(Character tab)) ifTrue:[
- newLine := self withTabsExpanded:newLine
- ]
- ]
- ]
- ].
- newLines at:index put:newLine
- ].
- list isNil ifTrue: [
- list := StringCollection new:(lineNr + nLines + 1)
- ] ifFalse: [
- list grow:((list size + nLines) max:(lineNr + nLines - 1))
- ].
-
- "I have changed 'replaceFrom:to:with:startingAt:' to correctly handle
- overlapping copy - if it didn't, we had to use:"
-"
- index := list size.
- [index > lineNr] whileTrue: [
- pIndex := index - 1.
- list at:index put:(list at:pIndex).
- index := pIndex
- ].
-"
- list replaceFrom:(lineNr + nLines) to:(list size) with:list startingAt:lineNr.
- list replaceFrom:lineNr to:(lineNr + nLines - 1) with:newLines startingAt:start.
- self contentsChanged
-
- "Modified: / 10.6.1998 / 19:01:16 / cg"
-!
-
-withoutRedrawInsertStringWithoutCRs:aString atLine:lineNr col:colNr
- "insert aString (which has no crs) at lineNr/colNr"
-
- |isText strLen line lineSize newLine stringType sz|
-
- (aString notNil) ifFalse:[ ^ self].
-
- strLen := aString size.
- self checkForExistingLine:lineNr.
-
- stringType := aString string species.
- isText := aString isText.
- line := list at:lineNr.
-
- line notNil ifTrue:[
- lineSize := line size.
- line bitsPerCharacter > aString bitsPerCharacter ifTrue:[
- stringType := line string species
- ].
- line isText ifTrue:[ isText := true ]
-
- ] ifFalse:[
- lineSize := 0
- ].
-
- ((colNr == 1) and:[lineSize == 0]) ifTrue: [
- newLine := aString
- ] ifFalse:[
- (lineSize == 0 or:[colNr > lineSize]) ifTrue: [
- sz := colNr + strLen - 1
- ] ifFalse:[
- sz := lineSize + strLen
- ].
-
- isText ifFalse:[
- newLine := stringType new:sz
- ] ifTrue:[
- newLine := Text string:(stringType new:sz)
- ].
-
- (lineSize ~~ 0) ifTrue: [
- (colNr > lineSize) ifTrue: [
- newLine replaceFrom:1 to:lineSize
- with:line startingAt:1
- ] ifFalse: [
- newLine replaceFrom:1 to:(colNr - 1)
- with:line startingAt:1.
- newLine replaceFrom:(colNr + strLen) to:(lineSize + strLen)
- with:line startingAt:colNr
- ]
- ].
- newLine replaceFrom:colNr to:(colNr + strLen - 1)
- with:aString startingAt:1
- ].
-
- (aString includes:(Character tab)) ifTrue:[
- newLine := self withTabsExpanded:newLine
- ].
-
- list at:lineNr put:newLine.
- widthOfWidestLine notNil ifTrue:[
- widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:newLine).
- ].
- self textChanged.
-
- "Modified: / 10.6.1998 / 19:01:52 / cg"
-! !
-
-!EditTextView methodsFor:'event processing'!
-
-buttonPress:button x:x y:y
- "hide the cursor when button is activated"
-
- hasKeyboardFocus := true.
- cursorShown ifTrue: [
- self drawCursor
- ].
-
- ((button == 1) or:[button == #select]) ifTrue:[
- self hideCursor
- ].
- (button == #paste) ifTrue:[
- self pasteOrReplace.
- ^ self
- ].
- super buttonPress:button x:x y:y
-
- "Modified: / 23.3.1999 / 13:51:40 / cg"
-!
-
-buttonRelease:button x:x y:y
- "move the cursor to the click-position of previous button press"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- typeOfSelection := nil.
- selectionStartLine isNil ifTrue:[
- clickCol notNil ifTrue:[
- self cursorMovementAllowed ifTrue:[
- self cursorLine:clickLine col:clickCol
- ]
- ]
- ] ifFalse:[
- lastString := nil. "new selection invalidates remembered string"
- ].
- self showCursor
- ].
- super buttonRelease:button x:x y:y
-
- "Modified: / 18.6.1998 / 14:14:05 / cg"
-!
-
-keyPress:key x:x y:y
- "handle keyboard input"
-
- <resource: #keyboard (#Paste #Insert #Cut #Again #Replace #Accept
- #Delete #BasicDelete #BackSpace #BasicBackspace
- #SelectWord
- #SearchMatchingParent #SelectMatchingParents
- #SelectToEnd #SelectFromBeginning
- #BeginOfLine #EndOfLine #NextWord #PreviousWord
- #CursorRight #CursorDown #CursorLeft #CursorUp
- #Return #Tab #Escape
- #GotoLine #Delete #BeginOfText #EndOfText
- #SelectLine #ExpandSelectionByLine #DeleteLine
- #InsertLine
- #SelectLineFromBeginning
- #'F*' #'f*')>
-
- |sensor n fKeyMacros shifted i|
-
- sensor := self sensor.
- shifted := (sensor ? device) shiftDown.
-
- (key isMemberOf:Character) ifTrue:[
- self isReadOnly ifTrue:[
- self flash
- ] ifFalse:[
- typeOfSelection == #paste ifTrue:[
- "pasted selection will NOT be replaced by keystroke"
- self unselect
- ].
-
- "replace selection by what is typed in -
- if word was selected with a space, keep it"
-
- (selectStyle == #wordLeft) ifTrue:[
- self replaceSelectionBy:(' ' copyWith:key)
- ] ifFalse:[
- (selectStyle == #wordRight) ifTrue:[
- self replaceSelectionBy:(key asString , ' ').
- self cursorLeft
- ] ifFalse:[
- self replaceSelectionBy:key
- ]
- ].
- selectStyle := nil.
-
- showMatchingParenthesis ifTrue:[
- "emacs style parenthesis shower"
-
- "claus: only do it for closing parenthesis -
- otherwise its too anoying.
- "
-"
- (#( $( $) $[ $] ${ $} ) includes:key) ifTrue:[
-"
- (#( $) $] $} ) includes:key) ifTrue:[
- self searchForMatchingParenthesisFromLine:cursorLine col:(cursorCol - 1)
- ifFound:[:line :col |
- |savLine savCol|
-
- self withCursor:Cursor eye do:[
- savLine := cursorLine.
- savCol := cursorCol.
- self cursorLine:line col:col.
- device flush.
- "/ want to wait 200ms, but not if another keyPress
- "/ arrives in the meantime ...
- "/
- 5 timesRepeat:[
- (sensor notNil and:[sensor hasKeyPressEventFor:self]) ifFalse:[
- Processor activeProcess millisecondDelay:40.
- ]
- ].
- self cursorLine:savLine col:savCol
- ]
- ]
- ifNotFound:[self showNotFound]
- onError:[self beep]
- ].
- ].
- ].
- ^ self
- ].
-
- replacing := false.
-
- "
- Fn pastes a key-sequence (but only if not overlayed with
- another function in the keyboard map)
-
- see TextView>>:x:y
- "
- (key at:1) asLowercase == $f ifTrue:[
- (('[fF][0-9]' match:key)
- or:['[fF][0-9][0-9]' match:key]) ifTrue:[
- shifted ifFalse:[
- fKeyMacros := UserPreferences current functionKeySequences.
- fKeyMacros notNil ifTrue:[
- (fKeyMacros includesKey:key) ifTrue:[
- self pasteOrReplace:(fKeyMacros at:key) asStringCollection.
- ^ self
- ]
- ]
- ]
- ].
- ].
-
- (key == #Accept) ifTrue:[^ self accept].
-
- ((key == #Paste) or:[key == #Insert]) ifTrue:[self pasteOrReplace. ^self].
- (key == #Cut) ifTrue:[self cut. ^self].
- (key == #Again) ifTrue:[self again. ^self].
-
- (key == #Replace) ifTrue:[self replace. ^self].
- (key == #SelectWord) ifTrue:[
- self makeCursorVisible.
- ^ self selectWordUnderCursor.
- ].
-
- (key == #SearchMatchingParent) ifTrue:[^ self searchForMatchingParenthesis.].
- (key == #SelectMatchingParents) ifTrue:[^ self searchForAndSelectMatchingParenthesis.].
- (key == #SelectToEnd) ifTrue:[^ self selectUpToEnd.].
- (key == #SelectFromBeginning) ifTrue:[^ self selectFromBeginning.].
-
-" disabled - nobody liked it ...
- and if you like it, its better done in the keymap.
-
- (key == #Ctrlb) ifTrue:[self unselect. self cursorLeft. ^ self].
- (key == #Ctrlf) ifTrue:[self unselect. self cursorRight. ^ self].
- (key == #Ctrln) ifTrue:[self unselect. self cursorDown. ^ self].
- (key == #Ctrlp) ifTrue:[self unselect. self cursorUp. ^ self].
-"
-
- (key == #BeginOfLine) ifTrue:[
- self unselect.
- shifted ifTrue:[
- self cursorHome
- ] ifFalse:[
- self cursorToBeginOfLine.
- ].
- ^ self
- ].
- (key == #EndOfLine) ifTrue:[
- self unselect.
- shifted ifTrue:[
- self cursorToBottom
- ] ifFalse:[
- self cursorToEndOfLine.
- ].
- ^ self
- ].
- (key == #NextWord) ifTrue:[self cursorToNextWord. ^self].
- (key == #PreviousWord) ifTrue:[self cursorToPreviousWord. ^self].
- (key == #GotoLine) ifTrue:[self gotoLine. ^self].
-
- (key == #CursorRight) ifTrue:[
- (shifted and:[selectionStartLine isNil]) ifTrue:[
- selectionStartLine := selectionEndLine := clickStartLine := cursorLine.
- selectionStartCol := selectionEndCol := clickStartCol := cursorCol.
- expandingTop := false.
- ^ self redrawLine:selectionStartLine.
- ].
-
- selectionStartLine notNil ifTrue:[
- self cursorMovementAllowed ifTrue:[
- "/
- "/ treat the whole selection as cursor
- "/
- cursorLine := selectionEndLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- selectionEndCol == 0 ifTrue:[
- selectionEndCol := 1.
- ].
- cursorCol := selectionEndCol.
- shifted ifTrue:[
- self expandSelectionRight.
- ^ self
- ].
- self unselect; makeCursorVisible.
- cursorCol == 1 ifTrue:[^ self].
- ].
- ].
- self cursorRight. ^self
- ].
- (key == #CursorDown) ifTrue:[
- (shifted and:[selectionStartLine isNil]) ifTrue:[
- selectionStartLine := clickStartLine := cursorLine. selectionEndLine := cursorLine + 1.
- selectionStartCol := clickStartCol := selectionEndCol := cursorCol.
- self redrawLine:selectionStartLine.
- expandingTop := false.
- ^ self redrawLine:selectionEndLine.
- ].
-
- selectionStartLine notNil ifTrue:[
- self cursorMovementAllowed ifTrue:[
- "/
- "/ treat the whole selection as cursor
- "/
- cursorLine := selectionEndLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- cursorCol := selectionStartCol.
- cursorCol == 0 ifTrue:[
- cursorCol := 1.
- cursorLine := cursorLine - 1.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- ].
- self makeCursorVisible.
-
- shifted ifTrue:[
- clickLine := cursorLine.
- clickCol := cursorCol.
- self expandSelectionDown.
- ^ self
- ].
- self unselect.
- ].
- ].
-
- sensor isNil ifTrue:[
- n := 1
- ] ifFalse:[
- n := 1 + (sensor compressKeyPressEventsWithKey:#CursorDown).
- ].
- self cursorDown:n.
- "/
- "/ flush keyboard to avoid runaway cursor
- "/
- sensor notNil ifTrue:[self sensor flushKeyboardFor:self].
- ^ self
- ].
- (key == #CursorLeft or:[key == #CursorUp]) ifTrue:[
- (shifted and:[selectionStartLine isNil]) ifTrue:[
- expandingTop := true.
- key == #CursorLeft ifTrue:[
- cursorCol > 1 ifTrue:[
- selectionStartLine := selectionEndLine := clickStartLine := cursorLine.
- selectionEndCol := clickStartCol := cursorCol-1.
- selectionStartCol := cursorCol-1.
- ^ self redrawLine:selectionStartLine.
- ]
- ] ifFalse:[
- cursorLine > 1 ifTrue:[
- selectionEndLine := clickStartLine := cursorLine.
- selectionEndCol := selectionStartCol := clickStartCol := cursorCol.
- selectionStartLine := cursorLine - 1.
- ^ self redrawFromLine:selectionStartLine to:cursorLine.
- ]
- ]
- ].
-
- selectionStartLine notNil ifTrue:[
- self cursorMovementAllowed ifTrue:[
- "/
- "/ treat the whole selection as cursor
- "/
- cursorLine := selectionStartLine.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- cursorCol := selectionStartCol.
- (key == #CursorLeft) ifTrue:[
- cursorCol := cursorCol+1. "/ compensate for followup crsr-left
- ].
- self makeCursorVisible.
-
- shifted ifTrue:[
- (key == #CursorUp) ifTrue:[
- clickLine := cursorLine.
- ^ self expandSelectionUp.
- ].
- ^ self expandSelectionLeft.
- ].
- self unselect.
- ].
- ].
- (key == #CursorLeft) ifTrue:[
- self cursorLeft. ^self
- ].
- (key == #CursorUp) ifTrue:[
- sensor isNil ifTrue:[
- n := 1
- ] ifFalse:[
- n := 1 + (sensor compressKeyPressEventsWithKey:#CursorUp).
- ].
- self cursorUp:n.
- "/
- "/ flush keyboard to avoid runaway cursor
- "/
- sensor notNil ifTrue:[sensor flushKeyboardFor:self].
- ^ self
- ].
- ].
-
- (key == #Return) ifTrue:[
- shifted ifTrue:[
- self unselect. self cursorReturn. ^self
- ].
- self isReadOnly ifTrue:[
- self unselect; makeCursorVisible.
- self cursorReturn
- ] ifFalse:[
- insertMode ifFalse:[
- self cursorReturn.
- autoIndent == true ifTrue:[
- i := self leftIndentForLine:(cursorLine + 1).
- self cursorCol:(i+1 max:1)
- ]
- ] ifTrue:[
- "/ old version just unselected ...
- "/ self unselect; makeCursorVisible.
-
- "/ new version deletes ...
- typeOfSelection == #paste ifTrue:[
- self unselect; makeCursorVisible.
- ] ifFalse:[
- self copyAndDeleteSelection.
- ].
- self insertCharAtCursor:(Character cr).
- autoIndent == true ifTrue:[
- i := self leftIndentForLine:cursorLine.
- self indentFromLine:cursorLine toLine:cursorLine.
- self cursorCol:(i+1 max:1)
- ].
- ].
- ].
- ^self
- ].
-
- (key == #Tab) ifTrue:[
- self tabMeansNextField ifTrue:[^ super keyPress:key x:x y:y].
-
- shifted ifTrue:[
- "
- the old version used shift-tab as backtab,
- however, backtab was seldom used.
- An alternative is to make it a non-inserting tab ...
- "
- "/ self unselect. self cursorBacktab.
- self unselect. self cursorTab.
- ^self
- ].
-
- "
- uncomment line below, if you like RAND/INed/MAXed editor behavior
- (where tab-key is only cursor positioning)
- this was the original behavior of the TAB key, but many people
- complained ....
- "
- insertMode ifFalse:[
- self unselect. self cursorTab. ^self
- ].
- self unselect. self insertTabAtCursor.
- ^self
- ].
-
- (key == #BackSpace
- or:[key == #BasicBackspace]) ifTrue:[
- selectionStartLine notNil ifTrue:[
- (key == #BasicBackspace) ifTrue:[
- ^ self deleteSelection.
- ] ifFalse:[
- ^ self copyAndDeleteSelection.
- ].
- ].
-
- self makeCursorVisible.
- self deleteCharBeforeCursor. ^self
- ].
-
- (key == #Delete
- or:[key == #BasicDelete]) ifTrue:[
- selectionStartLine notNil ifTrue:[
- (key == #BasicDelete) ifTrue:[
- ^ self deleteSelection.
- ] ifFalse:[
- ^ self copyAndDeleteSelection.
- ].
- ].
- self makeCursorVisible.
- self deleteCharAtCursor. ^self
- ].
-
- (key == #BeginOfText) ifTrue:[ "i.e. HOME"
- self unselect.
- cursorVisibleLine == 1 ifTrue:[
- self cursorHome.
- ] ifFalse:[
- self cursorToFirstVisibleLine
- ].
- ^ self
- ].
- (key == #EndOfText) ifTrue:[ "i.e. END"
- self unselect.
- cursorVisibleLine == nFullLinesShown ifTrue:[
- self cursorToBottom.
- ] ifFalse:[
- self cursorToLastVisibleLine
- ].
- ^self
- ].
- ((key == #Escape)
- or:[key == #SelectLineFromBeginning]) ifTrue:[
- self makeCursorVisible.
- self unselect. self selectCursorLineFromBeginning. ^ self
- ].
- (key == #SelectLine) ifTrue:[
- self makeCursorVisible.
- self unselect. self selectCursorLine. ^ self
- ].
- (key == #ExpandSelectionByLine) ifTrue:[
-"/ self makeCursorVisible.
- self selectExpandCursorLine. ^ self
- ].
- (key == #DeleteLine) ifTrue:[
- self makeCursorVisible.
- self unselect. self deleteCursorLine. ^self
- ].
- (key == #InsertLine) ifTrue:[
- self makeCursorVisible.
- self unselect. self insertLine:nil before:cursorLine. ^self
- ].
- super keyPress:key x:x y:y
-
- "Modified: / 6.2.1998 / 11:59:59 / stefan"
- "Modified: / 20.9.1998 / 17:55:11 / cg"
-!
-
-mapped
- "view was made visible"
-
- super mapped.
-"/ self makeCursorVisible.
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
-
- "Modified: 20.12.1996 / 14:15:56 / cg"
-!
-
-pointerEnter:state x:x y:y
- "mouse pointer entered - request the keyboard focus (sometimes)"
-
- self wantsFocusWithPointerEnter ifTrue:[
- self requestFocus.
- ].
-!
-
-sizeChanged:how
- "make certain, cursor is visible after the sizechange"
-
- |cv|
-
- cv := cursorVisibleLine.
- super sizeChanged:how.
- cv notNil ifTrue:[
- self makeLineVisible:cursorLine
- ]
-! !
-
-!EditTextView methodsFor:'focus handling'!
-
-hasKeyboardFocus:aBoolean
- "sent by the windowGroup, a delegate or myself to make me show a block cursor
- (otherwise, I would not know about this)"
-
- hasKeyboardFocus := aBoolean.
- (cursorShown
- and:[self enabled
- and:[readOnly not]]) ifTrue:[
- self drawCursor
- ].
-
- "Modified: / 23.3.1999 / 13:49:35 / cg"
-!
-
-showFocus:explicit
- "in addition to however my superclass thinks how a focusView is to be
- displayed, show the cursor when I got the focus"
-
- self showCursor.
- self hasKeyboardFocus:true.
- super showFocus:explicit
-
- "Modified: 11.12.1996 / 16:56:54 / cg"
-!
-
-wantsFocusWithPointerEnter
- "return true, if I want the focus when
- the mouse pointer enters"
-
- |pref|
-
- pref := UserPreferences current focusFollowsMouse.
- (pref ~~ false
- and:[(styleSheet at:#'editText.requestFocusOnPointerEnter' default:true)
- and:[self enabled
- and:[readOnly not]]]) ifTrue:[
- ^ true
- ].
-
- ^ false
-
-
-
-! !
-
-!EditTextView methodsFor:'formatting'!
-
-indent
- "indent selected line-range"
-
- |start end|
-
- selectionStartLine isNil ifTrue:[^ self].
- start := selectionStartLine.
- end := selectionEndLine.
- (selectionEndCol == 0) ifTrue:[
- end := end - 1
- ].
- self unselect.
- self indentFromLine:start toLine:end
-!
-
-indentFromLine:start toLine:end
- "indent a line-range - this is don by searching for the
- last non-empty line before start, and change the indent
- of the line based on that indent."
-
- |leftStart delta d line spaces|
-
- leftStart := self leftIndentForLine:start.
- (leftStart == 0) ifTrue:[^ self].
-
- delta := leftStart - (self leftIndentOfLine:start).
- (delta == 0) ifTrue:[^ self].
- (delta > 0) ifTrue:[
- spaces := String new:delta
- ].
- start to:end do:[:lineNr |
- line := self listAt:lineNr.
- line notNil ifTrue:[
- line isBlank ifTrue:[
- list at:lineNr put:nil
- ] ifFalse:[
- (delta > 0) ifTrue:[
- line := spaces , line.
- widthOfWidestLine notNil ifTrue:[
- widthOfWidestLine := widthOfWidestLine max:(self widthOfLineString:line).
- ]
- ] ifFalse:[
- "check if deletion is ok"
- d := delta negated + 1.
-
- line size > d ifTrue:[
- (line copyTo:(d - 1)) withoutSeparators isEmpty ifTrue:[
- line := line copyFrom:d
- ]
- ].
- widthOfWidestLine := nil
- ].
- list at:lineNr put:line.
- self textChanged.
- ]
- ]
- ].
- self redrawFromLine:start to:end
-
- "Modified: 5.3.1996 / 14:59:18 / cg"
-!
-
-leftIndentForLine:lineNr
- "find an appropriate indent for a line.
- this is done by searching for the last non-empty line before it
- and returning its indent."
-
- "SHOULD GO TO ListView"
-
- |line lnr indent|
-
- lnr := lineNr.
-
- [lnr ~~ 1] whileTrue:[
- lnr := lnr - 1.
- line := self listAt:lnr.
-
- line notNil ifTrue:[
- indent := line indexOfNonSeparatorStartingAt:1.
- indent ~~ 0 ifTrue:[
- ^ indent - 1
- ]
- ]
- ].
- ^ 0
-
- "Created: 5.3.1996 / 14:58:53 / cg"
-! !
-
-!EditTextView methodsFor:'initialization'!
-
-fetchDeviceResources
- "fetch device colors, to avoid reallocation at redraw time"
-
- super fetchDeviceResources.
-
- cursorFgColor notNil ifTrue:[cursorFgColor := cursorFgColor onDevice:device].
- cursorBgColor notNil ifTrue:[cursorBgColor := cursorBgColor onDevice:device].
- cursorNoFocusFgColor notNil ifTrue:[cursorNoFocusFgColor := cursorNoFocusFgColor onDevice:device].
-
- "Created: 14.1.1997 / 00:15:24 / cg"
- "Modified: 18.2.1997 / 15:02:46 / cg"
-!
-
-initEvents
- "enable enter/leave events in addition"
-
- super initEvents.
- self enableEnterLeaveEvents
-!
-
-initStyle
- "initialize style specific stuff"
-
- super initStyle.
- lockUpdates := false.
-
- cursorFgColor := DefaultCursorForegroundColor.
- cursorFgColor isNil ifTrue:[cursorFgColor := bgColor].
- cursorBgColor := DefaultCursorBackgroundColor.
- cursorBgColor isNil ifTrue:[cursorBgColor := fgColor].
- cursorType := cursorTypeNoFocus := DefaultCursorType.
- DefaultCursorTypeNoFocus notNil ifTrue:[
- cursorTypeNoFocus := DefaultCursorTypeNoFocus.
- ].
- cursorNoFocusFgColor := DefaultCursorNoFocusForegroundColor.
- cursorNoFocusFgColor isNil ifTrue:[
- cursorType ~~ #block ifTrue:[
- cursorNoFocusFgColor := cursorBgColor
- ] ifFalse:[
- cursorNoFocusFgColor := cursorFgColor
- ]
- ].
-
- "Modified: / 20.5.1998 / 04:26:31 / cg"
-!
-
-initialize
- "initialize a new EditTextView;
- setup some instance variables"
-
- super initialize.
-
- self level:-1.
- readOnly := false.
- fixedSize := false.
- exceptionBlock := [:errorText | ].
- cursorShown := prevCursorState := true.
- cursorLine := 1.
- cursorVisibleLine := 1.
- cursorCol := 1.
- modifiedChannel := ValueHolder newBoolean.
- acceptChannel := ValueHolder newBoolean.
- acceptChannel addDependent:self.
- showMatchingParenthesis := false.
- hasKeyboardFocus := false. "/ true.
- tabMeansNextField := false.
- autoIndent := false.
- insertMode := true.
- st80Mode := ST80Mode.
- trimBlankLines := st80Mode not. "true."
-
- "Modified: / 20.6.1998 / 18:19:17 / cg"
-! !
-
-!EditTextView methodsFor:'menu actions'!
-
-cut
- "cut selection into copybuffer"
-
- |line col history sel s|
-
- (self checkModificationsAllowed) ifFalse:[
- self flash.
- ^ self
- ].
-
- sel := self selection.
- sel notNil ifTrue:[
- lastString := s := sel asStringWithCRs.
- line := selectionStartLine.
- col := selectionStartCol.
- undoAction := [ self cursorLine:line col:col.
- self insertLines:(Array with:s) withCR:false.
- ].
-
- "
- remember in CopyBuffer
- "
- self setTextSelection:lastString.
-
- "
- append to DeleteHistory (if there is one)
- "
- history := Smalltalk at:#DeleteHistory.
- history notNil ifTrue:[
- history addAll:(lastString asStringCollection).
- history size > 1000 ifTrue:[
- history := history copyFrom:(history size - 1000)
- ].
- ].
-
- "
- now, delete it
- "
- self deleteSelection.
- lastReplacement := nil
- ] ifFalse:[
- "
- a cut without selection will search&cut again
- "
- self again
- ]
-
- "Modified: / 5.4.1998 / 16:51:53 / cg"
-!
-
-defaultForGotoLine
- "return a default value to show in the gotoLine box"
-
- cursorLine notNil ifTrue:[
- ^ cursorLine
- ].
- ^ super defaultForGotoLine
-!
-
-editMenu
- "return the views middleButtonMenu"
-
- <resource: #keyboard (#Again #Copy #Cut #Paste #Accept #Find #GotoLine #SaveAs #Print)>
- <resource: #programMenu>
-
- |items m sub sensor|
-
- ((sensor := self sensor) notNil and:[sensor ctrlDown]) ifTrue:[
- items := #(
- ('again (for all)' multipleAgain)
- ).
- ] ifFalse:[
- items := #(
-"/ ('undo' undo )
- ('again' again Again )
- ('-' )
- ('copy' copySelection Copy )
- ('cut' cut Cut )
- ('paste' pasteOrReplace Paste )
- ('-' )
- ('accept' accept Accept )
- ('=' )
- ('others' others )
- ).
- ].
-
- m := PopUpMenu itemList:items resources:resources.
-
- items := #(
- ('search ...' search Find )
- ('goto ...' gotoLine GotoLine )
- ('-' )
- ('font ...' changeFont )
- ('-' )
- ('indent' indent )
- ('autoIndent \c' autoIndent: )
- ('insertMode \c' insertMode: )
- ('-' )
- ('save as ...' save SaveAs )
- ('print' doPrint Print )
- ).
-
- sub := PopUpMenu itemList:items resources:resources performer:model.
-
- m subMenuAt:#others put:sub.
- sub checkToggleAt:#autoIndent: put:autoIndent.
- sub checkToggleAt:#insertMode: put:insertMode.
-
- self isReadOnly ifTrue:[
- m disableAll:#(paste pasteOrReplace cut indent autoIndent: insertMode:)
- ].
- self hasSelection not ifTrue:[
- m disable:#copySelection.
- ].
- (self hasSelection not or:[self isReadOnly]) ifTrue:[
- m disable:#cut.
- ].
- (undoAction isNil) ifTrue:[
- m disable:#undo.
- ].
- acceptEnabled == false ifTrue:[
- m disable:#accept
- ].
- ^ m.
-
- "Modified: / 21.5.1998 / 15:52:38 / cg"
-!
-
-paste
- "paste the copybuffer; if there is a selection, unselect first.
- Then paste at cursor position."
-
- |sel|
-
- self checkModificationsAllowed ifFalse:[
- self flash.
- ^ self
- ].
-
- sel := self getTextSelection.
- self unselect.
- sel notNil ifTrue:[
- self paste:sel.
- ]
-
- "Modified: / 5.4.1998 / 16:55:02 / cg"
-!
-
-paste:someText
- "paste someText at cursor"
-
- |s nLines startLine startCol l1 l2 c1 c2|
-
- self checkModificationsAllowed ifFalse:[^ self].
-
- someText notNil ifTrue:[
- s := someText.
- s isString ifTrue:[
- s := s asStringCollection
- ] ifFalse:[
- (s isStringCollection) ifFalse:[
- self warn:'selection (' , s class name , ') is not convertable to Text'.
- ^ self
- ]
- ].
- (nLines := s size) == 0 ifTrue:[^ self].
- (nLines == 1 and:[(s at:1) size == 0]) ifTrue:[^ self].
-
- startLine := l1 := cursorLine.
- startCol := c1 := cursorCol.
- self insertLines:(s withTabsExpanded) withCR:false.
- l2 := cursorLine.
- c2 := (cursorCol - 1).
- self selectFromLine:l1 col:c1 toLine:l2 col:c2.
- typeOfSelection := #paste.
- undoAction := [ self unselect.
- self deleteFromLine:l1 col:c1 toLine:l2 col:c2.
- self cursorLine:l1 col:c1.
- ].
- ]
-
- "Modified: / 14.2.1996 / 11:14:14 / stefan"
- "Modified: / 12.6.1998 / 22:12:00 / cg"
-!
-
-pasteOrReplace
- "paste the copybuffer; if there is a selection, replace it.
- otherwise paste at cursor position. Replace is not done
- for originating by a paste, to allow multiple
- paste."
-
- |sel|
-
- self checkModificationsAllowed ifFalse:[
- self flash.
- ^ self
- ].
-
- sel := self getTextSelection.
- self pasteOrReplace:sel.
-
- "Modified: / 5.4.1998 / 16:55:16 / cg"
-!
-
-pasteOrReplace:someText
- "paste someText; if there is a selection, replace it.
- otherwise paste at cursor position. Replace is not done
- for originating by a paste, to allow multiple
- paste."
-
- self checkModificationsAllowed ifFalse:[^ self].
-
- ((self hasSelection == true) and:[typeOfSelection ~~ #paste]) ifTrue:[
- ^ self replace:someText
- ].
- self paste:someText.
-
- "Modified: / 5.4.1998 / 16:55:21 / cg"
-!
-
-replace
- "replace the selection by the contents of the copybuffer"
-
- |sel|
-
- self checkModificationsAllowed ifFalse:[^ self].
-
- sel := self getTextSelection.
- sel notNil ifTrue:[
- self replace:sel
- ]
-
- "Modified: / 5.4.1998 / 16:55:24 / cg"
-!
-
-replace:someText
- "replace the selection by someText"
-
- |selected selectedString|
-
- self checkModificationsAllowed ifFalse:[^ self].
-
- selected := self selection.
- selected isNil ifTrue:[
- ^ self paste:someText
- ].
- self deleteSelection.
-
- "take care, if we replace a selection without space by a word selected
- with one - in this case we usually do not want the space.
- But, if we replace a word-selected selection by something without a
- space, we DO want the space added."
-
- selected size == 1 ifTrue:[
- selectedString := selected at:1.
- ].
-
- someText size == 1 ifTrue:[
- |cutOffSpace addSpace replacement replacementString|
-
- cutOffSpace := false.
- addSpace := false.
- replacement := someText copy.
-
- selectedString notNil ifTrue:[
- ((selectedString startsWith:' ') or:[selectedString endsWith:' ']) ifFalse:[
- "selection has no space"
-
- ((selectStyle == #wordleft) or:[selectStyle == #wordRight]) ifTrue:[
- cutOffSpace := true
- ]
- ] ifTrue:[
- addSpace := true
- ]
- ].
- replacementString := replacement at:1.
- cutOffSpace ifTrue:[
- (replacementString startsWith:' ') ifTrue:[
- replacementString := replacementString withoutSpaces
- ].
- ] ifFalse:[
- selectStyle == #wordLeft ifTrue:[
- "want a space at left"
- (replacementString startsWith:' ') ifFalse:[
- replacementString := replacementString withoutSpaces.
- replacementString := ' ' , replacementString
- ]
- ].
- selectStyle == #wordRight ifTrue:[
- "want a space at right"
-
- (replacementString endsWith:' ') ifFalse:[
- replacementString := replacementString withoutSpaces.
- replacementString := replacementString , ' '
- ]
- ].
- ].
- replacement at:1 put: replacementString.
- self paste:replacement.
- ] ifFalse:[
- self paste:someText
- ].
- lastString := selectedString.
- lastReplacement := someText
-
- "Modified: / 14.2.1996 / 10:37:02 / stefan"
- "Modified: / 5.4.1998 / 16:55:28 / cg"
-!
-
-showDeleted
- "open a readonly editor on all deleted text"
-
- |v|
-
- v := EditTextView openWith:(Smalltalk at:#DeleteHistory).
- v readOnly:true.
- v topView label:'deleted text'.
-! !
-
-!EditTextView methodsFor:'private'!
-
-checkModificationsAllowed
- "check if the text can be modified (i.e. is not readOnly).
- evaluate the exceptionBlock if not.
- This block should be provided by the application or user of the textView,
- and may show a warnBox or whatever."
-
- self isReadOnly ifTrue: [
- exceptionBlock isNil ifTrue:[
- ^ false
- ].
-
- (exceptionBlock value:'Text may not be modified') ~~ true ifTrue:[
- ^ false
- ]
- ].
- ^ true
-
- "Modified: / 17.6.1998 / 15:51:10 / cg"
-!
-
-textChanged
- "my text was modified (internally).
- Sent whenever text has been edited (not to confuse with
- contentsChanged, which is triggered when the size has changed, and
- is used to notify scrollers, other views etc.)"
-
- self contentsChanged.
- self modified:true.
- contentsWasSaved := false
-
- "Modified: 14.2.1997 / 16:58:38 / cg"
-! !
-
-!EditTextView methodsFor:'queries'!
-
-currentLine
- "the current line (for relative gotos)"
-
- ^ cursorLine
-
- "Created: / 17.5.1998 / 20:07:52 / cg"
-!
-
-isKeyboardConsumer
- "return true, if the receiver is a keyboard consumer;
- Return true here, redefined from SimpleView."
-
- ^ true
-
-!
-
-specClass
- "redefined, since the name of my specClass is nonStandard (i.e. not EditTextSpec)"
-
- self class == EditTextView ifTrue:[^ TextEditorSpec].
- ^ super specClass
-
- "Modified: / 31.10.1997 / 19:48:19 / cg"
-!
-
-tabMeansNextField
- "return true, if a Tab character should shift focus."
-
- "if not readOnly, I want my tab keys ..."
-
- ^ self isReadOnly or:[tabMeansNextField]
-
- "Created: 7.2.1996 / 19:15:31 / cg"
-!
-
-widthOfContents
- "return the width of the contents in pixels
- Redefined to add the size of a space (for the cursor).
- this enables us to scroll one position further than the longest
- line (and possibly see the cursor behind the line)"
-
- |w dev|
-
- w := super widthOfContents.
- (dev := device) isNil ifTrue:[
- "/ really dont know ...
- dev := Screen current
- ].
- ^ w + (font widthOn:dev)
-
- "Modified: 28.5.1996 / 19:32:25 / cg"
-! !
-
-!EditTextView methodsFor:'realization'!
-
-realize
- "make the view visible - scroll to make the cursor visible."
-
- super realize.
-
- self makeCursorVisible.
- cursorFgColor := cursorFgColor onDevice:device.
- cursorBgColor := cursorBgColor onDevice:device.
-
- "Modified: 20.12.1996 / 14:16:05 / cg"
- "Created: 24.7.1997 / 18:24:12 / cg"
-! !
-
-!EditTextView methodsFor:'redrawing'!
-
-redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
- "redraw the cursor, if it sits in a line range"
-
- cursorShown ifTrue:[
- cursorVisibleLine notNil ifTrue:[
- (cursorVisibleLine between:startVisLine and:endVisLine) ifTrue:[
- self drawCursorCharacter
- ]
- ]
- ]
-!
-
-redrawCursorIfInVisibleLine:visLine
- "redraw the cursor, if it sits in visible line"
-
- cursorShown ifTrue:[
- (visLine == cursorVisibleLine) ifTrue:[
- self drawCursorCharacter
- ]
- ]
-!
-
-redrawFromVisibleLine:startVisLine to:endVisLine
- "redraw a visible line range"
-
- super redrawFromVisibleLine:startVisLine to:endVisLine.
- self redrawCursorIfBetweenVisibleLine:startVisLine and:endVisLine
-!
-
-redrawVisibleLine:visLine
- "redraw a visible line"
-
- super redrawVisibleLine:visLine.
- self redrawCursorIfInVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine col:colNr
- "redraw the single character in visibleline at colNr"
-
- cursorShown ifTrue:[
- (visLine == cursorVisibleLine) ifTrue:[
- (colNr == cursorCol) ifTrue:[
- self drawCursorCharacter.
- ^ self
- ]
- ]
- ].
- super redrawVisibleLine:visLine col:colNr
-!
-
-redrawVisibleLine:visLine from:startCol
- "redraw a visible line from startCol to the end of line"
-
- super redrawVisibleLine:visLine from:startCol.
- self redrawCursorIfInVisibleLine:visLine
-!
-
-redrawVisibleLine:visLine from:startCol to:endCol
- "redraw a visible line from startCol to endCol"
-
- super redrawVisibleLine:visLine from:startCol to:endCol.
- self redrawCursorIfInVisibleLine:visLine
-! !
-
-!EditTextView methodsFor:'scrolling'!
-
-halfPageDown
- "half a page down - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super halfPageDown.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-!
-
-halfPageUp
- "half a page up - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super halfPageUp.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-!
-
-originChanged:delta
- "sent after scrolling - have to show the cursor if it was on before"
-
- super originChanged:delta.
- "
- should we move the cursor with the scroll - or leave it ?
- "
- cursorVisibleLine := self listLineToVisibleLine:cursorLine.
- prevCursorState ifTrue:[
- self showCursor
- ]
-
- "Modified: / 17.6.1998 / 16:13:24 / cg"
-!
-
-originWillChange
- "sent before scrolling - have to hide the cursor"
-
- prevCursorState := cursorShown.
- "/ cursorShown := false.
- cursorShown ifTrue:[
- self hideCursor
- ]
-
- "Modified: / 6.7.1998 / 13:07:23 / cg"
-!
-
-pageDown
- "page down - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super pageDown.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-!
-
-pageUp
- "page up - to keep cursor on same visible line, it has to be moved
- within the real text "
-
- |prevCursorLine|
-
- prevCursorLine := cursorVisibleLine.
- super pageUp.
- self cursorVisibleLine:prevCursorLine col:cursorCol
-! !
-
-!EditTextView methodsFor:'searching'!
-
-searchBwd:pattern ifAbsent:aBlock
- "do a backward search"
-
- |startLine startCol|
-
- cursorLine isNil ifTrue:[^ self].
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol
- ] ifFalse:[
- startLine := cursorLine min:list size.
- startCol := cursorCol
- ].
- self
- searchBackwardFor:pattern
- startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self showMatch:pattern atLine:line col:col.
-"/ self makeLineVisible:cursorLine
- typeOfSelection := #search]
- ifAbsent:aBlock
-
- "Modified: 9.10.1997 / 13:02:04 / cg"
-!
-
-searchBwd:pattern ignoreCase:ign ifAbsent:aBlock
- "do a backward search"
-
- |startLine startCol|
-
- cursorLine isNil ifTrue:[^ self].
- selectionStartLine notNil ifTrue:[
- startLine := selectionStartLine.
- startCol := selectionStartCol
- ] ifFalse:[
- startLine := cursorLine min:list size.
- startCol := cursorCol
- ].
- self
- searchBackwardFor:pattern
- ignoreCase:ign
- startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self showMatch:pattern atLine:line col:col.
-"/ self makeLineVisible:cursorLine
- typeOfSelection := #search]
- ifAbsent:aBlock
-
- "Modified: 9.10.1997 / 13:02:13 / cg"
-!
-
-searchForAndSelectMatchingParenthesis
- "select characters enclosed by matching parenthesis if one is under cusor"
-
- self
- searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
- ifFound:[:line :col |
- self selectFromLine:cursorLine col:cursorCol
- toLine:line col:col]
- ifNotFound:[self showNotFound]
- onError:[self beep]
-
- "Modified: 9.10.1997 / 12:57:34 / cg"
-!
-
-searchForMatchingParenthesis
- "search for a matching parenthesis starting at cursor position.
- Search for the corresponding character is done forward if its an opening,
- backwards if its a closing parenthesis.
- Positions the cursor if found, peeps if not"
-
- self
- searchForMatchingParenthesisFromLine:cursorLine col:cursorCol
- ifFound:[:line :col | self cursorLine:line col:col]
- ifNotFound:[self showNotFound]
- onError:[self beep]
-
- "Modified: 9.10.1997 / 12:56:30 / cg"
-!
-
-searchFwd:pattern ifAbsent:aBlock
- "do a forward search"
-
- |startCol|
-
- "/ if there is no selection and the cursor is at the origin,
- "/ assume its the first search and do not skip the very first match
- startCol := cursorCol.
- self hasSelection ifFalse:[
- (cursorLine == 1 and:[cursorCol == 1]) ifTrue:[
- startCol := 0
- ]
- ].
-
- self
- searchFwd:pattern
- startingAtLine:cursorLine col:startCol
- ifAbsent:aBlock
-
- "Modified: 9.10.1997 / 12:58:59 / cg"
-!
-
-searchFwd:pattern ignoreCase:ign ifAbsent:aBlock
- "do a forward search"
-
- |startCol|
-
- "/ if there is no selection and the cursor is at the origin,
- "/ assume its the first search and do not skip the very first match
- startCol := cursorCol.
- self hasSelection ifFalse:[
- (cursorLine == 1 and:[cursorCol == 1]) ifTrue:[
- startCol := 0
- ]
- ].
-
- self
- searchFwd:pattern
- ignoreCase:ign
- startingAtLine:cursorLine col:startCol
- ifAbsent:aBlock
-
- "Modified: 9.10.1997 / 12:58:59 / cg"
- "Created: 9.10.1997 / 13:04:10 / cg"
-!
-
-searchFwd:pattern ignoreCase:ign startingAtLine:startLine col:startCol ifAbsent:aBlock
- "do a forward search"
-
- cursorLine isNil ifTrue:[^ self].
- self
- searchForwardFor:pattern
- ignoreCase:ign
- startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self showMatch:pattern atLine:line col:col.
-"/ self makeLineVisible:cursorLine
- typeOfSelection := #search]
- ifAbsent:aBlock
-
- "Modified: 9.10.1997 / 12:57:47 / cg"
- "Created: 9.10.1997 / 13:01:12 / cg"
-!
-
-searchFwd:pattern startingAtLine:startLine col:startCol ifAbsent:aBlock
- "do a forward search"
-
- self
- searchForwardFor:pattern
- startingAtLine:startLine col:startCol
- ifFound:[:line :col |
- self cursorLine:line col:col.
- self showMatch:pattern atLine:line col:col.
- typeOfSelection := #search]
- ifAbsent:aBlock
-
- "Modified: 9.10.1997 / 13:07:52 / cg"
-!
-
-setSearchPattern
- "set the searchpattern from the selection if there is one, and position
- cursor to start of pattern"
-
- |sel|
-
- "/
- "/ if the last operation was a replcae, set pattern to last
- "/ original string (for search after again)
- "/
- (lastString notNil
- and:[lastReplacement notNil
- and:[typeOfSelection ~~ #search]]) ifTrue:[
- lastSearchPattern := lastString asString withoutSeparators.
- ^ self
- ].
-
- "/
- "/ if there is a selection:
- "/ if there was no previous search, take it as search pattern.
- "/ if there was a previous search, only take the selection if
- "/ it did not result from a paste.
- "/ (to allow search-paste to be repeated)
- "/
- sel := self selection.
- sel notNil ifTrue:[
- (lastSearchPattern isNil
- or:[typeOfSelection ~~ #paste]) ifTrue:[
- self cursorLine:selectionStartLine col:selectionStartCol.
- lastSearchPattern := sel asString withoutSeparators
- ]
- ]
-
- "Modified: 20.4.1996 / 12:50:13 / cg"
-! !
-
-!EditTextView methodsFor:'selections'!
-
-autoMoveCursorToEndOfSelection
- "return true, if the cursor should be automatically moved to the
- end of a selection.
- Redefined to return false in terminaViews, where the cursor should
- not be affected by selecting"
-
- ^ true
-!
-
-selectAll
- "select the whole text.
- redefined to send super selectFrom... since we dont want the
- cursor to be moved in this case."
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- super selectFromLine:1 col:1 toLine:(list size + 1) col:0.
- typeOfSelection := nil
- ]
-
- "Modified: 28.2.1997 / 19:14:54 / cg"
-!
-
-selectCursorLine
- "select cursorline"
-
- self selectFromLine:cursorLine col:1 toLine:cursorLine+1 col:0
-!
-
-selectCursorLineFromBeginning
- "select cursorline up to cursor position"
-
- cursorCol > 1 ifTrue:[
- self selectFromLine:cursorLine col:1
- toLine:cursorLine col:(cursorCol-1)
- ]
-
- "Modified: 16.8.1996 / 19:14:14 / cg"
-!
-
-selectExpandCursorLine
- "expand selection by one line or select cursorline"
-
- selectionStartLine isNil ifTrue:[
- self selectCursorLine
- ] ifFalse:[
- self selectFromLine:selectionStartLine col:selectionStartCol
- toLine:cursorLine+1 col:0.
- self makeLineVisible:selectionEndLine
- ]
-!
-
-selectFromBeginning
- "select the text from the beginning to the current cursor position."
-
- |col|
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- cursorCol == 0 ifTrue:[
- col := 0
- ] ifFalse:[
- col := cursorCol - 1
- ].
- super selectFromLine:1 col:1 toLine:cursorLine col:col.
- typeOfSelection := nil
- ]
-!
-
-selectFromLine:startLine col:startCol toLine:endLine col:endCol
- "when a range is selected, position the cursor behind the selection
- for easier editing. Also typeOfSelection is nilled here."
-
- super selectFromLine:startLine col:startCol toLine:endLine col:endCol.
- (selectionEndLine notNil and:[self autoMoveCursorToEndOfSelection]) ifTrue:[
- self cursorLine:selectionEndLine col:(selectionEndCol + 1).
- ].
- typeOfSelection := nil
-!
-
-selectUpToEnd
- "select the text from the current cursor position to the end."
-
- list isNil ifTrue:[
- self unselect
- ] ifFalse:[
- super selectFromLine:cursorLine col:cursorCol toLine:(list size + 1) col:0.
- typeOfSelection := nil
- ]
-!
-
-selectWordUnderCursor
- "select the word under the cursor"
-
- self selectWordAtLine:cursorLine col:cursorCol
-!
-
-unselect
- "forget and unhilight selection - must take care of cursor here"
-
- |wasOn|
-
- wasOn := self hideCursor.
- super unselect.
- wasOn ifTrue:[self showCursor]
-! !
-
-!EditTextView methodsFor:'undo & again'!
-
-again
- "repeat the last action (which was a cut or replace).
- If current selection is not last string, search forward to
- next occurence of it before repeating the last operation."
-
- |s l c sel savedSelectStyle|
-
- lastString notNil ifTrue:[
- s := lastString asString.
-
- "remove final cr"
- s := s copyWithoutLast:1.
-"/ s := s withoutSpaces. "XXX - replacing text with spaces ..."
- savedSelectStyle := selectStyle.
- selectStyle := nil.
-
- sel := self selection.
-
- "if we are already there (after a find), ommit search"
-
- (sel notNil and:[sel asString withoutSeparators = s]) ifTrue:[
- undoAction := [self insertLines:lastString atLine:cursorLine col:cursorCol].
- l := selectionStartLine "cursorLine".
- c := selectionStartCol "cursorCol".
- self deleteSelection.
- lastReplacement notNil ifTrue:[
- self insertLines:lastReplacement asStringCollection withCR:false.
- self selectFromLine:l col:c toLine:cursorLine col:(cursorCol - 1).
- ].
- selectStyle := savedSelectStyle.
- ^ true
- ].
-
- self searchForwardFor:s startingAtLine:cursorLine col:cursorCol
- ifFound:
- [
- :line :col |
-
- |repl|
-
- self selectFromLine:line col:col
- toLine:line col:(col + s size - 1).
- self makeLineVisible:line.
- undoAction := [self insertLines:lastString atLine:line col:col].
-
- self deleteSelection.
- lastReplacement notNil ifTrue:[
- lastReplacement isString ifFalse:[
- repl := lastReplacement asString withoutSpaces
- ] ifTrue:[
- repl := lastReplacement withoutSpaces.
- ].
- self insertLines:repl asStringCollection withCR:false.
- self selectFromLine:line col:col toLine:cursorLine col:(cursorCol - 1).
- ].
- selectStyle := savedSelectStyle.
- ^ true
- ]
- ifAbsent:
- [
- self showNotFound.
- selectStyle := savedSelectStyle.
- ^ false
- ]
- ]
-
- "Modified: 9.10.1996 / 16:14:11 / cg"
-!
-
-multipleAgain
- "repeat the last action (which was a cut or replace) until search fails"
-
- [self again] whileTrue:[]
-!
-
-undo
- "currently not implemented"
-
- undoAction notNil ifTrue:[
- undoAction value.
- undoAction := nil.
- ]
-! !
-
-!EditTextView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ETxtView.st,v 1.212 1999-08-18 15:06:16 cg Exp $'
-! !
--- a/FSaveBox.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,107 +0,0 @@
-"
- 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.
-"
-
-FileSelectionBox subclass:#FileSaveBox
- instanceVariableNames:'appendButton appendAction'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-DialogBoxes'
-!
-
-!FileSaveBox 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.
-"
-!
-
-documentation
-"
- Instances of FileSaveBox add an 'append'-button, and an
- associated append-action.
- The other behavior is that of a FileSelectionBox.
-
- [Instance variables:]
- appendAction action to be performed when append is pressed
-
-
- [author:]
- Claus Gittinger
-
- [see also:]
- DialogBox
- EnterBox2 FilenameEnterBox YesNoBox
- ListSelectionBox FileSelectionBox
-"
-! !
-
-!FileSaveBox methodsFor:'accessing'!
-
-appendAction:aBlock
- "set the action to be performed when append is pressed"
-
- appendAction := aBlock
-! !
-
-!FileSaveBox methodsFor:'initialization'!
-
-initialize
- <resource: #style (#'dialogBox.okAtLeft')>
-
- super initialize.
-
- label := resources string:'Save file dialog'.
-
- okButton label:(resources string:'save').
-
- "
- insert an append-button between abort- and save-buttons
- "
- appendButton := Button okButton.
- appendButton isReturnButton:false.
- appendButton label:(resources string:'append').
- appendButton action:[appendButton turnOffWithoutRedraw. self appendPressed].
- (styleSheet at:'dialogBox.okAtLeft' default:false) ifTrue:[
- self addButton:appendButton after:okButton.
- ] ifFalse:[
- self addButton:appendButton before:okButton.
- ].
-! !
-
-!FileSaveBox methodsFor:'user interaction'!
-
-appendPressed
- "append was pressed - evaluate the append-action"
-
- self hideAndEvaluate:[:string |
- appendAction notNil ifTrue:[
- appendAction value:string
- ]
- ]
-
- "Modified: 12.5.1996 / 21:45:52 / cg"
-! !
-
-!FileSaveBox class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/FSaveBox.st,v 1.14 1999-03-06 03:03:50 cg Exp $'
-! !
--- a/FSelBox.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,648 +0,0 @@
-"
- 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.
-"
-
-ListSelectionBox subclass:#FileSelectionBox
- instanceVariableNames:'patternField selectingDirectory'
- classVariableNames:'LastFileSelectionDirectory'
- poolDictionaries:''
- category:'Views-DialogBoxes'
-!
-
-!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.
-"
-!
-
-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. It is also possible, to open the box
- without action and ask it afterward if it has been left with ok
- (i.e. the ST-80 way, asking 'aBox accepted ifTrue:[...]')
-
- 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 are shown in
- the list. Directories are not affected by the patternField.
-
- In addition, there is an optional matchBlock (actually this is defined
- in the FileSelectionList). Only names for which this matchblock
- returns true will be presented. The matchBlock affects both regular files
- and names of directories. The argument passed to the matchBlock is the full
- pathname.
-
- All of the actual work is done in the fileList; see the documentation
- of FileSelectionList for more options
- (you can access a boxes fileList via 'aBox>>listView' and get access to all
- of those fancy settings)
- For example, by accessing the list, it is possible to hide all directories
- ('aBox listView ignoreDirectories:true'), to hide the parentDirectory alone
- ('aBox listView ignoreParentDirectory') and to turn off the marking
- of subdirectories ('aBox listView markSubdirectories:false').
-
- [author:]
- Claus Gittinger
-
- [see also:]
- DialogBox
- EnterBox2 FilenameEnterBox YesNoBox
- ListSelectionBox FileSaveBox
- FileSelectionList SelectionInListView
-"
-!
-
-examples
-"
- simple standard queries
-
- very simple:
- [exBegin]
- |name|
-
- name := FileSelectionBox requestFileName.
- Transcript showCR:name
- [exEnd]
-
-
- simple:
- [exBegin]
- |name|
-
- name := FileSelectionBox requestFileName:'which file ?'.
- Transcript showCR:name
- [exEnd]
-
-
- with initial selection:
- [exBegin]
- |name|
-
- name := FileSelectionBox requestFileName:'which file ?' default:'Make.proto'.
- Transcript showCR:name
- [exEnd]
-
-
-
- more detailed setup
-
- setting title:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box open.
- box accepted ifTrue:[
- Transcript showCR:'you selected: ' , box pathName
- ]
- [exEnd]
-
- setting a matchpattern:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box pattern:'*.rc'.
- box open
- [exEnd]
-
- setting multiple patterns:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box pattern:'*.rc;*.st'.
- box open
- [exEnd]
-
- setting a matchblock:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box directory:'/etc'.
- box pattern:'*'.
- box matchBlock:[:name | name asFilename baseName first between:$a and:$z].
- box open
- [exEnd]
-
- both pattern and matchBlock:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which directory ?'.
- box selectingDirectory:true.
- box pattern:'l*'.
- box matchBlock:[:name | OperatingSystem isDirectory:name].
- box action:[:fn | Transcript showCR:fn].
- box open
- [exEnd]
-
- dont show the parent directory:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which directory ?'.
- box listView ignoreParentDirectory:true.
- box open
- [exEnd]
-
- dont show any directory:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box listView ignoreDirectories:true.
- box open
- [exEnd]
-
- dont show any directory or hidden file:
- (notice the basename extraction - we are not interested in the full pathName)
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box listView ignoreDirectories:true.
- box matchBlock:[:name | (name asFilename baseName startsWith:'.') not].
- box open
- [exEnd]
-
- dont allow direct filename entry:
- (i.e. avoid the user choosing files from other directories)
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which one ?'.
- box enterField beInvisible.
- box open.
- box accepted ifTrue:[
- Transcript showCR:'path is ' , box pathName
- ].
- [exEnd]
-
- combined with above directory ignoring,
- this limits selection of files from a single directory:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which file ?'.
- box enterField beInvisible.
- box listView ignoreDirectories:true.
- box open.
- box accepted ifTrue:[
- Transcript showCR:'path is ' , box pathName
- ].
- [exEnd]
-
- finally, an action:
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which directory ?'.
- box pattern:'l*'.
- box matchBlock:[:name | OperatingSystem isDirectory:name].
- box action:[:name | Transcript showCR:name].
- box open
- [exEnd]
-
- concrete examples:
-
- only show files beginning with lowercase characters
- and ending in '.c':
- [exBegin]
- |box|
- box := FileSelectionBox new.
- box title:'Which directory ?'.
- box matchBlock:[:name |
- box pathName asFilename isDirectory
- or:[name first isLowercase
- and:[name endsWith:'.c']]
- ].
- box open.
- box accepted ifTrue:[
- Transcript showCR:'full path: ' , box pathName.
- Transcript showCR:'files name: ' , box fileName.
- Transcript showCR:'directory : ' , box directory pathName.
- ]
- [exEnd]
-"
-! !
-
-!FileSelectionBox class methodsFor:'accessing'!
-
-lastFileSelectionDirectory
- "return the name of the directory used in the previous
- fileSelection dialog. This will be used as default for the next dialog,
- if no explicit path is specified (see requestFileName:* methods)"
-
- |f|
-
- LastFileSelectionDirectory notNil ifTrue:[
- ((f := LastFileSelectionDirectory asFilename) exists
- and:[f isDirectory]) ifFalse:[
- LastFileSelectionDirectory := nil.
- ]
- ].
- ^ LastFileSelectionDirectory
-
- "Created: / 9.9.1997 / 10:03:17 / cg"
- "Modified: / 16.6.1998 / 15:11:20 / cg"
-!
-
-lastFileSelectionDirectory:aDirectoryString
- "set the name of the directory used in the previous
- fileSelection dialog. This will be used as default for the next dialog,
- if no explicit path is specified (see requestFileName:* methods)"
-
- LastFileSelectionDirectory := aDirectoryString
-
- "Created: / 9.9.1997 / 10:03:42 / cg"
- "Modified: / 15.6.1998 / 14:05:21 / cg"
-! !
-
-!FileSelectionBox class methodsFor:'defaults'!
-
-listViewType
- "return the type of listView - using a FileSelectionList here"
-
- ^ FileSelectionList
-! !
-
-!FileSelectionBox methodsFor:'accessing'!
-
-contents
- "return the current entered value (i.e. the enterFields string).
- redefined to return the full pathname."
-
- |string|
-
- string := super contents.
- string isNil ifTrue:[
- ^ selectionList directory pathName
- ].
- (string asFilename isAbsolute) ifTrue:[
- ^ string
- ].
- ^ (selectionList directory pathName asFilename construct:string) asString
-
- "Modified: / 9.9.1998 / 21:23:16 / cg"
-!
-
-directory
- "return the directory which is currently shown"
-
- ^ selectionList directory
-!
-
-directory:directoryName
- "change the directory shown in the list."
-
- selectionList directory:directoryName
-!
-
-fileName
- "if some filename has been entered, return it (without the directory path)
- otherwise, return nil"
-
- |string|
-
- string := super contents.
- string isNil ifTrue:[^ nil].
- ^ self pathName asFilename baseName
-
- "Modified: / 12.8.1998 / 09:54:01 / cg"
-!
-
-matchBlock:aBlock
- "set the matchBlock (in the selectionList). Only files
- for which the block returns true are shown.
- The matching is actually done in the fileSelectionList."
-
- selectionList matchBlock:aBlock
-!
-
-openOn:aPath
- "open the box showing files in aPath.
- This is only a shortcut message - no new functionality."
-
- self directory:aPath.
- self showAtPointer
-!
-
-pathName
- "same as contents - return the full pathname of the selected file,
- or the pathname of the directory if nothing has been entered"
-
- ^ self contents
-!
-
-pattern:aPattern
- "set the pattern - this also enables the PatternField
- (if the pattern is non-nil) or hides it (if nil)."
-
- |focusSequence|
-
- patternField initialText:aPattern.
- selectionList pattern:aPattern.
- aPattern isNil ifTrue:[
- patternField beInvisible.
- self makeUntabable:patternField.
- focusSequence := (Array
- with:enterField
- with:selectionList
- with:okButton
- with:abortButton)
- ] ifFalse:[
- patternField beVisible.
- self makeTabable:patternField before:enterField.
- focusSequence := (Array
- with:patternField
- with:enterField
- with:selectionList
- with:okButton
- with:abortButton)
- ].
-
- windowGroup notNil ifTrue:[
- windowGroup focusSequence:focusSequence
- ].
-
- "Modified: 18.10.1997 / 03:02:05 / cg"
-!
-
-selectingDirectory:aBoolean
- "setup the box for directory selection (hides regular files).
- Use this, to ask the user for a directories name"
-
- selectingDirectory := aBoolean.
- aBoolean ifTrue:[
- selectionList directoryChangeAction:[:entry | self directoryChanged].
- selectionList directorySelectAction:[:entry | self directorySelected].
- selectionList ignoreFiles:true.
- ]
-
- "Modified: 22.10.1996 / 13:24:50 / cg"
-! !
-
-!FileSelectionBox methodsFor:'change & update'!
-
-update:something with:argument from:changedObject
- |commonName index s|
-
- something == #directory ifTrue:[
- "
- sent by fileNameEnterField, if a filename
- completion was not possible due to multiple
- matches.
- "
- selectionList directory:argument.
- s := enterField contents.
- s notNil ifTrue:[
- commonName := s asFilename baseName.
- commonName size > 0 ifTrue:[
- index := selectionList list findFirst:[:entry | entry startsWith:commonName].
- index ~~ 0 ifTrue:[
- selectionList makeLineVisible:index
- ]
- ]
- ]
- ]
-! !
-
-!FileSelectionBox methodsFor:'initialization'!
-
-createEnterField
- "if the (optional) class FilenameEditField is present, use
- it, since it provides filename completion. Otherwise, we have
- to live with the dumb (default) field ...
- "
- FilenameEditField notNil ifTrue:[
- ^ FilenameEditField new.
- ].
- ^ super createEnterField
-
- "Modified: 18.4.1996 / 20:02:24 / cg"
-!
-
-initialize
- |corner|
-
- super initialize.
- selectingDirectory := false.
-
- label := resources string:'File dialog'.
-
- labelField extent:(0.7 @ labelField height).
- labelField label:(resources string:'select a file:').
- labelField adjust:#left.
-
- patternField := EditField in:self.
- self is3D ifTrue:[
- corner := (1.0 @ (labelField origin y+patternField heightIncludingBorder)).
- ] ifFalse:[
- corner := [(width - ViewSpacing - (patternField borderWidth * 2)) @ (labelField origin y+patternField height"IncludingBorder")].
- ].
- patternField origin:(0.7 @ labelField origin y) corner:corner.
- patternField rightInset:ViewSpacing.
- patternField initialText:'*'.
- patternField leaveAction:[:reason | self patternChanged].
- patternField crAction:[self patternChanged].
- patternField hiddenOnRealize:true. "delay showing, until a pattern is defined"
-"/ no, since its invisible
-"/ self makeTabable:patternField before:enterField.
-
- enterField addDependent:self.
-
- "
- FileSelectionBox open
- FileSelectionBox new show
- "
-
- "Modified: 18.10.1997 / 02:47:49 / cg"
-!
-
-postRealize
- "if some default is present in the enterField,
- scroll to make this one visible"
-
- |contents|
-
- super postRealize.
- (contents := enterField contents) notNil ifTrue:[
- contents notEmpty ifTrue:[
- selectionList makeVisible:contents
- ]
- ]
-
- "Created: 24.7.1997 / 18:19:14 / cg"
-! !
-
-!FileSelectionBox methodsFor:'private'!
-
-updateList
- selectionList updateList
-! !
-
-!FileSelectionBox methodsFor:'queries'!
-
-preferredExtent
- "return my preferred extent - thats the minimum size
- to make everything visible"
-
- |wWanted hWanted mm|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- mm := ViewSpacing.
-
- wWanted := mm +
- labelField preferredExtent x +
- (mm * 2) +
- patternField preferredExtent x +
- mm.
- (wWanted < width) ifTrue:[
- wWanted := width
- ].
- hWanted := mm + labelField height +
- mm + enterField height +
- mm + selectionList height +
- mm + buttonPanel preferredExtent y +
- mm.
-
- (hWanted < height) ifTrue:[
- hWanted := height
- ].
- ^ (wWanted @ hWanted)
-
- "Modified: 19.7.1996 / 20:44:04 / cg"
-! !
-
-!FileSelectionBox methodsFor:'user actions'!
-
-directoryChanged
- selectingDirectory ifTrue:[
- selectionList changeDirectory.
- enterField contents:(selectionList directory pathName).
- selectionList setSelection:nil.
- ].
-
- "Created: 18.4.1996 / 18:38:21 / cg"
- "Modified: 25.5.1996 / 12:27:05 / cg"
-!
-
-directorySelected
- "a directory was selected - show the new path in the inputField,
- if we are in directory mode"
-
- selectingDirectory ifTrue:[
- |newDir|
-
- newDir := (selectionList directory)
- construct:selectionList selectionValue.
- enterField contents:newDir pathName.
- ].
-
- "Created: / 18.4.1996 / 18:46:15 / cg"
- "Modified: / 7.8.1998 / 17:19:26 / cg"
-!
-
-doubleClick
- |entry|
-
- entry := selectionList selectionValue.
- entry notNil ifTrue:[
- ((selectionList directory asFilename construct:entry) isDirectory) ifFalse:[
- selectingDirectory ifFalse:[
- enterField contents:entry.
- self okPressed
- ]
- ]
- ].
-
- "Modified: 19.10.1997 / 00:17:37 / cg"
-!
-
-okPressed
- "called for both on ok-press and on return-key"
-
- |dir string fname|
-
- string := enterField contents.
- (string notNil and:[string notEmpty]) ifTrue:[
- string := string withoutSeparators.
- string asFilename isAbsolute ifTrue:[
- fname := string asFilename
- ] ifFalse:[
- dir := selectionList directory pathName asFilename.
- fname := dir construct:string
- ].
- fname isDirectory ifTrue:[
- selectingDirectory ifFalse:[
- selectionList directory:fname asString.
- self updateList.
- ^ self
- ]
- ]
- ] ifFalse:[
- selectingDirectory ifTrue:[
- enterField contents:(selectionList directory pathName).
- ].
- ].
-
- super okPressed
-
- "Modified: / 10.9.1998 / 22:19:11 / cg"
-!
-
-patternChanged
- selectionList pattern:patternField contents.
- self updateList
-
- "Created: 4.6.1996 / 20:30:23 / cg"
-!
-
-selectionChanged
- |entry|
-
- entry := selectionList selectionValue.
- (selectionList directory asFilename construct:entry) type == #directory ifFalse:[
- selectingDirectory ifTrue:[
- enterField contents:(selectionList directory pathName).
- selectionList setSelection:nil.
- ^ self
- ]
- ].
- enterField contents:entry
-
- "Modified: 21.9.1997 / 12:07:55 / cg"
-! !
-
-!FileSelectionBox class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/FSelBox.st,v 1.56 1999-03-19 21:12:13 cg Exp $'
-! !
--- a/FSelList.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1016 +0,0 @@
-"
- 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.
-"
-
-SelectionInListView subclass:#FileSelectionList
- instanceVariableNames:'pattern directory timeStamp directoryId directoryName
- directoryContents directoryFileTypes realAction matchBlock
- stayInDirectory ignoreParentDirectory markDirectories
- ignoreDirectories directoryChangeCheckBlock quickDirectoryChange
- directoryChangeAction directorySelectAction fileSelectAction
- ignoreFiles directoryHolder'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Lists'
-!
-
-!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.
-"
-!
-
-documentation
-"
- this class implements file selection lists - its basically a
- selection-in-list-view, but adds some right-arrows to directories.
- (and will soon remember the previous position when changing directories).
- You can specify an optional filename-pattern (such as '*.st') and an
- optional matchBlock (such as: [:name | name startsWith:'A']).
-
- Only files (plus directories) matching the pattern (if present) and
- for which the matchBlock returns true (if present), are shown.
-
- Except for file-browser like applications, FileSelectionLists are almost
- exclusively used with FileSelectionBoxes (see examples there).
-
- [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
-
- directoryName the path when it was taken
-
- directoryContents (cached) contents of current directory
-
- directoryFileTypes (cached) file types (symbols) of current directory
-
- fileTypes file types as shown in list (i.e only matching ones)
-
- matchBlock if non-nil: block evaluated per full filename;
- only files for which matchBlock returns true are shown.
-
- realAction (internal) the action to perform when a file is selected
-
- quickDirectoryChange if true, directories can be changed with a single click
- if false (the default), they need a double click.
- Makes sense if a directory is what we are interested in,
- for files its better to leave it as false.
-
- stayInDirectory if true, no directoryChanges are allowed.
- Makes sense to limit the user to choose among certain files.
- The default is false.
-
- ignoreParentDirectory if true, the parent directory is not shown.
- Makes sense to limit the user to files below the initial
- directory. Default is false.
-
- ignoreDirectories if true, no directories are shown at all.
- Makes sense to limit the user to choose among regular files.
- Default is false.
-
- ignoreFiles if true, no regular files are shown at all.
- Makes sense to limit the user to choose among directories files.
- Default is false.
-
- directoryChangeCheckBlock
- if nonNil, directoryChanges are only allowed if this block
- returns true. It is evaluated with one argument, the pathName.
- Defaults to nil (i.e. no checks).
-
- directorySelectAction
- if nonNil, a directory-select evaluate this block.
- Possible hook for others (used with Boxes)
- Defaults to nil.
-
- fileSelectAction
- if nonNil, file-select evaluate this block.
- Possible hook for others (used with Boxes)
- Defaults to nil.
-
- [author:]
- Claus Gittinger
-
- [see also:]
- DialogBox
- EnterBox2 YesNoBox
- ListSelectionBox FileSelectionBox FileSaveBox
-"
-!
-
-examples
-"
- FileSelectionLists are typically used in FileSelectionBoxes,
- or file-browser-like applications.
- Thus, the following examples are a bit untypical.
-
- example (plain file-list):
- [exBegin]
- |list|
-
- list := FileSelectionList new.
- list open
- [exEnd]
-
-
- setting a directory holder:
- [exBegin]
- |holder list|
-
- holder := '/etc' asValue.
- list := FileSelectionList new.
- list directoryHolder:holder.
- list open.
-
- (EditField on:holder) open.
- [exEnd]
-
-
- scrolled & some action:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- ignore the parentDirectory:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list ignoreParentDirectory:true.
- top open
- [exEnd]
-
- ignore all directories (i.e. regular files only):
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list ignoreDirectories:true.
- top open
- [exEnd]
-
- ignore all regular files (i.e. directories only):
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list ignoreFiles:true.
- top open
- [exEnd]
-
- dont show the directory arrow-mark:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list markDirectories:false.
- top open
- [exEnd]
-
- adds a pattern, only showing .st files and directories:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list pattern:'*.st'.
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- a more complicated pattern:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list pattern:'[A-D]*.st'.
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- adds a matchblock to show only writable files:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list matchBlock:[:name |
- |fileName|
- fileName := name asFilename.
- fileName isWritable or:[fileName isDirectory]
- ].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- adds a matchblock to suppress directories:
- (this can be done easier with #ignoreDirectories)
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list matchBlock:[:name |
- name asFilename isDirectory not
- ].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- the above can be done more convenient:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list ignoreDirectories:true.
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- adds a matchblock to block parent dirs (i.e. only allow files here & below):
- (can be done easier with #ignoreParentDirectory)
- [exBegin]
- |top v list currentDir|
-
- currentDir := '.' asFilename pathName.
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list matchBlock:[:name |
- ((name endsWith:'/..') and:[list directory pathName = currentDir]) not
- ].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- do not allow changing up AND show all .rc-files only:
- (but allow going down)
- [exBegin]
- |top v list currentDir|
-
- currentDir := '.' asFilename pathName.
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list pattern:'*.rc'.
- list matchBlock:[:name |
- ((name endsWith:'/..') and:[list directory pathName = currentDir]) not
- ].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- show only .rc-files in current directory:
- [exBegin]
- |top v list currentDir|
-
- currentDir := '.' asFilename pathName.
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list pattern:'*.rc'.
- list matchBlock:[:name |
- name asFilename isDirectory not
- ].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- show only h*-files in /etc; dont allow directory changes:
- [exBegin]
- |top v list|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list directory:'/etc'.
- list pattern:'h*'.
- list matchBlock:[:name | name printNL.
- name asFilename isDirectory not
- ].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
- only allow changing into directories below the current one; i.e. not up;
- but show it
- [exBegin]
- |top v list here|
-
- top := StandardSystemView new.
- top extent:(300 @ 200).
- v := ScrollableView for:FileSelectionList in:top.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- list := v scrolledView.
- list directoryChangeCheckBlock:[:dirPath |
- dirPath asFilename pathName
- startsWith:Filename currentDirectory pathName].
- list action:[:index | Transcript showCR:'you selected: ' , list selectionValue].
- top open
- [exEnd]
-
-
- living in a box:
- [exBegin]
- |box listView|
-
- box := Dialog new.
- box addTextLabel:'which file ?'.
-
- listView := box
- addListBoxOn:nil
- class:FileSelectionList
- withNumberOfLines:10
- hScrollable:false
- vScrollable:true.
-
- box addAbortButton; addOkButton.
- box stickAtBottomWithVariableHeight:listView.
- box open.
- box accepted ifTrue:[
- Transcript showCR:listView selectedPathname
- ]
- [exEnd]
-
-
- living in a box (local files only, no directory change allowed):
- [exBegin]
- |box listView|
-
- box := Dialog new.
- box addTextLabel:'which file ?'.
-
- listView := box
- addListBoxOn:nil
- class:FileSelectionList
- withNumberOfLines:10
- hScrollable:false
- vScrollable:true.
-
- listView ignoreDirectories:true.
- listView ignoreParentDirectory:true.
-
- box addAbortButton; addOkButton.
- box stickAtBottomWithVariableHeight:listView.
- box open.
- box accepted ifTrue:[
- Transcript showCR:listView selectedPathname
- ]
- [exEnd]
-
-
- living in a box (local files only; immediately show owner in another field):
- [exBegin]
- |box listView lbl|
-
- box := Dialog new.
- box addTextLabel:'which file ?'.
-
- listView := box
- addListBoxOn:nil
- class:FileSelectionList
- withNumberOfLines:10
- hScrollable:false
- vScrollable:true.
-
- lbl := box addTextLabel:''.
- lbl adjust:#left.
-
- listView fileSelectAction:[:index |
- |ownerId owner|
-
- ownerId := listView selectedPathname asFilename info at:#uid.
- ownerId == OperatingSystem getUserID ifTrue:[
- lbl label:('one of yours').
- ] ifFalse:[
- owner := OperatingSystem getUserNameFromID:ownerId.
- lbl label:(owner , '''s property').
- ]
- ].
-
- listView directorySelectAction:[:index |
- |ownerId owner|
-
- ownerId := listView selectedPathname asFilename info at:#uid.
- ownerId == OperatingSystem getUserID ifTrue:[
- lbl label:('your files there').
- ] ifFalse:[
- owner := OperatingSystem getUserNameFromID:ownerId.
- lbl label:(owner , '''s files there').
- ]
- ].
-
- box addAbortButton; addOkButton.
- box stickAtBottomWithFixHeight:lbl.
- box stickAtBottomWithVariableHeight:listView.
- box open.
- box accepted ifTrue:[
- Transcript showCR:listView selectedPathname
- ]
- [exEnd]
-"
-! !
-
-!FileSelectionList methodsFor:'accessing-behavior'!
-
-action:aBlock
- "set the action to be performed on a selection"
-
- realAction := aBlock
-!
-
-directoryChangeAction:aBlock
- "set the action to be performed on a directory change"
-
- directoryChangeAction := aBlock
-
- "Created: 5.3.1996 / 02:37:08 / cg"
-!
-
-directoryChangeCheckBlock:aBlock
- "set the directoryChangeCheckBlock - if non-nil, it controls if
- a directory change is legal."
-
- directoryChangeCheckBlock := aBlock
-!
-
-directorySelectAction:aBlock
- "set the action to be performed when a directory is selected.
- Useful if someone else wants to show additional information
- (readable/owner ...) somewhere."
-
- directorySelectAction := aBlock
-
- "Created: 18.4.1996 / 18:45:13 / cg"
-!
-
-fileSelectAction:aBlock
- "set the action to be performed when a file is selected.
- Useful if someone else wants to show additional information
- (readable/owner ...) somewhere."
-
- fileSelectAction := aBlock
-
- "Created: 18.4.1996 / 18:45:24 / cg"
-!
-
-ignoreDirectories:aBoolean
- "set/clear the flag which controls if directories are ignored
- (i.e. hidden). The default is false (i.e. dirs are shown)"
-
- ignoreDirectories := aBoolean
-!
-
-ignoreFiles:aBoolean
- "set/clear the flag which controls if plain files are ignored
- (i.e. hidden). The default is false (i.e. they are shown)"
-
- ignoreFiles := aBoolean
-
- "Created: 18.4.1996 / 18:48:43 / cg"
- "Modified: 18.4.1996 / 18:49:23 / cg"
-!
-
-ignoreParentDirectory:aBoolean
- "set/clear the flag which controls if the parent directory (..)
- is shown in the list. The default is false (i.e. show it)"
-
- ignoreParentDirectory := aBoolean
-!
-
-markDirectories:aBoolean
- "turn on/off marking of directories with an arrow.
- The default is on"
-
- markDirectories := aBoolean
-!
-
-matchBlock:aBlock
- "set the matchBlock - if non-nil, it controls which
- names are shown in the list."
-
- matchBlock := aBlock
-!
-
-pattern:aPattern
- "set the pattern - if it changes, update the list."
-
- pattern ~= aPattern ifTrue:[
- pattern := aPattern.
- realized ifTrue:[
- self updateList
- ].
- ].
-!
-
-quickDirectoryChange:aBoolean
- "set/clear quick change (i.e. chdir with single click).
- The default is false (i.e. double click is required)"
-
- quickDirectoryChange := aBoolean
-
- "Created: 4.3.1996 / 17:37:58 / cg"
-!
-
-stayInDirectory:aBoolean
- "set/clear the flag which controls if selecting a directory
- should locally change (if false) or be handled just like
- the selection of a file (if true).
- The default is false (i.e. change and do not tell via action)"
-
- stayInDirectory := aBoolean
-! !
-
-!FileSelectionList methodsFor:'accessing-channels'!
-
-directoryHolder:aValueHolder
- directoryHolder := aValueHolder.
- directoryHolder onChangeSend:#directoryHolderChange to:self.
- self directoryHolderChange
-
- "Modified: 20.9.1997 / 13:16:58 / cg"
-! !
-
-!FileSelectionList methodsFor:'accessing-contents'!
-
-directory
- "return the shown directory"
-
- ^ directory
-!
-
-directory:nameOrDirectory
- "set the lists contents to the filenames in the directory.
- This does not validate the change with any directoryChangeBlock."
-
- |oldPath f|
-
- nameOrDirectory isNil ifTrue:[
- directory := nil.
- directoryHolder notNil ifTrue:[directoryHolder value:directory].
- ^ self updateList
- ].
- directory notNil ifTrue:[
- oldPath := directory pathName.
- ].
- directory := nameOrDirectory asFilename.
- (directory exists
- and:[directory isDirectory]) ifFalse:[
- directory := Filename currentDirectory
- ].
- directoryHolder notNil ifTrue:[directoryHolder value:directory].
- realized ifTrue:[
- (directory pathName = oldPath) ifFalse:[
- self updateList
- ]
- ]
-
- "Modified: 18.9.1997 / 23:42:27 / stefan"
- "Modified: 20.9.1997 / 13:29:02 / cg"
-!
-
-selectedPathname
- "if there is a selection, return its full pathname.
- Of there is no selection, return nil."
-
- |sel|
-
- sel := self selectionValue.
- sel isNil ifTrue:[^ nil].
- ^ directory constructString:sel.
-
- "Modified: 7.9.1997 / 23:49:01 / cg"
- "Modified: 18.9.1997 / 23:49:16 / stefan"
-! !
-
-!FileSelectionList methodsFor:'drawing'!
-
-redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- "redefined to look for directory in every line"
-
- |l|
-
- "first, draw chunk of lines"
- super redrawFromVisibleLine:startVisLineNr to:endVisLineNr.
- markDirectories ifFalse:[^ self].
-
- "then draw marks"
- startVisLineNr to:endVisLineNr do:[:visLineNr |
- l := self visibleLineToListLine:visLineNr.
- l notNil ifTrue:[
- (directoryFileTypes at:l) == true ifTrue:[
- self drawRightArrowInVisibleLine:visLineNr
- ]
- ]
- ]
-
- "Modified: / 22.9.1998 / 12:32:24 / cg"
-!
-
-redrawVisibleLine:visLineNr
- "if the line is one for a directory, draw a right arrow"
-
- |l|
-
- super redrawVisibleLine:visLineNr.
- markDirectories ifFalse:[^ self].
-
- l := self visibleLineToListLine:visLineNr.
- l notNil ifTrue:[
- (directoryFileTypes at:l) == true ifTrue:[
- self drawRightArrowInVisibleLine:visLineNr
- ]
- ]
-
- "Modified: / 22.9.1998 / 12:32:34 / cg"
-! !
-
-!FileSelectionList methodsFor:'events'!
-
-directoryHolderChange
- self directory:directoryHolder value.
-
- "Created: 20.9.1997 / 13:12:45 / cg"
-!
-
-doubleClicked
- self selectionIsDirectory ifTrue:[
- stayInDirectory not ifTrue:[
- quickDirectoryChange ifFalse:[
- directoryChangeAction notNil ifTrue:[
- directoryChangeAction value:self selection
- ] ifFalse:[
- self changeDirectory
- ]
- ]
- ].
- ^ self
- ].
- super doubleClicked
-
- "Created: 4.3.1996 / 17:39:58 / cg"
- "Modified: 5.3.1996 / 02:38:06 / cg"
-!
-
-selectionChanged
- "if the selection changed, check for it being a directory
- and possibly go there. If its not a directory, perform the realAction."
-
- self selection isCollection ifFalse:[
- self selectionIsDirectory ifTrue:[
- (stayInDirectory not and:[quickDirectoryChange]) ifTrue:[
- directoryChangeAction notNil ifTrue:[
- directoryChangeAction value:self selection
- ] ifFalse:[
- self changeDirectory
- ]
- ] ifFalse:[
- directorySelectAction notNil ifTrue:[
- directorySelectAction value:self selection
- ]
- ]
- ] ifFalse:[
- realAction notNil ifTrue:[
- realAction value:self selection
- ].
- fileSelectAction notNil ifTrue:[
- fileSelectAction value:self selection
- ]
- ]
- ]
-
- "Modified: 18.4.1996 / 18:44:30 / cg"
-!
-
-sizeChanged:how
- "redraw marks if any"
-
- super sizeChanged:how.
- (shown and:[markDirectories]) ifTrue:[
- self invalidate
- ]
-
- "Modified: 29.5.1996 / 16:15:12 / cg"
-! !
-
-!FileSelectionList methodsFor:'initialization'!
-
-initialize
- directory := Filename currentDirectory.
- stayInDirectory := ignoreParentDirectory := ignoreDirectories := false.
- ignoreFiles := quickDirectoryChange := false.
- markDirectories := true.
- super initialize.
-
- pattern := '*'.
- self initializeAction.
-
- "nontypical use ..."
- "
- FileSelectionList new open
- (FileSelectionList new directory:'/etc') open
- (ScrollableView for:FileSelectionList) open
- (HVScrollableView for:FileSelectionList) open
- "
-
- "Modified: 18.4.1996 / 18:49:19 / cg"
- "Modified: 18.9.1997 / 18:52:03 / stefan"
-!
-
-initializeAction
- "setup action as: selections in list get forwarded to enterfield if not
- a directory; otherwise directory is changed"
-
- actionBlock := [:lineNr | self selectionChanged].
-"/ doubleClickActionBlock := [:lineNr | self selectionChanged].
-
- "Modified: 4.3.1996 / 17:39:08 / cg"
-!
-
-reinitialize
- directory := Filename currentDirectory.
- super reinitialize
-
- "Modified: 18.9.1997 / 18:52:16 / stefan"
-! !
-
-!FileSelectionList methodsFor:'private'!
-
-changeDirectory
- "change directory to the selected one"
-
- |entry ok newDir warnMessage oldDir|
-
- entry := self selectionValue.
- (entry isNil or:[entry isEmpty]) ifTrue:[ ^ false].
-
- (entry endsWith:' ...') ifTrue:[
- entry := entry copyWithoutLast:4.
- ].
-
- ok := false.
- oldDir := directory baseName.
- newDir := directory construct:entry.
-
- (directoryChangeCheckBlock isNil
- or:[directoryChangeCheckBlock value:newDir]) ifTrue:[
- newDir isReadable ifFalse:[
- warnMessage := 'not allowed to read directory %1'
- ] ifTrue:[
- newDir isExecutable ifFalse:[
- warnMessage := 'not allowed to change to directory %1'
- ] ifTrue:[
- ok := true.
- ]
- ].
- ].
- ok ifFalse:[
- warnMessage notNil ifTrue:[
- self warn:(resources string:warnMessage with:entry).
- ].
- self setSelection:nil
- ] ifTrue:[
- self directory:newDir.
- entry = '..' ifTrue:[
- self setSelectElement:oldDir
- ].
- ].
-
- "Created: 4.3.1996 / 17:45:18 / cg"
- "Modified: 26.5.1996 / 15:03:21 / cg"
- "Modified: 18.9.1997 / 23:34:39 / stefan"
-!
-
-selectionIsDirectory
- "return true, if the current selection is a directory"
-
- |entry|
-
- entry := self selectionValue.
- (entry isNil or:[entry isEmpty]) ifTrue:[ ^ false].
-
- (entry endsWith:' ...') ifTrue:[
- entry := entry copyWithoutLast:4.
- ].
- ^ (directory construct:entry) isDirectory
-
- "Created: / 4.3.1996 / 17:43:26 / cg"
- "Modified: / 18.9.1997 / 23:37:05 / stefan"
- "Modified: / 22.9.1998 / 12:30:21 / cg"
-!
-
-updateList
- "set the lists contents to the filenames in the directory"
-
- |oldCursor files newList index obsolete
- matching patternList dir|
-
- directory isNil ifTrue:[
- super list:nil.
- files := newList := nil.
- ^ self
- ].
-
- 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)
- "
- obsolete := directoryId ~~ directory id
- or:[directoryName ~= directory pathName
- or:[timeStamp notNil
- and:[directory modificationTime > timeStamp]]].
-
- obsolete ifTrue:[
- timeStamp := directory modificationTime.
- directoryId := directory id.
- directoryName := directory pathName.
- directoryContents := (directory fullDirectoryContents ? #()) sort.
- directoryFileTypes := OrderedCollection new.
- directoryContents do:[:name |
- |f|
-
- f := directory construct:name.
- directoryFileTypes add:(f isDirectory)
- ].
- ].
-
- files := directoryContents.
- newList := OrderedCollection new.
- index := 1.
-
- dir := directory pathName asFilename.
- files do:[:name |
- |type fullName|
-
- fullName := dir constructString:name.
- (matchBlock isNil or:[matchBlock value:fullName]) ifTrue:[
- (directoryFileTypes at:index) == true ifTrue:[
- ignoreDirectories ifFalse:[
- name = '..' ifTrue:[
- ignoreParentDirectory ifFalse:[
- newList add:name.
- ]
- ] ifFalse:[
- name = '.' ifTrue:[
- "ignore"
- ] ifFalse:[
- newList add:(name ", ' ...'").
- ]
- ]
- ]
- ] ifFalse:[
- ignoreFiles ifFalse:[
- matching := true.
-
- (pattern isNil
- or:[pattern isEmpty]) ifFalse:[
- pattern = '*' ifFalse:[
- (pattern includes:$;) ifTrue:[
- patternList := pattern asCollectionOfSubstringsSeparatedBy:$;.
- patternList := patternList collect:[:p | p withoutSeparators].
- matching := (patternList findFirst:[:subPattern | subPattern match:name]) ~~ 0.
- ] ifFalse:[
- matching := pattern match:name
- ]
- ]
- ].
-
- matching ifTrue:[
- newList add:name.
- ]
- ]
- ].
- ].
- index := index + 1
- ].
- super list:newList.
-
- self cursor:oldCursor.
-
- "Modified: / 18.9.1997 / 23:43:52 / stefan"
- "Modified: / 22.9.1998 / 14:44:02 / cg"
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |l|
-
- l := self visibleLineToListLine:visLineNr.
- l notNil ifTrue:[
- (directoryFileTypes at:l) == true ifTrue:[^ true].
- ^ super visibleLineNeedsSpecialCare:visLineNr
- ].
- ^ false
-
- "Modified: / 22.9.1998 / 12:32:48 / cg"
-!
-
-widthForScrollBetween:firstLine and:lastLine
- "return the width in pixels for a scroll between firstLine and lastLine
- - return full width here since there might be directory marks"
-
- ^ (width - margin - margin)
-! !
-
-!FileSelectionList methodsFor:'realization'!
-
-realize
- "check if directory is still valid (using timestamp and inode numbers)
- - reread if not"
-
- super realize.
-
- (timeStamp isNil
- or:[(directory modificationTime > timeStamp)
- or:[(directoryId isNil)
- or:[directoryId ~~ directory id]]]) ifTrue:[
- directoryId := nil.
- self updateList
- ].
-
- "Created: 24.7.1997 / 18:24:36 / cg"
- "Modified: 18.9.1997 / 23:36:10 / stefan"
-! !
-
-!FileSelectionList class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/FSelList.st,v 1.45 1999-06-18 19:42:30 cg Exp $'
-! !
--- a/HMiniScr.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,74 +0,0 @@
-"
- 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.
-"
-
-MiniScroller subclass:#HorizontalMiniScroller
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
-!
-
-!HorizontalMiniScroller 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.
-"
-!
-
-documentation
-"
- like a scroller, but taking less screen space.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!HorizontalMiniScroller methodsFor:'accessing-behavior'!
-
-scrollLeftAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-
- "Created: 17.4.1996 / 14:04:29 / cg"
-!
-
-scrollRightAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-
- "Created: 17.4.1996 / 14:04:30 / cg"
-! !
-
-!HorizontalMiniScroller methodsFor:'initialization'!
-
-initialize
- orientation := #horizontal.
- super initialize.
-
- "Created: 17.4.1996 / 14:01:26 / cg"
-! !
-
-!HorizontalMiniScroller class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HMiniScr.st,v 1.9 1996-04-25 17:22:22 cg Exp $'
-! !
--- a/HPanelV.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1468 +0,0 @@
-"
- 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.
-"
-
-PanelView subclass:#HorizontalPanelView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
-!
-
-!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.
-"
-!
-
-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.
-
- The layout is controlled the instance variables:
- horizontalLayout and verticalLayout
- in addition to
- horizontalSpace and verticalSpace.
-
- HorizontalSpace and verticalSpace control the spacing between elements;
- they default to some 1mm.
-
- The horizontal layout can be any of:
-
- #left arrange elements at left
- #leftSpace arrange elements at the left, start with spacing
- #fixLeft same as #left, but do not reduce spacing in case of no fit
- #fixLeftSpace same as #leftSpace, but do not reduce spacing in case of no fit
- #right arrange elements at the right
- #rightSpace arrange elements at the right, start with spacing
- #center arrange elements in the center
- #spread spread elements evenly
- #spreadSpace spread elements evenly with spacing at the ends
- #fit like #spread, but resize elements for tight packing
- #fitSpace like #fit, with additional spacing at the far ends
- #leftFit like #left, but extend the last (rightMost) element to the right
- #leftSpaceFit like #leftSpace, but extend the last (rightMost) element to the right
- #rightFit like #right, but extend the first (leftMost) element to the left
- #rightSpaceFit like #rightSpace, but extend the first (leftMost) element to the left
-
- #leftMax like corresponding non-Max layouts,
- #leftSpaceMax but resize all components to width of widest components
- #rightMax
- #rightSpaceMax
- #centerMax
- #spreadMax
- #spreadSpaceMax
-
- the vertical layout can be:
-
- #top place element at the top
- #topSpace place element at the top, offset by verticalSpace
- #center place it horizontally centered
- #bottom place it at the bottom
- #bottomSpace place it at the bottom, offset by verticalSpace
- #fit resize elements vertically to fit this panel
- #fitSpace like #fit, but with spacing
-
- #topMax like #top, but resize all views vertically to max height
- #topSpaceMax like #topSpace, but resize all views vertically to max height
- #bottomMax like #bottom, but resize all views vertically to max height
- #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
- #centerMax like #center, but resize all views vertically to max height
-
- The defaults is #center for both directions.
- The layout is changed by the messages #verticalLayout: and #horizontalLayout:.
- For backward compatibility (to times, where only hLayout existed), the simple
- #layout: does the same as #horizontalLayout:.
- Do not use this old method; it will vanish and currently outputs a warning.
-
- The panel assumes, that the elements do not resize themselfes, after it
- became visible. This is not true for all widgets (buttons, labels or
- inputFields may like to change).
- If you have changing elements, tell this to the panel
- with 'aPanel elementsChangeSize:true'. In that case, the panel will react
- to size changes of its elements, and reorganize things.
-
- By combining Horizontal- and VerticalPanels (i.e. place a hPanel into a
- vPanel), most layouts should be implementable.
- However, iff none of these layout/space combinations is exactly what you need
- in your application, create a subclass, and redefine the setChildPositions
- method there.
-
- TODO: for completeness, support #fixRight, #fixRightSpace,
- #rightFit, #rightSpaceFit layouts
-
- CAVEAT: this class started with #left and no vertical alignments;
- as time went by, more layouts were added (by users requests)
- and now, many layout combinations are possible.
- Reflecting this, the setup should be changed to use different selectors
- for space-on/off, max-resize and alignment
- (i.e. having more and more layout symbols makes things a bit confusing ...)
-
- [see also:]
- VerticalPanelView
- VariableVerticalPanel VariableHorizontalPanel
- Label
-
- [author:]
- Claus Gittinger
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- These examples show the effect of various horizontalLayout and
- verticalLayout settings. Try them all. Especially, notice the
- differences between the xxx and xxxSpace layouts and the effect of
- setting different values for the spacing.
- Try resizing the view and see how the elements get rearranged.
-
- Most of the examples below place 3 buttons onto a panel;
- Of course, you can put any other view into a panel ... the last examples show this.
- (The fit layouts are especially useful to be used with SelectionInListViews;
- you can combine multiple labels & editFields with a selectionInListView, which
- is expanded to fill the remaining area of the view)
-
- example: default layout (center)
- centers components
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'default: center'.
-
- 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
- [exEnd]
-
-
- example: same (default center layout) with different sized elements
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'default: center'.
-
- p := HorizontalPanelView in:v.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: horizontal default (center); vertical centerMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=centerMax'.
- p := HorizontalPanelView in:v.
- p verticalLayout:#centerMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: horizontal default (center); vertical topMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=topMax'.
- p := HorizontalPanelView in:v.
- p verticalLayout:#topMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: horizontal default (center); vertical topSpaceMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=topSpaceMax'.
- p := HorizontalPanelView in:v.
- p verticalLayout:#topSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: horizontal default (center); vertical bottomMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=bottomMax'.
- p := HorizontalPanelView in:v.
- p verticalLayout:#bottomMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: horizontal default (center); vertical bottomSpaceMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=bottomSpaceMax'.
- p := HorizontalPanelView in:v.
- p verticalLayout:#bottomSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: left-layout (vertical is default -> center)
- fills left-to-right; no spacing before leftMost component
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=left; vL=default (center)'.
-
- p horizontalLayout:#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
- [exEnd]
-
-
- example: left starting with spacing (vertical is default -> center)
- fills left-to-right; spacing before leftMost component
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=leftSpace; vL=center'.
-
- p horizontalLayout:#leftSpace.
- 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
- [exEnd]
-
-
- example: leftFit-layout (vertical is default -> center)
- fills left-to-right; resizes the rightMost component to fit
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=leftFit; vL=center'.
-
- p horizontalLayout:#leftFit.
- 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
- [exEnd]
-
-
- example: leftSpaceFit-layout (vertical is default -> center)
- fills left-to-right;
- starts with spacing & resizes the rightMost component to fit with spacing
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=leftSpaceFit; vL=center'.
-
- p horizontalLayout:#leftSpaceFit.
- 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
- [exEnd]
-
-
- example: right-layout (vertical is default -> center)
- right-to-left
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=right; vL=center'.
-
- p horizontalLayout:#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
- [exEnd]
-
-
- example: right with initial spacing (vertical is default -> center)
- right-to-left with spacing after last component
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=rightSpace; vL=center'.
-
- p horizontalLayout:#rightSpace.
- 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
- [exEnd]
-
-
- example: rightFit-layout (vertical is default -> center)
- right-to-left; resize the leftMost component to fit
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=rightFit; vL=center'.
-
- p horizontalLayout:#rightFit.
- 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
- [exEnd]
-
-
- example: rightSpaceFit with initial spacing (vertical is default -> center)
- right-to-left; start with spacing & resize the leftMost to fit
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=rightSpaceFit; vL=center'.
-
- p horizontalLayout:#rightSpaceFit.
- 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
- [exEnd]
-
-
- example: fit-layout (vertical is default -> center)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- p horizontalLayout:#fit.
- v label:'hL=fit; vL=center'.
-
- 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
- [exEnd]
-
-
- example: full fit i.e. no spacing (vertical is default -> center)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- p horizontalLayout:#fit.
- p horizontalSpace:0.
- v label:'hL=fit hS=0; vL=center'.
-
- 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
- [exEnd]
-
-
- example: fit with spacing (vertical is default -> center)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fitSpace; vL=center'.
-
- p horizontalLayout:#fitSpace.
- 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
- [exEnd]
-
-
- example: spread-layout (vertical is default -> center)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- p horizontalLayout:#spread.
- v label:'hL=spread; vL=center'.
-
- 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
- [exEnd]
-
-
- example: spread with spacing (vertical is default -> center)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace; vL=center'.
-
- p horizontalLayout:#spreadSpace.
- 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
- [exEnd]
-
-
- example: spread with spacing; vertical fit
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace; vL=fit'.
-
- p horizontalLayout:#spreadSpace.
- p verticalLayout:#fit.
- 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
- [exEnd]
-
-
- example: spread with spacing; vertical fit with spacing
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=spreadSpace; vL=fitSpace'.
-
- p horizontalLayout:#spreadSpace.
- p verticalLayout:#fitSpace.
- 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
- [exEnd]
-
-
- example: fit - top
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fit; vL=top'.
-
- p horizontalLayout:#fit.
- p verticalLayout:#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:300 @ 100.
- v open
- [exEnd]
-
-
- example: fit with initial spacing
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fitSpace; vL=top'.
-
- p horizontalLayout:#fitSpace.
- p verticalLayout:#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:300 @ 100.
- v open
- [exEnd]
-
-
- example: fit with initial spacing in both directions
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fitSpace; vL=fitSpace'.
-
- p horizontalLayout:#fitSpace.
- p verticalLayout:#fitSpace.
- 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
- [exEnd]
-
-
- example: fit without spacing in both directions
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fit hS=0; vL=fit'.
-
- p horizontalLayout:#fit.
- p verticalLayout:#fit.
- p horizontalSpace:0.
- 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
- [exEnd]
-
-
- example: fit with initial spacing; top with spacing
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fitSpace; vL=topSpace'.
-
- p horizontalLayout:#fitSpace.
- p verticalLayout:#topSpace.
- 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
- [exEnd]
-
-
- example: fit - top without spacing
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fit; vL=top'.
-
- p horizontalLayout:#fit.
- p verticalLayout:#top.
- p horizontalSpace:0.
- 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
- [exEnd]
-
-
- example: fit - bottom with spacing and bottomSpace
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fitSpace; vL=bottomSpace'.
-
- p horizontalLayout:#fitSpace.
- p verticalLayout:#bottomSpace.
- 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
- [exEnd]
-
-
- example: fit no horizontal space - bottom with spacing and bottomSpace
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=fit; vL=bottomSpace'.
-
- p horizontalLayout:#fit.
- p verticalLayout:#bottomSpace.
- p horizontalSpace:0.
- 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
- [exEnd]
-
- example: leftMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=leftMax; vL=default'.
-
- p horizontalLayout:#leftMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: leftSpaceMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=leftSpaceMax; vL=default'.
-
- p horizontalLayout:#leftSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: rightMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=rightMax; vL=default'.
-
- p horizontalLayout:#rightMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: rightSpaceMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=rightSpaceMax; vL=default'.
-
- p horizontalLayout:#rightSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: centerMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=centerMax; vL=default'.
-
- p horizontalLayout:#centerMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: spreadMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=spreadMax; vL=default'.
-
- p horizontalLayout:#spreadMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: spreadSpaceMax - vertical default
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=spreadSpaceMax; vL=default'.
-
- p horizontalLayout:#spreadSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'but3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: maximize elements in both directions and center
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'hL=centerMax; vL=centerMax'.
-
- p := HorizontalPanelView in:v.
- p horizontalLayout:#centerMax.
- p verticalLayout:#centerMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'but1' in:p. b1 font:(b1 font size:8).
- b2 := Button label:'b2' in:p. b2 font:(b1 font size:24).
- b3 := Button label:'button3' in:p.
- v extent:300 @ 100.
- v open
- [exEnd]
-
-
- example: placing hPanels into a vPanel
- [exBegin]
- |v vP hP1 hP2 hP3 b1 b2 b3 b4 b5 b6 b7 b8 b9|
-
- v := StandardSystemView new.
- vP := VerticalPanelView in:v.
- vP origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- vP verticalLayout:#fit;
- verticalSpace:0;
- horizontalLayout:#fit.
-
- hP1 := HorizontalPanelView in:vP.
- hP1 horizontalLayout:#fitSpace;
- verticalLayout:#center.
- b1 := Button label:'button1' in:hP1.
- b2 := Button label:'button2' in:hP1.
- b3 := Button label:'button3' in:hP1.
-
- hP2 := HorizontalPanelView in:vP.
- hP2 horizontalLayout:#fitSpace;
- verticalLayout:#center.
- b4 := Button label:'button4' in:hP2.
- b5 := Button label:'button5' in:hP2.
- b6 := Button label:'button6' in:hP2.
-
- hP3 := HorizontalPanelView in:vP.
- hP3 horizontalLayout:#fitSpace;
- verticalLayout:#center.
- b7 := Button label:'button7' in:hP3.
- b8 := Button label:'button8' in:hP3.
- b9 := Button label:'button9' in:hP3.
-
- v extent:300 @ 300.
- v open
- [exEnd]
-
- example: a browser like table, the two left tables have a fix width,
- while the rightmost list extends to the far right.
- [exBegin]
- |v p l1 l2 l3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView in:v.
- v label:'hL=leftFit hS=0; vL=fit'.
-
- p horizontalLayout:#leftFit.
- p horizontalSpace:0.
- p verticalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
-
- l1 := ScrollableView for:FileSelectionList in:p.
- l1 stayInDirectory:true.
- l1 ignoreParentDirectory:true.
- l1 directory:'/'.
- l1 action:[:selection | l2 directory:(l1 selectedPathname)].
-
- l2 := ScrollableView for:FileSelectionList in:p.
- l2 stayInDirectory:true.
- l2 directory:nil.
- l2 ignoreParentDirectory:true.
- l2 action:[:selection | l3 directory:(l2 selectedPathname)].
-
- l3 := ScrollableView for:FileSelectionList in:p.
- l3 directory:nil.
- l3 ignoreParentDirectory:false.
- v extent:400 @ 300.
- v open
- [exEnd]
-
-
- trouble example: self-resizing elements may cause trouble
- [exBegin]
- |v p l1 l2 l3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:v.
-
- l1 := (Label label:'one' in:p) level:-1.
- l2 := (Label label:'two' in:p) level:-1.
- l3 := (Label label:'three' in:p) level:-1.
-
- v extent:400 @ 300.
- v open.
-
- (Delay forSeconds:5) wait.
-
- l1 label:'oneone'.
- l2 label:'twotwo'.
- l3 label:'threethree'.
- [exEnd]
-
-
- fixed trouble example: tell the panel that this situation may happen
- [exBegin]
- |v p l1 l2 l3|
-
- v := StandardSystemView new.
- p := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:v.
- p elementsChangeSize:true.
-
- l1 := (Label label:'one' in:p) level:-1.
- l2 := (Label label:'two' in:p) level:-1.
- l3 := (Label label:'three' in:p) level:-1.
-
- v extent:400 @ 300.
- v open.
-
- (Delay forSeconds:5) wait.
-
- l1 label:'oneone'.
- l2 label:'twotwo'.
- l3 label:'threethree'.
- [exEnd]
-"
-! !
-
-!HorizontalPanelView methodsFor:'accessing'!
-
-horizontalLayout
- "return the horizontal layout as symbol.
- the returned value is one of
- #left arrange elements at the left
- #leftSpace arrange elements at the left, start with spacing
- #fixLeft same as #left, but do not reduce spacing in case of no fit
- #fixLeftSpace same as #leftSpace, but do not reduce spacing in case of no fit
- #right arrange elements at the right
- #rightSpace arrange elements at the right, start with spacing
- #center arrange elements in the center
- #spread spread elements evenly
- #spreadSpace spread elements evenly with spacing at the ends
- #fit like #spread, but resize elements for tight packing
- #fitSpace like #fit, with additional spacing at the far ends
- #leftFit like #left, but resize the last element to fit
- #leftSpaceFit like #leftSpace, but resize the last element to fit
- #rightFit like #right, but resize the first element to fit
- #rightSpaceFit like #rightSpace, but resize the first element to fit
- the default is #center
- See the class documentation for the meanings.
- "
-
- ^ hLayout
-
- "Modified: 17.8.1997 / 15:21:26 / cg"
-!
-
-horizontalLayout:aSymbol
- "change the horizontal layout as symbol.
- The argument, aSymbol must be one of:
- #left arrange elements at the left
- #leftSpace arrange elements at the left, start with spacing
- #fixLeft same as #left, but do not reduce spacing in case of no fit
- #fixLeftSpace same as #leftSpace, but do not reduce spacing in case of no fit
- #right arrange elements at the right
- #rightSpace arrange elements at the right, start with spacing
- #center arrange elements in the center
- #spread spread elements evenly
- #spreadSpace spread elements evenly with spacing at the ends
- #fit like #spread, but resize elements for tight packing
- #fitSpace like #fit, with additional spacing at the far ends
- #leftFit like #left, but resize the last element to fit
- #leftSpaceFit like #leftSpace, but resize the last element to fit
- #rightFit like #right, but resize the first element to fit
- #rightSpaceFit like #rightSpace, but resize the first element to fit
-
- #leftMax like non-Max layouts, resizing components to
- #leftSpaceMax the width of the widest component
- #rightMax
- #rightSpaceMax
- #centerMax
- #spreadMax
- #spreadSpaceMax
- the default (if never changed) is #center.
- See the class documentation for the meanings.
- "
-
- (hLayout ~~ aSymbol) ifTrue:[
- hLayout := aSymbol.
- self layoutChanged
- ]
-
- "Modified: 17.8.1997 / 15:21:16 / cg"
-!
-
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- leftover for historic reasons - do not use any more.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #horizontalLayout:'.
- ^ self horizontalLayout:something
-
- "Modified: 31.8.1995 / 23:07:33 / claus"
-!
-
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top place element at the top
- #topSpace place element at the top, offset by verticalSpace
- #center place it horizontally centered
- #bottom place it at the bottom
- #bottomSpace place it at the bottom, offset by verticalSpace
- #fit resize elements vertically to fit this panel
- #fitSpace like #fit, but with spacing
-
- #topMax like #top, but resize all views vertically to max height
- #topSpaceMax like #topSpace, but resize all views vertically to max height
- #bottomMax like #bottom, but resize all views vertically to max height
- #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
- #centerMax like #center, but resize all views vertically to max height
- the default is #center
- See the class documentation for the meanings.
- "
-
- ^ vLayout
-!
-
-verticalLayout:aSymbol
- "change the vertical layout as a symbol.
- The argument, aSymbol must be one of:
- #top place element at the top
- #topSpace place element at the top, offset by verticalSpace
- #center place it horizontally centered
- #bottom place it at the bottom
- #bottomSpace place it at the bottom, offset by verticalSpace
- #fit resize elements vertically to fit this panel
- #fitSpace like #fit, but with spacing
-
- #topMax like #top, but resize all views vertically to max height
- #topSpaceMax like #topSpace, but resize all views vertically to max height
- #bottomMax like #bottom, but resize all views vertically to max height
- #bottomSpaceMax like #bottomSpace, but resize all views vertically to max height
- #centerMax like #center, but resize all views vertically to max height
- the default (if never changed) is #center
- See the class documentation for the meanings.
- "
-
- (vLayout ~~ aSymbol) ifTrue:[
- vLayout := aSymbol.
- self layoutChanged
- ]
-! !
-
-!HorizontalPanelView methodsFor:'layout'!
-
-setChildPositions
- "(re)compute position of every child whenever childs are added or
- my size has changed"
-
- |xpos space sumOfWidths numChilds l wEach wInside hL vL resizeToMaxV
- resizeToMaxH maxHeight maxWidth d m2 subViews ext
- restWidth|
-
- subViews := self subViewsToConsider.
- subViews size == 0 ifTrue:[^ self].
-
- extentChanged ifTrue:[
- ext := self computeExtent.
- width := ext x.
- height := ext y.
- ].
-
- space := horizontalSpace.
- numChilds := subViews size.
-
- m2 := margin * 2.
- wInside := width - m2 + (borderWidth*2) - subViews last borderWidth.
-
- hL := hLayout.
- vL := vLayout.
-
- resizeToMaxH := false.
- (hL endsWith:'Max') ifTrue:[
- resizeToMaxH := true.
- wEach := maxWidth := subViews inject:0 into:[:maxSoFar :child | maxSoFar max:child widthIncludingBorder].
- hL := (hL copyWithoutLast:3) asSymbol.
- ].
-
- numChilds == 1 ifTrue:[
- (hL == #leftFit or:[hL == #rightFit]) ifTrue:[
- hL := #fit
- ].
- (hL == #leftSpaceFit or:[hL == #rightSpaceFit]) ifTrue:[
- hL := #fitSpace
- ].
- ].
-
- hL == #fitSpace ifTrue:[
- "
- adjust childs extents and set origins.
- Be careful to avoid accumulation of rounding errors
- "
- wEach := (wInside - (numChilds + 1 * space)) / numChilds.
- xpos := space + margin - borderWidth.
- ] ifFalse:[
- hL == #fit ifTrue:[
- "
- adjust childs extents and set origins.
- Be careful to avoid accumulation of rounding errors
- "
- wEach := (wInside - (numChilds - 1 * space)) / numChilds.
- xpos := margin - borderWidth.
- ] ifFalse:[
- l := hL.
-
- "/ adjust - do not include width of last(first) element if doing a fit
- (hL == #leftFit or:[hL == #leftSpaceFit]) ifTrue:[
- subViews last width:0.
- ].
- (hL == #rightFit or:[hL == #rightSpaceFit]) ifTrue:[
- subViews first width:0.
- ].
-
- "
- compute net width needed
- "
- resizeToMaxH ifTrue:[
- sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + maxWidth + (child borderWidth*2)].
- ] ifFalse:[
- sumOfWidths := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child widthIncludingBorder].
- ].
-
- restWidth := width - sumOfWidths.
-
- ((l == #center) and:[numChilds == 1]) ifTrue:[l := #spread].
- (l == #spread and:[numChilds == 1]) ifTrue:[l := #spreadSpace].
-
- "
- compute position of leftmost subview and space between them;
- if they do hardly fit, leave no space between them
- "
- ((sumOfWidths >= (width - m2))
- and:[l ~~ #fixLeftSpace and:[l ~~ #fixLeft]]) ifTrue:[
- xpos := margin.
- space := 0
- ] ifFalse: [
- l == #fixLeftSpace ifTrue:[
- l := #leftSpace
- ] ifFalse:[
- l == #fixLeft ifTrue:[
- l := #left
- ]
- ].
- ((l == #right) or:[l == #rightSpace
- or:[l == #rightFit or:[l == #rightSpaceFit]]]) ifTrue:[
- xpos := restWidth - (space * (numChilds - 1)).
-"/
-"/ borderWidth == 0 ifTrue:[
-"/ xpos := xpos + space
-"/ ].
-"/
- (l == #rightSpace
- or:[l == #rightSpaceFit]) ifTrue:[
- xpos >= space ifTrue:[
- xpos := xpos - space
- ]
- ].
- xpos := xpos - margin.
-
- xpos < 0 ifTrue:[
- space := space min:(restWidth // (numChilds + 1)).
- xpos := restWidth - (space * numChilds).
- ]
- ] ifFalse:[
- (l == #spread) ifTrue:[
- space := (restWidth - m2) // (numChilds - 1).
- xpos := margin.
- (space == 0) ifTrue:[
- xpos := restWidth // 2
- ]
- ] ifFalse:[
- (l == #spreadSpace) ifTrue:[
- space := (restWidth - m2) // (numChilds + 1).
- xpos := space + margin.
- (space == 0) ifTrue:[
- xpos := restWidth // 2
- ]
- ] ifFalse:[
- ((l == #left) or:[l == #leftSpace
- or:[l == #leftFit or:[l == #leftSpaceFit]]]) ifTrue:[
- space := space min:(restWidth - m2) // (numChilds + 1).
- (hL == #fixLeft or:[hL == #fixLeftSpace]) ifTrue:[
- space := space max:horizontalSpace.
- ] ifFalse:[
- space := space max:0.
- ].
- (l == #leftSpace or:[l == #leftSpaceFit]) ifTrue:[
- xpos := space + margin.
- ] ifFalse:[
- "/
- "/ if the very first view has a 0-level AND
- "/ my level is non-zero, begin with margin
- "/
- true "(margin ~~ 0 and:[subViews first level == 0])" ifTrue:[
- xpos := margin
- ] ifFalse:[
- xpos := 0
- ]
- ]
- ] ifFalse:[
- "center"
- xpos := (restWidth - ((numChilds - 1) * space)) // 2.
- xpos < 0 ifTrue:[
- space := restWidth // (numChilds + 1).
- xpos := (restWidth - ((numChilds - 1) * space)) // 2.
- ]
- ]
- ]
- ]
- ]
- ].
- ].
- ].
-
- resizeToMaxV := false.
- (vL endsWith:'Max') ifTrue:[
- resizeToMaxV := true.
- maxHeight := subViews inject:0 into:[:maxSoFar :child | maxSoFar max:child heightIncludingBorder].
- vL := (vL copyWithoutLast:3) asSymbol.
- ].
-
- "
- now set positions
- "
-
- subViews keysAndValuesDo:[:index :child |
- |ypos advance bwChild hChild newHChild|
-
- hChild := child heightIncludingBorder.
- bwChild := child borderWidth.
-
- resizeToMaxV ifTrue:[
- child height:(hChild := maxHeight - (bwChild * 2)).
- ].
-
- vL == #top ifTrue:[
- ypos := margin
- ] ifFalse:[
- vL == #topSpace ifTrue:[
- ypos := margin + verticalSpace
- ] ifFalse:[
- vL == #bottom ifTrue:[
- ypos := height - margin - child heightIncludingBorder
- ] ifFalse:[
- vL == #bottomSpace ifTrue:[
- ypos := height - margin
- - verticalSpace - child heightIncludingBorder.
- ] ifFalse:[
- vL == #fitSpace ifTrue:[
- ypos := verticalSpace.
- newHChild := height - (verticalSpace + bwChild * 2).
- ypos := ypos + margin.
- newHChild := newHChild - m2.
- ] ifFalse:[
- vL == #fit ifTrue:[
- newHChild := height - (bwChild * 2).
- "/
- "/ if the view has a 0-level AND
- "/ my level is non-zero, begin with margin
- "/
- true "(level ~~ 0 and:[child level == 0])" ifTrue:[
- ypos := margin.
- newHChild := newHChild - m2.
- ] ifFalse:[
- ypos := 0.
- ].
- ] ifFalse:[
- "centered"
- ypos := margin + ((height - m2 - hChild) // 2).
- ]
- ]
- ]
- ]
- ]
- ].
- newHChild notNil ifTrue:[
- child height:newHChild
- ].
-
- (ypos < 0) ifTrue:[ypos := 0].
-
- (hL == #fit
- or:[hL == #fitSpace
- or:[resizeToMaxH]]) ifTrue:[
-"/cg: removed this (OLD) piece of code,
-"/ which prevents resizing of label-like things if their sizeFixed
-"/ is set to true (I dont remember why I ever added this)
-
-"/ child sizeFixed ifTrue:[
-"/ d := wEach - (child widthIncludingBorder) // 2.
-"/ child origin:(xpos truncated + d @ ypos)
-"/ ] ifFalse:[
- child origin:(xpos truncated @ ypos)
- corner:(xpos + wEach - (child borderWidth) - 1) truncated
- @ (ypos + child height - 1).
-"/ ].
- advance := wEach.
- ] ifFalse:[
- child origin:(xpos @ ypos).
- advance := child widthIncludingBorder
- ].
-
- index == numChilds ifTrue:[
- |x|
-
- (hL == #leftFit or:[hL == #leftSpaceFit]) ifTrue:[
- x := width - margin - 1 - (child borderWidth * 2) + borderWidth.
- hL == #leftSpaceFit ifTrue:[
- x := x - space
- ].
- child corner:(x @ (ypos + child height - 1))
- ].
- ].
- index == 1 ifTrue:[
- |x xR|
-
- (hL == #rightFit or:[hL == #rightSpaceFit]) ifTrue:[
- x := margin + 0 + (child borderWidth * 2) - borderWidth.
- hL == #rightSpaceFit ifTrue:[
- x := x + space
- ].
- xR := child corner x.
- child origin:(x @ (child origin y))
- corner:(xR @ (child corner y))
- ].
- ].
-
- xpos := xpos + advance + space.
- ].
-
- "Modified: / 4.9.1995 / 18:43:10 / claus"
- "Modified: / 27.1.1998 / 21:03:06 / cg"
-! !
-
-!HorizontalPanelView methodsFor:'queries'!
-
-preferredExtent
- "return a good extent, one that makes subviews fit"
-
- |sumOfWidths maxHeight maxWidth m2 subViews|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- subViews := self subViewsToConsider.
- (subViews size == 0) ifTrue:[
- ^ super preferredExtent.
- "/ ^ horizontalSpace @ verticalSpace].
- ].
-
- "compute net height needed"
-
- sumOfWidths := 0.
- maxHeight := 0.
- maxWidth := 0.
-
- subViews do:[:child |
- |childsPreference|
-
- "/ better to use component's preferredExtent ...
-
- childsPreference := child preferredExtent.
- sumOfWidths := sumOfWidths + childsPreference x.
- maxHeight := maxHeight max:childsPreference y.
- maxWidth := maxWidth max:childsPreference x.
-
- "/ ... instead of actual extent
-"/ sumOfWidths := sumOfWidths + child widthIncludingBorder.
-"/ maxHeight := maxHeight max:(child heightIncludingBorder).
-"/ maxWidth := maxWidth max:(child widthIncludingBorder).
- ].
- borderWidth ~~ 0 ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2).
- maxHeight := maxHeight + (verticalSpace * 2).
- ].
- (hLayout == #fit
- or:[hLayout == #fitSpace
- or:[hLayout endsWith:'Max']]) ifTrue:[
- sumOfWidths := maxWidth * subViews size.
- borderWidth ~~ 0 ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2).
- ]
- ] ifFalse:[
- sumOfWidths := sumOfWidths + ((subViews size - 1) * horizontalSpace).
- ((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
- sumOfWidths := sumOfWidths + horizontalSpace
- ] ifFalse:[
- ((hLayout == #center) or:[hLayout == #spread]) ifTrue:[
- sumOfWidths := sumOfWidths + (horizontalSpace * 2)
- ]
- ].
- ].
-
- ((vLayout == #topSpace)
- or:[vLayout == #bottomSpace]) ifTrue:[
- maxHeight := maxHeight + verticalSpace
- ] ifFalse:[
- ((vLayout == #fitSpace)
- or:[vLayout == #center
- or:[vLayout == #centerSpace]]) ifTrue:[
- maxHeight := maxHeight + (verticalSpace * 2)
- ]
- ].
-
- m2 := margin * 2.
- ^ (sumOfWidths + m2) @ (maxHeight + m2)
-
- "Modified: / 17.1.1998 / 00:18:38 / cg"
-! !
-
-!HorizontalPanelView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HPanelV.st,v 1.37 1999-02-18 10:47:48 cg Exp $'
-! !
--- a/HScrBar.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-"
- 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.
-"
-
-ScrollBar subclass:#HorizontalScrollBar
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
-!
-
-!HorizontalScrollBar 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.
-"
-!
-
-documentation
-"
- this class implements horizontal scrollbars with scroller and
- 2 step-scroll buttons. When moved or stepped, it performs a
- predefined action.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!HorizontalScrollBar methodsFor:'initialization'!
-
-initialize
- orientation := #horizontal.
- super initialize
-
-! !
-
-!HorizontalScrollBar class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.29 1999-07-07 18:53:37 cg Exp $'
-! !
--- a/HScroller.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,72 +0,0 @@
-"
- 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.
-"
-
-Scroller subclass:#HorizontalScroller
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Interactors'
-!
-
-!HorizontalScroller 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.
-"
-!
-
-documentation
-"
- Actually simply a scroller which preinitializes itself to have
- a horizontal orientation.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!HorizontalScroller methodsFor:'accessing-behavior'!
-
-scrollLeftAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-!
-
-scrollRightAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-! !
-
-!HorizontalScroller methodsFor:'initialization'!
-
-initialize
- orientation := #horizontal.
- super initialize.
- orientation := #horizontal.
-
- "Modified: / 7.3.1999 / 00:01:08 / cg"
-! !
-
-!HorizontalScroller class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HScroller.st,v 1.16 1999-03-07 13:26:38 cg Exp $'
-! !
--- a/HVScrView.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,37 +0,0 @@
-ScrollableView subclass:#HVScrollableView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
-!
-
-!HVScrollableView class methodsFor:'documentation'!
-
-documentation
-"
- This class is now void; all horizontal scroll functionality is
- now contained in ScrollableView.
- It remains here, for backward compatibility with applications using
- it.
-
- Please see the documentation and examples in my superclass, ScrollableView
-
- [author:]
- Claus Gittinger
-"
-
-! !
-
-!HVScrollableView class methodsFor:'defaults'!
-
-defaultHorizontalScrollable
- ^ true
-
-
-! !
-
-!HVScrollableView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.27 1999-06-17 08:51:08 tm Exp $'
-! !
--- a/LSelBox.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,343 +0,0 @@
-"
- 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.
-"
-
-EnterBox subclass:#ListSelectionBox
- instanceVariableNames:'selectionList'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-DialogBoxes'
-!
-
-!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.
-"
-!
-
-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).
- see examples for typical uses.
-
- Notice, for file selections there is a specialized FileSelectionBox,
- which supports matchPatterns, changing directory etc.
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- simple:
- [exBegin]
- |box|
-
- box := ListSelectionBox new.
- box title:'select something:'.
- box list:#('foo' 'bar' 'baz').
- box okAction:[:sel | Transcript showCR:'the selection was:' , sel].
- box showAtPointer
- [exEnd]
-
-
- with a default:
- [exBegin]
- |box|
-
- box := ListSelectionBox new.
- box title:'select something:'.
- box list:#('foo' 'bar' 'baz').
- box okAction:[:sel | Transcript showCR:'the selection was:' , sel].
- box initialText:'foo'.
- box showAtPointer
- [exEnd]
-
-
- opening the box modeless (a stand-by box):
- (in this case, the default ok- and abortActions do not hide the box;
- therefore, we have to set those explicitely)
- [exBegin]
- |box|
-
- box := ListSelectionBox new.
- box title:'select something:'.
- box list:#('foo' 'bar' 'baz').
- box abortText:'close'.
- box okText:'apply'.
- box okAction:[:sel | Transcript showCR:'the selection was:' , sel].
- box abortAction:[:dummy | box hide].
- box openModeless
- [exEnd]
-"
-! !
-
-!ListSelectionBox class methodsFor:'instance creation'!
-
-title:titleString okText:okText abortText:abortText list:aList action:aBlock
- "create and return a new listSelectionBox with list already defined"
-
- |newBox|
-
- newBox := super title:titleString okText:okText abortText:abortText
- action:aBlock.
- ^ newBox list:aList
-! !
-
-!ListSelectionBox class methodsFor:'defaults'!
-
-defaultExtent
- "return the default extent of my instances.
- The value returned here is usually ignored, and
- the value from preferredExtent taken instead."
-
- ^ (Screen current pixelPerMillimeter * (80 @ 100)) rounded
-
- "Modified: 5.7.1996 / 13:53:46 / cg"
-!
-
-listViewType
- "return the type of listView
- - for easier redefinition in subclasses"
-
- ^ SelectionInListView
-! !
-
-!ListSelectionBox methodsFor:'accessing'!
-
-contents
- "return my contents"
-
- enterField isNil ifTrue:[
- ^ selectionList selectionValue
- ].
- ^ super contents
-
- "Created: 26.2.1996 / 20:05:47 / cg"
-!
-
-initialText:someString
- "in addition to showing the initial text, also select it in the list"
-
- super initialText:someString.
- selectionList setSelectElement:someString.
-
- "Modified: 26.5.1996 / 15:03:37 / cg"
-!
-
-list:aList
- "set the list to be displayed in selection list"
-
- selectionList list:aList
-!
-
-selectionIndex
- ^ selectionList selection
-
- "Created: 14.10.1996 / 16:28:50 / cg"
-! !
-
-!ListSelectionBox methodsFor:'accessing-components'!
-
-listView
- "return the listView component"
-
- ^ selectionList
-
- "Created: 26.10.1995 / 17:08:32 / cg"
-! !
-
-!ListSelectionBox methodsFor:'accessing-look'!
-
-noEnterField
- "suppress the enterField - now only existing items are selectable;
- the default is to present an enterField."
-
- enterField destroy.
- enterField := nil
-
- "Created: 26.10.1995 / 17:12:38 / cg"
- "Modified: 12.5.1996 / 21:49:14 / cg"
-! !
-
-!ListSelectionBox methodsFor:'initialization'!
-
-initialize
- |space2 halfSpace v vbw|
-
- super initialize.
-
- label := resources string:'Select or enter'.
-
- "need more space than an enterBox"
-
- "self height:(height + (font height * 5)). "
-
- space2 := 2 * ViewSpacing.
- halfSpace := ViewSpacing // 2.
-
- v := ScrollableView for:(self class listViewType) in:self.
-
-"/ old:
-"/ v origin:[0.0
-"/ @
-"/ (enterField origin y + enterField height + ViewSpacing)]
-"/ extent:[1.0
-"/ @
-"/ (height
-"/ - ViewSpacing - labelField heightIncludingBorder
-"/ - ViewSpacing - enterField heightIncludingBorder
-"/ - buttonPanel heightIncludingBorder - ViewSpacing
-"/ - space2)
-"/ ].
-
-"/ new:
- v origin:[enterField notNil ifTrue:[
- 0.0 @ (enterField origin y + enterField height + ViewSpacing)
- ] ifFalse:[
- 0.0 @ (labelField origin y + labelField height + ViewSpacing)
- ]
- ]
- corner:(1.0 @ 1.0).
- v bottomInset:(buttonPanel preferredExtent y + ViewSpacing).
-
- vbw := v borderWidth.
- v leftInset:halfSpace+vbw;
- rightInset:halfSpace+vbw.
-
- selectionList := v scrolledView.
- self makeTabable:selectionList.
-
- "self updateList."
-
- "I am interested in what is done in the selectionList
- (could also create a SelectionInList-model and catch its changes ...)"
- selectionList action:[:lineNr | self selectionChanged].
- selectionList doubleClickAction:[:lineNr | self doubleClick].
-
- enterField removeDependent:self. "dont want preferredExtent-changes"
-
- "
- mhm: the lists keyboard functions are disabled,
- and input passed to the enterfield (except cursor keys)
- "
- selectionList delegate:(
- KeyboardForwarder
- toView:enterField
- condition:#noFocus
- filter:[:key | (key ~~ #CursorUp) and:[key ~~ #CursorDown]]
- )
-
- "Modified: 31.5.1996 / 22:02:33 / cg"
-!
-
-postRealize
- "update the list now.
- This was not done in #initialize to allow settings to be changed before,
- in case list-updating is a slow operation - such as reading a directory"
-
- super postRealize.
- self updateList.
-
- "Modified: 12.5.1996 / 21:50:50 / cg"
- "Created: 24.7.1997 / 18:22:19 / cg"
-!
-
-updateList
- "setup contents of list;
- nothing done here but typically redefined in subclasses."
-
- ^ self
-
- "Modified: 12.5.1996 / 21:51:10 / cg"
-! !
-
-!ListSelectionBox methodsFor:'queries'!
-
-preferredExtent
- "return my preferred extent - thats the minimum size
- I like to have, to make everything visible"
-
- |wWanted hWanted eH mm|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- mm := ViewSpacing.
-
- wWanted := mm + labelField width + mm.
- (wWanted > width) ifFalse:[
- wWanted := width
- ].
-
- enterField notNil ifTrue:[
- eH := enterField height + mm
- ] ifFalse:[
- eH := 0
- ].
- hWanted := mm + labelField height +
- eH +
- mm + selectionList height +
- mm + buttonPanel preferredExtent y +
- mm - (mm * 2).
-
- (hWanted < height) ifTrue:[
- hWanted := height
- ].
- ^ (wWanted @ hWanted)
-
- "Modified: 19.7.1996 / 20:44:52 / cg"
-! !
-
-!ListSelectionBox methodsFor:'user actions'!
-
-doubleClick
- "doubleClick on an entry is select & ok"
-
- enterField notNil ifTrue:[
- enterField contents:(selectionList selectionValue).
- ].
- self okPressed
-
- "Modified: 26.2.1996 / 20:05:45 / cg"
-!
-
-selectionChanged
- "selections in list get forwarded to enterfield"
-
- enterField notNil ifTrue:[
- enterField contents:(selectionList selectionValue)
- ]
-
- "Modified: 26.10.1995 / 17:20:06 / cg"
-! !
-
-!ListSelectionBox class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/LSelBox.st,v 1.39 1997-07-26 14:21:52 cg Exp $'
-! !
--- a/ListViewC.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,65 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-Controller subclass:#ListViewController
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support'
-!
-
-!ListViewController class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ListViewC.st,v 1.2 1995-11-11 16:21:22 cg Exp $'
-!
-
-documentation
-"
- a very simple controller: only handles some keys to pageup/down
- the view.
-"
-! !
-
-!ListViewController methodsFor:'event processing'!
-
-keyPress:key x:x y:y
- "a key was pressed - handle page-keys here"
-
- (key == #Prior) ifTrue: [^ view pageUp].
- (key == #Next) ifTrue: [^ view pageDown].
-
- (key == #Ctrlb) ifTrue:[^ view pageUp].
- (key == #Ctrlf) ifTrue:[^ view pageDown].
- (key == #Ctrld) ifTrue:[^ view halfPageDown].
- (key == #Ctrlu) ifTrue:[^ view halfPageUp].
-
- (key == #ScrollUp) ifTrue:[^ view scrollUp].
- (key == #ScrollDown) ifTrue:[^ view scrollDown].
-
- super keyPress:key x:x y:y
-! !
-
--- a/MSelList.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,196 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-SelectionInList subclass:#MultiSelectionInList
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Models'
-!
-
-!MultiSelectionInList class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- Like a selectionInList, but allows for multiple selected items.
- For use as a model for SelectionInListViews, with multipleSelectOk set to true.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!MultiSelectionInList methodsFor:'accessing-values'!
-
-selection
- "return the selections value (i.e. the entry numbers in the list)"
-
- |l s|
-
- ( (l := self list) isNil "/ mhmh - no list; what should we do here ?
- or:[(s := selectionIndexHolder value) size == 0] "/ mhmh - can be nil ?
- ) ifTrue:[
- ^ self zeroIndex
- ].
-
- ^ s collect:[:index | l at:index ]
-
- "Created: 26.10.1995 / 16:52:27 / cg"
- "Modified: 20.4.1996 / 13:14:29 / cg"
-!
-
-selection:anObjectList
- "set the selection to be anObjectList."
-
- |l indizes objList|
-
- "/
- "/ for your convenience: allow 0 and nil as empty
- "/ selections
- "/
- anObjectList size == 0 ifTrue:[
- (anObjectList isCollection or:[anObjectList isNil]) ifTrue:[
- ^ self selectionIndex:#()
- ].
- objList := Array with:anObjectList
- ] ifFalse:[
- objList := anObjectList
- ].
-
- l := self list.
- l isNil ifTrue:[^ self]. "/ mhmh - no list; what should we do here ?
-
- indizes := OrderedCollection new.
- objList do:[:o |
- |idx|
-
- idx := l indexOf:o ifAbsent:0.
- idx ~~ 0 ifTrue:[
- indizes add:idx
- ].
- ].
- ^ self selectionIndex:indizes
-
- "Created: 26.10.1995 / 16:40:24 / cg"
- "Modified: 25.4.1996 / 09:07:44 / cg"
-!
-
-selectionIndex:indexes
- "set list of indexes
- "
- indexes size ~~ 0 ifTrue:[
- ^ super selectionIndex:indexes
- ].
-
- (indexes isCollection or:[indexes isNil]) ifTrue:[
- ^ super selectionIndex:#()
- ].
- ^ super selectionIndex:(OrderedCollection with:indexes)
-!
-
-selectionIndexes
- "added for ST-80 compatibility
- "
- ^ self selectionIndex value
-!
-
-selectionIndexes:indizes
- "added for ST-80 compatibility
- "
- ^ self selectionIndex:indizes
-! !
-
-!MultiSelectionInList methodsFor:'queries'!
-
-numberOfSelections
- "return the number of selected entries
- "
- ^ selectionIndexHolder value size
-
-!
-
-zeroIndex
- "return the selectionIndex returned when nothing is selected.
- Here, an empty collection is returned."
-
- ^ Array new
-
- "Modified: 20.4.1996 / 13:12:58 / cg"
-! !
-
-!MultiSelectionInList methodsFor:'selections'!
-
-clearAll
- "ST80 compatibility"
-
- self selection:nil.
-!
-
-selectAll
- "ST80 compatibility"
-
- |indizes size|
-
- (size := listHolder value size) == 0 ifTrue:[
- ^ self clearAll
- ].
-
- indizes := Array new:size.
- 1 to:size do:[:i| indizes at:i put:i].
- self selectionIndex:indizes.
-!
-
-selections
- "obsolete - almost the same as selection"
-
- |selectionIndices|
-
- self obsoleteMethodWarning.
-
- selectionIndices := selectionIndexHolder value.
- (selectionIndices isNil
- or:[selectionIndices == 0
- or:[selectionIndices isEmpty]]) ifFalse:[
- ^ selectionIndices collect:[:index | listHolder value at:index]
- ].
- ^ Array new
-
- "Modified: 25.4.1996 / 09:09:45 / cg"
-!
-
-selections:aCollection
- "ST80 compatibility"
-
- ^ self selection:aCollection
-
- "Created: / 8.11.1997 / 12:55:23 / cg"
-! !
-
-!MultiSelectionInList class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/MSelList.st,v 1.16 1998-01-14 15:17:01 ca Exp $'
-! !
--- a/Make.proto Wed Sep 08 20:14:57 1999 +0200
+++ b/Make.proto Thu Sep 09 12:52:02 1999 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libwidg/Make.proto,v 1.66 1999-09-08 18:14:55 cg Exp $
+# $Header: /cvs/stx/stx/libwidg/Make.proto,v 1.67 1999-09-09 10:51:43 cg Exp $
#
# -------------- no need to change anything below ----------
@@ -25,102 +25,104 @@
Button.$(O) \
ButtonController.$(O) \
Toggle.$(O) \
- ToggleController.$(O) \
- RadioButton.$(O) \
- RButtC.$(O) \
- RButtGrp.$(O) \
- CheckToggle.$(O) \
+ ToggleController.$(O) \
+ RadioButton.$(O) \
+ RadioButtController.$(O) \
+ RadioButtGroup.$(O) \
+ CheckToggle.$(O) \
CheckLabel.$(O) \
ScrollBar.$(O) \
- HScrBar.$(O) \
- MiniScr.$(O) \
- HMiniScr.$(O) \
+ HorizontalScrollBar.$(O) \
+ MiniScroller.$(O) \
+ HorizontalMiniScroller.$(O) \
DialogBox.$(O) \
+ OptionBox.$(O) \
EnterBox.$(O) \
EnterBox2.$(O) \
- LSelBox.$(O) \
- FSelBox.$(O) \
- FSaveBox.$(O) \
+ ListSelectionBox.$(O) \
+ FileSelelectionBox.$(O) \
+ FileSaveBox.$(O) \
InfoBox.$(O) \
- WarnBox.$(O) \
+ WarningBox.$(O) \
YesNoBox.$(O) \
- MSelList.$(O) \
+ MultiSelectionInList.$(O) \
FramedBox.$(O) \
Workspace.$(O) \
+ VariablePanelController.$(O) \
+ VariableVerticalPanelController.$(O) \
+ VariableHorizontalPanelController.$(O) \
+ PopUpListController.$(O) \
FontPanel.$(O)
OBJS= \
ListView.$(O) \
PanelView.$(O) \
- ScrView.$(O) \
- HVScrView.$(O) \
+ ScrollableView.$(O) \
+ HVScrollableView.$(O) \
SequenceView.$(O) \
Label.$(O) \
Scroller.$(O) \
- MiniScr.$(O) \
+ MiniScroller.$(O) \
ScrollBar.$(O) \
- ObjView.$(O) \
+ ObjectView.$(O) \
PopUpMenu.$(O) \
DialogBox.$(O) \
InfoBox.$(O) \
TextView.$(O) \
- SelListV.$(O) \
- HPanelV.$(O) \
- VPanelV.$(O) \
- VarPanel.$(O) \
- VarVPanel.$(O) \
- VarHPanel.$(O) \
+ SelectionInListView.$(O) \
+ HorizontalPanelView.$(O) \
+ VerticalPanelView.$(O) \
+ VariablePanel.$(O) \
+ VariableVerticalPanel.$(O) \
+ VariableHorizontalPanel.$(O) \
Button.$(O) \
- ArrButton.$(O) \
- HScroller.$(O) \
- HMiniScr.$(O) \
- HScrBar.$(O) \
+ ArrowButton.$(O) \
+ HorizontalScroller.$(O) \
+ HorizontalMiniScroller.$(O)\
+ HorizontalScrollBar.$(O) \
EnterBox.$(O) \
- WarnBox.$(O) \
+ WarningBox.$(O) \
YesNoBox.$(O) \
MenuView.$(O) \
- FSelList.$(O) \
- ETxtView.$(O) \
+ FileSelectionList.$(O) \
+ EditTextView.$(O) \
Toggle.$(O) \
- LSelBox.$(O) \
+ ListSelectionBox.$(O) \
EnterBox2.$(O) \
EditField.$(O) \
- TextColl.$(O) \
+ TextCollector.$(O) \
Workspace.$(O) \
CodeView.$(O) \
- FSelBox.$(O) \
- PullDMenu.$(O) \
- OptBox.$(O) \
+ FileSelectionBox.$(O) \
+ PullDownMenu.$(O) \
+ OptionBox.$(O) \
CheckToggle.$(O) \
CheckLabel.$(O) \
- FSaveBox.$(O) \
+ FileSaveBox.$(O) \
ButtonController.$(O) \
- PopUpLstC.$(O) \
+ PopUpListController.$(O) \
ToggleController.$(O) \
- RButtC.$(O) \
+ RadioButtonController.$(O) \
ClickMenuView.$(O) \
- EFGroup.$(O) \
+ EnterFieldGroup.$(O) \
FontPanel.$(O) \
PopUpList.$(O) \
FramedBox.$(O) \
- RButtGrp.$(O) \
+ RadioButtonGroup.$(O) \
RadioButton.$(O) \
- VarPanelC.$(O) \
- VarVPanelC.$(O) \
- VarHPanelC.$(O) \
- SelList.$(O) \
- MSelList.$(O)
-
-obsolete: Notifier.$(O) \
- ErrNotify.$(O)
+ VariablePanelController.$(O) \
+ VariableVerticalPanelController.$(O) \
+ VariableHorizontalPanelController.$(O) \
+ SelectionInList.$(O) \
+ MultiSelectionInList.$(O)
#
# on (my) aix system, this one cannot be compiled with
# optimizer - running out of space during compile
#
AIX:: ListView.o TextView.o
- $(MAKE) OPT="" ETxtView.o
- $(MAKE) OPT="" ObjView.o
+ $(MAKE) OPT="" EditTextView.o
+ $(MAKE) OPT="" ObjectView.o
cleanjunk::
@-rm -f *.c *.H
@@ -154,7 +156,7 @@
$(MAKE) CodeView.o STCFLAGS="$(STCFLAGS) $(LIMITSUPERINCLUDE)"
WARNBOX:
- $(MAKE) WarnBox.o STCFLAGS="$(STCFLAGS) $(LIMITSUPERINCLUDE)"
+ $(MAKE) WarningBox.o STCFLAGS="$(STCFLAGS) $(LIMITSUPERINCLUDE)"
RBUTTON:
$(MAKE) RadioButton.o STCFLAGS="$(STCFLAGS) $(LIMITSUPERINCLUDE)"
@@ -162,8 +164,8 @@
#
# special BIG-rule (kludge for HP)
#
-ETxtView.$(O):
- $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=ETxtView CC=$(CC) OPT="$(OPT)"
+EditTextView.$(O):
+ $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=EditTextView CC=$(CC) OPT="$(OPT)"
#
@@ -178,10 +180,10 @@
#HP::
#
#HPbigFiles:
-# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=ObjView CC=$(CC) OPT="$(OPT)"
+# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=ObjectView CC=$(CC) OPT="$(OPT)"
# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=DialogBox CC=$(CC) OPT="$(OPT)"
# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=TextView CC=$(CC) OPT="$(OPT)"
-# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=SelListV CC=$(CC) OPT="$(OPT)"
+# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=SelectionInListView CC=$(CC) OPT="$(OPT)"
# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=MenuView CC=$(CC) OPT="$(OPT)"
#
@@ -190,7 +192,7 @@
SUN:: SUNfiles
SUNfiles:
- $(MAKE) WarnBox.o STCFLAGS="$(STCFLAGS) $(LIMITSUPERINCLUDE)"
+ $(MAKE) WarningBox.o STCFLAGS="$(STCFLAGS) $(LIMITSUPERINCLUDE)"
--- a/MiniScr.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,151 +0,0 @@
-"
- 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.
-"
-
-Scroller subclass:#MiniScroller
- instanceVariableNames:''
- classVariableNames:'MiniScrollerSize'
- poolDictionaries:''
- category:'Views-Interactors'
-!
-
-!MiniScroller 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.
-"
-!
-
-documentation
-"
- like a scroller, but taking less screen space
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!MiniScroller class methodsFor:'defaults'!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'miniScroller.size')>
-
- MiniScrollerSize := StyleSheet at:'miniScroller.size'.
-
- "
- self updateStyleCache
- "
-
- "Created: 15.8.1997 / 01:51:38 / cg"
- "Modified: 20.10.1997 / 15:06:36 / cg"
-! !
-
-!MiniScroller methodsFor:'initialization'!
-
-initStyle
- "setup viewStyle specifics"
-
- |style lvl|
-
- super initStyle.
- style := StyleSheet name.
- style == #iris ifTrue:[
- tallyLevel := tallyMarks := 0.
- thumbEdgeStyle := nil.
- thumbLevel := thumbActiveLevel := 2.
- ].
- ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
- style == #st80 ifTrue:[
- lvl := 1.
- "/ lvl := 0.
- ] ifFalse:[
- lvl := -1.
- ].
- self level:lvl.
- self borderWidth:0
- ].
- shadowForm := lightForm := nil.
- fixThumbHeight := false.
-
- thumbImage := nil.
-
- "Modified: / 12.5.1998 / 20:41:52 / cg"
-!
-
-initialize
- "initialize - setup instvars from defaults"
-
- orientation isNil ifTrue:[orientation := #vertical].
- super initialize.
-! !
-
-!MiniScroller methodsFor:'queries'!
-
-isMiniScroller
- ^ true
-
- "Created: 7.3.1997 / 16:20:22 / cg"
-!
-
-preferredExtent
- "return my preferredExtent - make my width very small"
-
- |defExt w h mm|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- defExt := self class defaultExtent.
-
- (mm := MiniScrollerSize) isNil ifTrue:[
- mm := (thumbLevel ~~ 0) ifTrue:[1.8] ifFalse:[1.5].
- styleSheet name == #st80 ifTrue:[
- mm := 2
- ].
- ].
-
- w := defExt x.
- h := defExt y.
-
- orientation == #vertical ifTrue:[
- w := (device horizontalPixelPerMillimeter asFloat * mm) rounded.
- "/ dont let it become too small for thumb ...
- w := w max:((level abs + thumbLevel) * 2 + 1).
- ] ifFalse:[
- h := (device verticalPixelPerMillimeter asFloat * mm) rounded.
- "/ dont let it become too small for thumb ...
- h := h max:((level abs + thumbLevel) * 2 + 1).
- ].
- preferredExtent := w @ h.
- ^ preferredExtent.
-
- "Modified: / 25.1.1998 / 00:57:07 / cg"
-! !
-
-!MiniScroller class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/MiniScr.st,v 1.21 1998-05-12 19:00:42 cg Exp $'
-! !
--- a/ObjView.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3229 +0,0 @@
-"
- 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.
-"
-
-View subclass:#ObjectView
- instanceVariableNames:'contents sorted lastButt pressAction releaseAction
- shiftPressAction doublePressAction motionAction keyPressAction
- selection gridShown gridPixmap scaleMetric dragObject
- leftHandCursor oldCursor movedObject moveStartPoint moveDelta
- documentFormat canDragOutOfView rootMotion rootView aligning
- gridAlign aligningMove'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
-!
-
-!ObjectView 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.
-"
-!
-
-documentation
-"
- a View which can hold DisplayObjects, can make selections, move them around etc.
- this is an abstract class providing common mechanisms - actual instances are
- DrawView, DirectoryView, LogicView or DocumentView.
-
- [Instance variables:]
-
- contents <Collection> the objects. The order in which
- these are in that collection defines
- their appearance in the z-plane:
- an object located after another one
- here will be drawn ABOVE the other.
-
- sorted <Boolean> if set, redraw and picking methods
- assume that the objects are sorted by
- >= y-coordinates. These operations are
- a bit faster then, since a binary search
- can be done. (use with care).
-
- lastButt <Point> last pointer press position
- (internal)
-
- pressAction <Block> action to perform when mouse pointer
- is pressed. Can be set to something like
- [self startCreate], [self startSelectOrMove]
- etc.
-
- releaseAction <Block> action to perform when mouse pointer is
- released. Typically set in one of the
- startXXX methods.
-
- shiftPressAction <Block> like pressAction, if shift key is
- pressed.
-
- doublePressAction <Block> same for double-clicks
-
- motionAction <Block> action to perform on mouse-pointer
- motion.
-
- keyPressAction <Block> action for keyboard events
-
- selection <any> the current selection; either a single
- object or a collection of objects.
-
- gridShown <Boolean> internal
-
- gridPixmap <Form> internal
-
- scaleMetric <Symbol> either #mm or #inch; used to
- decide how the grid is defined
-
- dragObject internal
-
- leftHandCursor cursor shown while dragging a rectangle
-
- oldCursor saved original cursor while dragging a rectangle
-
- movedObject internal
- moveStartPoint internal
- moveDelta internal
-
- documentFormat <Symbol> defines the size and layout of the
- document. Can be any of
- #letter, #a4, #a3 etc.
-
- canDragOutOfView <Boolean> if true, objects can be dragged out of the
- view. If false, dragging is restricted to within
- this view.
-
- rootMotion internal
- rootView internal
-
- aligning <Boolean> if true, pointer positions are
- aligned (snapped) to the point
- specified in gridAlign
-
- gridAlign <Point> if aligning is true, this point
- defines the snapping. For example,
- 12@12 defines snap to the nearest
- 12-point grid.
-
- written spring/summer 89 by claus
-
- [author:]
- Claus Gittinger
-
- [see also:]
- DrawTool LogicTool
- DrawObject
- DisplayObject
-"
-!
-
-examples
-"
- typically, ObjectViews are not used on their own, but instead
- subclassed and thereby provide the common functionality for
- views which show (possibly overlapping) objects.
- The methods here provide all mechanisms to handle redraws, picking
- (i.e. finding an object by position), gridding, moving objects with
- minimum redraw etc.
- Also, zooming and scrolling is handled.
- All objects which respond to the DisplayObject protocol can be handled
- by ObjectView - therefore, you can add almost any object and have it
- displayed and handled here. (as an example, try to copy a LogicGate
- from a LogicView and paste it into a DrawTool - it will work).
-
- Reminder: ObjectViews are not to be used as below, but instead to be
- subclassed. Therefore, the examples below are somewhat untypical.
-
- simple example:
- [exBegin]
- |v o|
-
- v := ObjectView new.
- v extent:200@200.
-
- o := DrawRectangle new.
- o origin:10@10 corner:100@100.
- v add:o.
-
- o := DrawText new.
- o text:'hello there'; origin:50@50; foreground:Color red.
- v add:o.
-
- v open
- [exEnd]
-
- add scrolling:
- [exBegin]
- |v top o|
-
- top := HVScrollableView for:ObjectView.
- top extent:200@200.
- v := top scrolledView.
-
- o := DrawRectangle new.
- o origin:10@10 corner:100@100.
- v add:o.
-
- o := DrawText new.
- o text:'hello there'; origin:50@50; foreground:Color red.
- v add:o.
-
- top open
- [exEnd]
-
- or, using miniscrollers:
- [exBegin]
- |v top o|
-
- top := HVScrollableView for:ObjectView
- miniScrollerH:true miniScrollerV:true.
- top extent:200@200.
- v := top scrolledView.
-
- o := DrawRectangle new.
- o origin:10@10 corner:100@100.
- v add:o.
-
- o := DrawText new.
- o text:'hello there'; origin:50@50; foreground:Color red.
- v add:o.
-
- top open
- [exEnd]
-
- grid:
- [exBegin]
- |v top o|
-
- top := HVScrollableView for:ObjectView
- miniScrollerH:true miniScrollerV:true.
- top extent:200@200.
- v := top scrolledView.
- v showGrid.
-
- o := DrawRectangle new.
- o origin:10@10 corner:100@100.
- v add:o.
-
- o := DrawText new.
- o text:'hello there'; origin:50@50; foreground:Color red.
- v add:o.
-
- top open
- [exEnd]
-
- zoom:
- [exBegin]
- |v top o|
-
- top := HVScrollableView for:ObjectView
- miniScrollerH:true miniScrollerV:true.
- top extent:200@200.
- v := top scrolledView.
- v showGrid.
-
- o := DrawRectangle new.
- o origin:10@10 corner:100@100.
- v add:o.
-
- o := DrawText new.
- o text:'hello there'; origin:50@50; foreground:Color red.
- v add:o.
-
- top open.
-
- Delay waitForSeconds:5.
- v zoom:2.
-
- Delay waitForSeconds:5.
- v zoom:0.35.
-
- Delay waitForSeconds:5.
- v zoom:1.
- [exEnd]
-
- private benchmark: display 10000 objects ...
- [exBegin]
- |v top o rnd|
-
- top := HVScrollableView for:ObjectView
- miniScrollerH:true miniScrollerV:true.
- top extent:200@200.
- v := top scrolledView.
-
- rnd := Random new.
- 10000 timesRepeat:[
- o := DrawLine new.
- o origin:(rnd nextIntegerBetween:0 and:700) @ (rnd nextIntegerBetween:0 and:700)
- corner:(rnd nextIntegerBetween:0 and:700) @ (rnd nextIntegerBetween:0 and:700).
- v add:o.
- ].
-
- top openAndWait.
-
- Transcript showCR:(
- Time millisecondsToRun:[
- v redraw
- ])
- [exEnd]
-"
-! !
-
-!ObjectView class methodsFor:'defaults'!
-
-handleSize
- "size of blob drawn for handles"
-
- ^ (Display horizontalPixelPerMillimeter * 1.2) rounded asInteger
-!
-
-hitDelta
- "when clicking an object, allow for hitDelta pixels around object;
- 0 is exact; 1*pixelPerMillimeter is good for draw programs"
-
- ^ 0
-! !
-
-!ObjectView methodsFor:'accessing'!
-
-contents
- ^ contents
-
- "Created: / 4.7.1999 / 15:15:15 / cg"
-!
-
-gridShown
- ^ gridShown
-! !
-
-!ObjectView methodsFor:'accessing - behavior'!
-
-setDefaultActions
- "setup actions for default behavior (do - nothing)"
-
- motionAction := [:movePoint | nil].
- releaseAction := [nil]
-
- "Modified: / 4.7.1999 / 18:55:01 / cg"
-! !
-
-!ObjectView methodsFor:'adding / removing'!
-
-add:something
- "add something, anObject or a collection of objects to the contents
- with redraw"
-
- self forEach:something do:[:anObject |
- self addObject:anObject
- ]
-!
-
-addObject:anObject
- "add the argument, anObject to the contents - with redraw"
-
- anObject notNil ifTrue:[
- contents addLast:anObject.
- self changed:#addObject.
- "its on top - only draw this one"
- shown "realized" ifTrue:[
- self showUnselected:anObject
- ]
- ]
-
- "Modified: / 4.7.1999 / 16:50:24 / cg"
-!
-
-addObjectFirst:anObject
- "add the argument, anObject to the beginning of the contents - with redraw"
-
- anObject notNil ifTrue:[
- contents addFirst:anObject.
- self changed:#addObject.
- "its on top - only draw this one"
- shown "realized" ifTrue:[
- self showUnselected:anObject
- ]
- ]
-
- "Modified: / 4.7.1999 / 16:50:22 / cg"
-!
-
-addObjectFirstWithoutRedraw:anObject
- "add the argument, anObject to the start of the contents - no redraw"
-
- anObject notNil ifTrue:[
- contents addFirst:anObject.
- self changed:#addObject.
- ]
-
- "Modified: / 4.7.1999 / 16:50:19 / cg"
-!
-
-addObjectWithoutRedraw:anObject
- "add the argument, anObject to the contents - no redraw"
-
- anObject notNil ifTrue:[
- contents addLast:anObject.
- self changed:#addObject.
- ]
-
- "Modified: / 4.7.1999 / 16:50:16 / cg"
-!
-
-addSelected:something
- "add something, anObject or a collection of objects to the contents
- and select it"
-
- self add:something.
- self select:something
-!
-
-addWithoutRedraw:something
- "add something, anObject or a collection of objects to the contents
- do not redraw"
-
- self forEach:something do:[:anObject |
- self addObjectWithoutRedraw:anObject
- ]
-!
-
-remove:something
- "remove something, anObject or a collection of objects from the contents
- do redraw"
-
- something size > (contents size / 4) ifTrue:[
- "
- better to remove first, then redraw rest
- "
- self forEach:something do:[:anObject |
- self removeFromSelection:anObject.
- contents remove:anObject.
- self changed:#removeObject.
- ].
- self invalidate.
- ^ self
- ].
-
- self forEach:something do:[:anObject |
- self removeObject:anObject
- ]
-
- "Modified: / 4.7.1999 / 16:50:09 / cg"
-!
-
-removeAll
- "remove all - redraw"
-
- self removeAllWithoutRedraw.
- self invalidate
-
- "Modified: 29.5.1996 / 16:20:28 / cg"
-!
-
-removeAllWithoutRedraw
- "remove all - no redraw"
-
- contents := OrderedCollection new.
- self changed:#removeObject.
- selection notNil ifTrue:[
- selection := nil.
- self changed:#selection.
- ].
-
- "Modified: / 4.7.1999 / 16:50:43 / cg"
-!
-
-removeObject:anObject
- "remove the argument, anObject from the contents - no redraw"
-
- anObject notNil ifTrue:[
- self removeFromSelection:anObject.
- contents remove:anObject.
- self changed:#removeObject.
- shown "realized" ifTrue:[
- self redrawObjectsIn:(anObject frame)
- ]
- ]
-
- "Modified: / 4.7.1999 / 16:50:49 / cg"
-!
-
-removeObjectWithoutRedraw:anObject
- "remove the argument, anObject from the contents - no redraw"
-
- anObject notNil ifTrue:[
- self removeFromSelection:anObject.
- contents remove:anObject.
- self changed:#removeObject.
- ]
-
- "Modified: / 4.7.1999 / 16:50:58 / cg"
-!
-
-removeWithoutRedraw:something
- "remove something, anObject or a collection of objects from the contents
- do not redraw"
-
- self forEach:something do:[:anObject |
- self removeObjectWithoutRedraw:anObject
- ]
-! !
-
-!ObjectView methodsFor:'cut & paste '!
-
-convertForPaste:anObject
- "return a converted version of anObject to be pasted, or nil if
- the object is not compatible with me.
- Return nil here; concrete subclasses should try to convert.
- Notice: anObject may be a collection of to-be-pasted objects."
-
- "in concrete subclasses, you can use:"
-"
- |s|
-
- (anObject respondsTo:#asDisplayObject) ifTrue:[
- ^ anObject asDisplayObject
- ].
- (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
- ].
- anObject size > 0 ifTrue:[
- (anObject inject:true into:[:okSoFar :element |
- okSoFar and:[element respondsTo:#asDisplayObject]
- ]) ifFalse:[
- self warn:'selection not convertable to DisplayObject'.
- ^ nil
- ].
- ^ anObject collect:[:element | element asDisplayObject].
- ].
-"
- ^ nil.
-!
-
-copySelection
- "copy the selection into the cut&paste-buffer"
-
- |tmp|
-
- tmp := OrderedCollection new.
- self selectionDo:[:object |
- tmp add:(object copy)
- ].
-"/ self forEach:tmp do:[:anObject |
-"/ anObject moveTo:(anObject origin + (8 @ 8))
-"/ ].
- self setSelection:tmp
-!
-
-cutSelection
- "cut the selection into the cut&paste buffer"
-
- |tmp|
-
- tmp := selection.
- tmp notNil ifTrue:[
- self unselect.
- self remove:tmp.
- self setSelection:tmp
- ]
-
- "Created: / 4.7.1999 / 15:07:59 / cg"
- "Modified: / 4.7.1999 / 15:29:50 / cg"
-!
-
-deleteSelection
- "delete the selection"
-
- |tmp|
-
- tmp := selection.
- tmp notNil ifTrue:[
- self unselect.
- self remove:tmp.
-"/ self setSelection:tmp
- ].
-
- "Modified: / 4.7.1999 / 15:29:55 / cg"
-!
-
-paste:something
- "add the objects in the cut&paste-buffer"
-
- |s|
-
- s := self convertForPaste:something .
- s isNil ifTrue:[
- self warn:'selection not convertable'.
- ^ self
- ].
- self unselect.
- self addSelected:s
-!
-
-pasteBuffer
- "add the objects in the paste-buffer"
-
- |sel|
-
- sel := self getSelection.
- ((device platformName = 'WIN32')
- or:[device getSelectionOwnerOf:(device atomIDOf:'PRIMARY') == drawableId])
- ifTrue:[
- "
- a local selection - paste with some offset
- "
- sel size > 0 ifTrue:[
- sel := sel collect:[:element |
- element copy moveTo:(element origin + (8 @ 8))
- ]
- ] ifFalse:[
- sel := sel copy moveTo:(sel origin + (8 @ 8))
- ]
- ].
- self paste:sel
-
- "Modified: / 4.7.1999 / 15:10:46 / cg"
-! !
-
-!ObjectView methodsFor:'dragging line'!
-
-doLineDrag:aPoint
- "do drag a line"
-
- self invertDragLine.
- dragObject corner:aPoint.
- self invertDragLine.
-!
-
-endLineDrag
- "cleanup after line drag; select them. Find the origin and destination
- views and relative offsets, then dispatch to one of the endLineDrag methods.
- These can be redefined in subclasses to allow connect between views."
-
- |rootPoint viewId offs
- lastViewId destinationId destinationView destinationPoint inMySelf|
-
- self invertDragLine.
-
- self cursor:oldCursor.
-
- "check if line drag is into another view"
- rootMotion ifTrue:[
- rootPoint := lastButt.
- "
- get device coordinates
- "
- transformation notNil ifTrue:[
- rootPoint := transformation applyTo:rootPoint.
- ].
- viewId := rootView id.
-
- "
- translate to screen
- "
- offs := device translatePoint:0@0 from:(self id) to:viewId.
- rootPoint := rootPoint + offs.
-
- "search view the drop is in"
-
- [viewId notNil] whileTrue:[
- destinationId := device viewIdFromPoint:rootPoint in:viewId.
- lastViewId := viewId.
- viewId := destinationId
- ].
- destinationView := device viewFromId:lastViewId.
- destinationId := lastViewId.
- inMySelf := (destinationView == self).
- rootMotion := false
- ] ifFalse:[
- inMySelf := true
- ].
-
- inMySelf ifTrue:[
- "a simple line within myself"
- self lineDragFrom:dragObject origin to:dragObject corner
- ] ifFalse:[
- "into another one"
- destinationView notNil ifTrue:[
- destinationPoint := device translatePoint:rootPoint
- from:(rootView id)
- to:(destinationView id).
- destinationView transformation notNil ifTrue:[
- destinationPoint := destinationView transformation applyInverseTo:destinationPoint
- ].
- "
- move into another smalltalk view
- "
- self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
- ] ifFalse:[
- "
- not one of my views
- "
- self lineDragFrom:dragObject origin
- to:destinationPoint
- inAlienViewId:destinationId
- ]
- ].
- self setDefaultActions.
- dragObject := nil
-!
-
-invertDragLine
- "helper for line dragging - invert the dragged line.
- Extracted for easier redefinition in subclasses
- (different line width etc.)"
-
- |dragger offs p1 p2|
-
- p1 := dragObject origin.
- p2 := dragObject corner.
- rootMotion ifTrue:[
- dragger := rootView.
- "
- get device coordinates
- "
- transformation notNil ifTrue:[
- p1 := transformation applyTo:p1.
- p2 := transformation applyTo:p2.
- ].
- "
- translate to screen
- "
- offs := device translatePoint:0@0 from:(self id) to:(rootView id).
- p1 := p1 + offs.
- p2 := p2 + offs.
- ] ifFalse:[
- dragger := self.
- ].
-
- dragger xoring:[
- dragger lineWidth:0.
- dragger displayLineFrom:p1 to:p2.
- dragger flush
- ].
-
- "Modified: 16.12.1995 / 17:32:56 / cg"
-!
-
-lineDragFrom:startPoint to:endPoint
- "this is called after a line-drag. Nothing is done here.
- - should be redefined in subclasses"
-
- ^ self
-!
-
-lineDragFrom:startPoint to:endPoint in:destinationView
- "this is called after a line-drag crossing view boundaries.
- - should be redefined in subclasses"
-
- ^ self notify:'dont know how to connect to external views'
-!
-
-lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
- "this is called after a line-drag with rootmotion set
- to true, IFF the endpoint is in an alien view
- - should be redefined in subclasses"
-
- self notify:'cannot connect object in alien view'
-!
-
-setLineDragActions
- "setup to drag a line. Call this (for example) from your buttonPress
- method, to make the view start to drag a line.
- See startLineDrag and startRootLineDrag."
-
- motionAction := [:movePoint | self doLineDrag:movePoint].
- releaseAction := [self endLineDrag]
-!
-
-startLineDrag:startPoint
- "start a line drag within the view"
-
- self setLineDragActions.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragLine.
- oldCursor := cursor.
- self cursor:leftHandCursor
-!
-
-startRootLineDrag:startPoint
- "start a line drag possibly crossing my view boundaries"
-
- self setLineDragActions.
- rootMotion := true.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragLine.
- oldCursor := cursor.
- self cursor:leftHandCursor
-! !
-
-!ObjectView methodsFor:'dragging object move'!
-
-doObjectMove:aPoint
- "do an object move - this is called for every motion
- when moving objects."
-
- |d org nOrg|
-
- movedObject isNil ifTrue:[
- movedObject := selection.
- "
- draw first outline
- "
- movedObject notNil ifTrue:[
- moveDelta := 0@0.
-
- "tricky, the moved object may not currently be aligned.
- if so, simulate a frame move of the delta"
-
- aligningMove ifTrue:[
- org := movedObject origin.
- d := org - (self alignToGrid:(org)).
- moveDelta := d negated.
- ].
- self invertDragObject:movedObject delta:moveDelta
- ]
- ].
- movedObject notNil ifTrue:[
- d := aPoint - moveStartPoint.
- aligningMove ifTrue:[
- org := movedObject origin.
- nOrg := org + d.
- d := (self alignToGrid:(nOrg)) - org.
- ].
- d ~= moveDelta ifTrue:[
- "
- clear prev outline,
- draw new outline
- "
- self invertDragObject:movedObject delta:moveDelta.
- moveDelta := d.
- self invertDragObject:movedObject delta:moveDelta
- ]
- ]
-!
-
-endObjectMove
- "cleanup after object move - called when the object move ends.
- Find the destination view and position and dispatch to
- one of the moveObjectXXX-methods which should do the real move.
- These can be redefined in subclasses."
-
- |inMySelf rootPoint destinationPoint p
- viewId destinationView destinationId lastViewId|
-
- movedObject notNil ifTrue:[
- self invertDragObject:movedObject delta:moveDelta.
-
- "check if object is to be put into another view"
- rootMotion ifTrue:[
- p := lastButt.
- "
- get device coordinates
- "
- transformation notNil ifTrue:[
- p := transformation applyTo:p.
- ].
- viewId := rootView id.
- "
- translate to screen
- "
- rootPoint := p + (device translatePoint:0@0 from:(self id) to:viewId).
-
- "search view the drop is in"
- [viewId notNil] whileTrue:[
- destinationId := device viewIdFromPoint:rootPoint in:viewId.
- lastViewId := viewId.
- viewId := destinationId
- ].
- destinationView := device viewFromId:lastViewId.
- destinationId := lastViewId.
- inMySelf := (destinationView == self).
- rootMotion := false
- ] ifFalse:[
- inMySelf := true
- ].
-
- inMySelf ifTrue:[
- "simple move"
- self move:movedObject by:moveDelta
- ] ifFalse:[
- destinationPoint := device translatePoint:rootPoint
- from:(rootView id)
- to:destinationId.
- destinationView notNil ifTrue:[
- destinationView transformation notNil ifTrue:[
- destinationPoint := destinationView transformation applyInverseTo:destinationPoint
- ].
- "
- move into another smalltalk view
- "
- self move:movedObject to:destinationPoint in:destinationView
- ] ifFalse:[
- "
- not one of my views
- "
- self move:movedObject to:destinationPoint inAlienViewId:destinationId
- ]
- ].
- self setDefaultActions.
- movedObject := nil
- ]
-!
-
-invertDragObject:movedObject delta:moveDelta
- "draw inverting for an object move"
-
- |dragger offs p d scale oldTrans|
-
- rootMotion ifTrue:[
- p := movedObject origin + moveDelta.
- dragger := rootView.
- "
- get device coordinates
- "
-"/ 'logical ' print. p printNL.
- transformation notNil ifTrue:[
- scale := transformation scale.
- p := transformation applyTo:p.
-"/ 'device ' print. p printNL.
- ].
- "
- translate to screen
- "
- offs := device translatePoint:0@0 from:(self id) to:(rootView id).
-"/ 'offs' print. offs printNL.
- p := p + offs.
-"/ 'screen ' print. p printNL.
- "
- p is where we want it ...
- have to adust slightly, since showDragging shows the object
- at its origin plus some offset; here we want it to be drawn
- at absolute p.
- To do so, we set the draggers translation to p and
- draw the object scaled at 0@0 (by setting offset to its negative org)
- "
-
- oldTrans := dragger transformation.
- dragger transformation:(WindowingTransformation
- scale:scale
- translation:p).
- d := movedObject origin negated.
-
- dragger xoring:[
- self showDragging:movedObject offset:d.
- ].
-
- dragger transformation:oldTrans.
- dragger flush.
- ] ifFalse:[
- self xoring:[
- self showDragging:movedObject offset:moveDelta.
- ].
- self flush
- ].
-
- "Modified: 16.12.1995 / 17:33:04 / cg"
-!
-
-setMoveActions
- "setup to drag an object. Call this (for example) from your buttonPress
- method, to make the view start to drag some object.
- See startObjectMove and startRootObjectMove."
-
- motionAction := [:movePoint | self doObjectMove:movePoint].
- releaseAction := [self endObjectMove]
-!
-
-startObjectMove:something at:aPoint
- "start an object move"
-
- self startObjectMove:something at:aPoint inRoot:canDragOutOfView
-!
-
-startObjectMove:something at:aPoint inRoot:inRoot
- "start an object move; if inRoot is true, view
- boundaries may be crossed."
-
- something notNil ifTrue:[
- (self canSelect:something) ifTrue:[
- self select:something.
- (self canMove:something) ifTrue:[
- self setMoveActions.
- moveStartPoint := aPoint.
- rootMotion := inRoot.
- ] ifFalse:[
- self setDefaultActions
- ]
- ] ifFalse:[
- self setDefaultActions
- ]
- ]
-
- "Modified: / 4.7.1999 / 18:58:08 / cg"
-!
-
-startRootObjectMove:something at:aPoint
- "start an object move, possibly crossing view boundaries"
-
- self startObjectMove:something at:aPoint inRoot:true
-! !
-
-!ObjectView methodsFor:'dragging rectangle'!
-
-doRectangleDrag:aPoint
- "do drag a rectangle"
-
- self invertDragRectangle.
- dragObject corner:aPoint.
- self invertDragRectangle.
-!
-
-endRectangleDrag
- "cleanup after rectangle drag; select them"
-
- self invertDragRectangle.
- self cursor:oldCursor.
- self selectAllIn:dragObject
-!
-
-invertDragRectangle
- "helper for rectangle drag - invert the dragRectangle.
- Extracted into a separate method to allow easier redefinition
- (different lineWidth etc)"
-
- self xoring:[
- self lineWidth:0.
-"/ self lineStyle:#dashed.
- self displayRectangle:dragObject.
-"/ self lineStyle:#solid.
- ].
-
- "Modified: 3.6.1996 / 10:02:22 / cg"
-!
-
-setRectangleDragActions
- "setup to drag a rectangle. Call this (for example) from your buttonPress
- method, to make the view start the drag.
- See startRectangleDrag:."
-
- motionAction := [:movePoint | self doRectangleDrag:movePoint].
- releaseAction := [self endRectangleDrag]
-!
-
-startRectangleDrag:startPoint
- "start a rectangle drag"
-
- self setRectangleDragActions.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragRectangle.
- oldCursor := cursor.
- self cursor:leftHandCursor
-! !
-
-!ObjectView methodsFor:'drawing'!
-
-redraw
- "redraw complete View"
-
- shown ifTrue:[
- self clear.
- self redrawObjects
- ]
-!
-
-redrawObjects
- "redraw all objects"
-
- self redrawObjectsOn:self
-!
-
-redrawObjectsAbove:anObject in:aRectangle
- "redraw all objects which have part of themselfes in aRectangle
- and are above (in front of) anObject.
- draw only in (i.e. clip output to) aRectangle"
-
- |vis oldClip|
-
- shown ifTrue:[
- vis := aRectangle.
- clipRect notNil ifTrue:[
- vis := vis intersect:clipRect
- ].
- oldClip := clipRect.
- self clippingRectangle:vis.
-
- self redrawObjectsAbove:anObject intersecting:vis.
-
- self clippingRectangle:oldClip
- ]
-
- "Modified: 28.5.1996 / 19:57:06 / cg"
-!
-
-redrawObjectsAbove:anObject inVisible:aRectangle
- "redraw all objects which have part of themselfes in a vis rectangle
- and are above (in front of) anObject.
- draw only in (i.e. clip output to) aRectangle"
-
- |vis oldClip|
-
- shown ifTrue:[
- vis := aRectangle.
- clipRect notNil ifTrue:[
- vis := vis intersect:clipRect
- ].
- oldClip := clipRect.
- self clippingRectangle:vis.
-
- self redrawObjectsAbove:anObject intersectingVisible:vis.
-
- self clippingRectangle:oldClip
- ]
-
- "Modified: 28.5.1996 / 19:56:44 / cg"
-!
-
-redrawObjectsAbove:anObject intersecting:aRectangle
- "redraw all objects which have part of themself in aRectangle
- and are above (in front of) anObject"
-
- self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
- self show:theObject
- ]
-!
-
-redrawObjectsAbove:anObject intersectingVisible:aRectangle
- "redraw all objects which have part of themself in a vis rectangle
- and are above (in front of) anObject"
-
- self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
- self show:theObject
- ]
-!
-
-redrawObjectsIn:aRectangle
- "redraw all objects which have part of themselfes in aRectangle
- draw only in (i.e. clip output to) aRectangle"
-
- |visRect oldClip|
-
- shown ifTrue:[
- visRect := Rectangle origin:(aRectangle origin)
- extent:(aRectangle extent).
-"/ transformation notNil ifTrue:[
- visRect := visRect origin truncated
- corner:(visRect corner + (1@1)) truncated.
-"/ ].
- clipRect notNil ifTrue:[
- visRect := visRect intersect:clipRect
- ].
- oldClip := clipRect.
- self clippingRectangle:visRect.
-
- self clearRectangle:visRect.
- self redrawObjectsIntersecting:visRect.
-
- self clippingRectangle:oldClip
- ]
-
- "Modified: 28.5.1996 / 19:56:20 / cg"
-!
-
-redrawObjectsInVisible:visRect
- "redraw all objects which have part of themselfes in a vis rectangle
- draw only in (i.e. clip output to) aRectangle"
-
- |vis oldClip|
-
- shown ifTrue:[
- vis := visRect.
- clipRect notNil ifTrue:[
- vis := vis intersect:clipRect
- ].
-
- transformation notNil ifTrue:[
-"/ transformation scale ~~ 1 ifTrue:[
- vis := vis origin truncated
- corner:(vis corner + (1@1)) truncated.
-"/ ]
- ].
-
- oldClip := clipRect.
- self clippingRectangle:vis.
-
- self clearRectangle:vis.
- self redrawObjectsIntersecting:vis.
-
- self clippingRectangle:oldClip
- ]
-
- "Modified: 28.5.1996 / 19:55:47 / cg"
-!
-
-redrawObjectsIntersecting:aRectangle
- "redraw all objects which have part of themself in aRectangle"
-
- self objectsIntersecting:aRectangle do:[:theObject |
- self show:theObject
- ]
-!
-
-redrawObjectsIntersectingVisible:aRectangle
- "redraw all objects which have part of themself in a vis rectangle
- This is a leftOver from times when scrolling was not transparent.
- Please use redrawObjectsIntersecting:, since this will vanish."
-
- self redrawObjectsIntersecting:aRectangle
-!
-
-redrawObjectsOn:aGC
- "redraw all objects on a graphic context"
-
- |vFrame|
-
- (aGC == self) ifTrue:[
- shown ifFalse:[^ self].
- vFrame := Rectangle left:0 top:0 width:width height:height.
-
- transformation notNil ifTrue:[
- vFrame := transformation applyInverseTo:vFrame.
- ].
- self redrawObjectsIntersecting:vFrame
- ] ifFalse:[
- "should loop over pages"
-
- vFrame := Rectangle left:0 top:0 width:9999 height:9999.
-
- self objectsIntersecting:vFrame do:[:theObject |
- theObject drawIn:aGC
- ]
- ]
-
- "Modified: 8.5.1996 / 21:01:27 / cg"
-!
-
-redrawScale
- "redraw the scales"
-
- self redrawHorizontalScale.
- self redrawVerticalScale
-!
-
-show:anObject
- "show the object, either selected or not"
-
- (self isSelected:anObject) ifTrue:[
- self showSelected:anObject
- ] ifFalse:[
- self showUnselected:anObject
- ]
-!
-
-showDragging:something offset:anOffset
- "show an object while dragging"
-
- |drawer|
-
- rootMotion ifTrue:[
- "drag in root-window"
-
- drawer := rootView
- ] ifFalse:[
- drawer := self
- ].
- self forEach:something do:[:anObject |
- anObject drawDragIn:drawer offset:anOffset
- ]
-!
-
-showSelected:anObject
- "show an object as selected"
-
- anObject drawSelectedIn:self
-!
-
-showUnselected:anObject
- "show an object as unselected"
-
- anObject drawIn:self
-! !
-
-!ObjectView methodsFor:'event handling'!
-
-buttonMotion:buttonMask x:buttX y:buttY
- "user moved mouse while button pressed"
-
- |xpos ypos movePoint limitW limitH|
-
- "is it the select or 1-button ?"
- self sensor leftButtonPressed ifFalse:[^ self].
-"/ (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
-"/ (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
-"/ ^ self
-"/ ].
-"/ ].
-
- lastButt notNil ifTrue:[
- xpos := buttX.
- ypos := buttY.
-
- "check against visible limits if move outside is not allowed"
- rootMotion ifFalse:[
- limitW := width.
- limitH := height.
- transformation notNil ifTrue:[
- limitW := transformation applyInverseToX:width.
- limitH := transformation applyInverseToY:height.
- ].
-
- (xpos < 0) ifTrue:[
- xpos := 0
- ] ifFalse: [
- (xpos > limitW) ifTrue:[xpos := limitW]
- ].
- (ypos < 0) ifTrue:[
- ypos := 0
- ] ifFalse: [
- (ypos > limitH) ifTrue:[ypos := limitH]
- ]
- ].
- movePoint := xpos @ ypos.
-
- (xpos == (lastButt x)) ifTrue:[
- (ypos == (lastButt y)) ifTrue:[
- ^ self "no move"
- ]
- ].
-
- motionAction notNil ifTrue:[
- motionAction value:movePoint.
- lastButt := movePoint.
- ^ self
- ].
- lastButt := movePoint
- ].
- super buttonMotion:buttonMask x:buttX y:buttY
-
- "Modified: / 28.7.1998 / 16:01:31 / cg"
-!
-
-buttonMultiPress:button x:x y:y
- "user pressed left button twice (or more)"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- doublePressAction notNil ifTrue:[
- doublePressAction value:(x @ y).
- ^ self
- ]
- ].
- super buttonMultiPress:button x:x y:y
-
- "Modified: 30.5.1996 / 17:57:36 / cg"
-!
-
-buttonPress:button x:x y:y
- "user pressed left button"
-
- ((button == 1) or:[button == #select]) ifTrue:[
- self sensor shiftDown ifTrue:[
- ^ self buttonShiftPress:button x:x y:y
- ].
-
- pressAction notNil ifTrue:[
- lastButt := x @ y.
- pressAction value:lastButt.
- ^ self
- ]
- ].
- super buttonPress:button x:x y:y
-
- "Modified: 1.8.1996 / 19:13:01 / cg"
-!
-
-buttonRelease:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- releaseAction notNil ifTrue:[
- releaseAction value.
- ^ self
- ]
- ].
- super buttonRelease:button x:x y:y
-
- "Modified: 30.5.1996 / 17:57:13 / cg"
-!
-
-buttonShiftPress:button x:x y:y
- "user pressed left button with shift"
-
- shiftPressAction notNil ifTrue:[
- lastButt := x @ y.
- shiftPressAction value:lastButt.
- ^ self
- ]
-
- "Modified: 1.8.1996 / 19:13:19 / cg"
-!
-
-keyPress:key x:x y:y
- keyPressAction notNil ifTrue:[
- selection notNil ifTrue:[
- self selectionDo: [:obj |
- obj keyInput:key .
- ]
- ].
- ^ self.
- ].
- super keyPress:key x:x y:y
-
- "Modified: 30.5.1996 / 17:57:54 / cg"
-!
-
-pointerEnter:state x:x y:y
- "mouse pointer entered - request the keyboard focus"
-
- self wantsFocusWithPointerEnter ifTrue:[
- self requestFocus.
- ].
-
-
-
-!
-
-redrawX:x y:y width:w height:h
- |redrawFrame |
-
- redrawFrame := Rectangle left:x top:y width:w height:h.
- self clearRectangle:redrawFrame.
- ((contents size ~~ 0) or:[gridShown]) ifTrue:[
- self redrawObjectsInVisible:redrawFrame
- ]
-
- "Modified: 5.6.1996 / 10:42:19 / cg"
-! !
-
-!ObjectView methodsFor:'focus control'!
-
-wantsFocusWithPointerEnter
- ^ UserPreferences current focusFollowsMouse ~~ false
-
-
-! !
-
-!ObjectView methodsFor:'grid manipulation'!
-
-alignOff
- "do no align point to grid"
-
- aligning := false
-!
-
-alignOn
- "align points to grid"
-
- aligning := true.
- self getAlignParameters
-!
-
-defineGrid
- "define the grid pattern - this creates the gridPixmap, which is
- used as viewBackground when a grid is to be shown.
- The grid is specified by the value returned from gridParameters,
- which can be redefined in subclasses. See the comment there on how
- the numbers are interpreted."
-
- |mmH mmV params showDocumentBoundary gridW gridH
- bigStepH bigStepV littleStepH littleStepV hires devPixmap colorMap|
-
- mmH := self horizontalPixelPerMillimeter.
- mmV := self verticalPixelPerMillimeter.
- hires := self horizontalPixelPerInch > 120.
-
- params := self gridParameters.
-
- bigStepH := params at:1.
- bigStepV := params at:2.
- littleStepH := params at:3.
- littleStepV := params at:4.
- showDocumentBoundary := params at:7.
-
- transformation notNil ifTrue:[
- mmH := mmH * transformation scale x.
- mmV := mmV * transformation scale y.
- bigStepH := bigStepH * transformation scale x.
- bigStepV := bigStepV * transformation scale y.
- littleStepH notNil ifTrue:[
- littleStepH := littleStepH * transformation scale x.
- ].
- littleStepV notNil ifTrue:[
- littleStepV := littleStepV * transformation scale y.
- ].
- ].
-
- bigStepH isNil ifTrue:[^ self].
-
- gridW := (self widthOfContentsInMM * mmH).
- gridH := (self heightOfContentsInMM * mmV).
-
- self withWaitCursorDo:[
- |xp yp y x|
-
- ((bigStepH isInteger and:[littleStepH isNil or:[littleStepH isInteger]])
- and:[(bigStepV isInteger and:[littleStepV isNil or:[littleStepV isInteger]])]) ifTrue:[
- gridW := bigStepH.
- littleStepH notNil ifTrue:[gridW := gridW max:littleStepH].
- gridH := bigStepV.
- littleStepV notNil ifTrue:[gridH := gridH max:littleStepV].
- ] ifFalse:[
-
- "
- up to next full unit
- "
- gridW := ((gridW // bigStepH) + 1 * bigStepH) asInteger.
- gridH := ((gridH // bigStepV) + 1 * bigStepV) asInteger.
- ].
-
- gridPixmap := Form width:gridW height:gridH depth:1.
- gridPixmap colorMap:(Array with:White with:Black).
- gridPixmap clear.
- gridPixmap paint:(Color colorId:1).
-
- "draw first row point-by-point"
- yp := 0.0.
- xp := 0.0.
- y := yp asInteger.
- [xp <= gridW] whileTrue:[
- x := xp rounded.
- hires ifTrue:[
- gridPixmap displayPointX:(x + 1) y:y.
- gridPixmap displayPointX:(x + 2) y:y
- ].
- gridPixmap displayPointX:x y:y.
- littleStepH notNil ifTrue:[
- xp := xp + littleStepH
- ] ifFalse:[
- xp := xp + bigStepH
- ]
- ].
-
- "copy rest from what has been drawn already"
- yp := yp + bigStepV.
- [yp <= gridH] whileTrue:[
- y := yp rounded.
- hires ifTrue:[
- gridPixmap copyFrom:gridPixmap x:0 y:0
- toX:0 y:(y + 1)
- width:gridW height:1.
- gridPixmap copyFrom:gridPixmap x:0 y:0
- toX:0 y:(y + 2)
- width:gridW height:1
- ].
- gridPixmap copyFrom:gridPixmap x:0 y:0
- toX:0 y:y
- width:gridW height:1.
- yp := yp + bigStepV
- ].
-
- "draw first col point-by-point"
- xp := 0.0.
- yp := 0.0.
- x := xp asInteger.
- [yp <= gridH] whileTrue:[
- y := yp rounded.
- hires ifTrue:[
- gridPixmap displayPointX:x y:(y + 1).
- gridPixmap displayPointX:x y:(y + 2)
- ].
- gridPixmap displayPointX:x y:y.
- littleStepV notNil ifTrue:[
- yp := yp + littleStepV
- ] ifFalse:[
- yp := yp + bigStepV
- ]
- ].
-
- "copy rest from what has been drawn already"
- xp := xp + bigStepH.
- [xp <= gridW] whileTrue:[
- x := xp rounded.
- hires ifTrue:[
- gridPixmap copyFrom:gridPixmap x:0 y:0
- toX:(x + 1) y:0
- width:1 height:gridH.
- gridPixmap copyFrom:gridPixmap x:0 y:0
- toX:(x + 2) y:0
- width:1 height:gridH
- ].
- gridPixmap copyFrom:gridPixmap x:0 y:0
- toX:x y:0
- width:1 height:gridH.
- xp := xp + bigStepH
- ].
-
- showDocumentBoundary ifTrue:[
- "
- mark the right-end and bottom of the document
- "
- gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
- gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
- ].
-
- device platformName = 'WIN32' ifTrue:[
- "/ kludge - needs a deep form
- colorMap := gridPixmap colorMap.
- devPixmap := Form width:gridW height:gridH depth:device depth on:device.
- devPixmap notNil ifTrue:[
- devPixmap paint:(colorMap at:1).
- devPixmap fillRectangleX:0 y:0 width:gridW height:gridH.
- devPixmap foreground:(colorMap at:2) background:(colorMap at:1).
- devPixmap copyPlaneFrom:gridPixmap x:0 y:0 toX:0 y:0 width:gridW height:gridH.
- gridPixmap := devPixmap.
- ]
- ].
- ]
-
- "Modified: / 6.6.1999 / 01:00:16 / cg"
-!
-
-getAlignParameters
- |params|
-
- params := self gridParameters.
- gridAlign := (params at:5) @ (params at:6)
-!
-
-gridParameters
- "used by defineGrid, and in a separate method for
- easier redefinition in subclasses.
- Returns the grid parameters in an array of 7 elements,
- which control the appearance of the grid-pattern.
- the elements are:
-
- bigStepH number of pixels horizontally between 2 major steps
- bigStepV number of pixels vertically between 2 major steps
- littleStepH number of pixels horizontally between 2 minor steps
- littleStepV number of pixels vertically between 2 minor steps
- gridAlignH number of pixels for horizontal grid align (pointer snap)
- gridAlignV number of pixels for vertical grid align (pointer snap)
- docBounds true, if document boundary should be shown
-
- if littleStepH/V are nil, only bigSteps are drawn.
- "
-
- |mmH mmV bigStepH bigStepV littleStepH littleStepV arr|
-
- "example: 12grid & 12snapIn"
-"/ ^ #(12 12 nil nil 12 12 false).
-
- "example: 12grid & 24snapIn"
-"/ ^ #(12 12 nil nil 24 24 false).
-
- "default: cm/mm grid & mm snapIn for metric,
- 1inch , 1/8inch grid & 1/8 inch snapIn"
-
- mmH := self horizontalPixelPerMillimeter.
- mmV := self verticalPixelPerMillimeter.
-
- "
- metric grid: small steps every millimeter, big step every
- centimeter. If the transformation is shrinking, turn off little
- steps.
- "
- (scaleMetric == #mm) ifTrue:[
- "dots every mm; lines every cm"
- bigStepH := mmH * 10.0.
- bigStepV := mmV * 10.0.
- (transformation notNil
- and:[transformation scale <= 0.5]) ifFalse:[
- littleStepH := mmH.
- littleStepV := mmV
- ]
- ].
- "
- inch grid: small steps every 1/8th inch, big step every half inch
- If the transformation is shrinking, change little steps to 1/th inch
- or even turn them off completely.
- "
- (scaleMetric == #inch) ifTrue:[
- "dots every eights inch; lines every half inch"
- bigStepH := mmH * (25.4 / 2).
- bigStepV := mmV * (25.4 / 2).
- (transformation notNil
- and:[transformation scale <= 0.5]) ifTrue:[
- transformation scale > 0.2 ifTrue:[
- littleStepH := mmH * (25.4 / 4).
- littleStepV := mmV * (25.4 / 4)
- ]
- ] ifFalse:[
- littleStepH := mmH * (25.4 / 8).
- littleStepV := mmV * (25.4 / 8)
- ]
- ].
-
- arr := Array new:8.
- arr at:1 put:bigStepH.
- arr at:2 put:bigStepV.
- arr at:3 put:littleStepH.
- arr at:4 put:littleStepV.
- arr at:5 put:littleStepH.
- arr at:6 put:littleStepV.
- arr at:7 put:false.
-
- ^ arr
-!
-
-hideGrid
- "hide the grid"
-
- gridShown := false.
- self newGrid
-!
-
-newGrid
- "define a new grid - this is a private helper which has to be
- called after any change in the grid. It (re)creates the gridPixmap,
- clears the view and redraws all visible objects."
-
- gridPixmap := nil.
- shown ifTrue:[
- self viewBackground:White.
- self clear.
- ].
-
- gridShown ifTrue:[
- self defineGrid.
- self viewBackground:gridPixmap.
- ].
-
- self invalidate
-
- "Modified: 29.5.1996 / 16:20:11 / cg"
-!
-
-showGrid
- "show the grid. The grid is defined by the return value of
- gridParameters, which can be redefined in concrete subclasses."
-
- gridShown := true.
- self newGrid
-! !
-
-!ObjectView methodsFor:'initialization'!
-
-initEvents
-"/ self backingStore:true.
-!
-
-initialize
- super initialize.
-
- viewBackground := White.
-
- bitGravity := #NorthWest.
- contents := OrderedCollection new.
- gridShown := false.
-
- canDragOutOfView := false.
- rootView := DisplayRootView new.
- rootView clippedByChildren:false.
- rootMotion := false.
- self setInitialDocumentFormat.
-
- leftHandCursor := Cursor leftHand.
- sorted := false.
- aligning := false.
- aligningMove := false.
-
- "Modified: 20.1.1997 / 20:41:10 / cg"
-!
-
-setInitialDocumentFormat
- (Smalltalk language == #english) ifTrue:[
- documentFormat := 'letter'.
- scaleMetric := #inch
- ] ifFalse:[
- documentFormat := 'a4'.
- scaleMetric := #mm
- ].
-! !
-
-!ObjectView methodsFor:'layout manipulation'!
-
-alignBottom:something
- |botMost|
-
- botMost := -999999.
- self forEach:something do:[:anObject |
- botMost := botMost max:(anObject frame bottom)
- ].
- self withSelectionHiddenDo:[
- self forEach:something do:[:anObject |
- self moveObject:anObject to:(anObject frame left)
- @
- (botMost - (anObject frame height))
- ]
- ]
-!
-
-alignHorizontal:something
- "align selection along their center horizontally"
-
- |topMost bottomMost h|
-
- topMost := 999999.
- bottomMost := -999999.
- self forEach:something do:[:anObject |
- |f|
- f := anObject frame.
- topMost := topMost min:(f top).
- bottomMost := bottomMost max:(f bottom).
- ].
- h := bottomMost - topMost.
-
- self withSelectionHiddenDo:[
- self forEach:something do:[:anObject |
- self moveObject:anObject
- to:(anObject frame left)
- @
- (topMost + ((h - anObject frame height) // 2))
- ]
- ]
-
- "Created: 4.6.1996 / 20:01:19 / cg"
- "Modified: 4.6.1996 / 21:19:48 / cg"
-!
-
-alignLeft:something
- |leftMost|
-
- leftMost := 999999.
- self forEach:something do:[:anObject |
- leftMost := leftMost min:(anObject frame left)
- ].
- self withSelectionHiddenDo:[
- self forEach:something do:[:anObject |
- self moveObject:anObject to:(leftMost @ (anObject frame top))
- ]
- ]
-!
-
-alignRight:something
- |rightMost|
-
- rightMost := -999999.
- self forEach:something do:[:anObject |
- rightMost := rightMost max:(anObject frame right)
- ].
- self withSelectionHiddenDo:[
- self forEach:something do:[:anObject |
- self moveObject:anObject to:(rightMost - (anObject frame width))
- @ (anObject frame top)
- ]
- ]
-!
-
-alignTop:something
- |topMost|
-
- topMost := 999999.
- self forEach:something do:[:anObject |
- topMost := topMost min:(anObject frame top)
- ].
- self withSelectionHiddenDo:[
- self forEach:something do:[:anObject |
- self moveObject:anObject to:((anObject frame left) @ topMost)
- ]
- ]
-!
-
-alignVertical:something
- "align selection along their center vertically"
-
- |leftMost rightMost w|
-
- leftMost := 999999.
- rightMost := -999999.
- self forEach:something do:[:anObject |
- |f|
- f := anObject frame.
- rightMost := rightMost max:(f right).
- leftMost := leftMost min:(f left).
- ].
- w := rightMost - leftMost.
-
- self withSelectionHiddenDo:[
- self forEach:something do:[:anObject |
- self moveObject:anObject
- to:(leftMost + ((w - anObject frame width) // 2))
- @
- (anObject frame top)
- ]
- ]
-
- "Created: 4.6.1996 / 19:59:16 / cg"
- "Modified: 4.6.1996 / 21:19:58 / cg"
-!
-
-move:something by:delta
- "change the position of something, an Object or Collection
- by delta, aPoint"
-
- (delta x == 0) ifTrue:[
- (delta y == 0) ifTrue:[^ self]
- ].
-
- self forEach:something do:[:anObject |
- self moveObject:anObject by:delta
- ]
-!
-
-move:something to:aPoint in:aView
- "can only happen when dragOutOfView is true
- - should be redefined in subclasses"
-
- self notify:'cannot move object(s) out of view'
-!
-
-move:something to:aPoint inAlienViewId:aViewId
- "can only happen when dragOutOfView is true
- - should be redefined in subclasses"
-
- self notify:'cannot move object(s) to alien views'
-!
-
-moveObject:anObject by:delta
- "change the position of anObject by delta, aPoint"
-
- self moveObject:anObject to:(anObject origin + delta)
-!
-
-moveObject:anObject to:newOrigin
- "move anObject to newOrigin, aPoint"
-
- |oldOrigin oldFrame newFrame
- objectsIntersectingOldFrame objectsIntersectingNewFrame
- wasObscured isObscured intersects
- oldLeft oldTop w h newLeft newTop griddedNewOrigin clip|
-
- anObject isNil ifTrue:[^ self].
- anObject canBeMoved ifFalse:[^ self].
-
- griddedNewOrigin := self alignToGrid:newOrigin.
- oldOrigin := anObject origin.
- (oldOrigin = griddedNewOrigin) ifTrue:[^ self].
-
- oldFrame := self frameOf:anObject.
- objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
- wasObscured := self isObscured:anObject.
-
- anObject moveTo:griddedNewOrigin.
- self changed:#objectLayout.
- shown ifFalse:[^ self].
-
- newFrame := self frameOf:anObject.
- objectsIntersectingNewFrame := self objectsIntersecting:newFrame.
-
- "try to redraw the minimum possible"
-
- "if no other object intersects both frames we can do a copy:"
-
- intersects := oldFrame intersects:newFrame.
- intersects ifFalse:[
- gridShown ifFalse:[
- transformation isNil ifTrue:[
- (objectsIntersectingOldFrame size == 1) ifTrue:[
- (objectsIntersectingNewFrame size == 1) ifTrue:[
- clip := self clippingRectangleOrNil.
- (clip isNil or:[oldFrame isContainedIn:clip]) ifTrue:[
- oldLeft := oldFrame left.
- oldTop := oldFrame top.
- newLeft := newFrame left.
- newTop := newFrame top.
- w := oldFrame width.
- h := oldFrame height.
- ((newLeft < width) and:[newTop < height]) ifTrue:[
- ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
- self catchExpose.
- self
- copyFrom:self
- x:oldLeft y:oldTop
- toX:newLeft y:newTop
- width:w height:h
- async:true.
- self waitForExpose
- ]
- ].
- ((oldLeft < width) and:[oldTop < height]) ifTrue:[
- ((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
- self clearRectangleX:oldLeft y:oldTop width:w height:h.
-
-"/ self fillRectangleX:oldLeft y:oldTop width:w height:h
-"/ with:viewBackground
- ]
- ].
- ^ self
- ]
- ]
- ]
- ]
- ]
- ].
- isObscured := self isObscured:anObject.
- (oldFrame intersects:newFrame) ifTrue:[
- isObscured ifFalse:[
- self redrawObjectsIn:oldFrame.
- self show: anObject
- ] ifTrue:[
- self redrawObjectsIn:(oldFrame merge:newFrame)
- ]
- ] ifFalse:[
- self redrawObjectsIn:oldFrame.
- isObscured ifFalse:[
- self show: anObject
- ] ifTrue:[
- self redrawObjectsIn:newFrame
- ]
- ]
-
- "Modified: / 4.7.1999 / 16:52:17 / cg"
-!
-
-objectToBack:anObject
- "bring the argument, anObject to back"
-
- anObject notNil ifTrue:[
- contents remove:anObject.
- contents addFirst:anObject.
- (self isObscured:anObject) ifTrue:[
- self redrawObjectsIn:(anObject frame)
- ].
- self changed:#objectLayout.
- ]
-
- "Modified: / 4.7.1999 / 16:52:39 / cg"
-!
-
-objectToFront:anObject
- "bring the argument, anObject to front"
-
- |wasObscured|
-
- anObject notNil ifTrue:[
- wasObscured := self isObscured:anObject.
- contents remove:anObject.
- contents addLast:anObject.
- wasObscured ifTrue:[
-"old:
- self redrawObjectsIn:(anObject frame)
-"
- self hideSelection.
- self show:anObject.
- self showSelection
- ].
- self changed:#objectLayout.
- ]
-
- "Modified: / 4.7.1999 / 16:52:49 / cg"
-!
-
-selectionAlignBottom
- "align selected objects at bottom"
-
- self alignBottom:selection
-!
-
-selectionAlignHorizontal
- "align selected objects horizontally"
-
- self alignHorizontal:selection
-
- "Created: 4.6.1996 / 19:58:46 / cg"
- "Modified: 4.6.1996 / 19:59:10 / cg"
-!
-
-selectionAlignLeft
- "align selected objects left"
-
- self alignLeft:selection
-!
-
-selectionAlignRight
- "align selected objects right"
-
- self alignRight:selection
-!
-
-selectionAlignTop
- "align selected objects at top"
-
- self alignTop:selection
-!
-
-selectionAlignVertical
- "align selected objects vertically"
-
- self alignVertical:selection
-
- "Created: 4.6.1996 / 19:59:00 / cg"
-!
-
-selectionToBack
- "bring the selection to back"
-
- self toBack:selection
-!
-
-selectionToFront
- "bring the selection to front"
-
- self toFront:selection
-!
-
-toBack:something
- "bring the argument, anObject or a collection of objects to back"
-
- self forEach:something do:[:anObject |
- self objectToBack:anObject
- ]
-!
-
-toFront:something
- "bring the argument, anObject or a collection of objects to front"
-
- self forEach:something do:[:anObject |
- self objectToFront:anObject
- ]
-! !
-
-!ObjectView methodsFor:'misc'!
-
-documentFormat:aFormatString
- "set the document format (mostly used by scrollbars).
- The argument should be a string such as 'a4', 'a5'
- or 'letter'.
- See the UnitConverter class for supported formats."
-
- aFormatString ~= documentFormat ifTrue:[
- documentFormat := aFormatString.
- self contentsChanged.
- self defineGrid.
- gridShown ifTrue:[
- self invalidate "/ clear; redraw
- ]
- ]
-
- "Modified: 31.5.1996 / 19:44:08 / cg"
-!
-
-forEach:aCollection do:aBlock
- "apply block to every object in a collectioni;
- (adds a check for non-collection)"
-
- aCollection isNil ifTrue:[^self].
- aCollection isCollection ifTrue:[
- aCollection do:[:object |
- object notNil ifTrue:[
- aBlock value:object
- ]
- ]
- ] ifFalse: [
- aBlock value:aCollection
- ]
-!
-
-hitDelta
- "when clicking an object, allow for hitDelta pixels around object.
- We compensate for any scaling here, to get a constant physical
- hitDelta (i.e. the value returned here is inverse scaled)."
-
- |delta|
-
- delta := self class hitDelta.
- transformation notNil ifTrue:[
- delta := delta / transformation scale x
- ].
- ^ delta
-!
-
-numberOfObjectsIntersecting:aRectangle
- "answer the number of objects intersecting the argument, aRectangle"
-
- |tally|
-
- tally := 0.
- contents do:[:theObject |
- (theObject frame intersects:aRectangle) ifTrue:[
- tally := tally + 1
- ]
- ].
- ^ tally
-!
-
-numberOfObjectsIntersectingVisible:aRectangle
- "answer the number of objects intersecting the argument, aRectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use numberOfObjectsIntersecting:, since this will vanish."
-
- ^ self numberOfObjectsIntersecting:aRectangle
-!
-
-objectsAbove:objectToBeTested do:aBlock
- "do something to every object above objectToBeTested
- (does not mean obscured - simply above in hierarchy)"
-
- |startIndex|
-
- startIndex := contents identityIndexOf:objectToBeTested
- ifAbsent:[self error].
- contents from:startIndex to:(contents size) do:aBlock
-!
-
-objectsAbove:anObject intersecting:aRectangle do:aBlock
- "do something to every object above objectToBeTested
- and intersecting aRectangle"
-
- self objectsAbove:anObject do:[:theObject |
- (theObject frame intersects:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
- ]
-!
-
-objectsBelow:objectToBeTested do:aBlock
- "do something to every object below objectToBeTested
- (does not mean obscured by - simply below in hierarchy)"
-
- |endIndex|
-
- endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
- contents from:1 to:(endIndex - 1) do:aBlock
-!
-
-objectsIn:aRectangle do:aBlock
- "do something to every object which is completely in a rectangle"
-
- |bot|
-
- sorted ifTrue:[
- bot := aRectangle bottom.
- contents do:[:theObject |
- (theObject isContainedIn:aRectangle) ifTrue:[
- aBlock value:theObject
- ] ifFalse:[
- theObject frame top > bot ifTrue:[^ self]
- ]
- ].
- ^ self
- ].
-
- contents do:[:theObject |
- (theObject isContainedIn:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
- ]
-!
-
-objectsInVisible:aRectangle do:aBlock
- "do something to every object which is completely in a
- visible rectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIn:do:, since this will vanish."
-
- self objectsIn:aRectangle do:aBlock
-!
-
-objectsIntersecting:aRectangle
- "answer a Collection of objects intersecting the argument, aRectangle"
-
- |newCollection|
-
- newCollection := OrderedCollection new.
- self objectsIntersecting:aRectangle do:[:theObject |
- newCollection add:theObject
- ].
- (newCollection size == 0) ifTrue:[^ nil].
- ^ newCollection
-!
-
-objectsIntersecting:aRectangle do:aBlock
- "do something to every object which intersects a rectangle"
-
- |f top bot
- firstIndex "{ Class: SmallInteger }"
- delta "{ Class: SmallInteger }"
- theObject
- nObjects "{ Class: SmallInteger }"|
-
- nObjects := contents size.
- (nObjects == 0) ifTrue:[^ self].
-
- sorted ifFalse:[
- "
- have to check every object
- "
- contents do:[:theObject |
- (theObject frame intersects:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
- ].
- ^ self
- ].
-
- "
- contents is sorted by y; can do a fast (binary) search for the first
- object which intersects aRectangle and
- break from the draw loop, when the 1st object below aRectangle is reached.
- "
- bot := aRectangle bottom.
- top := aRectangle top.
-
- "
- binary search for an object in aRectangle ...
- "
- delta := nObjects // 2.
- firstIndex := delta.
- (firstIndex == 0) ifTrue:[
- firstIndex := 1
- ].
- theObject := contents at:firstIndex.
- (theObject frame bottom < top) ifTrue:[
- [theObject frame bottom < top and:[delta > 1]] whileTrue:[
- delta := delta // 2.
- firstIndex := firstIndex + delta.
- theObject := contents at:firstIndex
- ]
- ] ifFalse:[
- [theObject frame top > bot and:[delta > 1]] whileTrue:[
- delta := delta // 2.
- firstIndex := firstIndex - delta.
- theObject := contents at:firstIndex
- ]
- ].
-
- "
- now, theObject at:firstIndex is in aRectangle; go backward to the object
- following first non-visible
- "
- [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
- firstIndex := firstIndex - 1.
- theObject := contents at:firstIndex
- ].
-
- firstIndex to:nObjects do:[:index |
- theObject := contents at:index.
- f := theObject frame.
- (f intersects:aRectangle) ifTrue:[
- aBlock value:theObject
- ] ifFalse:[
- (f top > bot) ifTrue:[^ self]
- ]
- ]
-!
-
-objectsIntersectingVisible:aRectangle
- "answer a Collection of objects intersecting a visible aRectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIntersecting:, since this will vanish."
-
- ^ self objectsIntersecting:aRectangle
-!
-
-objectsIntersectingVisible:aRectangle do:aBlock
- "do something to every object which intersects a visible rectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIntersecting:do:, since this will vanish."
-
- self objectsIntersecting:aRectangle do:aBlock
-!
-
-rectangleForScroll
- "find the area occupied by visible objects"
-
- |left right top bottom frame oLeft oRight oTop oBottom|
-
- left := 9999.
- right := 0.
- top := 9999.
- bottom := 0.
- self visibleObjectsDo:[:anObject |
- frame := anObject frame.
- oLeft := frame left.
- oRight := frame right.
- oTop := frame top.
- oBottom := frame bottom.
- (oLeft < left) ifTrue:[left := oLeft].
- (oRight > right) ifTrue:[right := oRight].
- (oTop < top) ifTrue:[top := oTop].
- (oBottom > bottom) ifTrue:[bottom := oBottom]
- ].
- (left < margin) ifTrue:[left := margin].
- (top < margin) ifTrue:[top := margin].
- (right > (width - margin)) ifTrue:[right := width - margin].
- (bottom > (height - margin)) ifTrue:[bottom := height - margin].
-
- ((left > right) or:[top > bottom]) ifTrue:[^ nil].
-
- ^ Rectangle left:left right:right top:top bottom:bottom
-!
-
-visibleObjectsDo:aBlock
- "do something to every visible object"
-
- |absRect|
-
- absRect := Rectangle left:0 top:0 width:width height:height.
- self objectsIntersecting:absRect do:aBlock
-! !
-
-!ObjectView methodsFor:'queries'!
-
-heightOfContents
- "answer the height of the document in pixels"
-
- |h|
-
- h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
- ^ h rounded
-!
-
-heightOfContentsInMM
- "answer the height of the document in millimeters"
-
- |unit value|
-
- "landscape"
- unit := (documentFormat , 'H') asSymbolIfInterned.
- unit isNil ifTrue:[
- "/ certainly unknown
- ] ifFalse:[
- value := UnitConverter convert:1 from:unit to:#millimeter
- ].
- value isNil ifTrue:[
- "/ assuming window size is document size
- value := (height / self verticalPixelPerMillimeter:1) asInteger
- ].
- ^ value
-
- "Modified: 31.5.1996 / 19:38:51 / cg"
-!
-
-widthOfContents
- "answer the width of the document in pixels"
-
- |w|
-
- w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
- ^ w rounded
-!
-
-widthOfContentsInMM
- "answer the width of the document in millimeters"
-
- |unit value|
-
- "landscape"
- unit := (documentFormat , 'W') asSymbolIfInterned.
- unit isNil ifTrue:[
- "/ certainly unknown
- ] ifFalse:[
- value := UnitConverter convert:1 from:unit to:#millimeter
- ].
- value isNil ifTrue:[
- "/ assuming window size is document size
- value := (width / self horizontalPixelPerMillimeter:1) asInteger
- ].
- ^ value
-
- "Modified: 31.5.1996 / 19:38:22 / cg"
-! !
-
-!ObjectView methodsFor:'saving / restoring'!
-
-fileInContentsFrom:aStream
- "remove all objects, load new contents from aStream and redraw"
-
- self fileInContentsFrom:aStream redraw:true new:true binary:false
-!
-
-fileInContentsFrom:aStream redraw:redraw
- "remove all objects, load new contents from aStream
- and redraw if the redraw argument is true"
-
- self fileInContentsFrom:aStream redraw:redraw new:true binary:false
-!
-
-fileInContentsFrom:aStream redraw:redraw new:new
- "remove all objects, load new contents from aStream
- and redraw if the redraw argument is true"
-
- self fileInContentsFrom:aStream redraw:redraw new:new binary:false
-!
-
-fileInContentsFrom:aStream redraw:redraw new:new binary:binary
- "if the new argument is true, remove all objects.
- Then load objects from aStream. If redraw is false, no redraw
- is done
- (allows fileIn of multiple files doing a single redraw at the end)."
-
- binary ifTrue:[
- aStream binary
- ].
- self topView withReadCursorDo:[
- |newObject chunk individualRedraw|
-
- self unselect.
- individualRedraw := redraw.
- new ifTrue:[
- self removeAll.
- individualRedraw := false.
- ].
- [aStream atEnd] whileFalse:[
- binary ifTrue:[
- newObject := Object readBinaryFrom:aStream
- ] ifFalse:[
- chunk := aStream nextChunk.
- (chunk size > 0) ifTrue:[
- newObject := Compiler evaluate:chunk compile:false.
- ] ifFalse:[
- newObject := nil
- ]
- ].
- newObject notNil ifTrue:[
- self initializeFileInObject:newObject.
- individualRedraw ifFalse:[
- self addObjectWithoutRedraw:newObject
- ] ifTrue:[
- self addObject:newObject
- ]
- ]
- ].
- (new and:[redraw]) ifTrue:[
- self invalidate
- ]
- ]
-
- "Modified: / 30.1.1998 / 01:02:16 / cg"
-!
-
-initializeFileInObject:anObject
- "each object may be processed here after its being filed-in
- - subclasses may do whatever they want here ...
- (see LogicView for example)"
-
- ^ self
-!
-
-storeBinaryContentsOn:aStream
- "store the contents in binary representation on aStream."
-
- aStream binary.
- self topView withCursor:Cursor write do:[
- self forEach:contents do:[:theObject |
- theObject storeBinaryOn:aStream.
- ].
- ]
-!
-
-storeContentsOn:aStream
- "store the contents in textual representation on aStream.
- Notice, that for huge objects (such as DrawImages) this ascii output
- can become quite large, and the time to save and reload can become
- long."
-
- |excla|
-
- self topView withCursor:Cursor write do:[
- excla := aStream class chunkSeparator.
- self forEach:contents do:[:theObject |
- theObject storeOn:aStream.
- aStream nextPut:excla.
- aStream cr
- ].
- aStream nextPut:excla
- ]
-!
-
-withoutRedrawFileInContentsFrom:aStream
- "remove all objects, load new contents from aStream without any redraw"
-
- self fileInContentsFrom:aStream redraw:false new:true binary:false
-! !
-
-!ObjectView methodsFor:'scrolling'!
-
-horizontalScrollStep
- "return the amount to scroll when stepping left/right.
- Redefined to scroll by inches or centimeters."
-
- scaleMetric == #inch ifTrue:[
- ^ (device horizontalPixelPerInch * (1/2)) asInteger
- ].
- ^ (device horizontalPixelPerMillimeter * 20) asInteger
-!
-
-verticalScrollStep
- "return the amount to scroll when stepping left/right.
- Redefined to scroll by inches or centimeters."
-
- scaleMetric == #inch ifTrue:[
- ^ (device verticalPixelPerInch * (1/2)) asInteger
- ].
- ^ (device verticalPixelPerMillimeter * 20) asInteger
-! !
-
-!ObjectView methodsFor:'selection & handles'!
-
-drawHandle:aPoint
- |hsize halfSize|
-
- hsize := self handleSize.
- halfSize := hsize // 2.
- self fillRectangleX:(aPoint x - halfSize)
- y:(aPoint y - halfSize)
- width:hsize
- height:hsize
-!
-
-drawHandlesFor:anObject
- |hsize halfSize|
-
- hsize := self handleSize.
- halfSize := hsize // 2.
- anObject handlesDo:[:point |
- self fillRectangleX:(point x - halfSize)
- y:(point y - halfSize)
- width:hsize
- height:hsize
- ]
-!
-
-findObjectHandleAt:aPoint
- |objectFound|
- contents do:[:object |
- (self object:object hasHandle:aPoint) ifTrue:[
- objectFound := object
- ]
- ].
- ^ objectFound
-!
-
-handle:handlePoint isHitBy:aPoint
- ^ (self handleFor:handlePoint) containsPoint:aPoint
-!
-
-handleFor:aPoint
- "return the handle-rectangle for a handle at aPoint"
-
- |hsize centerX centerY|
-
- hsize := self handleSize.
- centerX := aPoint x.
- centerY := aPoint y.
- ^ Rectangle left:(centerX - hsize)
- top:(centerY - hsize)
- right:(centerX + hsize)
- bottom:(centerY + hsize)
-!
-
-handleSize
- "return the size of the handles - sincc handles should be
- the same size regardless of scaling, inverse-scale from
- what the default is."
-
- |hs|
-
- hs := self class handleSize.
- transformation notNil ifTrue:[
- ^ transformation applyInverseScaleX:hs
- ].
- ^ hs
-!
-
-invertHandle:aHandle
- self xoring:[self drawHandle:aHandle]
-!
-
-invertHandlesOf:aSelection
- aSelection notNil ifTrue:[
- self xoring:[
- self forEach:aSelection do:[:anObject |
- (anObject respondsTo:#handlesDo:) ifTrue:[
- self drawHandlesFor:anObject
- ] ifFalse:[
- anObject drawOutlineIn:self
- ]
- ]
- ]
- ]
-!
-
-object:anObject hasHandleAt:aPoint
- |found|
-
- found := false.
- anObject handlesDo:[:handlePoint |
- (self handle:handlePoint isHitBy:aPoint) ifTrue:[
- found := true
- ]
- ].
- ^ found
-!
-
-selectionHandlesDo:aBlock
- self forEach:selection do:[:theObject |
- (theObject respondsTo:#handlesDo:) ifTrue:[
- theObject handlesDo:[:theHandle |
- aBlock value:theObject value:theHandle
- ]
- ]
- ]
-! !
-
-!ObjectView methodsFor:'selections'!
-
-addToSelection:anObject
- "add anObject to the selection; redraw it selected"
-
- selection isCollection ifFalse:[
- selection isNil ifTrue:[
- ^ self select:anObject
- ].
- selection := OrderedCollection with:selection
- ].
-
- (selection includes:anObject) ifFalse:[
- (self frameIncludesSelectionHandlesOn:anObject) ifFalse:[
- self hideSelection.
- selection add:anObject.
- self showSelection.
- self changed:#selection.
- ] ifTrue:[
- self showSelected:anObject
- ]
- ].
-
- "Modified: / 4.7.1999 / 15:22:13 / cg"
-!
-
-hideSelection
- "hide the selection - undraw hilights - whatever that is"
-
- self selectionDo:[:object |
- self showUnselected:object
- ]
-!
-
-removeFromSelection:anObject
- "remove anObject from the selection"
-
- |wasSelected didHide|
-
- didHide := false.
- wasSelected := true.
-
- (self frameIncludesSelectionHandlesOn:anObject) ifFalse:[
- "/ must hide any selection-handles first
- self hideSelection.
- didHide := true.
- ].
-
- selection isCollection ifTrue:[
- (selection remove:anObject ifAbsent:[nil]) isNil ifTrue:[
- wasSelected := false
- ].
- (selection size == 1) ifTrue:[
- selection := selection first
- ] ifFalse:[
- selection isEmpty ifTrue:[
- selection := nil
- ]
- ]
- ] ifFalse:[
- (selection == anObject) ifTrue:[
- selection := nil
- ] ifFalse:[
- wasSelected := false
- ]
- ].
-
- didHide ifTrue:[
- self showSelection.
- ] ifFalse:[
- wasSelected ifTrue:[
- self showUnselected:anObject
- ].
- ].
-
- self changed:#selection.
-
- "Modified: / 4.7.1999 / 15:22:28 / cg"
-!
-
-select:something
- "select something - hide previouse selection, set to something and hilight"
-
- (selection == something) ifFalse:[
- self hideSelection.
- selection := something.
- self showSelection.
- self changed:#selection.
- ]
-
- "Modified: / 4.7.1999 / 15:22:39 / cg"
-!
-
-selectAll
- "select all objects"
-
- self hideSelection.
- selection := contents copy.
- self showSelection.
- self changed:#selection.
-
- "Modified: / 4.7.1999 / 15:22:56 / cg"
-!
-
-selectAllIn:aRectangle
- "select all objects fully in aRectangle"
-
- self hideSelection.
- selection := OrderedCollection new.
- self objectsIn:aRectangle do:[:theObject |
- selection add:theObject
- ].
- (selection size == 0) ifTrue:[
- selection := nil
- ] ifFalse:[
- (selection size == 1) ifTrue:[selection := selection first]
- ].
- self showSelection.
- self changed:#selection.
-
- "Modified: / 4.7.1999 / 15:23:08 / cg"
-!
-
-selectAllIntersecting:aRectangle
- "select all objects touched by aRectangle"
-
- self hideSelection.
- selection := OrderedCollection new.
-
- self objectsIntersecting:aRectangle do:[:theObject |
- selection add:theObject
- ].
- (selection size == 0) ifTrue:[
- selection := nil
- ] ifFalse:[
- (selection size == 1) ifTrue:[selection := selection first]
- ].
- self showSelection.
- self changed:#selection.
-
- "Modified: / 4.7.1999 / 15:23:15 / cg"
-!
-
-selection
- "return the selection as a collection or nil"
-
- selection isNil ifTrue:[^ nil].
- selection isCollection ifTrue:[^ selection].
- ^ Array with:selection
-
- "Created: / 4.7.1999 / 14:33:16 / cg"
- "Modified: / 4.7.1999 / 14:34:20 / cg"
-!
-
-selectionDo:aBlock
- "apply block to every object in selection"
-
- self forEach:selection do:aBlock
-!
-
-showSelection
- "show the selection - draw hilights - whatever that is"
-
- self selectionDo:[:object |
- self showSelected:object
- ]
-!
-
-unselect
- "unselect - hide selection; clear selection"
-
- selection size notNil ifTrue:[
- self hideSelection.
- selection := nil.
- self changed:#selection.
- ]
-
- "Modified: / 4.7.1999 / 15:30:36 / cg"
-!
-
-withSelectionHiddenDo:aBlock
- "evaluate aBlock while selection is hidden"
-
- |sel|
-
- sel := selection.
- sel notNil ifTrue:[self unselect].
- aBlock value.
- sel notNil ifTrue:[self select:sel]
-! !
-
-!ObjectView methodsFor:'testing objects'!
-
-canMove:something
- "return true, if the argument, anObject or a collection can be moved"
-
- something isCollection ifTrue:[
- self forEach:something do:[:theObject |
- (theObject perform:#canBeMoved ifNotUnderstood:true) ifFalse:[^ false]
- ].
- ^ true
- ].
- ^ something perform:#canBeMoved ifNotUnderstood:true
-!
-
-canSelect:something
- "return true, if the argument, anObject or a collection can be selected"
-
- something isCollection ifTrue:[
- self forEach:something do:[:theObject |
- (theObject perform:#canBeSelected ifNotUnderstood:true) ifFalse:[^ false]
- ].
- ^ true
- ].
- ^ something perform:#canBeSelected ifNotUnderstood:true
-
- "Created: / 4.7.1999 / 18:51:29 / cg"
-!
-
-findObjectAt:aPoint
- "find the last object (by looking from back to front) which is hit by
- the argument, aPoint - this is the topmost object hit"
-
- |hdelta|
-
- hdelta := self hitDelta.
- contents reverseDo:[:object |
- (object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
- ].
- ^ nil
-!
-
-findObjectAt:aPoint suchThat:aBlock
- "find the last object (back to front ) which is hit by
- the argument, aPoint and for which the testBlock, aBlock evaluates to
- true"
-
- |hdelta|
-
- hdelta := self hitDelta.
- contents reverseDo:[:object |
- (object isHitBy:aPoint withDelta:hdelta) ifTrue:[
- (aBlock value:object) ifTrue:[^ object]
- ]
- ].
- ^ nil
-!
-
-findObjectAtVisible:aPoint
- "find the last object (by looking from back to front) which is hit by
- a visible point - this is the topmost object hit.
- This is a leftOver from times when scrolling was not transparent.
- Please use findObjectAt:, since this will vanish."
-
- ^ self findObjectAt:aPoint
-!
-
-findObjectAtVisible:aPoint suchThat:aBlock
- "find the last object (back to front ) which is hit by
- the argument, aPoint and for which the testBlock, aBlock evaluates to
- true.
- This is a leftOver from times when scrolling was not transparent.
- Please use findObjectAt:suchThat:, since this will vanish."
-
- ^ self findObjectAt:aPoint suchThat:aBlock
-!
-
-frameIncludesSelectionHandlesOn:anObject
- "return true, if anObjects frame includes any selection
- handles, false if not or if we do not know.
- This can be used to optimize the redraw, in removeObjectFromSelection.
- Subclasses which know how selections are highlighted may redefine this."
-
- ^ false "/ i.e. dont know.
-
- "Created: 1.10.1996 / 12:06:51 / cg"
-!
-
-frameOf:anObjectOrCollection
- "answer the maximum extent defined by the argument, anObject or a
- collection of objects"
-
- |first frameAll|
-
- anObjectOrCollection isNil ifTrue:[^ nil ].
- first := true.
- self forEach:anObjectOrCollection do:[:theObject |
- first ifTrue:[
- frameAll := theObject frame.
- first := false
- ] ifFalse:[
- frameAll := frameAll merge:(theObject frame)
- ]
- ].
- ^ frameAll
-!
-
-isObscured:something
- "return true, if the argument something, anObject or a collection of
- objects is obscured (partially or whole) by any other object"
-
- self forEach:something do:[:anObject |
- (self objectIsObscured:anObject) ifTrue:[
- ^ true
- ]
- ].
- ^ false
-!
-
-isSelected:anObject
- "return true, if the argument, anObject is in the selection"
-
- selection isNil ifTrue:[^ false].
- (selection == anObject) ifTrue:[^ true].
- selection isCollection ifTrue:[
- ^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
- ].
- ^ false
-!
-
-objectIsObscured:objectToBeTested
- "return true, if the argument, anObject is obscured (partially or whole)
- by any other object"
-
- |frameToBeTested frameleft frameright frametop framebot
- objectsFrame startIndex|
-
- (objectToBeTested == (contents last)) ifTrue:[
- "quick return if object is on top"
- ^ false
- ].
-
- frameToBeTested := self frameOf:objectToBeTested.
- frameleft := frameToBeTested left.
- frameright := frameToBeTested right.
- frametop := frameToBeTested top.
- framebot := frameToBeTested bottom.
-
- "check objects after the one to check"
-
- startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
- contents from:(startIndex + 1) to:(contents size) do:[:object |
- objectsFrame := self frameOf:object.
- (objectsFrame right < frameleft) ifFalse:[
- (objectsFrame left > frameright) ifFalse:[
- (objectsFrame bottom < frametop) ifFalse:[
- (objectsFrame top > framebot) ifFalse:[
- ^ true
- ]
- ]
- ]
- ]
- ].
- ^ false
-! !
-
-!ObjectView methodsFor:'user interface'!
-
-alignToGrid:aPoint
- "round aPoint to the next nearest point on the grid"
-
- aligning ifFalse:[
- ^ aPoint
- ].
-
- ^ (aPoint grid:gridAlign) rounded
-!
-
-selectMore:aPoint
- "add/remove an object from the selection"
-
- |anObject|
-
- anObject := self findObjectAt:aPoint.
- anObject notNil ifTrue:[
- (self isSelected:anObject) ifTrue:[
- "remove from selection"
- self removeFromSelection:anObject
- ] ifFalse:[
- "add to selection"
- (self canSelect:anObject) ifTrue:[
- self addToSelection:anObject
- ]
- ]
- ].
- ^ self
-
- "Modified: / 4.7.1999 / 18:52:13 / cg"
-!
-
-startSelectMoreOrMove:aPoint
- "add/remove object hit by aPoint, then start a rectangleDrag or move
- - if aPoint hits an object, a move is started, otherwise a rectangleDrag.
- This is typically the button shiftPressAction."
-
- |anObject|
-
- anObject := self findObjectAt:aPoint.
- anObject notNil ifTrue:[
- (self isSelected:anObject) ifTrue:[
- "remove from selection"
- self removeFromSelection:anObject
- ] ifFalse:[
- "add to selection"
- (self canSelect:anObject) ifTrue:[
- self addToSelection:anObject
- ]
- ].
- self startObjectMove:selection at:aPoint.
- ^ self
- ].
-"/ self unselect.
-"/ self startRectangleDrag:aPoint
-
- "Modified: / 4.7.1999 / 18:51:52 / cg"
-!
-
-startSelectOrMove:aPoint
- "start a rectangleDrag or objectMove - if aPoint hits an object,
- an object move is started, otherwise a rectangleDrag.
- This is typically the button pressAction."
-
- |anObject|
-
- anObject := self findObjectAt:aPoint.
- anObject notNil ifTrue:[
- (self isSelected:anObject) ifFalse:[self unselect].
- self startObjectMove:anObject at:aPoint.
- ^ self
- ].
- "nothing was hit by this click - this starts a group select"
- self unselect.
- self startRectangleDrag:aPoint
-! !
-
-!ObjectView methodsFor:'view manipulation'!
-
-inchMetric
- (scaleMetric ~~ #inch) ifTrue:[
- scaleMetric := #inch.
- self newGrid
- ]
-!
-
-millimeterMetric
- (scaleMetric ~~ #mm) ifTrue:[
- scaleMetric := #mm.
- self newGrid
- ]
-!
-
-zoom:factor
- "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
- 0.5 is shrink by 2"
-
- |current|
-
- transformation isNil ifTrue:[
- current := 1@1
- ] ifFalse:[
- current := transformation scale
- ].
- factor asPoint = current asPoint ifTrue:[
- ^ self
- ].
- current := factor.
- current isNil ifTrue:[
- current := 1
- ].
-
- (current = 1) ifTrue:[
- transformation := nil
- ] ifFalse:[
- transformation := WindowingTransformation scale:current translation:0.
- ].
- self contentsChanged.
- self setInnerClip.
- gridShown ifTrue:[
- self newGrid
- ].
- shown ifTrue:[
- self invalidate "/ clear; redraw
- ].
-
- "Modified: 29.5.1996 / 16:20:41 / cg"
-!
-
-zoomIn
- self zoomIn:2
-
- "Modified: 27.4.1996 / 10:08:50 / cg"
-!
-
-zoomIn:factor
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:0
- ].
- transformation := WindowingTransformation
- scale:(transformation scale / factor)
- translation:0.
- self contentsChanged.
- self setInnerClip.
- self invalidate.
-
- "Created: 27.4.1996 / 10:08:39 / cg"
- "Modified: 29.5.1996 / 16:20:46 / cg"
-!
-
-zoomOut
- self zoomOut:2
-
- "Modified: 27.4.1996 / 10:09:27 / cg"
-!
-
-zoomOut:factor
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:0
- ].
- transformation := WindowingTransformation
- scale:(transformation scale * factor)
- translation:0.
- self contentsChanged.
- self setInnerClip.
- self invalidate
-
- "Created: 27.4.1996 / 10:09:19 / cg"
- "Modified: 29.5.1996 / 16:20:49 / cg"
-! !
-
-!ObjectView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.75 1999-07-05 11:21:52 cg Exp $'
-! !
--- a/OptBox.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,405 +0,0 @@
-"
- 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.
-"
-
-DialogBox subclass:#OptionBox
- instanceVariableNames:'formLabel textLabel buttons actions defaultButtonIndex'
- classVariableNames:'WarnBitmap'
- poolDictionaries:''
- category:'Views-DialogBoxes'
-!
-
-!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.
-"
-!
-
-documentation
-"
- CAVEAT: this is a leftover - functionality has been merged into DialogBox
- PLEASE use one of the `Dialog chooseXXX' methods nstead of OptionBox.
-
-
- Historic note:
- originally, ST/X had separate classes for the various entry methods;
- there were YesNoBox, EnterBox, InfoBox and so on.
- In the meantime, the DialogBox class (and therefore its alias: Dialog)
- is going to duplicate most funcionality found in these classes.
-
- In the future, those existing subclasses' functionality is going to
- be moved fully into Dialog, and the subclasses will be replaced by dummy
- delegators. (They will be kept for backward compatibility, though).
-
-
- OptionBoxes are like YesNoBoxes but with as many buttons as you like;
- this will finally be a superclass of WarnBox and YesNoBox - or maybe merged
- all into DialogBox..
- Use them for multiway questions.
- For a consistent user interface, the rightmost button is the default return
- button (i.e. pressing return in the box performs this buttons function).
-
- [author:]
- Claus Gittinger
-
- [see also:]
- DialogBox
-"
-!
-
-examples
-"
- [exBegin]
- |box|
-
- box := OptionBox title:'hello' numberOfOptions:4.
- box showAtPointer
- [exEnd]
-
-
- [exBegin]
- |box|
- box := OptionBox title:'hello' numberOfOptions:3.
- box buttonTitles:#('one' 'two' 'three').
- box showAtPointer
- [exEnd]
-
- performing an action:
-
- [exBegin]
- |box|
- box := OptionBox title:'hello' numberOfOptions:3.
- box buttonTitles:#('one' 'two' 'three').
- box action:[:which | Transcript show:'button ';
- show: which;
- showCR:' was pressed'].
- box showAtPointer
- [exEnd]
-
- returning a value:
- [exBegin]
- |what|
-
- what := OptionBox
- request:('text has not been accepted.\\Your modifications will be lost when continuing.') withCRs
- label:' Attention'
- form:(WarningBox iconBitmap)
- buttonLabels:#('abort' 'accept' 'continue')
- values:#(#abort #accept #continue).
- Transcript showCR:what.
- [exEnd]
-"
-! !
-
-!OptionBox class methodsFor:'instance creation'!
-
-title:titleString numberOfOptions:nOptions
- "create a new optionBox with title, aTitleString and nOptions options"
-
- |box|
-
- box := (self basicNew) numberOfOptions:nOptions.
- box device:Screen current.
- box initialize.
- box title:titleString.
- ^ box
-! !
-
-!OptionBox class methodsFor:'easy startup '!
-
-request:title label:label form:aForm buttonLabels:labels values:values
- "create a new optionBox, open it modal and return the value of
- the corresponding values collection."
-
- ^ self request:title label:label form:aForm buttonLabels:labels values:values default:nil
-!
-
-request:title label:label form:aForm buttonLabels:labels values:values default:defaultValue
- "create a new optionBox, open it modal and return the value of
- the corresponding values collection."
-
- |box|
-
- box := OptionBox title:title numberOfOptions:(labels size).
- box buttonTitles:labels.
- box defaultButtonIndex:(values indexOf:defaultValue).
- box action:[:n | box destroy. ^ values at:n].
- box label:label; form:aForm.
- box showAtPointer.
- box destroy.
- ^ defaultValue
-
- "
- OptionBox request:'please select'
- label:'select any'
- form:(WarningBox iconBitmap)
- buttonLabels:#('one' 'two' 'three')
- values:#(1 2 3)
- default:3
- "
-
- "Modified: 7.1.1997 / 22:59:21 / cg"
-! !
-
-!OptionBox methodsFor:'accessing'!
-
-action:actionBlock
- "define a single the action for all buttons.
- The action will be evaluated with the button index as argument."
-
- buttons keysAndValuesDo:[:index :button |
- button action:[
- button turnOffWithoutRedraw.
- self hide.
- actionBlock value:index
- ]
- ].
-!
-
-actions:actionBlocks
- "define the actions"
-
- actions := actionBlocks
-!
-
-buttonTitles:titles actions:actionBlocks
- "define both button titles and actions"
-
- self buttonTitles:titles.
- actions := actionBlocks.
-!
-
-buttons
- "return the buttons collection"
-
- ^ buttons
-!
-
-defaultButtonIndex:index
- "define which button is the default (i.e. return-) button.
- By default, no returnButton is setup. The argument must be an
- index 1..nButtons, or nil"
-
- defaultButtonIndex notNil ifTrue:[
- (buttons at:defaultButtonIndex) isReturnButton:false
- ].
- (index notNil and:[index ~~ 0]) ifTrue:[
- defaultButtonIndex := index.
- defaultButtonIndex notNil ifTrue:[
- (buttons at:defaultButtonIndex) isReturnButton:true
- ].
- ]
-
- "Modified: 18.10.1996 / 14:53:36 / cg"
-!
-
-numberOfOptions
- "return the number of options"
-
- ^ buttons size
-!
-
-numberOfOptions:nOptions
- "set the number of options - this is a private interface"
-
- buttons := (OrderedCollection new:nOptions) grow:nOptions.
- actions := (OrderedCollection new:nOptions) grow:nOptions
-
- "Modified: 18.10.1996 / 14:54:30 / cg"
-! !
-
-!OptionBox methodsFor:'accessing - look'!
-
-buttonTitles:titles
- "set the button titles"
-
- titles keysAndValuesDo:[:index :aString |
- |b|
-
- (b := buttons at:index) label:aString.
- b resize.
- ].
- shown ifTrue:[self resize]
-!
-
-form:aFormOrImage
- "set the image shown in the label-view"
-
- formLabel form:aFormOrImage
-!
-
-formLabel
- "return the label-view which displays a bitmap"
-
- ^ formLabel
-!
-
-title:aString
- "set the boxes title"
-
- aString ~= textLabel label ifTrue:[
- textLabel label:aString withoutSeparators.
- textLabel forceResize.
- shown ifTrue:[self resize]
- ]
-!
-
-title:aString numberOfOptions:nOptions
- "set the boxes title and number of options"
-
- self title:aString.
- buttons grow:nOptions.
- actions grow:nOptions
-! !
-
-!OptionBox methodsFor:'events'!
-
-keyPress:aKey x:x y:y
- "return-key dublicates ok-function if acceptReturnAsOK is true"
-
- <resource: #keyboard (#Return)>
-
- |action|
-
- defaultButtonIndex notNil ifTrue:[
- (aKey == #Return) ifTrue:[
- self hide.
- action := actions at:defaultButtonIndex.
- action notNil ifTrue:[
- action value
- ]
- ]
- ].
- super keyPress:aKey x:x y:y
-
- "Modified: 7.3.1996 / 13:17:36 / cg"
-! !
-
-!OptionBox methodsFor:'initializing'!
-
-initFormBitmap
- WarnBitmap isNil ifTrue:[
- WarnBitmap := WarningBox iconBitmap.
-"/ WarnBitmap := Image fromFile:'bitmaps/Warning.xbm' resolution:100 on:Display
- ].
- formLabel form:WarnBitmap
-
- "Modified: / 25.5.1999 / 16:08:06 / cg"
-!
-
-initialize
- |nButt mm|
-
- super initialize.
-
- mm := ViewSpacing.
-
- formLabel := Label in:self.
- self initFormBitmap.
- formLabel borderWidth:0.
- formLabel origin:(mm @ mm).
-
- textLabel := Label label:'Select' in:self.
- textLabel borderWidth:0.
- textLabel origin:((mm + formLabel width + mm) @ mm).
-
-"/ buttonPanel isNil ifTrue:[
-"/ buttonPanel := HorizontalPanelView origin:(0.0 @ 1.0) corner:(1.0 @ 1.0) in:self.
-"/ ].
- buttonPanel
- bottomInset:mm;
- topInset:(font height + mm * 2) negated.
- buttonPanel
- borderWidth:0;
- horizontalLayout:#fitSpace.
-
- nButt := buttons size.
-
- 1 to:nButt do:[:index |
- |button|
-
- button := Button label:'press'.
- button action:[
- |action|
-
- (buttons at:index) turnOffWithoutRedraw.
- self hide.
- action := actions at:index.
- action notNil ifTrue:[
- action value
- ]
- ].
-"/ index == nButt ifTrue:[
-"/ button isReturnButton:true
-"/ ].
- buttonPanel addSubView:button.
- buttons at:index put:button.
- ].
-
- "
- |box|
-
- box := OptionBox title:'hello' numberOfOptions:4.
- box open
- "
-
- "Modified: / 27.7.1998 / 19:37:17 / cg"
-! !
-
-!OptionBox methodsFor:'queries'!
-
-preferredExtent
- "return a size to make everything fit into myself"
-
- |w w1 h maxH prefPanel mm|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- mm := ViewSpacing.
-
- w1 := (mm * 3) + formLabel width + textLabel width.
- prefPanel := buttonPanel preferredExtent.
- w := w1 max:prefPanel x.
-
-"/ maxH := 0.
-"/ buttons do:[:button |
-"/ maxH := maxH max:(button preferredExtent y)
-"/ ].
- maxH := prefPanel y.
-
- h := (mm * 4)
- + ((formLabel height) max:(textLabel height))
- + maxH.
-
- ^ w @ h
-
- "Modified: 19.7.1996 / 20:45:11 / cg"
-! !
-
-!OptionBox class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/OptBox.st,v 1.41 1999-05-25 14:14:41 cg Exp $'
-! !
--- a/PopUpLstC.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,115 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-ButtonController subclass:#PopUpListController
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Controllers'
-!
-
-!PopUpListController class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- redefined the behavior on various keys if my view has the focus.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!PopUpListController methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- "redefined to not send any change message to the model when
- pressed (this is done by the popped menu)"
-
- (button == 1 or:[button == #select]) ifFalse:[
- ^ super buttonPress:button x:x y:y
- ].
-
- enableChannel value ifTrue:[
- pressed ifFalse:[
- pressed := true.
- view showActive.
-
- (pressActionBlock notNil or:[model notNil]) ifTrue:[
- "
- force output - so that button is drawn correctly in case
- of any long-computation (at high priority)
- "
- view flush.
- ].
-
- pressActionBlock value.
-
- ]
- ]
-
- "Created: 27.1.1997 / 17:22:16 / cg"
- "Modified: 27.1.1997 / 17:23:17 / cg"
-!
-
-keyPress:key x:x y:y
- "pull menu on Return and space, if I am the focusView of my group
- (i.e. if I got an explicit focus)"
-
- <resource: #keyboard (#Return #CursorUp #CursorDown)>
-
- view hasFocus ifTrue:[
-"/ (key == #Return) ifTrue:[
-"/ view menu shown ifTrue:[
-"/ self halt:'not yet implemented'.
-"/ ^ self.
-"/ ].
-"/ ].
- (key == #CursorUp or:[key == #CursorDown]) ifTrue:[
- view menu shown ifTrue:[
- key == #CursorUp ifTrue:[view menu selectNext]
- ifFalse:[view menu selectPrevious].
- ^ self.
- ].
- ].
- (key == Character space) ifTrue:[
- view menu exclusivePointer:false.
- view menu hideOnRelease:true.
- view popMenu.
- view menu exclusivePointer:true.
- ^ self.
- ]
- ].
- view keyPress:key x:x y:y
-
- "Created: 9.12.1995 / 23:06:09 / cg"
- "Modified: 7.3.1996 / 13:17:46 / cg"
-! !
-
-!PopUpListController class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/PopUpLstC.st,v 1.11 1997-01-27 16:47:40 cg Exp $'
-! !
--- a/PullDMenu.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1795 +0,0 @@
-"
- 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.
-"
-
-View subclass:#PullDownMenu
- instanceVariableNames:'receiver menus titles selectors activeMenuNumber
- showSeparatingLines topMargin fgColor bgColor activeFgColor
- activeBgColor onLevel offLevel edgeStyle toggleMode toggleKeep
- raiseTopWhenActivated actions'
- classVariableNames:'DefaultViewBackground DefaultForegroundColor
- DefaultBackgroundColor DefaultHilightForegroundColor
- DefaultHilightBackgroundColor DefaultLevel DefaultHilightLevel
- DefaultShadowColor DefaultLightColor DefaultEdgeStyle
- DefaultToggleMode DefaultKeepMenu DefaultToggleKeep
- DefaultSeparatingLines'
- poolDictionaries:''
- category:'Views-Menus'
-!
-
-!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.
-"
-!
-
-documentation
-"
- Notice: this class is obsolete now - please use a MenuPanel
- in new applications, which provides all of this functionality,
- plus more.
-
- 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.
-
- A PullDownMenu itself consists of a single row of labels, which activate
- a pulled menu when clicked. Entries may be empty (i.e. have no menu)
- and empty entries may (optionally) also perform some action when clicked.
- An entries selector is used as the key to define and access submenus
- and (for empty entries:) the selector sent to the receiver of the menu.
-
- [Instance variables:]
-
- menus <Collection> the sub menus
-
- titles <Collection> the strings in the menu
-
- selectors <Collection> the selectors to send to the menu-
- receiver (for empty pull-menus)
- if nil (the default), title entries
- do not send anything.
-
- 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> fg color to draw passive menu-titles
- bgColor <Color> bg color to draw passive menu-titles
-
- activeFgColor <Color> fg color to draw activated menu-titles
- activeBgColor <Color> bg color to draw activated menu-titles
-
- onLevel <Integer> 3D level of entry-buttons when pressed
- offLevel <Integer> 3D level of entry-buttons when released
-
- edgeStyle <Symbol> how to draw edges
-
- toggleMode <Symbol> if #toggle, press pulls menu,
- another press hides it.
- if other, its hidden on release.
-
- except menus, titles and selectors, instvars are usually defined from
- defaults in the styleSheet; you should not care for them.
-
-
- [StyleSheet values:]
-
- pullDownMenuViewBackground view background Color for the menu bar
- default: menuViewBackground
-
- pullDownMenuForegroundColor foreground drawing color for the menu bar
- default: menuForegroundColor
-
- pullDownMenuBackgroundColor background drawing color for the menu bar
- default: menuBackgroundColor
-
- pullDownMenuHilightForegroundColor active foreground drawing color for the menu bar
- default: menuHilightForegroundColor
-
- pullDownMenuHilightBackgroundColor active background drawing color for the menu bar
- default: menuHilightBackgroundColor
-
- pullDownMenuHilightLevel level (3D only) when active
- default: menuHilightLevel
-
- pullDownMenuEdgeStyle edge style (nil or #soft)
-
- pullDownMenuKeepMenu if true, pulled menu stays open until button
- is pressed again outside of the item-area (motif behavior)
- if false, menu closes on release (default)
-
- pullDownMenuToggleKeep if true, pulled menu closes when an entry is pressed
- again. Otherwise, only press outside of the items area
- hides it. default is false
-
- pullDownMenuLevel level (3D only)
-
- pullDownMenuFont font to use for the menu bar
- default: menuFont
-
- pullDownMenuShowSeparatingLines if true, lines are drawn between items.
- default: false
-
- pullDownMenuRaiseTop if true, topview is raised whenever an entry
- is activated.
- default: true
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- with default level (from styleSheets 'pullDownMenuLevel' setting):
- [exBegin]
- |top menu|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- top open
- [exEnd]
-
- with a defined level:
- [exBegin]
- |top menu|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu level:1.
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- top open
- [exEnd]
-
-
- empty entries are possible as selectable items (with non-nil seletor) ...
- [exBegin]
- |top menu|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' 'bar' 'baz').
- menu selectors:#(foo bar baz).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#baz
- putLabels:#('baz1' 'baz2' 'baz3')
- selectors:#(baz1 baz2 baz3)
- receiver:nil.
- top open
- [exEnd]
-
-
- ... or as separators (with nil selector)
- [exBegin]
- |top menu|
-
- top := StandardSystemView new.
- top extent:500@200.
-
- menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
- menu labels:#('foo' ' ' 'bar' ' baz' ' ' 'moreFoo' 'moreBar' 'moreBaz').
- menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- menu at:#bar
- putLabels:#('bar1' 'bar2' 'bar3')
- selectors:#(bar1 bar2 bar3)
- receiver:nil.
- menu at:#baz
- putLabels:#('baz1' 'baz2' 'baz3')
- selectors:#(baz1 baz2 baz3)
- receiver:nil.
- top open
- [exEnd]
-
-
-
- use the menus default height
- [exBegin]
- |top menu|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- menu := PullDownMenu in:top.
- menu origin:0.0@0.0 corner:1.0@(menu height).
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
- [exEnd]
-
-
-
- although you can change the font, colors etc. (as shown below)
- you should NOT do it - since if you do so, the styleSheet settings
- are ineffective (which users probably won't like)
- BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
- pullDownMenuBackgroundColor and pullDownMenuFont
- [exBegin]
- |top menu|
-
- top := StandardSystemView new.
- menu := PullDownMenu in:top.
- menu font:(Font family:'courier' size:20).
- menu foregroundColor:Color red.
- menu backgroundColor:Color yellow.
- menu viewBackground:Color green.
- menu showSeparatingLines:true.
-
- menu origin:0.0@0.0 corner:1.0@(menu height).
- menu labels:#('foo' 'bar').
- menu selectors:#(foo bar).
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- (menu menuAt:#foo) font:(Font family:'courier' size:36).
- top open
- [exEnd]
-
-
- you can use icons, too ...
- [exBegin]
- |labels top menu|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- menu := PullDownMenu in:top.
- menu origin:0.0@0.0 corner:1.0@(menu height).
- labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
- with:'foo'
- with:'bar'.
- menu labels:labels.
- menu selectors:#(about foo bar).
- menu at:#about
- putLabels:#('about PullDownMenus')
- selectors:#(aboutMenus)
- receiver:nil.
- menu at:#foo
- putLabels:#('foo1' 'foo2' 'foo3')
- selectors:#(foo1 foo2 foo3)
- receiver:nil.
- top open
- [exEnd]
-
-
- a concrete example (combining things described above)
- (using a Plug, since we have no application class here):
- [exBegin]
- |labels top menu textView appModel|
-
- appModel := Plug new.
- appModel respondTo:#quit with:[top destroy].
- appModel respondTo:#showAbout with:[self information:'some info here ...'].
- appModel respondTo:#help with:[self information:'some help here ...'].
-
- top := StandardSystemView new.
- top extent:300@300.
-
- menu := PullDownMenu in:top.
- menu receiver:appModel.
- menu origin:0.0@0.0 corner:1.0@(menu height).
-
- textView := ScrollableView forView:(EditTextView new).
- textView origin:0.0@menu height corner:1.0@1.0.
- top addSubView:textView.
-
- labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
- with:'file'
- with:'edit'
- with:'help'.
- menu labels:labels.
- menu selectors:#(about file edit help).
- menu at:#about
- putLabels:#('about PullDownMenus')
- selectors:#(showAbout)
- receiver:appModel.
- menu at:#file
- putLabels:#('quit')
- selectors:#(quit)
- receiver:appModel.
- menu at:#edit
- putLabels:#('copy' 'cut' 'paste')
- selectors:#(copySelection cut paste)
- receiver:textView.
- top open
- [exEnd]
-"
-
-! !
-
-!PullDownMenu class methodsFor:'instance creation'!
-
-labels:titleArray
- "create and return a new PullDownMenu"
-
- ^ self new labels:titleArray
-! !
-
-!PullDownMenu class methodsFor:'defaults'!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'pullDownMenu.viewBackground' #'menuView.background'
- #'pullDownMenu.foregroundColor' #'menu.foregroundColor'
- #'pullDownMenu.backgroundColor' #'menu.backgroundColor'
- #'pullDownMenu.hilightForegroundColor' #'menu.hilightForegroundColor'
- #'pullDownMenu.hilightBackgroundColor' #'menu.hilightBackgroundColor'
- #'pullDownMenu.hilightLevel' #'menu.hilightLevel'
- #'pullDownMenu.edgeStyle'
- #'pullDownMenu.toggleMode'
- #'pullDownMenu.level'
- #'pullDownMenu.font' #'menu.font'
- #'pullDownMenu.separatingLines')>
-
- |styleSheet|
-
- styleSheet := StyleSheet.
-
- DefaultViewBackground := styleSheet colorAt:#'pullDownMenu.viewBackground'.
- DefaultViewBackground isNil ifTrue:[
- DefaultViewBackground := styleSheet colorAt:#'menuView.background'.
- ].
- DefaultForegroundColor := styleSheet colorAt:#'pullDownMenu.foregroundColor'.
- DefaultForegroundColor isNil ifTrue:[
- DefaultForegroundColor := styleSheet colorAt:#'menu.foregroundColor'.
- ].
- DefaultBackgroundColor := styleSheet colorAt:#'pullDownMenu.backgroundColor'.
- DefaultBackgroundColor isNil ifTrue:[
- DefaultViewBackground notNil ifTrue:[
- DefaultBackgroundColor := DefaultViewBackground
- ] ifFalse:[
- DefaultBackgroundColor := styleSheet colorAt:#'menu.backgroundColor'.
- ]
- ].
- DefaultHilightForegroundColor := styleSheet colorAt:#'pullDownMenu.hilightForegroundColor'.
- DefaultHilightForegroundColor isNil ifTrue:[
- DefaultHilightForegroundColor := styleSheet colorAt:#'menu.hilightForegroundColor'.
- ].
- DefaultHilightBackgroundColor := styleSheet colorAt:#'pullDownMenu.hilightBackgroundColor'.
- DefaultHilightBackgroundColor isNil ifTrue:[
- DefaultHilightBackgroundColor := styleSheet colorAt:#'menu.hilightBackgroundColor'.
- ].
- DefaultHilightLevel := styleSheet at:#'pullDownMenu.hilightLevel'.
- DefaultHilightLevel isNil ifTrue:[
- DefaultHilightLevel := styleSheet at:#'menu.hilightLevel' default:0.
- ].
- DefaultEdgeStyle := styleSheet at:#'pullDownMenu.edgeStyle'.
- DefaultToggleMode := styleSheet at:#'pullDownMenu.toggleMode' default:#toggle.
- DefaultLevel := styleSheet at:#'pullDownMenu.level' default:1.
- DefaultFont := styleSheet fontAt:#'pullDownMenu.font'.
- DefaultFont isNil ifTrue:[DefaultFont := styleSheet fontAt:#'menu.font'].
- DefaultSeparatingLines := styleSheet at:#'pullDownMenu.separatingLines' default:false.
-
- "
- PullDownMenu updateStyleCache
- "
-
- "Modified: 20.10.1997 / 14:02:28 / cg"
-! !
-
-!PullDownMenu methodsFor:'accessing'!
-
-add:label selector:selector
- "add a new title-item at the end.
- The corresponding label can later be set with #at:putMenu:
- or #at:putLabels:selectors:..."
-
- self add:label selector:selector after:nil
-
- "Modified: 5.6.1996 / 16:45:46 / cg"
-!
-
-add:label selector:selector after:indexOrString
- "add a new title-item after an existing item, indexOrString,
- or at the end if the after-arg is nil.
- The corresponding label can later be set with #at:putMenu:
- or #at:putLabels:selectors:..."
-
- |idx|
-
- indexOrString isNil ifTrue:[
- idx := titles size
- ] ifFalse:[
- idx := self indexOf:indexOrString.
- ].
-
- titles isNil ifTrue:[
- menus := Array with:nil.
- titles := Array with:label.
- selectors := Array with:selector.
- ] ifFalse:[
- menus := (menus copyTo:idx) , #(nil) , (menus copyFrom:idx+1).
- titles := ((titles copyTo:idx) copyWith:label) , (titles copyFrom:idx+1).
- selectors := ((selectors copyTo:idx) copyWith:selector) , (selectors copyFrom:idx+1).
- ].
-
- shown ifTrue:[
- self redraw
- ]
-
- "
- |top m|
-
- top := StandardSystemView new.
- m := PullDownMenu in:top.
- m labels:#('file' 'edit').
- m selectors:#(file #edit).
-
- m add:'help' selector:#help after:#file.
- m at:#help putMenu:(MenuView labels:#('foo' 'bar')
- selectors:#(foo bar)
- receiver:nil).
-
- top open
- "
-
- "Modified: 5.7.1996 / 11:40:47 / cg"
-!
-
-add:label selector:selector before:indexOrString
- "add a new title-item before an existing item, indexOrString,
- or at the beginning if the before-arg is nil.
- The corresponding label can later be set with #at:putMenu:
- or #at:putLabels:selectors:..."
-
- |idx|
-
- indexOrString isNil ifTrue:[
- idx := 1
- ] ifFalse:[
- idx := self indexOf:indexOrString.
- ].
-
- titles isNil ifTrue:[
- menus := Array with:nil.
- titles := Array with:label.
- selectors := Array with:selector.
- ] ifFalse:[
- menus := (menus copyTo:idx-1) , #(nil) , (menus copyFrom:idx).
- titles := ((titles copyTo:idx-1) copyWith:label) , (titles copyFrom:idx).
- selectors := ((selectors copyTo:idx-1) copyWith:selector) , (selectors copyFrom:idx).
- ].
-
- shown ifTrue:[
- self redraw
- ]
-
- "
- |top m|
-
- top := StandardSystemView new.
- m := PullDownMenu in:top.
- m labels:#('file' 'edit').
- m selectors:#(file #edit).
-
- m add:'help' selector:#help before:#edit.
- m at:#help putMenu:(MenuView labels:#('foo' 'bar')
- selectors:#(foo bar)
- receiver:nil).
-
- m add:'foo' selector:#foo before:nil.
- m at:#foo putMenu:(MenuView labels:#('foo1' 'foo2')
- selectors:#(foo1 foo2)
- receiver:nil).
-
- top open
- "
-
- "Modified: 5.7.1996 / 11:40:55 / cg"
-!
-
-at:aString putLabels:labels selector:selector args:args receiver:anObject
- "create and set the menu under the title, aString
- OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
- single symbol-arg for selectors ..."
-
- ^ self at:aString putLabels:labels selectors:selector args:args receiver:anObject
-
- "Modified: 5.6.1996 / 16:47:32 / cg"
-!
-
-at:aString putLabels:labels selectors:selectors
- "create and set the menu under the title, aString"
-
- ^ self at:aString putLabels:labels selectors:selectors receiver:nil
-
- "Created: 24.3.1996 / 17:06:45 / cg"
-!
-
-at:aString putLabels:labels selectors:selectors accelerators:shorties args:args receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selectors:selectors
- accelerators:shorties
- args:args
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView.
- ^ menuView
-
- "Created: 5.6.1996 / 16:51:48 / cg"
-!
-
-at:aString putLabels:labels selectors:selectors accelerators:shorties receiver:anObject
- "create and set the menu under the title, aString"
-
- ^ self at:aString putLabels:labels selectors:selectors accelerators:shorties args:nil receiver:anObject
-
- "Modified: 5.6.1996 / 16:48:26 / cg"
- "Created: 5.6.1996 / 16:53:39 / cg"
-!
-
-at:aString putLabels:labels selectors:selectors args:args receiver:anObject
- "create and set the menu under the title, aString"
-
- |menuView|
-
- menuView := MenuView labels:labels
- selectors:selectors
- args:args
- receiver:anObject
- for:self.
- self at:aString putMenu:menuView.
- ^ menuView
-!
-
-at:aString putLabels:labels selectors:selectors receiver:anObject
- "create and set the menu under the title, aString"
-
- ^ self at:aString putLabels:labels selectors:selectors args:nil receiver:anObject
-
- "Modified: 5.6.1996 / 16:48:26 / cg"
-!
-
-at:aString putMenu:aMenu
- "set the menu under the title, aString"
-
- |index|
-
- index := self indexOf:aString.
- (index == 0) ifTrue:[
- self error:'no such menu entry' mayProceed:true.
- ^ nil
- ].
-
- aMenu container:(self superView).
- aMenu beInvisible.
- menus at:index put:aMenu.
- aMenu masterView:self.
-
- ^ aMenu
-
- "Modified: 5.6.1996 / 16:48:50 / cg"
-!
-
-labels
- "return the menu-titles (group-headers)"
-
- ^ titles
-!
-
-labels:titleArray
- "define the menu-titles (group-headers)"
-
- |numberOfLabels|
-
- numberOfLabels := titleArray size.
- menus := Array new:numberOfLabels.
- titles := Array new:numberOfLabels.
-
- titleArray keysAndValuesDo:[:index :entry |
- |e|
-
- entry isImage ifTrue:[
- e := entry onDevice:device
- ] ifFalse:[
- e := entry printString
- ].
- titles at:index put:e
- ].
- shown ifTrue:[
- self invalidate "/ clear; redraw
- ]
-
- "Modified: 29.5.1996 / 16:21:00 / cg"
-!
-
-labels:titleArray selectors:selectorArray
- "define the menu-titles (group-headers) and selectors.
- Selectors are mostly used as access keys to get to submenus later."
-
- self labels:titleArray.
- self selectors:selectorArray
-
- "Created: 20.10.1995 / 20:15:54 / cg"
-!
-
-menuAt:stringOrNumber
- "return the menu with the title; nil if not found"
-
- ^ self subMenuAt:stringOrNumber
-
- "Modified: 24.3.1996 / 17:10:11 / cg"
-!
-
-numberOfTitles:n
- "setup blank title-space to be filled in later"
-
- menus := Array new:n.
- titles := Array new:n
-!
-
-receiver:anObject
- "set the menu-receiver. Thats the one who gets the
- messages (both from myself and from my submenus).
- This only sets the receiver for menus which are already
- created - menus added later should get their receiver in
- the creation send."
-
- receiver := anObject.
- menus notNil ifTrue:[
- menus do:[:aMenu |
- aMenu notNil ifTrue:[
- aMenu receiver:anObject
- ]
- ]
- ]
-!
-
-remove:indexOrString
- "remove the menu, indexOrString."
-
- |idx|
-
- idx := self indexOf:indexOrString.
- idx == 0 ifTrue:[^ self].
-
- menus removeIndex:idx.
- titles removeIndex:idx.
- selectors removeIndex:idx.
-
- shown ifTrue:[
- self clear.
- self redraw
- ]
-
- "
- |top m|
-
- top := StandardSystemView new extent:300@200.
- m := PullDownMenu in:top.
- m labels:#('file' 'edit').
- m selectors:#(file #edit).
- top open.
-
- Delay waitForSeconds:3.
- m add:'help' selector:#help after:#file.
- m at:#help putMenu:(MenuView labels:#('foo' 'bar')
- selectors:#(foo bar)
- receiver:nil).
-
- Delay waitForSeconds:3.
- m remove:'help'
- "
-
- "Modified: 5.7.1996 / 11:43:08 / cg"
-!
-
-selectors
- "return the menu-selectors"
-
- ^ selectors
-!
-
-selectors:selectorArray
- "define the menu-selectors. These are used as accesskey only
- in menuAt: accesses. This makes PullDownMenu accesss
- somewhat more compatible to PopUpMenus."
-
- selectors := selectorArray copy.
-
- "Modified: 30.4.1996 / 15:57:04 / cg"
-!
-
-subMenuAt:stringOrNumber
- "return the menu with the title; nil if not found."
-
- |index|
-
- index := self indexOf:stringOrNumber.
- (index == 0) ifTrue:[^ nil].
- ^ menus at:index
-
- "Modified: 24.3.1996 / 17:09:56 / cg"
-! !
-
-!PullDownMenu methodsFor:'accessing-behavior'!
-
-actionAt:stringOrNumber
- "return the actionBlock associated with stringOrNumber;
- nil if there is none (but there may be still a selector there)."
-
- |index|
-
- actions isNil ifTrue:[^ nil].
- index := self indexOf:stringOrNumber.
- (index == 0) ifTrue:[^ nil].
- ^ actions at:index ifAbsent:nil
-
- "Modified: 24.3.1996 / 17:09:56 / cg"
- "Created: 17.4.1996 / 20:50:45 / cg"
-!
-
-actionAt:stringOrNumber put:aBlock
- "return the actionBlock associated with stringOrNumber;
- nil if there is none (but there may be still a selector there)."
-
- |index newActions|
-
- index := self indexOf:stringOrNumber.
- (index == 0) ifTrue:[^ nil].
- actions size < index ifTrue:[
- newActions := Array new:index.
- newActions replaceFrom:1 to:actions size with:actions.
- actions := newActions
- ].
- actions at:index put:aBlock
-
- "Modified: 24.3.1996 / 17:09:56 / cg"
- "Created: 17.4.1996 / 20:52:13 / cg"
-! !
-
-!PullDownMenu methodsFor:'accessing-look'!
-
-backgroundColor:aColor
- "set the background drawing color.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- bgColor := aColor onDevice:device
-!
-
-font:aFont
- "set the menus font.
- adjusts menu-origins when font changes.
- You should not use this method; instead leave the value as
- defined in the styleSheet.
- CAVEAT: with the addition of Text objects,
- this method is going to be obsoleted by a textStyle
- method, which allows specific control over
- normalFont/boldFont/italicFont parameters."
-
- aFont ~~ font ifTrue:[
- super font:(aFont onDevice:device).
- self height:(font height + (font descent * 2)).
- shown ifTrue:[
- self setMenuOrigins
- ]
- ]
-
- "Modified: 22.5.1996 / 12:37:04 / cg"
-!
-
-foregroundColor:aColor
- "set the foreground drawing color.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- fgColor := aColor onDevice:device
-!
-
-showSeparatingLines:aBoolean
- "turn on/off drawing of separating lines.
- You should not use this method; instead leave the value as
- defined in the styleSheet."
-
- showSeparatingLines := aBoolean.
- shown ifTrue:[
- self setMenuOrigins.
- self invalidate
- ]
-
- "Modified: 29.5.1996 / 16:21:06 / cg"
-! !
-
-!PullDownMenu methodsFor:'converting'!
-
-asMenu
- ^ self asMenu:self
-
-!
-
-asMenu:aView
- |menu values item subM rcv|
-
- menu := Menu new.
- values := aView selectors.
-
- aView labels keysAndValuesDo:[:anIndex :aLabel|
- item := MenuItem labeled:(aLabel printString).
- aLabel isImage ifTrue:[
- rcv := ResourceRetriever new.
- rcv className:#MenuEditor.
- rcv selector:#iconUnknown.
- item labelImage:rcv.
- ] ifFalse:[
- aView ~~ self ifTrue:[
- rcv := aView checkToggleAt:anIndex.
- rcv notNil ifTrue:[
- item indication:rcv
- ]
- ]
- ].
-
- subM := aView subMenuAt:anIndex.
-
- subM notNil ifTrue:[
- item submenu:(self asMenu:subM)
- ].
- menu addItem:item value:(values at:anIndex).
- ].
- ^ menu
-
-
-! !
-
-!PullDownMenu methodsFor:'drawing '!
-
-drawActiveTitleSelected:selected
- |x|
- activeMenuNumber notNil ifTrue:[
- x := self titleLenUpTo:activeMenuNumber.
- self drawTitle:(titles at:activeMenuNumber) x:x selected:selected
- ]
-!
-
-drawTitle:stringOrImage x:x0 selected:selected
- |y w x wSpace fg bg map|
-
- selected ifTrue:[
- fg := activeFgColor.
- bg := activeBgColor
- ] ifFalse:[
- fg := fgColor.
- bg := bgColor
- ].
-
- wSpace := font widthOf:' '.
- x := x0.
- stringOrImage isString ifTrue:[
- y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
- w := font widthOf:stringOrImage.
- ] ifFalse:[
- y := ((height - stringOrImage height) // 2) max:0.
- w := stringOrImage width
- ].
- w := w + (wSpace * 2).
-
- self paint:bg.
- self fillRectangleX:x y:0 width:w height:height.
-
- self is3D ifTrue:[
- self drawEdgesForX:x y:0
- width:w
- height:height
- level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
- ].
- self paint:fg on:bg.
- x := x + wSpace.
- stringOrImage isString ifTrue:[
- self displayOpaqueString:stringOrImage x:x y:y
- ] ifFalse:[
- stringOrImage isImageOrForm ifTrue:[
- stringOrImage depth == 1 ifTrue:[
- (map := stringOrImage colorMap) notNil ifTrue:[
- map at:1 put:((map at:1) onDevice:device).
- map at:2 put:((map at:2) onDevice:device).
-
- self paint:(map at:2) on:(map at:1).
- self displayOpaqueForm:stringOrImage x:x y:y.
- ^ self
- ]
- ].
- self displayForm:stringOrImage x:x y:y
- ] ifFalse:[
- stringOrImage displayOn:self x:x y:y
- ]
- ]
-
- "Modified: 14.1.1997 / 00:06:07 / cg"
-!
-
-highlightActiveTitle
- self drawActiveTitleSelected:true
-!
-
-redraw
- |x "{ Class: SmallInteger }"
- y "{ Class: SmallInteger }"
- index "{ Class: SmallInteger }"
- wSpace clr|
-
- shown ifFalse: [ ^ self ].
- titles isNil ifTrue:[^ self].
-
- wSpace := (font widthOf:' ').
- x := 0.
- y := height "- 1".
- index := 1.
- titles do:[:title |
- self drawTitle:title x:x selected:(index == activeMenuNumber).
-
- title isString ifTrue:[
- x := x + (font widthOf:title).
- ] ifFalse:[
- x := x + title width
- ].
- x := x + wSpace + wSpace.
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:x y:0 toX:x y:y.
- x := x + 1.
- clr := lightColor.
- ] ifFalse:[
- clr := fgColor.
- ].
- self paint:clr.
- self displayLineFromX:x y:0 toX:x y:y.
- x := x + 1
- ].
- index := index + 1
- ]
-
- "Modified: 14.1.1997 / 00:06:22 / cg"
-!
-
-unHighlightActiveTitle
- self drawActiveTitleSelected:false
-! !
-
-!PullDownMenu methodsFor:'event handling'!
-
-buttonMotion:state x:x y:y
- |titleIndex activeMenu activeLeft activeTop|
-
- state == 0 ifTrue:[
- "/ self hideActiveMenu.
- ^ self
- ].
- "is it the select or 1-button ?"
- self sensor anyButtonPressed ifFalse:[^ self].
-
- activeMenuNumber isNil ifTrue:[^ self].
-
- activeMenuNumber notNil ifTrue:[
- activeMenu := menus at:activeMenuNumber.
- ].
-
- (y < height) ifTrue:[
- "moving around in title line"
- activeMenu notNil ifTrue:[
- activeMenu setSelection:nil
- ].
- titleIndex := self titleIndexForX:x.
- titleIndex notNil ifTrue:[
- (titleIndex ~~ activeMenuNumber) ifTrue:[
- self pullMenu:titleIndex
- ]
- ] ifFalse:[
- self hideActiveMenu
- ]
- ] ifFalse:[
- "moving around below"
- activeMenu isNil ifTrue:[^self].
- 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 buttonMotion:state
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- "moved outside menu"
- activeMenu setSelection:nil
- ]
-
- "Modified: / 28.7.1998 / 16:01:50 / cg"
-!
-
-buttonPress:button x:x y:y
- |titleIndex activeMenu activeLeft activeTop m|
-
- device ungrabPointer.
- device ungrabKeyboard.
-
- (y between:0 and:height) ifTrue:[
- titleIndex := self titleIndexForX:x.
- ].
-
- "
- now, titleIndex is non-nil if pressed within myself
- "
- (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
- "/ pressed on another item
- m := self pullMenu:titleIndex.
- (toggleMode == #toggle) ifTrue:[
- device grabPointerInView:self.
- device grabKeyboardInView:self.
-"/ self cursor:Cursor upRightArrow
- ]
- ] ifFalse:[
- titleIndex == activeMenuNumber ifTrue:[
- "/ pressed on same item
- (toggleMode ~~ #toggle) ifTrue:[
- "same pressed again ... stay"
- titleIndex notNil ifTrue:[
- device grabPointerInView:self.
- device grabKeyboardInView:self.
- ].
- ] ifFalse:[
- self hideActiveMenu.
- ].
- ^ self
- ].
-
- "/ pressed outside
-
- 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:[
-
- "/ pressed inside currently pulled menu
- activeMenu buttonPress:button x:(x - activeLeft) y:(y - activeTop).
- ^ self
- ].
- ].
-
- "/ somewhere else
- self hideActiveMenu.
- ]
-
- "Modified: 6.3.1996 / 17:14:16 / cg"
-!
-
-buttonRelease:button x:x y:y
- |activeMenu activeLeft activeTop hideMenu|
-
- activeMenuNumber isNil ifTrue:[^self].
- activeMenu := menus at:activeMenuNumber.
-
- hideMenu := false.
- (y >= height) ifTrue:[
- "release below title-line"
- 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.
- activeMenu buttonRelease:button
- x:(x - activeLeft)
- y:(y - activeTop).
- ^ self
- ]
- ].
- hideMenu := true.
- ] ifFalse:[
- y < 0 ifTrue:[
- hideMenu := true
- ] ifFalse:[
- activeMenu isNil ifTrue:[
- self performSelectedAction.
- hideMenu := true.
- ] ifFalse:[
- (toggleMode == #toggle) ifFalse:[
- hideMenu := true
- ]
- ]
- ]
- ].
- hideMenu ifTrue:[
- self hideActiveMenu.
- ]
-
- "Modified: 17.4.1996 / 20:56:08 / cg"
-!
-
-keyPress:key x:x y:y
-
- <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect #Return)>
-
- |index startIndex m|
-
- "
- handle CursorLeft/Right for non-mouse operation
- (for example, if it has the explicit focus)
- These will pull the previous/next menu
- "
- ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
- activeMenuNumber isNil ifTrue:[
- index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
- ] ifFalse:[
- (key == #CursorRight) ifTrue:[
- "/ if its a cursor-right, and the current item
- "/ has a submenu, then pop up the submenu
- m := menus at:activeMenuNumber.
- m notNil ifTrue:[
- m selectedItemHasSubmenu ifTrue:[
- m showSubmenu:(m selection).
- ^ self.
- ].
- ].
- ].
-
- (key == #CursorRight) ifTrue:[
- index := activeMenuNumber+1
- ] ifFalse:[
- index := activeMenuNumber-1
- ].
- index == 0 ifTrue:[index := menus size]
- ifFalse:[
- index > menus size ifTrue:[index := 1]
- ]
- ].
- self pullMenu:index.
- ^ self
- ].
-
-"/ activeMenuNumber isNil ifTrue:[
- "/
- "/ find an item starting with that alpha-key
- "/
- key isCharacter ifTrue:[
- (key isLetter) ifTrue:[
- activeMenuNumber isNil ifTrue:[
- startIndex := 1.
- ] ifFalse:[
- startIndex := activeMenuNumber + 1
- ].
- index := titles
- findFirst:[:item |
- item isString
- and:[(item startsWith:key asUppercase)
- or:[item startsWith:key asLowercase]]]
- startingAt:startIndex.
-
- (index == 0 and:[startIndex ~~ 1]) ifTrue:[
- index := titles
- findFirst:[:item |
- item isString
- and:[(item startsWith:key asUppercase)
- or:[item startsWith:key asLowercase]]]
- startingAt:1.
- ].
-
- index ~~ 0 ifTrue:[
- self pullMenu:index.
- ].
- ^ self
- ]
- ].
-"/ ].
-
- activeMenuNumber isNil ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
-
- "
- Return, space or the (virtual) MenuSelect key trigger
- a menu entry (for non-submenu entries).
- Otherwise, if we have a submenu open,
- pass the key on to it ...
- "
- m := menus at:activeMenuNumber.
- m isNil ifTrue:[
- (key == #Return
- or:[key == #MenuSelect
- or:[key == Character space]]) ifTrue:[
- self performSelectedAction.
- ].
- ] ifFalse:[
- m keyPress:key x:0 y:0.
- ].
-
- "Modified: 25.2.1997 / 23:38:15 / cg"
-!
-
-showNoFocus:explicit
- "when stepping focus, hide any active menu"
-
- explicit ifTrue:[
- self hideActiveMenu.
- super showNoFocus:explicit
- ]
-
- "Modified: 25.2.1997 / 23:31:38 / cg"
-! !
-
-!PullDownMenu methodsFor:'hiding/showing menus'!
-
-hide
- "sent by an aborted menu"
-
- self hideActiveMenu.
-!
-
-hideActiveMenu
- "hide currently active menu - release grab if there is any grab"
-
- ^ self hideActiveMenuRelease:true
-!
-
-hideActiveMenuRelease:aBoolean
- "hide currently active menu - release grab if aBoolean is true
- and a grab was set"
-
- |m|
-
- activeMenuNumber notNil ifTrue:[
- (m := menus at:activeMenuNumber) notNil ifTrue:[
- m beInvisible.
- ].
- self unHighlightActiveTitle.
- activeMenuNumber := nil
- ].
- aBoolean ifTrue:[
- device ungrabKeyboard.
- device ungrabPointer.
-"/ self cursor:Cursor normal
- ].
-
- "Modified: 6.3.1996 / 17:14:21 / cg"
-!
-
-pullMenu:aNumber
- "activate a menu, return it or nil"
-
- <resource: #style (#'pullDownMenu.autoselectFirst')>
-
- |subMenu r posY|
-
- activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
- activeMenuNumber := aNumber.
- subMenu := menus at:aNumber.
-
- raiseTopWhenActivated ifTrue:[
- self topView raise.
- ].
-
- (activeMenuNumber notNil
- and:[
- subMenu notNil
- or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
- self highlightActiveTitle.
- ].
-
- subMenu notNil ifTrue:[
- subMenu origin:((left + (self titleLenUpTo:aNumber))
- @
- (posY := height + subMenu borderWidth)).
- subMenu hiddenOnRealize:false.
- subMenu setSelection:nil.
- subMenu create.
- subMenu saveUnder:true.
- subMenu superMenu:self.
-
- subMenu right > (r := self right) ifTrue:[
- subMenu origin:((r - subMenu width) @ posY).
- ].
- subMenu raise show.
-
- (styleSheet at:#'pullDownMenu.autoselectFirst') == true ifTrue:[
- subMenu setSelection:1
- ]
- ].
- ^ subMenu
-
- "Modified: / 26.10.1997 / 17:04:00 / cg"
-!
-
-regainControl
- true ifTrue:[
- device grabPointerInView:self.
- device grabKeyboardInView:self.
-"/ self cursor:Cursor upRightArrow
- self sensor flushMotionEventsFor:nil
- ]
-
- "Modified: 6.3.1996 / 17:14:27 / cg"
-! !
-
-!PullDownMenu methodsFor:'initialize / release'!
-
-container:aView
- "when my container changes, all of my menus must change as well"
-
- super container:aView.
-
- menus notNil ifTrue:[
- menus do:[:aMenu |
- aMenu notNil ifTrue:[
- aMenu container:aView
- ]
- ]
- ]
-
- "Modified: 9.5.1996 / 00:43:13 / cg"
- "Created: 9.5.1996 / 00:43:38 / cg"
-!
-
-create
- super create.
- self setMenuOrigins
-!
-
-destroy
- "have to destroy the menus manually here,
- since they are no real subviews of myself"
-
- menus notNil ifTrue:[
- menus do:[:m |
- m notNil ifTrue:[m destroy]
- ].
- menus := nil
- ].
- activeMenuNumber := nil.
- super destroy.
-!
-
-fetchDeviceResources
- "fetch device colors, to avoid reallocation at redraw time"
-
- super fetchDeviceResources.
-
- bgColor notNil ifTrue:[bgColor := bgColor onDevice:device].
- fgColor notNil ifTrue:[fgColor := fgColor onDevice:device].
-
- activeBgColor notNil ifTrue:[activeBgColor := activeBgColor onDevice:device].
- activeFgColor notNil ifTrue:[activeFgColor := activeFgColor onDevice:device].
-
- "Created: 13.1.1997 / 23:25:14 / cg"
-!
-
-initCursor
- "set up a hand cursor"
-
- cursor := Cursor hand
-!
-
-initStyle
- "initialize style specifics"
-
- <resource: #style (#name #'pullDownMenu.raiseTop')>
-
- |style|
-
- super initStyle.
-
-"/ DefaultFont notNil ifTrue:[font := DefaultFont on:device].
-
- showSeparatingLines := DefaultSeparatingLines. "/ false.
- DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground onDevice:device
- ].
-
- DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor
- ] ifFalse:[
- fgColor := Black.
- ].
- DefaultBackgroundColor notNil ifTrue:[
- bgColor := DefaultBackgroundColor
- ] ifFalse:[
- bgColor := viewBackground.
- ].
- onLevel := DefaultHilightLevel.
- offLevel := DefaultLevel.
-
- self is3D ifTrue:[
- device hasColors ifTrue:[
- activeFgColor := Color name:'yellow'
- ] ifFalse:[
- activeFgColor := White
- ].
- device hasGrayscales ifTrue:[
- activeBgColor := bgColor.
- ] ifFalse:[
- activeBgColor := fgColor.
- ].
- topMargin := 2.
-
- style := styleSheet name.
- ((style == #iris) or:[style == #motif]) ifTrue:[
- self level:2.
- onLevel := 2.
- offLevel := 0.
- activeFgColor := fgColor
- ] ifFalse:[
- style == #win95 ifTrue:[
- self level:1
- ]
- ]
- ] ifFalse:[
- activeFgColor := bgColor.
- activeBgColor := fgColor.
- topMargin := 0
- ].
-
- edgeStyle := DefaultEdgeStyle.
- toggleMode := DefaultToggleMode.
-
- DefaultHilightForegroundColor notNil ifTrue:[
- activeFgColor := DefaultHilightForegroundColor
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- activeBgColor := DefaultHilightBackgroundColor
- ].
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor
- ].
-
- raiseTopWhenActivated := styleSheet at:#'pullDownMenu.raiseTop' default:true.
-
- "Modified: / 15.9.1998 / 22:58:42 / cg"
-!
-
-initialize
- super initialize.
-
- font := font onDevice:device.
- self origin:(0.0 @ 0.0)
- extent:(1.0 @ self preferredExtent y)
-"/ extent:(1.0 @ (font height + (font descent * 2) + topMargin)).
-!
-
-recreate
- "if the image was saved with an active menu, hide it"
-
- |m|
-
- activeMenuNumber notNil ifTrue:[
- (m := menus at:activeMenuNumber) notNil ifTrue:[
- m unmap.
- ].
- activeMenuNumber := nil.
- ].
- super recreate.
- self setMenuOrigins
-
- "Modified: 3.5.1996 / 23:48:55 / stefan"
-! !
-
-!PullDownMenu methodsFor:'private'!
-
-indexOf:stringOrNumber
- "return the index of the menu with title; return 0 if not found.
- stringOrNumber may be a number, a selector from the selectorArray
- or a string from the title array.
- If stringOrNumber is not a valid item, return 0."
-
- |idx|
-
- stringOrNumber isNumber ifTrue:[
- ^ stringOrNumber
- ].
- selectors notNil ifTrue:[
- idx := selectors indexOf:stringOrNumber.
- idx ~~ 0 ifTrue:[^ idx].
- ].
- stringOrNumber isString ifTrue:[
- ^ titles indexOf:stringOrNumber
- ].
- (stringOrNumber respondsTo:#string) ifTrue:[
- ^ titles indexOf:stringOrNumber asString
- ].
- ^ 0
-
- "Modified: 27.4.1996 / 15:25:28 / cg"
-!
-
-performEntry:itemIndex
- |block sel|
-
- actions notNil ifTrue:[
- block := actions at:itemIndex.
- block notNil ifTrue:[
- block value.
- ^ self
- ].
- ].
- selectors notNil ifTrue:[
- sel := selectors at:itemIndex.
- sel notNil ifTrue:[
- model notNil ifTrue:[
- model perform:sel
- ] ifFalse:[
- receiver perform:sel
- ]
- ].
- ].
-
- "Modified: 17.4.1996 / 20:55:11 / cg"
-!
-
-performSelectedAction
- |block sel|
-
- actions notNil ifTrue:[
- block := actions at:activeMenuNumber.
- block notNil ifTrue:[
- block value.
- ^ self
- ].
- ].
- selectors notNil ifTrue:[
- sel := selectors at:activeMenuNumber.
- sel notNil ifTrue:[
- model notNil ifTrue:[
- model perform:sel
- ] ifFalse:[
- receiver perform:sel
- ]
- ].
- ].
-
- "Modified: 17.4.1996 / 20:55:11 / cg"
- "Created: 17.4.1996 / 20:55:53 / cg"
-!
-
-setMenuOrigins
- "adjust origins of menus when font changes"
-
- (font graphicsDevice == device) ifTrue:[
- menus notNil ifTrue:[
- menus keysAndValuesDo:[:index :aMenu |
- aMenu notNil ifTrue:[
- aMenu origin:((left + (self titleLenUpTo:index))
- @
- (height + aMenu borderWidth))
- ].
- ]
- ]
- ]
-
- "Modified: 5.7.1996 / 17:55:08 / cg"
-!
-
-someMenuItemLabeled:aLabel
- "find a menu item.
- Currently, in ST/X, instances of MenuItem are only created as dummy"
-
- |idx|
-
- idx := self indexOf:aLabel.
- idx ~~ 0 ifTrue:[
- ^ MenuItem new menu:self index:idx
- ].
- menus notNil ifTrue:[
- menus do:[:aMenu |
- |item|
-
- aMenu notNil ifTrue:[
- (item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
- ^ item
- ]
- ]
- ]
- ].
- ^ nil
-!
-
-titleIndexForX:x
- "given a click x-position, return index in title or nil"
-
- |xstart "{ Class: SmallInteger }"
- xend "{ Class: SmallInteger }"
- wSpace wSep|
-
- wSpace := (font widthOf:' ') * 2.
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- wSep := 2
- ] ifFalse:[
- wSep := 1
- ]
- ] ifFalse:[
- wSep := 0
- ].
- xstart := 0.
- 1 to:(titles size) do:[:index |
- |entry thisLength|
-
- entry := titles at:index.
- entry isString ifTrue:[
- thisLength := font widthOf:entry.
- ] ifFalse:[
- thisLength := entry width
- ].
- xend := xstart + thisLength + wSpace + wSep.
- (x between:xstart and:xend) ifTrue:[^ index].
- xstart := xend
- ].
- ^ nil
-!
-
-titleLenUpTo:index
- "answer len (in pixels) of all title-strings up-to
- (but excluding) title-index. Used to compute x-position when drawing
- individual entries."
-
- |len "{ Class: SmallInteger }"
- wSpace wSep|
-
- (index <= 1) ifTrue:[^ 0].
- wSpace := (font widthOf:' ').
- showSeparatingLines ifTrue:[
- self is3D ifTrue:[
- wSep := 2
- ] ifFalse:[
- wSep := 1
- ]
- ] ifFalse:[
- wSep := 0
- ].
-
- len := 0.
- titles from:1 to:(index - 1) do:[:entry |
- |thisLength|
-
- entry isString ifTrue:[
- thisLength := (font widthOf:entry).
- ] ifFalse:[
- thisLength := entry width
- ].
- len := len + thisLength + wSpace + wSep + wSpace.
- ].
- ^ len
-! !
-
-!PullDownMenu methodsFor:'queries'!
-
-preferredExtent
- "return my preferredExtent from the title-item widths & font height"
-
- |w hMax|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- w := self titleLenUpTo:(titles size + 1).
- hMax := font height + (font descent * 2).
- titles notNil ifTrue:[
- titles do:[:aStringOrImage |
- aStringOrImage isString ifFalse:[
- hMax := hMax max:(aStringOrImage heightOn:self)
- ]
- ]
- ].
-
- ^ w @ (hMax + (margin*2) + ((onLevel abs max:offLevel abs)*2) "+ topMargin").
-
- "Modified: / 31.10.1997 / 20:49:23 / cg"
-!
-
-specClass
- "redefined, since the name of my specClass is nonStandard (i.e. not PullDownMenuSpec)"
-
- ^ MenuPanelSpec
-
- "Modified: / 31.10.1997 / 19:48:23 / cg"
-! !
-
-!PullDownMenu methodsFor:'submenu notifications'!
-
-hideSubmenu
- "sent by en escaped menu - ignored here"
-
- ^ self
-
- "Modified: 4.3.1996 / 22:58:22 / cg"
-!
-
-showActive
- "sent by a menu to tell me that it starts to perform
- its menu action."
-
- windowGroup notNil ifTrue:[windowGroup showCursor:Cursor wait]
-!
-
-showPassive
- "sent by a menu to tell me that it finished its menu-action.
- Here, we hide the currently active menu."
-
- self hideActiveMenu.
- windowGroup notNil ifTrue:[windowGroup restoreCursors]
-!
-
-submenuTriggered
- "sent by a sub-submenu to tell me that it finished its menu-action."
-
- self showPassive
-! !
-
-!PullDownMenu class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/PullDMenu.st,v 1.87 1999-08-18 14:38:30 cg Exp $'
-! !
--- a/RButtC.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,68 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-ToggleController subclass:#RadioButtonController
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Controllers'
-!
-
-!RadioButtonController class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- RadioButtonControllers redefine the response to a button-click.
- While toggles (i.e. ToggleControllers) change state with every click,
- radioButtons will only do so for an off-to-on transition.
- They will NEVER turn themselfes off with a click.
- To turn a radioButton off, another button in its buttonGroup must
- be turned on and thereby (via the buttonGroup) turn the first button off.
-
- You can place both toggles (for 'zero-or-one-on' behavior) or
- radiobuttons (for 'one-on' behavior) into a buttongroup.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!RadioButtonController methodsFor:'initialize / release'!
-
-initialize
- super initialize.
- isToggle := false.
- isRadio := true.
- isTriggerOnDown := true.
-
- "Created: 15.7.1996 / 13:43:23 / cg"
-! !
-
-!RadioButtonController class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/RButtC.st,v 1.8 1996-07-15 14:41:38 cg Exp $'
-! !
--- a/RButtGrp.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,307 +0,0 @@
-"
- 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.
-"
-
-ValueHolder subclass:#RadioButtonGroup
- instanceVariableNames:'numberOfValues'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Support'
-!
-
-!RadioButtonGroup 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.
-"
-!
-
-documentation
-"
- RadioButtonGroups control the interaction between RadioButtons
- turning off other button(s) when one of the group is pressed.
- To group some buttons (and have one-on behavior) use:
-
- |g|
-
- g := RadioButtonGroup new.
- ...
- b1 := RadioButton label:....
- g add:b1
- ...
- b2 := RadioButton label:....
- g add:b2
- ...
-
- A radioButtonGroup is itself usable as a model, holding the index of
- the selected button. It can be used as a selectionIndexHolder of a
- SelectionInList instance.
-
- [author:]
- Claus Gittinger
-
- [see also:]
- RadioButton Toggle CheckBox CheckToggle Button
- Model ValueHolder SelectionInList
-"
-
- "Modified: 1.3.1997 / 14:11:57 / cg"
-!
-
-examples
-"
- using Toggles for 'at most one-on behavior':
- [exBegin]
- |top panel b group|
-
- top := StandardSystemView label:'toggles'.
- panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
- group := RadioButtonGroup new.
- b := Toggle label:'one' in:panel.
- group add:b.
- b := Toggle label:'two' in:panel.
- group add:b.
- b := Toggle label:'three' in:panel.
- group add:b.
- top extent:(panel preferredExtent).
- top open.
- [exEnd]
-
-
- using RadioButtons for 'one-on behavior':
- [exBegin]
- |top panel b group|
-
- top := StandardSystemView label:'radio'.
- panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
- group := RadioButtonGroup new.
- b := RadioButton label:'one' in:panel.
- group add:b.
- b := RadioButton label:'two' in:panel.
- group add:b.
- b := RadioButton label:'three' in:panel.
- group add:b.
- top extent:(panel preferredExtent).
- top open.
- [exEnd]
-
-
- same, with initial selection:
- [exBegin]
- |top panel b group|
-
- top := StandardSystemView label:'radio'.
- panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
- group := RadioButtonGroup new.
- b := RadioButton label:'one' in:panel.
- group add:b.
- b := RadioButton label:'two' in:panel.
- group add:b.
- b := RadioButton label:'three' in:panel.
- group add:b.
- top extent:(panel preferredExtent).
-
- group value:1.
- top open.
- [exEnd]
-
-
- using Buttons for 'none-on behavior';
- buttons do not show the boolean state (they only fire);
- however, the groups value remembers the last pressed button:
- [exBegin]
- |top panel b group|
-
- top := StandardSystemView new.
- panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
- group := RadioButtonGroup new.
- b := Button label:'one' in:panel.
- group add:b.
- b := Button label:'two' in:panel.
- group add:b.
- b := Button label:'three' in:panel.
- group add:b.
- top extent:(panel preferredExtent).
- top open.
-
- group inspect
- [exEnd]
-
-
- using checkBoxes (these have a label included).
- notice, that we change their behavior to radioButton behavior:
- [exBegin]
- |top panel b group|
-
- top := StandardSystemView new.
- panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
- panel horizontalLayout:#left.
- group := RadioButtonGroup new.
- b := CheckBox label:'one' in:panel.
- b controller beRadioButton.
- group add:b.
- b := CheckBox label:'two' in:panel.
- b controller beRadioButton.
- group add:b.
- b := CheckBox label:'three' in:panel.
- b controller beRadioButton.
- group add:b.
- top extent:(panel preferredExtent).
- top open.
- [exEnd]
-
-
- a small dialog
- [exBegin]
- |dialog group b|
-
- dialog := Dialog new.
-
- group := RadioButtonGroup new.
- group add:(b := dialog addCheckBox:'one' on:nil).
- b controller beRadioButton.
- group add:(b := dialog addCheckBox:'two' on:nil).
- b controller beRadioButton.
- group add:(b := dialog addCheckBox:'three' on:nil).
- b controller beRadioButton.
- group value:2.
- dialog addAbortButton; addOkButton.
- dialog open.
-
- dialog accepted ifTrue:[
- Transcript showCR:'you selected: ' , group value printString
- ] ifFalse:[
- Transcript showCR:'aborted'
- ]
- [exEnd]
-
- as a selectionIndexHolder of a selectionInList
- (i.e. a selectionInListView and a group displaying the same selection):
- [exBegin]
- |top top2 panel b sv group selectionInList|
-
- top := StandardSystemView extent:200@200.
-
- panel := HorizontalPanelView
- origin:0.0@0.0 corner:1.0@1.0 in:top.
-
- group := RadioButtonGroup new.
- selectionInList := SelectionInList new.
- selectionInList list:#('am' 'fm' 'off').
- selectionInList selectionIndexHolder:group.
-
- b := RadioButton label:'am' in:panel.
- group add:b.
-
- b := RadioButton label:'fm' in:panel.
- group add:b.
-
- b := RadioButton label:'off' in:panel.
- group add:b.
-
- group value:1.
- top open.
-
-
- top2 := StandardSystemView extent:200@200.
- sv := SelectionInListView in:top2.
- sv model:selectionInList.
- sv origin:0.0@0.0 corner:1.0@1.0.
- top2 open.
- [exEnd]
-"
-
- "Created: / 15.11.1995 / 17:14:53 / cg"
- "Modified: / 30.10.1997 / 20:18:25 / cg"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/RButtGrp.st,v 1.30 1999-03-22 21:57:33 cg Exp $'
-! !
-
-!RadioButtonGroup class methodsFor:'helpers'!
-
-adaptorFor:someValueHolder value:buttonValue
- "create and return an adaptor for a radioButton"
-
- |adaptor|
-
- adaptor := PluggableAdaptor on:someValueHolder.
-
- "/ the adapter plays boolean-value holder towards
- "/ the radioButton, returning true iff the groups
- "/ value is the same as the buttons index-value; false otherwise.
- "/ Likewise, a true-store from the button sets the group value
- "/ to the buttons index.
-
- adaptor getBlock:[:m | (m value = buttonValue) ]
- putBlock:[:m :onOff |
- onOff ifTrue:[
- m value:buttonValue
- ] ifFalse:[
- "/ support for toggles
- buttonValue = m value ifTrue:[
- m value:nil
- ]
- ]
- ]
- updateBlock:[:m :a :v | true].
-
- ^ adaptor
-
- "Created: / 30.10.1997 / 19:45:34 / cg"
- "Modified: / 30.10.1997 / 20:14:25 / cg"
-! !
-
-!RadioButtonGroup methodsFor:'adding / removing'!
-
-add:aRadioButton
- "add a radioButton to the group - actually, this name is misleading;
- it simple creates an adaptor, which converts my value into a boolean,
- depending on the buttons index-number
- "
- self add:aRadioButton value:nil
-!
-
-add:aRadioButton value:aValueOrNil
- "add a radioButton to the group - actually, this name is misleading;
- it simply creates an adaptor, which converts my value into a boolean,
- depending on the buttons index-number or aValueOrNil"
-
- |adaptor selectValue|
-
- numberOfValues := (numberOfValues ? 0) + 1.
- selectValue := aValueOrNil ? numberOfValues.
-
- "/ the adapter plays boolean-value holder towards
- "/ the radioButton, returning true iff the groups
- "/ value is the same as the buttons index-value; false otherwise.
- "/ Likewise, a true-store from the button sets the group value
- "/ to the buttons index.
-
- adaptor := self class adaptorFor:self value:selectValue.
- aRadioButton isOn ifTrue:[
- self value:selectValue.
- ].
- aRadioButton model:adaptor.
-
- "Modified: / 30.10.1997 / 20:14:54 / cg"
-! !
-
--- a/ScrView.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,2109 +0,0 @@
-"
- 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.
-"
-
-SimpleView subclass:#ScrollableView
- instanceVariableNames:'scrolledView vScrollBar hScrollBar scrollBarPosition lockUpdates
- hideVScrollBar hideHScrollBar hasHorizontalScrollBar
- hasVerticalScrollBar horizontalMini verticalMini vScrollBarHidden
- hScrollBarHidden'
- classVariableNames:'DefaultScrolledViewLevel DefaultScrolledViewMargin
- DefaultScrollBarSpacing DefaultScrolledViewBorderWidth
- DefaultLevel DefaultScrollBarLevel MyDefaultViewBackgroundColor'
- poolDictionaries:''
- category:'Views-Basic'
-!
-
-!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.
-"
-!
-
-documentation
-"
- a view containing a scrollbar and some other (slave-)view.
- This view wraps scrollbar(s) around the view to be scrolled.
- The scrollbars are setup to send scrollUp/scrollDown/scrollVerticalTo
- and scrollLeft/scrollRight/scrollHorizontalTo- messages whenever moved.
- The view itself has to implement these (there is a default implementation
- in the common View class for this - so your widgets usually dont have to
- care for this).
-
- For the scrollbars to know about the full (maximum) size, the view
- MUST implement #heightOfContents and/or #widthOfContents.
- The values returned by those methods are used to compute the fraction
- which is visible (i.e. the scrollers thumb heights).
-
- There are three ways to setup a scrollableView:
- if the type of the view to be scrolled is known in advance,
- use:
- v := ScrollableView for:<ViewClass>
- or:
- v := ScrollableView for:<ViewClass> in:someSuperView
-
-
- otherwise, create an empty scrollableView with:
-
- v := ScrollableView new
- or:
- v := ScrollableView in:someSuperView
-
- and define the view later with:
-
- v scrolledView:aViewToBeScrolled
-
-
- Finally, if the view to be scrolled has been already created,
- use:
-
- v := ScrollableView forView:aViewToBeScrolled
- or:
- v := ScrollableView forView:aViewToBeScrolled in:someSuperView
-
- It is also possible to change the scrolledView later (even multiple times).
- This may be useful, if different views are needed to display different types
- of data (see example2) and at creation time, it is not known what type
- of view is required (multidocument format applications).
-
- If you want to scroll a bucnh of other views (instead of a views contents),
- you need a companion class (ViewScroller). See the documentation there.
-
- If you need horizontal scrolling too, use an instance of HVScrollableView.
-
- By default, scrollbars are full size scrollbars - for horizontal scrolling
- (which is less often used), scrollableViews can optionally be created with
- miniscrollers which take up less screen space.
-
- TODO:
- this is pretty old and needs a rewrite. There are quite some
- historic leftovers found here and things can be done better
- (especially in initializeFor...)
-
- Also, it should be rewritten into one class which supports both
- Vertical-only, Horizontal-only and HV scrolling.
- Currently, horizontal-only scrolling is not available.
- (you have to write your own class ...)
-
- Finally, some means to hide scrollbars should be added - this would
- give more screenspace to the view when all is visible
- (and therefore, the scrollbars are not needed, anyway)
-
- Expect the above things to be fixed in an upcoming version.
-
- Recent changes:
- Originally, there where two classes, for vertical-only and
- horizontal+vertical scrollability.
- These have now been merged into the common ScrollableView class,
- and each scrollability can be controlled individually.
- The original HVScrollableView class is almost empty, but remains
- for backward compatibility (it simply initializes the scrollability
- flags for H+V scrollability).
-
- [author:]
- Claus Gittinger
-
- [see also:]
- ScrollBar Scroller
- HVScrollableView
-"
-!
-
-examples
-"
- simple scrolled text:
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example1'.
- top extent:200@100.
-
- 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'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
-
-
- changing the scrolledView later:
- [exBegin]
- |top scr txtView1 txtView2 browserView|
-
- top := StandardSystemView label:'scroll example2'.
- top extent:300@100.
-
- scr := ScrollableView in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
-
- top open.
-
- (Delay forSeconds:5) wait.
-
- txtView1 := EditTextView new.
- txtView1 list:#(
- 'wait 5 seconds to see the other text'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- scr scrolledView:txtView1.
-
- (Delay forSeconds:5) wait.
-
- txtView2 := EditTextView new.
- txtView2 list:#('this is the other views text'
- 'alternative line2'
- 'alternative line3'
- 'alternative line4'
- 'alternative line5'
- 'alternative line6').
- scr scrolledView:txtView2.
- [exEnd]
-
-
-
-
- using a miniscroller:
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example3'.
- top extent:200@100.
-
- scr := ScrollableView for:EditTextView miniScroller:true in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
- txt := scr scrolledView.
-
- txt list:#('line1'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
-
-
-
- scrolling in both directions:
- Notice: HVScrollableView remains existent for backward compatibility;
- scrollability can now be controlled in both directions at any
- time (see examples below).
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example4'.
- top extent:200@100.
-
- scr := HVScrollableView 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'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
-
-
-
- using a full scroller vertically, miniscroller horizontally:
- Notice: HVScrollableView remains existent for backward compatibility;
- scrollability can now be controlled in both directions at any
- time (see examples below).
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example5'.
- top extent:200@100.
-
- scr := HVScrollableView for:EditTextView miniScrollerH:true in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
- txt := scr scrolledView.
-
- txt list:#('line1'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
-
-
-
- using miniscrollers for both directions:
- Notice: HVScrollableView remains existent for backward compatibility;
- scrollability can now be controlled in both directions at any
- time (see examples below).
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example6'.
- top extent:200@100.
-
- scr := HVScrollableView for:EditTextView miniScroller:true in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
- txt := scr scrolledView.
-
- txt list:#('line1'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
- controlling scrollability:
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example6'.
- top extent:200@100.
-
- txt := EditTextView new.
-
- scr := ScrollableView forView:txt in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
- scr horizontalScrollable:true.
- scr verticalScrollable:false.
-
- txt list:#('line1'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
- controlling scrollability and miniScroller:
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example6'.
- top extent:200@100.
-
- txt := EditTextView new.
-
- scr := ScrollableView forView:txt in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
- scr horizontalScrollable:true; horizontalMini:false.
- scr verticalScrollable:true; verticalMini:true.
-
- txt list:#('line1'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
- autohiding scrollbars (edit the text to make scrollbars visible/invisible)
- (NOTICE:
- this is controlled by the styleSheet and
- should normally NOT be done by the program):
- [exBegin]
- |top scr txt|
-
- top := StandardSystemView label:'scroll example6'.
- top extent:200@100.
-
- txt := EditTextView new.
-
- scr := ScrollableView forView:txt in:top.
- scr origin:0.0@0.0 corner:1.0@1.0.
- scr horizontalScrollable:true; horizontalMini:false.
- scr verticalScrollable:true; verticalMini:true.
- scr autoHideScrollBars:true.
-
- txt list:#('line1'
- 'line2'
- 'line3'
- 'line4'
- 'line5'
- 'line7'
- 'line8'
- 'line9'
- 'line10'
- ).
- top open
- [exEnd]
-"
-! !
-
-!ScrollableView class methodsFor:'instance creation'!
-
-for:aViewClass
- "return a new scrolling view scrolling an instance of aViewClass.
- The subview is created here.
- The view will have full scrollbars."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:false
- miniScrollerV:false
- origin:nil
- corner:nil
- in:nil
-
- "Created: 6.3.1997 / 18:06:22 / cg"
- "Modified: 6.3.1997 / 23:18:32 / cg"
-!
-
-for:aViewClass hasHorizontalScrollBar:hasH hasVerticalScrollBar:hasV miniScrollerH:miniH miniScrollerV:miniV
- "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 true."
-
- |newView|
-
- aViewClass notNil ifTrue:[
- newView := aViewClass new.
- ].
- ^ self
- forView:newView
- hasHorizontalScrollBar:hasH
- hasVerticalScrollBar:hasV
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:nil
- corner:nil
- in:nil
-
- "Created: 7.4.1997 / 19:00:14 / cg"
-!
-
-for:aViewClass hasHorizontalScrollBar:hasH hasVerticalScrollBar:hasV miniScrollerH:miniH miniScrollerV:miniV origin:org corner:corn 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 true."
-
- |newView|
-
- aViewClass notNil ifTrue:[
- newView := aViewClass new.
- ].
- ^ self
- forView:newView
- hasHorizontalScrollBar:hasH
- hasVerticalScrollBar:hasV
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:org
- corner:corn
- in:aView
-
- "
- |top scr|
-
- top := StandardSystemView extent:200@200.
- scr := ScrollableView for:nil
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:false
- miniScrollerV:false
- origin:0.0@0.0
- corner:1.0@1.0
- in:top.
- top open
- "
-
- "Modified: 6.3.1997 / 18:36:01 / cg"
-!
-
-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
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:false
- miniScrollerV:false
- origin:nil
- corner:nil
- in:aView
-
- "Modified: 6.3.1997 / 23:18:41 / cg"
-!
-
-for:aViewClass miniScroller:mini
- "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
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:mini
- miniScrollerV:mini
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 23:18:45 / cg"
-!
-
-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
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:mini
- miniScrollerV:mini
- origin:nil
- corner:nil
- in:aView
-
- "Modified: 6.3.1997 / 23:18:50 / cg"
-!
-
-for:aViewClass miniScroller:mini origin:org corner:corn 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
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:mini
- miniScrollerV:mini
- origin:org
- corner:corn
- in:aView
-
- "Modified: 6.3.1997 / 23:18:53 / cg"
-!
-
-for:aViewClass miniScrollerH:miniH
- "return a new scrolling view scrolling an instance of aViewClass.
- The subview is created here.
- The view will have full scrollbars if miniH is false,
- and a horizontal miniscroller if true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:false
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 18:30:15 / cg"
-!
-
-for:aViewClass miniScrollerH:miniH 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 true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:false
- origin:nil
- corner:nil
- in:aView
-
- "Modified: 6.3.1997 / 18:30:31 / cg"
-!
-
-for:aViewClass miniScrollerH:miniH miniScrollerV:miniV
- "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 true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 18:30:47 / cg"
-!
-
-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 true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:nil
- corner:nil
- in:aView
-
- "Modified: 6.3.1997 / 18:31:02 / cg"
-!
-
-for:aViewClass miniScrollerH:miniH miniScrollerV:miniV origin:org corner:corn 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 true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:org
- corner:corn
- in:aView
-
- "Modified: 6.3.1997 / 18:31:17 / cg"
-!
-
-for:aViewClass miniScrollerH:miniH origin:org corner:corn in:aView
- "return a new scrolling view scrolling an instance of aViewClass.
- The subview is created here.
- The view will have a full horizontal scrollbar if miniH is false,
- a miniscroller if true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:false
- origin:org
- corner:corn
- in:aView
-
- "Modified: 6.3.1997 / 18:31:28 / cg"
-!
-
-for:aViewClass miniScrollerV:miniV origin:org corner:corn in:aView
- "return a new scrolling view scrolling an instance of aViewClass.
- The subview is created here.
- The view will have a full vertical scrollbar if miniV is false,
- a miniscroller if true."
-
- ^ self
- for:aViewClass
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:false
- miniScrollerV:miniV
- origin:org
- corner:corn
- in:aView
-
- "Modified: 6.3.1997 / 18:31:41 / cg"
-!
-
-for:aViewClass origin:org corner:corner 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
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:false
- miniScrollerV:false
- origin:org
- corner:corner
- in:aView
-
- "Modified: 6.3.1997 / 23:19:05 / cg"
-!
-
-forView:aView
- "return a new scrolling view scrolling aView.
- The view will have full scrollbars."
-
- ^ self
- forView:aView
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:false
- miniScrollerV:false
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 23:19:08 / cg"
-!
-
-forView:aScrolledView hasHorizontalScrollBar:hasH hasVerticalScrollBar:hasV miniScrollerH:miniH miniScrollerV:miniV origin:org corner:corn 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 true."
-
- |newView dev|
-
- aView notNil ifTrue:[
- dev := aView graphicsDevice
- ] ifFalse:[
- dev := Screen current
- ].
- newView := self basicNew device:dev.
- newView initialize.
- newView setupVertical:hasV mini:miniV horizontal:hasH mini:miniH.
-
- aScrolledView notNil ifTrue:[
- newView scrolledView:aScrolledView.
- ].
-
- org notNil ifTrue:[
- newView origin:org
- ].
- corn notNil ifTrue:[
- newView corner:corn
- ].
-
- aView notNil ifTrue:[
- aView addSubView:newView
- ].
- ^ newView
-
- "
- |top scr|
-
- top := StandardSystemView extent:200@200.
- scr := ScrollableView
- forView:(TextView new)
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:false
- miniScrollerV:false
- origin:0.0@0.0
- corner:1.0@1.0
- in:top.
- top open
- "
- "
- |top scr|
-
- top := StandardSystemView extent:200@200.
- scr := ScrollableView
- forView:(TextView new)
- hasHorizontalScrollBar:false
- hasVerticalScrollBar:true
- miniScrollerH:false
- miniScrollerV:false
- origin:0.0@0.0
- corner:1.0@1.0
- in:top.
- top open
- "
-
- "Modified: 6.3.1997 / 18:42:40 / cg"
- "Modified: 19.3.1997 / 15:32:51 / stefan"
-!
-
-forView:aView in:aSuperView
- "return a new scrolling view scrolling aView.
- The view will have full scrollbars."
-
- ^ self
- forView:aView
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:false
- miniScrollerV:false
- origin:nil
- corner:nil
- in:aSuperView
-
- "Modified: 6.3.1997 / 23:19:12 / cg"
-!
-
-forView:aView miniScrollerH:mini
- "return a new scrolling view scrolling aView.
- The view will have a full vertical scrollbar and a horizontal
- miniScroller if mini is true."
-
- ^ self
- forView:aView
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:mini
- miniScrollerV:false
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 18:32:58 / cg"
-!
-
-forView:scrolledView miniScrollerH:miniH miniScrollerV:miniV in:aView
- "return a new scrolling view, scrolling aView.
- The view will have full scrollbars if the corresponding miniH/miniV
- is false, miniscrollers if true."
-
- ^ self
- forView:scrolledView
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:nil
- corner:nil
- in:aView
-
- "Modified: 6.3.1997 / 18:33:20 / cg"
-!
-
-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
- forView:nil
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:false
- miniScrollerV:false
- origin:nil
- corner:nil
- in:aView
-
- "Modified: 6.3.1997 / 23:19:19 / cg"
-!
-
-miniScroller:mini
- "return a new scrolling view. The subview will be created later.
- The view will have full scrollbars if mini is false,
- miniscrollers if true."
-
- ^ self
- forView:nil
- hasHorizontalScrollBar:self defaultHorizontalScrollable
- hasVerticalScrollBar:self defaultVerticalScrollable
- miniScrollerH:mini
- miniScrollerV:mini
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 23:19:21 / cg"
-!
-
-miniScrollerH:miniH
- "return a new scrolling view. The subview will be created later.
- The view will have full scrollbars if miniH is false,
- and a horizontal miniscroller if true."
-
- ^ self
- forView:nil
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:false
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 18:34:06 / cg"
-!
-
-miniScrollerH:miniH miniScrollerV:miniV
- "return a new scrolling view. The subview will be created later.
- The view will have full scrollbars if the corresponding miniH/miniV
- is false, miniscrollers if true."
-
- ^ self
- forView:nil
- hasHorizontalScrollBar:true
- hasVerticalScrollBar:true
- miniScrollerH:miniH
- miniScrollerV:miniV
- origin:nil
- corner:nil
- in:nil
-
- "Modified: 6.3.1997 / 18:34:16 / cg"
-!
-
-new
- "return a new scrolling view.
- There is no slave view now - this has to be set later via
- the scrolledView: method.
- The view will have full scrollbars."
-
- ^ self in:nil
-
- "Modified: / 12.11.1998 / 14:55:54 / cg"
-! !
-
-!ScrollableView class methodsFor:'defaults'!
-
-defaultHorizontalScrollable
- ^ false
-!
-
-defaultScrollBarPosition
- "return the default position of the scrollBar.
- (max be of interest to panels, to make the handlePosition alike)"
-
- <resource: #style (#'scrollBar.position')>
-
- ^ StyleSheet at:#'scrollBar.position' default:#left.
-
- "
- self defaultScrollBarPosition
- "
-
- "Modified: / 31.10.1997 / 12:58:15 / cg"
-!
-
-defaultVerticalScrollable
- ^ true
-!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'scrolledView.level' #'scrolledView.margin'
- #'scrolledView.borderWidth'
- #'scrollBar.spacing' #'scrollBar.level'
- #'scrollableView.level' #'scrollableView.backgroundColor' )>
-
- |defLevel defMargin defSpacing|
-
- StyleSheet is3D ifTrue:[
- defLevel := -1.
- defMargin := ViewSpacing // 2.
- defSpacing := defMargin.
- ] ifFalse:[
- defLevel := 0.
- defMargin := 0.
- defSpacing := 0
- ].
- DefaultScrolledViewLevel := StyleSheet at:#'scrolledView.level' default:defLevel.
- DefaultScrolledViewBorderWidth := StyleSheet at:#'scrolledView.borderWidth' default:nil.
- DefaultScrolledViewMargin := StyleSheet at:#'scrolledView.margin' default:defMargin.
- DefaultScrollBarSpacing := StyleSheet at:#'scrollBar.spacing' default:defSpacing.
- DefaultLevel := StyleSheet at:#'scrollableView.level' default:nil.
- DefaultScrollBarLevel := StyleSheet at:#'scrollBar.level' default:nil.
- MyDefaultViewBackgroundColor := StyleSheet at:#'scrollableView.backgroundColor' default:DefaultViewBackgroundColor.
-
- "
- self updateStyleCache
- "
-
- "Modified: / 31.10.1997 / 20:57:10 / cg"
-! !
-
-!ScrollableView methodsFor:'accessing-behavior'!
-
-autoHideHorizontalScrollBar:aBoolean
- "set/clear the flag which controls if the horizontal scrollBar should
- be made invisible dynamically, if there is nothing to scroll
- (and shown if there is).
- This flags setting is normally controlled by the styleSheet."
-
- hideHScrollBar := aBoolean.
-
- "Modified: 19.3.1997 / 16:28:42 / cg"
- "Created: 19.3.1997 / 17:24:39 / cg"
-!
-
-autoHideScrollBars:aBoolean
- "set/clear the flag which controls if scrollBars should
- be made invisible dynamically, if there is nothing to scroll
- (and shown if there is).
- This flags setting is normally controlled by the styleSheet."
-
- hideVScrollBar := hideHScrollBar := aBoolean.
-
- "Modified: 19.3.1997 / 16:28:42 / cg"
- "Created: 19.3.1997 / 17:24:39 / cg"
-!
-
-autoHideVerticalScrollBar:aBoolean
- "set/clear the flag which controls if the vertical scrollBar should
- be made invisible dynamically, if there is nothing to scroll
- (and shown if there is).
- This flags setting is normally controlled by the styleSheet."
-
- hideVScrollBar := aBoolean.
-
- "Modified: 19.3.1997 / 16:28:42 / cg"
- "Created: 19.3.1997 / 17:24:39 / cg"
-! !
-
-!ScrollableView methodsFor:'accessing-components'!
-
-horizontalScrollBar
- "return the horizontal scrollbar (or nil, if there is none)"
-
-"/ hScrollBar isNil ifTrue:[
-"/ self horizontalScrollable:true.
-"/ ].
- ^ hScrollBar
-
- "Created: / 6.3.1997 / 18:06:23 / cg"
- "Modified: / 25.5.1998 / 12:53:58 / cg"
-!
-
-removeSubView:aView
- super removeSubView:aView.
- aView == scrolledView ifTrue:[
- scrolledView := nil
- ].
- aView == vScrollBar ifTrue:[
- vScrollBar := nil
- ].
- aView == hScrollBar ifTrue:[
- hScrollBar := nil
- ].
-
-
-
-
-!
-
-scrollBar
- "return the vertical scrollbar (or nil, if there is none)"
-
-"/ vScrollBar isNil ifTrue:[
-"/ self verticalScrollable:true.
-"/ ].
- ^ vScrollBar
-
- "Created: / 6.3.1997 / 18:06:23 / cg"
- "Modified: / 25.5.1998 / 12:54:06 / cg"
-!
-
-scrolledView
- "return the scrolled view (or nil, if there is none)"
-
- ^ scrolledView
-
- "Modified: 6.3.1997 / 16:48:09 / cg"
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-scrolledView:aView
- "set the view to scroll"
-
- scrolledView notNil ifTrue:[
- scrolledView removeDependent:self.
- scrolledView destroy.
- scrolledView := nil.
- ].
-
- scrolledView := aView.
-
- super addSubViewFirst:aView.
- scrolledView notNil ifTrue:[
- self setScrollActions.
-
- realized ifTrue:[
- self setupDimensionsConfigureScrolledView:true.
- self sizeChanged:nil.
- scrolledView realize
- ].
- ]
-
- "Modified: / 19.3.1997 / 15:32:37 / stefan"
- "Modified: / 21.5.1998 / 00:48:57 / cg"
-!
-
-verticalScrollBar
- "return the vertical scrollbar (or nil, if there is none)"
-
-"/ vScrollBar isNil ifTrue:[
-"/ self verticalScrollable:true.
-"/ ].
- ^ vScrollBar
-
- "Modified: 6.3.1997 / 16:59:24 / cg"
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-widget
- "for ST80 compatibility (where a wrapper returns its wrapped
- widget), return the scrolledView here"
-
- ^ scrolledView
-
- "Created: 20.6.1997 / 14:45:16 / cg"
-! !
-
-!ScrollableView methodsFor:'accessing-look'!
-
-horizontalMini:aBoolean
- "control the horizontal scrollBar to be either a miniScroller,
- or a full scrollBar."
-
- horizontalMini ~~ aBoolean ifTrue:[
- horizontalMini := aBoolean.
- (styleSheet at:#'scrollBar.neverMini' default:false) == true ifTrue:[
- horizontalMini := false.
- ].
- self setupViews.
- shown ifTrue:[
- self setupDimensionsConfigureScrolledView:false.
- ]
- ].
-
- "Created: / 7.3.1997 / 21:57:02 / cg"
- "Modified: / 22.4.1998 / 22:42:25 / ca"
- "Modified: / 21.5.1998 / 00:48:25 / cg"
-!
-
-horizontalScrollable:aBoolean
- "enable/disable horizontal scrollability.
- If disabled, the horizontal scrollBar is made invisible."
-
- hasHorizontalScrollBar ~~ aBoolean ifTrue:[
- hasHorizontalScrollBar := aBoolean.
- hScrollBarHidden := false.
- self setupViews.
- shown ifTrue:[
- self setupDimensionsConfigureScrolledView:false.
- ]
- ].
-
- "Created: / 7.3.1997 / 21:56:28 / cg"
- "Modified: / 21.5.1998 / 00:48:44 / cg"
-!
-
-verticalMini:aBoolean
- "control the vertical scrollBar to be either a miniScroller,
- or a full scrollBar."
-
- verticalMini ~~ aBoolean ifTrue:[
- verticalMini := aBoolean.
- (styleSheet at:#'scrollBar.neverMini' default:false) == true ifTrue:[
- verticalMini := false.
- ].
- self setupViews.
- shown ifTrue:[
- self setupDimensionsConfigureScrolledView:false.
- ]
- ]
-
- "Created: / 7.3.1997 / 21:56:57 / cg"
- "Modified: / 22.4.1998 / 22:42:32 / ca"
- "Modified: / 21.5.1998 / 00:49:10 / cg"
-!
-
-verticalScrollable:aBoolean
- "enable/disable vertical scrollability.
- If disabled, the vertical scrollBar is made invisible."
-
- hasVerticalScrollBar ~~ aBoolean ifTrue:[
- hasVerticalScrollBar := aBoolean.
- vScrollBarHidden := false.
- self setupViews.
- shown ifTrue:[
- self setupDimensionsConfigureScrolledView:false.
- ]
- ]
-
- "Created: / 7.3.1997 / 21:56:39 / cg"
- "Modified: / 21.5.1998 / 00:49:16 / cg"
-! !
-
-!ScrollableView methodsFor:'changes '!
-
-update:something with:argument from:changedObject
- "whenever the scrolledView changes its contents, the scroller(s) must
- be updated as well"
-
- |doUpdate|
-
- doUpdate := false.
- changedObject == scrolledView ifTrue:[
- something == #sizeOfContents ifTrue:[
- vScrollBar notNil ifTrue:[
- vScrollBar setThumbFor:scrolledView.
- doUpdate := true
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar setThumbFor:scrolledView.
- doUpdate := true
- ].
- ] ifFalse:[
- something == #originOfContents ifTrue:[
- lockUpdates ifFalse:[
- vScrollBar notNil ifTrue:[
- vScrollBar setThumbOriginFor:scrolledView.
- doUpdate := true
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar setThumbOriginFor:scrolledView.
- doUpdate := true
- ].
- ].
- ].
- ].
-
- doUpdate ifTrue:[
- self updateScrollBarVisibility
- ]
- ].
-
-!
-
-updateScrollBarVisibility
- "check if any scrollbar needs to be hidden or shown"
-
- |anyChange hide|
-
- anyChange := false.
-
- hideVScrollBar ~~ false ifTrue:[
- vScrollBar notNil ifTrue:[
- hide := vScrollBar thumbHeight >= 100.
- hide ~~ vScrollBarHidden ifTrue:[
- vScrollBarHidden := hide.
- hide ifTrue:[vScrollBar beInvisible] ifFalse:[vScrollBar beVisible].
- anyChange := true.
- ]
- ].
- ].
-
- hideHScrollBar ~~ false ifTrue:[
- hScrollBar notNil ifTrue:[
- hide := hScrollBar thumbHeight >= 100.
- hide ~~ hScrollBarHidden ifTrue:[
- hScrollBarHidden := hide.
- hide ifTrue:[hScrollBar beInvisible] ifFalse:[hScrollBar beVisible].
- anyChange := true.
- ]
- ].
- ].
-
- anyChange ifTrue:[
- self setupDimensionsConfigureScrolledView:false.
-
- "/ force him to recompute its dimension ...
- scrolledView notNil ifTrue:[
- vScrollBar notNil ifTrue:[
- vScrollBar setThumbFor:scrolledView.
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar setThumbFor:scrolledView.
- ].
- ].
-
- "/ stupid - showing one may need the other ...
- "/ and vice versa; do it again.
-
- anyChange := false.
-
- hideVScrollBar ~~ false ifTrue:[
- vScrollBar notNil ifTrue:[
- hide := vScrollBar thumbHeight >= 100.
- hide ~~ vScrollBarHidden ifTrue:[
- vScrollBarHidden := hide.
- hide ifTrue:[vScrollBar beInvisible] ifFalse:[vScrollBar beVisible].
- anyChange := true.
- ]
- ].
- ].
-
- hideHScrollBar ~~ false ifTrue:[
- hScrollBar notNil ifTrue:[
- hide := hScrollBar thumbHeight >= 100.
- hide ~~ hScrollBarHidden ifTrue:[
- hScrollBarHidden := hide.
- hide ifTrue:[hScrollBar beInvisible] ifFalse:[hScrollBar beVisible].
- anyChange := true.
- ]
- ].
- ].
-
- anyChange ifTrue:[
- self setupDimensionsConfigureScrolledView:false.
- ].
- ].
-
- "Modified: / 19.3.1997 / 15:33:36 / stefan"
- "Modified: / 21.5.1998 / 00:49:05 / cg"
-! !
-
-!ScrollableView methodsFor:'event processing'!
-
-keyPress:key x:x y:y
- "a key was pressed - handle page-keys here"
-
- <resource: #keyboard ( #Prior #Next ) >
-
- (key == #Prior) ifTrue: [^ self pageUp].
- (key == #Next) ifTrue: [^ self pageDown].
-
- super keyPress:key x:x y:y
-
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-sizeChanged:how
- "handle size changes - this may change any scrollBars visibility"
-
- |orgX orgY thV thH scrollH scrollV|
-
- "/ resize components manually, in an order which is optimal
-
- how == #smaller ifTrue:[
- "/ first resize the horizontalScrollBar,
-
- scrolledView notNil ifTrue:[
- scrolledView containerChangedSize
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar containerChangedSize
- ].
- vScrollBar notNil ifTrue:[
- vScrollBar containerChangedSize
- ].
- ] ifFalse:[
- hScrollBar notNil ifTrue:[
- hScrollBar containerChangedSize
- ].
- vScrollBar notNil ifTrue:[
- vScrollBar containerChangedSize
- ].
- scrolledView notNil ifTrue:[
- scrolledView containerChangedSize
- ].
- ].
-
- scrolledView isNil ifTrue:[^ self].
- (hScrollBar isNil and:[vScrollBar isNil]) ifTrue:[
- ^ self
- ].
-
- vScrollBar notNil ifTrue:[
- vScrollBar setThumbFor:scrolledView.
- orgY := vScrollBar thumbOrigin.
- thV := vScrollBar thumbHeight.
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar setThumbFor:scrolledView.
- orgX := hScrollBar thumbOrigin.
- thH := hScrollBar thumbHeight.
- ].
-
- "/ splitted, since there are optimized scrollProcedures for each case ...
-
- hScrollBar isNil ifTrue:[
- "/ only care for vertical ...
- orgY + thV >= 100 ifTrue:[
- vScrollBar thumbOrigin:(100 - thV).
- scrolledView scrollVerticalToPercent:vScrollBar thumbOrigin.
- ].
- ] ifFalse:[
- vScrollBar isNil ifTrue:[
- "/ only care for horizontal ...
- orgX + thH >= 100 ifTrue:[
- hScrollBar thumbOrigin:(100 - thH).
- scrolledView scrollHorizontalToPercent:hScrollBar thumbOrigin.
- ].
- ] ifFalse:[
- "/ care for both ...
-
- scrollH := scrollV := false.
-
- orgY + thV >= 100 ifTrue:[
- vScrollBar thumbOrigin:(100 - thV).
- orgY := vScrollBar thumbOrigin.
- scrollV := true.
- ].
- orgX + thH >= 100 ifTrue:[
- hScrollBar thumbOrigin:(100 - thH).
- orgX := hScrollBar thumbOrigin.
- scrollH := true.
- ].
- scrollV ifTrue:[
- scrollH ifTrue:[
- scrolledView scrollToPercent:(orgX@orgY).
- ] ifFalse:[
- scrolledView scrollVerticalToPercent:orgY.
- ]
- ] ifFalse:[
- scrollH ifTrue:[
- scrolledView scrollHorizontalToPercent:orgX.
- ]
- ]
- ]
- ].
- self updateScrollBarVisibility.
-
- "Modified: 28.3.1997 / 17:25:38 / cg"
-! !
-
-!ScrollableView methodsFor:'forced scroll'!
-
-pageDown
- "page down - but only if there is a vertical scrollbar"
-
- vScrollBar notNil ifTrue:[
- vScrollBar pageDown
- ]
-
- "Created: 6.3.1997 / 18:06:23 / cg"
- "Modified: 19.3.1997 / 16:32:34 / cg"
-!
-
-pageLeft
- "page left - but only if there is a horizontal scrollbar"
-
- hScrollBar notNil ifTrue:[
- hScrollBar pageDown
- ]
-
- "Created: 19.3.1997 / 16:32:14 / cg"
- "Modified: 19.3.1997 / 16:32:44 / cg"
-!
-
-pageRight
- "page right - but only if there is a horizontal scrollbar"
-
- hScrollBar notNil ifTrue:[
- hScrollBar pageUp
- ]
-
- "Created: 19.3.1997 / 16:32:22 / cg"
- "Modified: 19.3.1997 / 16:32:48 / cg"
-!
-
-pageUp
- "page up - but only if there is a vertical scrollbar"
-
- vScrollBar notNil ifTrue:[
- vScrollBar pageUp
- ]
-
- "Created: 6.3.1997 / 18:06:23 / cg"
- "Modified: 19.3.1997 / 16:32:38 / cg"
-! !
-
-!ScrollableView methodsFor:'initialization'!
-
-initStyle
- "initialize style specifics"
-
- <resource: #style (#'scrollBar.position' #'scrollBar.hiding')>
-
- super initStyle.
-
- viewBackground := MyDefaultViewBackgroundColor.
- scrollBarPosition := styleSheet at:#'scrollBar.position' default:#left.
- hideHScrollBar := hideVScrollBar := styleSheet at:#'scrollBar.hiding' default:false.
- DefaultLevel notNil ifTrue:[self level:DefaultLevel].
-
- "Created: / 6.3.1997 / 18:06:23 / cg"
- "Modified: / 21.5.1998 / 00:52:26 / cg"
-!
-
-initialize
- "setup some default"
-
- verticalMini := horizontalMini := false.
- hasVerticalScrollBar := hasHorizontalScrollBar := false.
- vScrollBarHidden := hScrollBarHidden := true.
- super initialize.
-!
-
-realize
- "realize (i.e. make me visible).
- Since scrolledView may have done something to its contents
- during init-time we had no chance yet to catch contents-
- changes; do it now"
-
- self setupDimensionsConfigureScrolledView:true.
- super realize.
-
- scrolledView notNil ifTrue:[
- vScrollBar notNil ifTrue:[
- vScrollBar setThumbFor:scrolledView
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar setThumbFor:scrolledView
- ].
- self updateScrollBarVisibility.
- ].
-
- "Modified: / 21.5.1998 / 00:52:18 / cg"
-!
-
-releaseHorizontalScrollBar
- "destroy any horizontal scrollBar"
-
- hScrollBar notNil ifTrue:[
- hScrollBar destroy.
- hScrollBar := nil
- ].
-
- "Modified: 6.3.1997 / 17:43:20 / cg"
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-releaseVerticalScrollBar
- "destroy any vertical scrollBar"
-
- vScrollBar notNil ifTrue:[
- vScrollBar destroy.
- vScrollBar := nil
- ].
-
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-setScrollActions
- "lock prevents repositioning the scroller to the
- actual (often rounded) position while scrolling,
- and keeps it instead at the pointer position.
-
- (this avoids run-away scroller when scrolling
- textviews, when the text is aligned line-wise).
- Consider this as a kludge."
-
- lockUpdates := false.
-
- vScrollBar notNil ifTrue:[
- vScrollBar scrollAction:[:position |
- lockUpdates := true.
- scrolledView scrollVerticalToPercent:position.
- lockUpdates := false
- ].
- vScrollBar
- scrollUpAction:[|sensor|
- ((sensor := self sensor) notNil
- and:[sensor shiftDown or:[sensor ctrlDown]]) ifTrue:[
- scrolledView scrollToTop
- ] ifFalse:[
- scrolledView scrollUp
- ]
- ].
- vScrollBar
- scrollDownAction:[|sensor|
- ((sensor := self sensor) notNil
- and:[sensor shiftDown or:[sensor ctrlDown]]) ifTrue:[
- scrolledView scrollToBottom
- ] ifFalse:[
- scrolledView scrollDown
- ]
- ].
- ].
- hScrollBar notNil ifTrue:[
- hScrollBar scrollAction:[:position |
- lockUpdates := true.
- scrolledView scrollHorizontalToPercent:position.
- lockUpdates := false
- ].
- hScrollBar
- scrollUpAction:[|sensor|
- ((sensor := self sensor) notNil
- and:[sensor shiftDown or:[sensor ctrlDown]]) ifTrue:[
- scrolledView scrollToLeft
- ] ifFalse:[
- scrolledView scrollLeft
- ]
- ].
- hScrollBar
- scrollDownAction:[|sensor|
- ((sensor := self sensor) notNil
- and:[sensor shiftDown or:[sensor ctrlDown]]) ifTrue:[
- scrolledView scrollToRight
- ] ifFalse:[
- scrolledView scrollRight
- ]
- ].
- ].
-
- scrolledView addDependent:self.
-
- "
- pass my keyboard input (and other subviews input)
- to the scrolled view ...
- "
- self delegate:(KeyboardForwarder toView:scrolledView).
-
- "Modified: 6.3.1997 / 17:03:43 / cg"
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-setupDimensionsConfigureScrolledView:configureScrolledView
- "set the components dimensions (i.e. layouts) according to
- the scrollability and hidden settings.
- This may heavily move around the parts ..."
-
- |scrolledViewMargin scrollBarSpacing hasV hasH
- scrolledViewLayout hScrollBarLayout vScrollBarLayout
- vBd "{ Class: SmallInteger }"
- hBd "{ Class: SmallInteger }"
- sBd "{ Class: SmallInteger }"
- wVScroll "{ Class: SmallInteger }"
- hHScroll "{ Class: SmallInteger }"
- hLeftOffs "{ Class: SmallInteger }"
- hRightOffs "{ Class: SmallInteger }"
- hTopOffs "{ Class: SmallInteger }"
- hBottomOffs "{ Class: SmallInteger }"
- sLeftOffs "{ Class: SmallInteger }"
- sRightOffs "{ Class: SmallInteger }"
- sTopOffs "{ Class: SmallInteger }"
- sBottomOffs "{ Class: SmallInteger }"
- vLeftOffs "{ Class: SmallInteger }"
- vRightOffs "{ Class: SmallInteger }"
- vTopOffs "{ Class: SmallInteger }"
- vBottomOffs "{ Class: SmallInteger }"
- addMargin "{ Class: SmallInteger }"|
-
- sBd := 0.
- DefaultScrolledViewBorderWidth notNil ifTrue:[
- sBd := DefaultScrolledViewBorderWidth.
- scrolledView notNil ifTrue:[
- scrolledView borderWidth:DefaultScrolledViewBorderWidth.
- ]
- ] ifFalse:[
- scrolledView notNil ifTrue:[
- sBd := scrolledView borderWidth
- ]
- ].
-
- (hasV := (vScrollBar notNil and:[vScrollBarHidden not])) ifTrue:[
- vBd := vScrollBar borderWidth.
- wVScroll := vScrollBar widthIncludingBorder.
- ] ifFalse:[
- vBd := wVScroll := 0.
- ].
-
- (hasH := (hScrollBar notNil and:[hScrollBarHidden not])) ifTrue:[
- hBd := hScrollBar borderWidth.
- hHScroll := hScrollBar heightIncludingBorder.
- ] ifFalse:[
- hBd := hHScroll := 0.
- ].
-
- "/ the raw layout ...
-
- scrolledViewLayout := ((0.0 @ 0.0) corner:(1.0@1.0)) asLayout.
- hScrollBarLayout := ((0.0 @ 1.0) corner:(1.0@1.0)) asLayout.
-
- "/ the painful details; mostly complicated for 2D styles,
- "/ where the positions are setUp to overlay borders ...
- "/ (well, with 3D styles, a single pixel error will not be noticed;
- "/ but 2D styles are very sensitive to those;
- "/ the code below may not work correctly with different borderWidths).
-
- scrolledViewMargin := DefaultScrolledViewMargin.
- scrollBarSpacing := DefaultScrollBarSpacing.
-
- vTopOffs := 0 - vBd + scrolledViewMargin + margin.
-
- scrolledViewMargin == 0 ifTrue:[
- vBottomOffs := vBd - scrolledViewMargin - sBd.
- ] ifFalse:[
- vBottomOffs := vBd - scrolledViewMargin + sBd.
- ].
-
- hLeftOffs := 0 - hBd + scrolledViewMargin + margin.
- hRightOffs := hBd - scrolledViewMargin - sBd.
-
- sLeftOffs := 0 - hBd + scrolledViewMargin + margin.
- sRightOffs := hBd - scrolledViewMargin - sBd - sBd - sBd.
-
- scrolledViewMargin == 0 ifTrue:[
- sTopOffs := 0 - sBd + margin.
- sBottomOffs := sBd - sBd.
- ] ifFalse:[
- sTopOffs := 0 + scrolledViewMargin + margin.
- sBottomOffs := sBd - scrolledViewMargin - sBd - sBd - sBd.
- ].
-
-"/ kludge - for now
-styleSheet name == #win95 ifTrue:[
- vTopOffs := 0.
- hLeftOffs := 0.
- sLeftOffs := 0.
- sTopOffs := 0.
-].
-
- addMargin := 0.
-"/ DefaultScrollBarLevel == DefaultScrolledViewLevel
-"/ addMargin := 1.
-"/ ].
-
- hasV ifTrue:[
- scrollBarPosition == #right ifTrue:[
- "/ right/bottom
- vScrollBarLayout := ((1.0 @ 0.0) corner:(1.0@1.0)) asLayout.
-
- vRightOffs := 0 - scrolledViewMargin + margin "???".
- vLeftOffs := vRightOffs - wVScroll.
-
- sRightOffs := sRightOffs - scrollBarSpacing - wVScroll + sBd.
-
- hRightOffs := hRightOffs - wVScroll - scrollBarSpacing - sBd.
-
- sRightOffs := sRightOffs - addMargin
- ] ifFalse:[
- "/ left/bottom
- vScrollBarLayout := ((0.0 @ 0.0) corner:(0.0@1.0)) asLayout.
-
- vLeftOffs := 0 - vBd + scrolledViewMargin + margin.
- vRightOffs := vLeftOffs + wVScroll + margin.
-
- sLeftOffs := wVScroll + scrolledViewMargin + scrollBarSpacing + margin.
- sRightOffs := 0 - scrolledViewMargin - margin.
- hLeftOffs := hLeftOffs + wVScroll + vBd + scrollBarSpacing.
-
- sLeftOffs := sLeftOffs + addMargin
- ].
- ].
-
- hasH ifTrue:[
- hBottomOffs := 0 - scrolledViewMargin - hBd + margin "???".
- hTopOffs := hBottomOffs - hHScroll.
- scrolledViewMargin == 0 ifTrue:[
- hTopOffs := hTopOffs + sBd + sBd
- ].
- sBottomOffs := sBottomOffs - scrollBarSpacing - hHScroll.
- (vScrollBar notNil and:[vScrollBarHidden not]) ifTrue:[
- vBottomOffs := vBottomOffs - scrollBarSpacing - hHScroll.
- ].
-
- sBottomOffs := sBottomOffs - addMargin.
- hRightOffs := hRightOffs - addMargin.
- ].
-
- (hScrollBar notNil
- and:[ hScrollBar borderWidth == 0
- and:[sBd ~~ 0
- and:[scrollBarPosition == #right]]]) ifTrue:[
- hRightOffs := hRightOffs + sBd + sBd.
- ].
-
- scrolledView notNil ifTrue:[
- scrolledViewLayout leftOffset:sLeftOffs.
- scrolledViewLayout rightOffset:sRightOffs.
- scrolledViewLayout topOffset:sTopOffs.
- scrolledViewLayout bottomOffset:sBottomOffs.
-
- configureScrolledView ifTrue:[
- ((hideVScrollBar or:[hideHScrollBar]) not
- and:[(hScrollBar isNil or:[hScrollBarHidden])
- and:[(vScrollBar isNil or:[vScrollBarHidden])]]) ifTrue:[
- scrolledView level:0
- ] ifFalse:[
- scrolledView level:DefaultScrolledViewLevel.
- ].
- ].
- scrolledView layout:scrolledViewLayout.
- ].
- hasH ifTrue:[
- hScrollBarLayout leftOffset:hLeftOffs.
- hScrollBarLayout rightOffset:hRightOffs.
- hScrollBarLayout topOffset:hTopOffs.
- hScrollBarLayout bottomOffset:hBottomOffs.
-
- hScrollBar level:DefaultScrollBarLevel.
- hScrollBar layout:hScrollBarLayout.
-
-"/ scrollBarPosition == #right ifTrue:[
-"/ "/ right/bottom
-"/ hScrollBar viewGravity:#SouthWest.
-"/ ] ifFalse:[
-"/ hScrollBar viewGravity:#NorthWest.
-"/ ]
- ].
- (vScrollBar notNil and:[vScrollBarHidden not]) ifTrue:[
- vScrollBarLayout leftOffset:vLeftOffs.
- vScrollBarLayout rightOffset:vRightOffs.
- vScrollBarLayout topOffset:vTopOffs.
- vScrollBarLayout bottomOffset:vBottomOffs.
-
- vScrollBar level:DefaultScrollBarLevel.
- vScrollBar layout:vScrollBarLayout.
-
-"/ scrollBarPosition == #right ifTrue:[
-"/ "/ right/bottom
-"/ vScrollBar viewGravity:#NorthEast.
-"/ ] ifFalse:[
-"/ vScrollBar viewGravity:#NorthWest.
-"/ ]
- ].
-
- "Created: / 21.5.1998 / 00:48:35 / cg"
- "Modified: / 9.9.1998 / 18:57:35 / cg"
-!
-
-setupVertical:isVertical mini:miniV horizontal:isHorizontal mini:miniH
- "setup scrollbars as specified in the arguments"
-
- |noMiniScrollers|
-
- vScrollBarHidden := hScrollBarHidden := false.
-
- hasVerticalScrollBar := isVertical.
- hasHorizontalScrollBar := isHorizontal.
-
- noMiniScrollers := styleSheet at:#'scrollBar.neverMini' default:false.
- verticalMini := miniV.
- horizontalMini := miniH.
-
- noMiniScrollers == true ifTrue:[
- verticalMini := false.
- horizontalMini := false.
- ].
-
- self setupViews.
-
- "Modified: 7.3.1997 / 22:09:12 / cg"
-!
-
-setupViews
- "setup scrollbars as specified in the arguments"
-
- |cls|
-
- hasVerticalScrollBar ifTrue:[
- cls := ScrollBar.
- verticalMini ifTrue:[
- cls := MiniScroller
- ].
- (vScrollBar notNil
- and:[vScrollBar class ~~ cls]) ifTrue:[
- self releaseVerticalScrollBar
- ].
- vScrollBar isNil ifTrue:[
- vScrollBar := cls in:self.
- realized ifTrue:[
- vScrollBar realize "/ beVisible
- ]
- ].
- vScrollBar thumbOrigin:0 thumbHeight:100.
- ] ifFalse:[
- vScrollBar notNil ifTrue:[
- self releaseVerticalScrollBar
- ]
- ].
-
- hasHorizontalScrollBar ifTrue:[
- cls := HorizontalScrollBar.
- horizontalMini ifTrue:[
- cls := HorizontalMiniScroller
- ].
- (hScrollBar notNil
- and:[hScrollBar class ~~ cls]) ifTrue:[
- self releaseHorizontalScrollBar
- ].
- hScrollBar isNil ifTrue:[
- hScrollBar := cls in:self.
- realized ifTrue:[
- hScrollBar realize "/ beVisible
- ]
- ].
- hScrollBar thumbOrigin:0 thumbHeight:100.
- ] ifFalse:[
- hScrollBar notNil ifTrue:[
- self releaseHorizontalScrollBar
- ]
- ].
-
- scrolledView notNil ifTrue:[
- self setScrollActions.
- ]
-
- "Created: 6.3.1997 / 18:06:23 / cg"
- "Modified: 8.4.1997 / 00:44:33 / cg"
-! !
-
-!ScrollableView methodsFor:'queries'!
-
-isHorizontalScrollable
- "return true if I am horizontally scrollable"
-
- ^ hScrollBar notNil
-
- "Modified: 6.3.1997 / 17:03:49 / cg"
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-isScrollWrapper
- ^ true
-
- "Created: / 20.6.1998 / 14:15:42 / cg"
-!
-
-isVerticalScrollable
- "return true if I am vertically scrollable"
-
- ^ vScrollBar notNil
-
- "Modified: 6.3.1997 / 17:03:52 / cg"
- "Created: 6.3.1997 / 18:06:23 / cg"
-!
-
-preferredExtent
- "return my preferredExtent from the scrolledViews prefExtent
- plus the size of the scrollBar"
-
- |slavesPref prefX prefY margin|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- scrolledView notNil ifTrue:[
- slavesPref := scrolledView preferredExtent.
- prefX := slavesPref x.
- prefY := slavesPref y.
- margin := (DefaultScrolledViewMargin * 2) + DefaultScrollBarSpacing.
- vScrollBar notNil ifTrue:[
- prefX := prefX + vScrollBar width + margin.
- ].
- hScrollBar notNil ifTrue:[
- prefY := prefY + hScrollBar height + margin.
- ].
-
- ^ prefX @ prefY.
- ].
-
- ^ super preferredExtent.
-
- "Created: 6.3.1997 / 18:06:24 / cg"
- "Modified: 6.3.1997 / 22:34:09 / cg"
-!
-
-preferredExtentForLines:numLines cols:numCols
- "return my preferredExtent from the scrolledViews prefExtent
- plus the size of the scrollBar"
-
- |slavesPref prefX prefY|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- scrolledView notNil ifTrue:[
- slavesPref := scrolledView preferredExtentForLines:numLines cols:numCols.
- prefX := slavesPref x.
- prefY := slavesPref y.
- vScrollBar notNil ifTrue:[
- prefX := prefX + vScrollBar width + (DefaultScrolledViewMargin * 2) + DefaultScrollBarSpacing.
- ].
- hScrollBar notNil ifTrue:[
- prefY := prefY + hScrollBar height + (DefaultScrolledViewMargin * 2) + DefaultScrollBarSpacing.
- ].
-
- ^ prefX @ prefY.
- ].
-
- ^ super preferredExtent.
-
- "Created: 6.3.1997 / 18:06:24 / cg"
- "Modified: 6.3.1997 / 22:34:30 / cg"
-!
-
-specClass
- "redefined, since my subclasses also want ScrollableViewSpecs"
-
- ^ ScrollableViewSpec
-
- "Modified: / 31.10.1997 / 19:48:48 / cg"
-! !
-
-!ScrollableView methodsFor:'slave-view messages'!
-
-clear
- "convenient method: forward this to the scrolledView"
-
- scrolledView notNil ifTrue:[scrolledView clear]
-
- "Created: 6.3.1997 / 18:06:24 / cg"
- "Modified: 19.3.1997 / 16:34:19 / cg"
-!
-
-doesNotUnderstand:aMessage
- "this is funny: all message we do not understand, are passed
- on to the scrolledView - so we do not have to care for all
- possible messages ...(thanks to the Message class)"
-
- scrolledView isNil ifFalse:[
- ^ scrolledView perform:(aMessage selector)
- withArguments:(aMessage arguments)
- ].
- ^ super doesNotUnderstand:aMessage
-
- "Created: 6.3.1997 / 18:06:24 / cg"
- "Modified: 6.3.1997 / 18:38:54 / cg"
-!
-
-leftButtonMenu
- "return scrolledViews leftbuttonmenu"
-
- scrolledView isNil ifTrue:[^ nil].
- ^ scrolledView leftButtonMenu
-
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-leftButtonMenu:aMenu
- "pass on leftbuttonmenu to scrolledView"
-
- scrolledView leftButtonMenu:aMenu
-
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-middleButtonMenu
- "return scrolledViews middlebuttonmenu"
-
- scrolledView isNil ifTrue:[^ nil].
- ^ scrolledView middleButtonMenu
-
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-middleButtonMenu:aMenu
- "pass on middlebuttonmenu to scrolledView"
-
- scrolledView middleButtonMenu:aMenu
-
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-model
- "return my scrolledViews model"
-
- scrolledView isNil ifTrue:[^ nil].
- ^ scrolledView model
-
- "Modified: 1.3.1997 / 01:38:07 / cg"
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-model:aModel
- "forward model change to my scrolledViews"
-
- ^ scrolledView model:aModel
-
- "Modified: 5.6.1996 / 17:09:50 / cg"
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-requestFocus
- ^ scrolledView requestFocus
-!
-
-rightButtonMenu
- "return scrolledViews rightbuttonmenu"
-
- scrolledView isNil ifTrue:[^ nil].
- ^ scrolledView rightButtonMenu
-
- "Created: 6.3.1997 / 18:06:24 / cg"
-!
-
-rightButtonMenu:aMenu
- "pass on rightbuttonmenu to scrolledView"
-
- scrolledView rightButtonMenu:aMenu
-
- "Created: 6.3.1997 / 18:06:24 / cg"
-! !
-
-!ScrollableView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ScrView.st,v 1.100 1999-08-17 10:59:01 cg Exp $'
-! !
--- a/SelList.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,429 +0,0 @@
-"
- 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.
-"
-
-ValueHolder subclass:#SelectionInList
- instanceVariableNames:'listHolder selectionIndexHolder'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Models'
-!
-
-!SelectionInList 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.
-"
-!
-
-documentation
-"
- Instances of SelectionInList can be used as model for
- a SelectionInListView or a PopUpList.
- They keep two values: a list value and a selection value;
- both are referred to via valueHolders.
-
- If any of those two changes, the selectionInList notifies its
- dependents via a change notification,
- using #list or #selectionIndex as update aspect respectively.
-
- A popupList also knows how to deal with a selectionInList model;
- this makes it possible to have popupLists be somewhat exchangable
- with selectionInListViews.
-
- SelectionInLists only support a single selection within the list;
- use MultiSelectionInList, if multiple selections are needed.
-
- [instance variables:]
- listHolder <ValueHolder> holds the list
- selectionIndexHolder <ValueHolder> holdes the selectionIndex
-
-
- [see also:]
- SelectionInListView PopUpList
- MultiSelectionInList Model ValueHolder
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- basic setup using a selectionInList as model of a selectionInListView:
- [exBegin]
- |m v|
-
- m := SelectionInList new.
- m list:#('one' 'two' 'three' 'four').
- m selectionIndex:2.
-
- v := SelectionInListView on:m.
- v open
- [exEnd]
-
-
- similar, a selectionInList as model of a popUpList:
- [exBegin]
- |m v|
-
- m := SelectionInList new.
- m list:#('one' 'two' 'three' 'four').
- m selectionIndex:2.
-
- v := PopUpList on:m.
- v open
- [exEnd]
-
-
- using a combination-instance creation method:
- [exBegin]
- |m v|
-
- m := SelectionInList
- with:#('one' 'two' 'three' 'four')
- initialSelection:2.
-
- v := PopUpList on:m.
- v open
- [exEnd]
-
-
- two different views on the same selectionInList model:
- [exBegin]
- |m v1 v2|
-
- m := SelectionInList new.
- m list:#('one' 'two' 'three' 'four').
- m selectionIndex:2.
-
- v1 := PopUpList on:m.
- v1 open.
-
- v2 := SelectionInListView on:m.
- v2 open
- [exEnd]
-
-
- two views on the same selectionInList:
- and a button, which adds an item to the list.
- [exBegin]
- |m v1 v2 b numItems|
-
- numItems := 4.
-
- m := SelectionInList new.
- m list:((1 to:numItems) collect:[:i | i printString]).
- m selectionIndex:2.
-
- v1 := ScrollableView forView:(SelectionInListView on:m).
- v1 open.
-
- v2 := ScrollableView forView:(SelectionInListView on:m).
- v2 open.
-
- b := Button label:'add item'.
- b action:[numItems := numItems + 1.
- m list:((1 to:numItems) collect:[:i | i printString]).
- ].
- b open
- [exEnd]
-"
-! !
-
-!SelectionInList class methodsFor:'instance creation'!
-
-with:aList
- "return a new instance holding aList"
-
- ^ self new listHolder:(ValueHolder with:aList)
-
- "Modified: / 21.5.1998 / 03:17:16 / cg"
-!
-
-with:aList initialSelection:index
- "return a new instance holding aList and initially selecting
- the item at index."
-
- ^ (self with:aList)
- selectionIndexHolder:(ValueHolder with:index)
-
- "Created: / 24.4.1996 / 08:47:33 / cg"
- "Modified: / 21.5.1998 / 03:17:31 / cg"
-! !
-
-!SelectionInList methodsFor:'accessing-holders'!
-
-listHolder
- "return the valueHolder which holds the list"
-
- ^ listHolder
-
- "Modified: 24.4.1996 / 08:39:44 / cg"
-!
-
-listHolder:aValueHolder
- "set the valueHolder which holds the list.
- Q: should we forward a change-notification ?"
-
- listHolder notNil ifTrue:[
- listHolder removeDependent:self
- ].
- listHolder := aValueHolder.
- listHolder addDependent:self
-
- "Modified: 24.4.1996 / 08:39:59 / cg"
-!
-
-selectionHolder
- "return someone holding on the selection itself (not the index).
- Since we have no one, create an adapter, to get up-to-date values."
-
- ^ AspectAdaptor
- subject:self
- sendsUpdates:false
- accessWith:#selection
- assignWith:#'selection:'
- aspect:#selectionIndex
-
- "Modified: 24.4.1996 / 08:40:19 / cg"
-!
-
-selectionIndexHolder
- "return the valueHolder which holds the index"
-
- ^ selectionIndexHolder
-
- "Modified: 24.4.1996 / 08:40:31 / cg"
-!
-
-selectionIndexHolder:aValueHolder
- "set the valueHolder which holdes the index.
- Q: should we forward a change-notification ?"
-
- selectionIndexHolder notNil ifTrue:[
- selectionIndexHolder removeDependent:self
- ].
- selectionIndexHolder := aValueHolder.
- selectionIndexHolder addDependent:self
-
- "Modified: 24.4.1996 / 08:40:42 / cg"
-! !
-
-!SelectionInList methodsFor:'accessing-values'!
-
-list
- "return the list - thats the thingy held by the listHolder"
-
- ^ listHolder value
-
- "Modified: 24.4.1996 / 08:41:05 / cg"
-!
-
-list:aCollection
- "set the list - thats the thingy held by the listHolder"
-
- aCollection == listHolder value ifTrue:[
- "/ same value set again - send change notification
- "/ manually (valueHolder does not ...)
- self changed:#list.
- listHolder changed.
- ] ifFalse:[
- listHolder value:aCollection.
- ].
-
- "Modified: / 2.2.1998 / 13:05:56 / cg"
-!
-
-selection
- "return the selections value (i.e. the entry in the list - not its index).
- If nothing is selected, nil is returned."
-
- |idx|
-
- idx := self selectionIndex.
- (idx isNil or:[idx == 0]) ifTrue:[^ nil].
- ^ self list at:idx
-
- "Modified: 24.4.1996 / 08:53:23 / cg"
-!
-
-selection:anObject
- "set the selection to be anObject.
- If anObject is not in the list, the selection is cleared"
-
- ^ self selectionIndex:(self list indexOf:anObject ifAbsent:0)
-!
-
-selectionIndex
- "return the selections index (1..). Thats the thingy held by the indexHolder.
- For ST-80 compatibility, 0 is returned if nothing is selected."
-
- ^ selectionIndexHolder value
-
- "Modified: 24.4.1996 / 08:53:45 / cg"
-!
-
-selectionIndex:newIndex
- "set the selectionIndex"
-
- selectionIndexHolder value ~= newIndex ifTrue:[
- selectionIndexHolder value:newIndex
- ]
-
- "Modified: 24.4.1996 / 08:42:04 / cg"
-! !
-
-!SelectionInList methodsFor:'change & update'!
-
-update:something with:aParameter from:changedObject
- "whenever one of my holders value changes,
- tell my dependents about this"
-
- |oldSelection|
-
- changedObject == selectionIndexHolder ifTrue:[
- self changed:#selectionIndex
- ] ifFalse:[
- changedObject == listHolder ifTrue:[
- something == #value ifTrue:[
- oldSelection := selectionIndexHolder value.
- self clearSelection. "/ clears without update
- self changed:#list.
- oldSelection ~= (selectionIndexHolder value) ifTrue:[
- selectionIndexHolder changed:#value
- ]
- ]
- ]
- ]
-
- "Modified: 20.4.1996 / 13:08:32 / cg"
-! !
-
-!SelectionInList methodsFor:'initialization'!
-
-initialize
- "initialize; create the valueHolders for the index and the list"
-
- self listHolder:(ValueHolder with:List new).
- self selectionIndexHolder:(ValueHolder with:self zeroIndex).
-
- "Modified: / 21.5.1998 / 03:17:56 / cg"
-! !
-
-!SelectionInList methodsFor:'obsolete backward compatibility'!
-
-index
- "return the selections index.
- This is an OBSOLETE backward compatibility interface"
-
- self obsoleteMethodWarning:'use #selectionIndex'.
- ^ self selectionIndex
-
- "Modified: 24.4.1996 / 08:43:10 / cg"
-!
-
-index:newIndex
- "set the selections index.
- This is an OBSOLETE backward compatibility interface"
-
- self obsoleteMethodWarning:'use #selectionIndex:'.
- ^ self selectionIndex:newIndex
-
- "Modified: 24.4.1996 / 08:43:06 / cg"
-!
-
-indexHolder
- "return the valueHolder of the selections index.
- This is an OBSOLETE backward compatibility interface"
-
- self obsoleteMethodWarning:'use #selectionIndexHolder'.
- ^ self selectionIndexHolder
-
- "Modified: 24.4.1996 / 08:43:35 / cg"
-!
-
-indexHolder:aValueHolder
- "set the valueHolder of the selections index.
- This is an OBSOLETE backward compatibility interface"
-
- self obsoleteMethodWarning:'use #selectionIndexHolder:'.
- ^ self selectionIndexHolder:aValueHolder
-
- "Modified: 24.4.1996 / 08:43:43 / cg"
-! !
-
-!SelectionInList methodsFor:'printing & storing'!
-
-displayString
- "return a string for display in inspectors etc."
-
- ^ self class name , '(' , self selectionIndex displayString , ')'
-
- "Modified: 20.9.1997 / 11:41:31 / cg"
-! !
-
-!SelectionInList methodsFor:'private'!
-
-clearSelection
- "clear the selection.
- For ST-80 compatibility, a non-selection has an index of 0
- although, nil sounds more natural to me ... (sigh)"
-
- selectionIndexHolder setValue:self zeroIndex.
-
- "Modified: 24.4.1996 / 08:44:37 / cg"
-! !
-
-!SelectionInList methodsFor:'queries'!
-
-hasSelection
- "return true, if there is a selection
- "
- ^ self numberOfSelections ~~ 0
-!
-
-numberOfSelections
- "return the number of selected entries
- "
- |s|
-
- s:= selectionIndexHolder value.
- ^ (s ~~ 0 and:[s notNil]) ifTrue:[1] ifFalse:[0]
-!
-
-zeroIndex
- "return the selections index returned when nothing
- is selected. This method is provided to allow applications
- to deal transparently with SelectionInList models AND with
- MultSelectionInList models, which use different no-selection values.
- Although I would prefer nil, ST-80 uses 0 to represent `no-selection'. (sigh)"
-
- ^ 0
-
- "Created: 20.4.1996 / 13:10:53 / cg"
- "Modified: 24.4.1996 / 08:46:18 / cg"
-! !
-
-!SelectionInList class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/SelList.st,v 1.24 1998-05-21 01:18:07 cg Exp $'
-! !
--- a/SelListV.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3619 +0,0 @@
-"
- 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.
-"
-
-ListView subclass:#SelectionInListView
- instanceVariableNames:'selection actionBlock enabled hilightFgColor hilightBgColor
- halfIntensityFgColor doubleClickActionBlock selectConditionBlock
- listAttributes multipleSelectOk clickLine initialSelectionMsg
- printItems oneItem useIndex hilightLevel hilightFrameColor
- ignoreReselect arrowLevel smallArrow keyActionStyle
- returnKeyActionStyle toggleSelect strikeOut iSearchString items
- doubleClickMsg hilightStyle clickPosition allowDrag
- dragObjectConverter dragIsActive endDragAction dropTarget
- dropSource visualBlock selectedVisualBlock'
- classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
- SmallRightArrowShadowForm SmallRightArrowLightForm
- DefaultForegroundColor DefaultBackgroundColor
- DefaultHilightForegroundColor DefaultHilightBackgroundColor
- DefaultHilightFrameColor DefaultHilightLevel
- DefaultRightArrowStyle DefaultRightArrowLevel
- DefaultDisabledForegroundColor DefaultShadowColor
- DefaultLightColor DefaultHilightStyle'
- poolDictionaries:''
- category:'Views-Lists'
-!
-
-!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.
-"
-!
-
-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 toggleSelect is true, clicking toggles (i.e. click on a seleted item
- will deselect).
-
- 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. (this stupid behavior is due to the multiple
- select feature being added later - the first implementation used to support
- only single selections).
-
- The actionBlock is called with the current selection (single number or
- collection of numbers) as argument.
-
- Also, to support ST-80 MVC-style use, the model (if nonNil) is notified
- by the change mechanism (performs changeMsg) and vice versa, the view
- updates if the model changes (with aspect of either #list or #selectionIndex).
-
- Before actually adding entries to the the selection, a checkBlock (if non-nil) is evaluated
- passing the number of the entry whch is about to be selected as argument.
- The select change operation is only done if this returns true. This allows
- interception of select, for example to query the user if he/she wants to save
- the old contents before (see uses in SystemBrowser and FileBrowser), or to
- disable individual entries.
-
- 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:).
-
- Finally, ignoreReselect controls if pressing on an already selected item
- triggers the action or not. For some applications it is useful to allow
- reselects (for example, the SystemBrowsers method-list updates the
- source code in this case).
-
- Currently, some limited form of line attributes are supported. These
- are kept in the instance variable lineAttributes.
- This may change (using mechanisms similar to MultiColListEntry), so
- be prepared. (dont use the listAttributes instvar directly; if possible,
- use MultiColListEntry or subclasses of it.
-
- Although currently based on the listAttributes instVar, the implementation of
- text attributes will be changed in the near future (when Text/DisplayText are
- available).
- However, the protocol will probably be kept for backward compatibility
- (i.e. use #attributeAt: / #attributeAt:put etc. - at least, these are easy to find
- when migrating to the new attributed text handling).
-
- [Instance variables:]
- selection <misc> the current selection. nil, a number or collection of numbers
-
- actionBlock <Block> block to be evaluated on selection changes
- (1-arg blocks gets selectionIndex or selectionValue
- as arg - depending upon the useIndex setting)
-
- useIndex <Boolean> if true, the index of a selection is passed to
- the actionBlock or stuffed into the selection valueHolder;
- if false, the seelction-value is passed.
-
- enabled <Boolean> true: selection changes allowed; false: ignore clicks
-
- hilightFgColor
- hilightBgColor <Color> how highlighted items are drawn
-
- halfIntensityColor <Color> foreground for disabled items
-
- selectConditionBlock <Block> if non-nil, this nlock can decide if selection is ok
-
- doubleClickActionBlock <Block> action to perform on double-click
- (1-arg blocks gets selectionIndex or selectionValue
- as arg - depending upon the useIndex setting)
-
- listAttributes dont use - will vanish
-
- hilightLevel <Integer> level to draw selections (i.e. for 3D effect)
- hilightFrameColor <Color> rectangle around highlighted items
-
- multipleSelectOk <Boolean> if true, multiple selections (with shift) are ok.
- default: false
-
- ignoreReselect <Boolean> if true, selecting same again does not trigger action;
- if false, every select triggers it.
- default: true
-
- toggleSelect <Boolean> if true, click toggles;
- if false, click selects.
- default: false
-
- arrowLevel <Integer> level to draw right-arrows (for submenus etc.)
- smallArrow <Boolean> if true, uses a small arrow bitmap
-
- listMsg if non-nil, use ST-80 style (model-access)
- initialSelectionMsg
- printItems
- oneItem
-
- keyActionStyle <Symbol> controls how to respond to keyboard selects
-
- returnKeyActionStyle <Symbol> controls how to respond to return key
-
- written spring/summer 89 by claus
- 3D Jan 90 by claus
- multiselect Jun 92 by claus
- keyboard-select jun 94 by claus
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- SelectionInListView can be used both in the ST/X way, using action blocks
- or in the traditional mvc way.
- with actions:
-
- basic interface:
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:index | Transcript showCR:'selected ' , index printString].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- get element instead of index:
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:element | Transcript showCR:'selected ' , element printString].
- slv useIndex:false.
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- concrete example; show filenames:
- (notice: normally, you would use a FileSelectionList)
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index |
- Transcript showCR:'selected ' , index printString.
- Transcript showCR:' the value is: ', slv selectionValue].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- add a scrollbar:
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- allow reselect
- (clicking on already selected entry
- triggers action/changeNotification again):
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv ignoreReselect:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- allow multiple selections (shift-select):
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:indexList | Transcript showCR:'selected ' , indexList printString].
- slv multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
- same, not using index:
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:indexList | Transcript showCR:'selected ' , indexList printString].
- slv multipleSelectOk:true; useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- strikeout mode (single):
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv strikeOut:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- strikeout mode (multiple):
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv strikeOut:true; multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
- toggleSelect mode (clicking on selected entry deselects it):
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv toggleSelect:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
- define what to do on double-click:
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv doubleClickAction:[:index | Transcript showCR:'doubleclick on ' , index printString].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
- enable / disable:
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv disable.
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
- Delay waitForSeconds:5.
- slv enable.
- [exEnd]
-
- enable / disable via a channel:
- [exBegin]
- |top slv enableChannel t|
-
- enableChannel := true asValue.
- t := Toggle label:'enable'.
- t model:enableChannel.
- t open.
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:(Filename currentDirectory directoryContents).
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv enableChannel:enableChannel.
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
- [exEnd]
-
- using a Model:
- [exBegin]
- |top slv model|
-
- model := Plug new.
- model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:[1].
- model respondTo:#setSelection: with:[:arg | Transcript showCR:'model selected:', arg printString].
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
- notice, that the ST-80 behavaior on reselect is to send a selection change
- with an index of 0.
-
- same, with useIndex false:
- [exBegin]
- |top slv model|
-
- model := Plug new.
- model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:['bar'].
- model respondTo:#setSelection: with:[:arg | Transcript showCR:'model selected:', arg printString].
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
- slv useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- self changing list:
- (selectionInListView updates itself when button changes initial selection):
- [exBegin]
- |top slv model sel changeButton|
-
- sel := 'bar'.
- model := Plug new.
- model respondTo:#getList with:['getList' printNL. #('foo' 'bar' 'baz' 'hello')].
- model respondTo:#initial with:['initial' printNL. sel].
- model respondTo:#setSelection: with:[:arg | ('model selected:', arg) printNL. sel := arg].
-
- changeButton := Button label:'change selection'.
- changeButton action:[sel := 'foo'. model changed:#initial].
- changeButton open.
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#someAspect
- change:#setSelection:
- list:#getList
- initialSelection:#initial.
- slv useIndex:false.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
-
- using a SelectionInList-Model:
- (see how changes in the model (via list:...) are reflected in the view)
- [exBegin]
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
- model selection:'bar'.
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView on:model.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
-
- InspectorView openOn:model monitor:'selectionIndexHolder'
- [exEnd]
-
-
- two selectionInListViews on the same selectionInList model:
- [exBegin]
- |top1 slv1 top2 slv2 model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- top1 := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv1 := SelectionInListView on:model.
-
- top1 add:(ScrollableView forView:slv1) in:(0.0@0.0 corner:1.0@1.0).
- top1 open.
-
- top2 := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv2 := SelectionInListView on:model.
-
- top2 add:(ScrollableView forView:slv2) in:(0.0@0.0 corner:1.0@1.0).
- top2 open.
- [exEnd]
-
-
- a MultiSelectionInList model:
- [exBegin]
- |top slv model|
-
- model := MultiSelectionInList with:#('foo' 'bar' 'baz' 'hello').
- model selection:#('foo' 'bar').
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView on:model.
- slv multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
-
- InspectorView openOn:model monitor:'selectionIndexHolder'
- [exEnd]
-
- with strikeOut:
- [exBegin]
- |top slv model|
-
- model := MultiSelectionInList with:#('foo' 'bar' 'baz' 'hello').
- model selection:#('foo' 'bar').
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView on:model.
- slv multipleSelectOk:true; toggleSelect:true; strikeOut:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
-
- InspectorView openOn:model monitor:'selectionIndexHolder'
- [exEnd]
-
-
- two listViews on the same list, but separate selections
- [exBegin]
- |top top2 lv1 lv2 selInL1 selInL2 listHolder l1 l2|
-
- top := StandardSystemView new extent:300@300.
-
- lv1 := SelectionInListView origin:0.0@0.0 corner:1.0@0.5 in:top.
- lv1 level:-1.
- lv1 toggleSelect:true.
-
- lv2 := SelectionInListView origin:0.0@0.5 corner:1.0@1.0 in:top.
- lv2 level:-1.
- lv2 toggleSelect:true.
-
- selInL1 := SelectionInList new.
- selInL2 := SelectionInList new.
-
- listHolder := #('foo' 'bar' 'baz') asValue.
-
- selInL1 listHolder:listHolder.
- selInL2 listHolder:listHolder.
-
- lv1 model:selInL1.
- lv2 model:selInL2.
-
- top open.
-
- top2 := StandardSystemView new extent:100 @ 30.
- l1 := Label origin:0.0@0.0 corner:0.5@1.0 in:top2.
- l2 := Label origin:0.5@0.0 corner:1.0@1.0 in:top2.
-
- l1 model:(BlockValue with:[:arg | arg value printString] argument:selInL1 selectionIndexHolder).
- l2 model:(BlockValue with:[:arg | arg value printString] argument:selInL2 selectionIndexHolder).
-
- l1 labelMessage:#value.
- l2 labelMessage:#value.
-
- top2 open.
-
- Delay waitForSeconds:2.
- listHolder value:#('1' '2' '3' '4').
- [exEnd]
- non-string entries (text)
- [exBegin]
- |top l slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- l := OrderedCollection new.
- l add:(Text string:'red' emphasis:(#color->Color red)).
- l add:(Text string:'green' emphasis:(#color->Color green)).
- l add:(Text string:'blue' emphasis:(#color->Color blue)).
- slv list:l.
- slv action:[:index | Transcript showCR:'selected ' , index printString].
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-
- non string entries
- [exBegin]
- |top slv wrapper l fileImage dirImage m|
-
- dirImage := Image fromFile:'DirObj.xbm'.
- fileImage := Image fromFile:'FileObj.xbm'.
-
-
- l := OrderedCollection new.
- Filename currentDirectory directoryContents do:[:s |
- s asFilename isDirectory ifTrue:[
- l add:(LabelAndIcon icon:dirImage string:s)
- ] ifFalse:[
- l add:(LabelAndIcon icon:fileImage string:s)
- ]
- ].
-
- m := SelectionInList new.
- m list:l.
-
- slv := SelectionInListView new.
- slv model:m.
- wrapper := HVScrollableView forView:slv miniScrollerH:true.
-
- top := StandardSystemView extent:150@200.
- top add:wrapper in:(0.0@0.0 corner:1.0@1.0).
- top open.
- [exEnd]
-
- [exBegin]
- |top slv|
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView new.
- slv list:#('one' 'two' 'three').
- slv action:[:index | Transcript showCR:'selected ' , index printString].
- slv multipleSelectOk:true.
- slv allowDrag:true.
-
- top add:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
- [exEnd]
-"
-
- "Modified: 26.10.1995 / 16:42:02 / cg"
-! !
-
-!SelectionInListView class methodsFor:'instance creation'!
-
-on:aModel aspect:aspect change:change list:list initialSelection:initial
- ^ self on:aModel
- printItems:true
- oneItem:false
- aspect:aspect
- change:change
- list:list
- menu:nil
- initialSelection:initial
- useIndex:true
-!
-
-on:aModel aspect:aspect change:change list:list menu:menu initialSelection:initial
- ^ self on:aModel
- printItems:true
- oneItem:false
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:true
-!
-
-on:aModel printItems:print oneItem:one aspect:aspect
- change:change list:list menu:menu initialSelection:initial
-
- "for ST-80 compatibility"
-
- ^ self on:aModel
- printItems:print
- oneItem:one
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:false
-!
-
-on:aModel printItems:print oneItem:one aspect:aspect change:change
- list:list menu:menu initialSelection:initial useIndex:useIndex
-
- "for ST-80 compatibility"
-
- ^ (self new) on:aModel
- printItems:print
- oneItem:one
- aspect:aspect
- change:change
- list:list
- menu:menu
- initialSelection:initial
- useIndex:useIndex
-! !
-
-!SelectionInListView class methodsFor:'defaults'!
-
-defaultAspectMessage
- ^ nil
-!
-
-defaultChangeMessage
- ^ #selectionIndex:
-!
-
-defaultListMessage
- ^ #list
-!
-
-defaultSelectionMessage
- ^ #selectionIndex
-!
-
-rightArrowFormOn:aDevice
- "return the form used for the right arrow (non 3D)"
-
- <resource: #style (#'selection.rightArrowForm' #'selection.rightArrowFormFile')>
-
- |f fn bits|
-
- ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
- ^ RightArrowForm
- ].
-
- f := StyleSheet at:#'selection.rightArrowForm'.
- f isNil ifTrue:[
- fn := StyleSheet at:#'selection.rightArrowFormFile' default:'RightArrow.xbm'.
- f := Image fromFile:fn resolution:100 on:aDevice.
- f isNil ifTrue:[
- DefaultRightArrowStyle == #solid ifTrue:[
- bits := #[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000010 2r00000000
- 2r00000011 2r00000000
- 2r00000011 2r10000000
- 2r00000011 2r11000000
- 2r00000011 2r11100000
- 2r00000011 2r11110000
- 2r00000011 2r11100000
- 2r00000011 2r11000000
- 2r00000011 2r10000000
- 2r00000011 2r00000000
- 2r00000010 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000]
- ] ifFalse:[
- bits := #[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000110 2r00000000
- 2r00000101 2r00000000
- 2r00000100 2r10000000
- 2r00000100 2r01000000
- 2r00000100 2r00100000
- 2r00000100 2r00010000
- 2r00000100 2r00100000
- 2r00000100 2r01000000
- 2r00000100 2r10000000
- 2r00000101 2r00000000
- 2r00000110 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000]
- ].
- f := Form width:16 height:16 fromArray:bits on:aDevice
- ]
- ].
- (aDevice == Display) ifTrue:[
- RightArrowForm := f
- ].
- ^ f
-
- "Modified: / 5.8.1998 / 00:04:40 / cg"
-!
-
-rightArrowLightFormOn:aDevice
- "return the form used for the right arrow light pixels (3D only)"
-
- |f|
-
- ((aDevice == Display) and:[RightArrowLightForm notNil]) ifTrue:[
- ^ RightArrowLightForm
- ].
- f := Image fromFile:'bitmaps/RightArrowLight.xbm' resolution:100 on:aDevice.
- f isNil ifTrue:[
- f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000110 2r00000000
- 2r00000101 2r00000000
- 2r00000100 2r10000000
- 2r00000100 2r01000000
- 2r00000100 2r00100000
- 2r00000100 2r00000000
- 2r00000100 2r00000000
- 2r00000100 2r00000000
- 2r00000100 2r00000000
- 2r00000100 2r00000000
- 2r00000100 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- (aDevice == Display) ifTrue:[
- RightArrowLightForm := f
- ].
- ^ f
-
- "Modified: 1.1.1970 / 14:10:42 / cg"
-!
-
-rightArrowShadowFormOn:aDevice
- "return the form used for the right arrow light pixels (3D only)"
-
- |f|
-
- ((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
- ^ RightArrowShadowForm
- ].
- f := Image fromFile:'bitmaps/RightArrowShadow.xbm' resolution:100 on:aDevice.
- f isNil ifTrue:[
- f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00010000
- 2r00000000 2r00100000
- 2r00000000 2r01000000
- 2r00000000 2r10000000
- 2r00000001 2r00000000
- 2r00000010 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- (aDevice == Display) ifTrue:[
- RightArrowShadowForm := f
- ].
- ^ f
-
- "Modified: 1.1.1970 / 01:00:00 / cg"
-!
-
-smallRightArrowLightFormOn:aDevice
- "return the form used for the small right arrow light pixels (3D only)"
-
- |f|
-
- ((aDevice == Display) and:[SmallRightArrowLightForm notNil]) ifTrue:[
- ^ SmallRightArrowLightForm
- ].
- f := Image fromFile:'bitmaps/SmallRightArrowLight.xbm' resolution:100 on:aDevice.
- f isNil ifTrue:[
- f := Form width:9 height:9 fromArray:#[2r00000000 2r00000000
- 2r01100000 2r00000000
- 2r01011000 2r00000000
- 2r01000110 2r00000000
- 2r01000000 2r00000000
- 2r01000000 2r00000000
- 2r01000000 2r00000000
- 2r01000000 2r00000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- (aDevice == Display) ifTrue:[
- SmallRightArrowLightForm := f
- ].
- ^ f
-
- "Modified: 19.12.1996 / 14:10:59 / cg"
-!
-
-smallRightArrowShadowFormOn:aDevice
- "return the form used for the small right arrow light pixels (3D only)"
-
- |f|
-
- ((aDevice == Display) and:[SmallRightArrowShadowForm notNil]) ifTrue:[
- ^ SmallRightArrowShadowForm
- ].
- f := Image fromFile:'bitmaps/SmallRightArrowShadow.xbm' resolution:100 on:aDevice.
- f isNil ifTrue:[
- f := Form width:9 height:9 fromArray:#[2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000000 2r00000000
- 2r00000001 2r00000000
- 2r00000110 2r00000000
- 2r00011000 2r00000000
- 2r00100000 2r00000000
- 2r00000000 2r00000000]
- on:aDevice
- ].
- (aDevice == Display) ifTrue:[
- SmallRightArrowShadowForm := f
- ].
- ^ f
-
- "Modified: 19.12.1996 / 14:11:10 / cg"
-!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'selection.disabledForegroundColor'
- #'selection.hilightForegroundColor' #'selection.hilightBackgroundColor'
- #'selection.hilightFrameColor' #'selection.hilightLevel'
- #'selection.rightArrowStyle' #'selection.rightArrowLevel'
- #'selection.foregroundColor' #'selection.backgroundColor'
- #'selection.shadowColor' #'selection.lightColor'
- #'selection.font' #'selection.hilightStyle')>
-
- DefaultDisabledForegroundColor := StyleSheet colorAt:#'selection.disabledForegroundColor'.
- DefaultHilightForegroundColor := StyleSheet colorAt:#'selection.hilightForegroundColor'.
- DefaultHilightBackgroundColor := StyleSheet colorAt:#'selection.hilightBackgroundColor'.
- DefaultHilightFrameColor := StyleSheet colorAt:#'selection.hilightFrameColor'.
- DefaultHilightLevel := StyleSheet at:#'selection.hilightLevel' default:0.
- DefaultHilightStyle := StyleSheet at:#'selection.hilightStyle' default:(StyleSheet name).
- DefaultRightArrowStyle := StyleSheet at:#'selection.rightArrowStyle'.
- DefaultRightArrowLevel := StyleSheet at:#'selection.rightArrowLevel'.
- DefaultForegroundColor := StyleSheet colorAt:#'selection.foregroundColor'.
- DefaultBackgroundColor := StyleSheet colorAt:#'selection.backgroundColor'.
- DefaultShadowColor := StyleSheet colorAt:#'selection.shadowColor'.
- DefaultLightColor := StyleSheet colorAt:#'selection.lightColor'.
- DefaultFont := StyleSheet fontAt:#'selection.font'.
- RightArrowForm := nil.
-
- "
- self updateStyleCache
- "
-
- "Modified: 20.10.1997 / 14:04:26 / cg"
-! !
-
-!SelectionInListView methodsFor:'ST80 compatibility'!
-
-sequence
- "same as #list - for ST80 compatibility"
-
- ^ self list
-
- "Created: / 21.6.1998 / 02:46:50 / cg"
-! !
-
-!SelectionInListView methodsFor:'accessing-actions'!
-
-action:aBlock
- "set the action block to be performed on select.
- With useIndex==true, the block gets the selectionIndex as arg,
- otherwise, it gets the selectionValue."
-
- actionBlock := aBlock
-!
-
-doubleClickAction:aOneArgBlock
- "set the double click action block.
- If non-nil, that one is evaluated on double click, passing the
- selection-line-number (useIndex==true) or selectionValue (useIndex==false) as argument."
-
- doubleClickActionBlock := aOneArgBlock
-
- "Modified: 24.2.1996 / 16:07:28 / cg"
-!
-
-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
-
- the default (set in #initialize) is #select
- "
-
- keyActionStyle := aSymbol
-!
-
-returnKeyActionStyle:aSymbol
- "defines how the view should respond to a return key pressed.
- Possible values are:
- #doubleClick -> perform double-click action
-
- #pass -> will pass key to superclass (i.e. no special treatment)
-
- nil -> will ignore key
-
- the default (set in #initialize) is #doubleClick
- "
-
- returnKeyActionStyle := aSymbol
-!
-
-selectConditionBlock:aBlock
- "set the conditionBlock; this block is evaluated before a selection
- change is performed; the change will not be done, if the evaluation
- returns false. For example, this allows confirmation queries in
- the SystemBrowser"
-
- selectConditionBlock := aBlock
-!
-
-useIndex
- "set/clear the useIndex flag. If set, both actionBlock and change-messages
- are passed the index(indices) of the selection as argument.
- If clear, the value(s) (i.e. the selected string) is passed.
- Default is true."
-
- ^ useIndex
-!
-
-useIndex:aBoolean
- "set/clear the useIndex flag. If set, both actionBlock and change-messages
- are passed the index(indices) of the selection as argument.
- If clear, the value(s) (i.e. the selected string) is passed.
- Default is true."
-
- useIndex ~~ aBoolean ifTrue:[
- useIndex := aBoolean.
- useIndex ifTrue:[
- changeMsg == #selection: ifTrue:[
- changeMsg := #selectionIndex:.
- aspectMsg := #selectionIndex.
- ]
- ] ifFalse:[
- changeMsg == #selectionIndex: ifTrue:[
- changeMsg := #selection:.
- aspectMsg := #selection.
- ]
- ].
- ].
-
-! !
-
-!SelectionInListView methodsFor:'accessing-attributes'!
-
-attributeAt:index
- "return the line attribute of list line index.
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- listAttributes isNil ifFalse:[
- (index > listAttributes size) ifFalse:[
- ^ listAttributes at:index
- ]
- ].
- ^ nil
-!
-
-attributeAt:index add:aSymbolOrCollectionOfSymbols
- "add to a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[
- current := Set new.
- ] ifFalse:[
- current isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
- current := Set with:current
- ]
- ].
-
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current add:aSymbolOrCollectionOfSymbols
- ] ifFalse:[
- (current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
- current addAll:aSymbolOrCollectionOfSymbols
- ].
- self attributeAt:index put:current
-!
-
-attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
- "set a lines attribute(s);
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- (index > self size) ifFalse:[
- listAttributes isNil ifTrue:[
- listAttributes := (OrderedCollection new:index) grow:index
- ] ifFalse:[
- (index > listAttributes size) ifTrue:[
- listAttributes grow:index
- ]
- ].
- aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
- listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
- self redrawLine:index
- ]
- ]
-
-!
-
-attributeAt:index remove:aSymbolOrCollectionOfSymbols
- "remove a line attribute;
- currently supported are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |current|
-
- current := self attributeAt:index.
- current isNil ifTrue:[^ self].
- current isSymbol ifTrue:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
- ] ifFalse:[
- (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
- current := nil
- ]
- ]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
- current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
- ] ifFalse:[
- aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
- ]
- ].
- self attributeAt:index put:current
-!
-
-line:lineNr hasAttribute:aSymbol
- "return true, if line nr has attribute, aSymbol;
- currently supported attributes are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |attr|
-
- listAttributes isNil ifTrue:[^ false].
- (lineNr > listAttributes size) ifTrue:[^ false].
- attr := listAttributes at:lineNr.
- attr isNil ifTrue:[^ false].
- attr isSymbol ifTrue:[^ attr == aSymbol].
- ^ (attr includes:aSymbol)
-!
-
-setAttributes:aList
- "set the attribute list.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- listAttributes := aList
-!
-
-strikeOut:aBoolean
- "turn on/off strikeOut mode"
-
- strikeOut := aBoolean.
-! !
-
-!SelectionInListView methodsFor:'accessing-behavior'!
-
-dragObjectConverter:aBlock
- "set an optional dragObject converter;
- if non-nil, this one will be evaluated on a drag-start,
- for each dropItem as argument, and supposed
- to convert it into a dragObject and return it.
- If it returns nil, the object will not be dropped.
- Useful, if the receiver view represents fileNames or other
- names of the actual objects to be dragged."
-
- dragObjectConverter := aBlock
-
- "Created: 6.4.1997 / 12:16:11 / cg"
- "Modified: 6.4.1997 / 14:12:45 / cg"
-!
-
-enabled
- "return true if selections are possible"
-
- ^ enabled.
-
- "Created: 29.1.1997 / 12:40:54 / stefan"
-!
-
-enabled:aBoolean
- "enable/disable the view - selection changes are allowed/disallowed"
-
- enabled := aBoolean
-
- "Modified: / 30.3.1999 / 15:26:10 / stefan"
-!
-
-ignoreReselect:aBoolean
- "set/clear the ignoreReselect flag -
- if set, a click on an already selected entry is ignored.
- Otherwise the notification is done, even if no
- change in the selection occurs.
- (for example, in browser to update a method).
- Setting ignoreReselect to false makes sense if data is shown
- which may change by itself (i.e. without the user doing anything)
- For example, the inspector uses this, and redisplays the value,
- if the selection is the same.
- The default is true, meaning that a click on an already selected
- does not lead to a notification via the actionBlock/change mechanism."
-
-"ca:
- multiple selection on: the ignoreReselect will have no influence
-"
- ignoreReselect := aBoolean
-!
-
-multipleSelectOk:aBoolean
- "allow/disallow multiple selections. If enabled, the
- user may select multiple entries in the list, and the program
- always gets a collection of selected items (indexes if useIndex is true,
- values otherwise). The default is false, for single selections."
-
- multipleSelectOk := aBoolean.
-
-!
-
-toggleSelect:aBoolean
- "turn on/off toggle select. If true, clicking on a selected entry
- unselects it and vice versa. The default is false, which means
- that clicking on an already selected entry does not change its
- select status (see also ignoreReselect:)."
-
- toggleSelect := aBoolean.
-! !
-
-!SelectionInListView methodsFor:'accessing-channels'!
-
-listHolder
- ^ listChannel
-!
-
-listHolder:aListHolder
- listChannel notNil ifTrue:[
- listChannel removeDependent:self
- ].
- (listChannel := aListHolder) notNil ifTrue:[
- listChannel addDependent:self
- ].
- self getListFromModel
-! !
-
-!SelectionInListView methodsFor:'accessing-contents'!
-
-add:aValue beforeIndex:index
- "must recompute our current selections"
-
- selection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- selection := selection collect:[ :sel |
- sel >= index ifTrue:[
- sel + 1
- ] ifFalse:[
- sel
- ]
- ].
- ] ifFalse:[
- selection >= index ifTrue:[
- selection := selection + 1.
- ].
- ].
- ].
- ^ super add:aValue beforeIndex:index.
-!
-
-contents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super contents:aCollection.
-!
-
-list:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- self list:aCollection keepSelection:false
-!
-
-list:aCollection keepSelection:aBoolean
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- |oldSelection|
-
- "somewhat of a kludge: if selection is first line,
- we have to remove the highlight frame by hand here"
-
- (shown and:[hilightLevel ~~ 0]) ifTrue:[
- selection == firstLineShown ifTrue:[
- self paint:bgColor.
- self fillRectangleX:margin y:margin
- width:(width - (margin * 2))
- height:(hilightLevel abs).
- ].
- ].
-
- aBoolean ifTrue:[
- oldSelection := selection.
- selection := nil.
- ].
- listAttributes := nil.
- super list:aCollection expandTabs:printItems.
- self setSelection:oldSelection. "/ nil if keep is false
-
- "Modified: 25.5.1996 / 16:31:13 / cg"
-!
-
-printItems:aBoolean
- "set/clear the printItems flag. If set, items (as set via #list: or
- as returned from the model) are sent #printString to display them.
- If false, items are assumed to be either strings, or know how to
- display themself in a GC (i.e. they are instances of ListEntry).
- The default is false.
- Caveat: printString seems to be too specialized - I'd rather have
- a definable printSelector or - better - a printConverter.
- This may be added in the future."
-
- printItems := aBoolean
-!
-
-removeIndexWithoutRedraw:lineNr
- "delete line - no redraw;
- return true, if something was really deleted.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndexWithoutRedraw:lineNr
-!
-
-setContents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super setContents:aCollection.
-!
-
-setList:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes.
- No redraw is done - the caller should make sure to redraw afterwards
- (or use this only before the view is visible)."
-
- selection := nil.
- listAttributes := nil.
- super setList:aCollection.
-! !
-
-!SelectionInListView methodsFor:'accessing-look'!
-
-selectedVisualBlock:aBlock
- "ST-80 compatibility - dummy for now"
-
- selectedVisualBlock := aBlock
-
- "Created: / 27.10.1997 / 19:50:58 / cg"
- "Modified: / 21.6.1998 / 02:40:46 / cg"
-!
-
-visualBlock:aBlock
- "ST-80 compatibility - dummy for now"
-
- visualBlock := aBlock
-
- "Modified: / 21.6.1998 / 02:40:57 / cg"
-! !
-
-!SelectionInListView methodsFor:'accessing-mvc'!
-
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
-
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#doubleClickMessage put:doubleClickMsg.
- aDictionary at:#initialSelectionMessage put:initialSelectionMsg.
-
- "
- SelectionInListView new modelInterface
- "
-!
-
-doubleClick:aSymbol
- "set the symbol with which the model is informed about double-click.
- OBSOLETE: please use #doubleClickMessage:"
-
- self obsoleteMethodWarning:'please use #doubleClickMessage:'.
- doubleClickMsg := aSymbol
-!
-
-doubleClickMessage
- "return the symbol with which the model (if any) is informed about
- double-click. If nil (which is the default), it is not informed."
-
- ^ doubleClickMsg
-!
-
-doubleClickMessage:aSymbol
- "set the symbol with which the model (if any) is informed about double-click.
- If nil (which is the default), it is not informed."
-
- doubleClickMsg := aSymbol
-!
-
-initialSelectionMessage
- "return the symbol by which the model informes me about a changed
- selectionIndex. This is used both in change notification and to
- actually aquire a new selection value."
-
- ^ initialSelectionMsg
-!
-
-initialSelectionMessage:aSymbol
- "set the symbol by which the model informes me about a changed
- selectionIndex. This is used both in change notification and to
- actually aquire a new selection value."
-
- initialSelectionMsg := aSymbol
-!
-
-on:aModel printItems:print oneItem:one aspect:aspectSymbol change:changeSymbol
- list:listSymbol menu:menuSymbol initialSelection:initialSymbol useIndex:use
-
- "ST-80 compatibility"
-
- aspectMsg := aspectSymbol.
- changeMsg := changeSymbol.
- listMsg := listSymbol.
- menuMsg := menuSymbol.
- initialSelectionMsg := initialSymbol.
- printItems := print.
- oneItem := one.
- useIndex := use.
- ignoreReselect := false. "/ ST80 behavior
- self model:aModel.
-! !
-
-!SelectionInListView methodsFor:'accessing-selection'!
-
-addElementToSelection:anObject
- "add the element with the same printstring as the argument, anObject
- to the selection. The entry is searched by comparing printStrings.
- No scrolling is done. Returns true, if ok, false if no such entry
- was found.
- *** No model and/or actionBlock notification is done here."
-
- |lineNo str|
-
- str := anObject printString.
- lineNo := list findFirst:[:entry | str = entry printString].
- lineNo ~~ 0 ifTrue:[
- self addToSelection:lineNo.
- ^ true
- ].
- ^ false
-
- "Modified: 15.11.1996 / 16:59:43 / cg"
-!
-
-addToSelection:aNumber
- "add entry, aNumber to the selection. No scrolling is done.
- *** No model and/or actionBlock notification is done here."
-
- (self isValidSelection:aNumber) ifFalse:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
-
- selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifTrue:[^ self].
- selection := selection copyWith:aNumber.
-"/ selection add:aNumber
- ] ifFalse:[
- (aNumber == selection) ifTrue:[^ self].
- selection := OrderedCollection with:selection with:aNumber
- ].
- self redrawElement:aNumber
-
- "Modified: 15.11.1996 / 16:59:29 / cg"
-!
-
-removeFromSelection:aNumber
- "remove entry, aNumber from the selection.
- *** No model and/or actionBlock notification is done here."
-
- selection isNil ifTrue:[^ self].
-
- multipleSelectOk ifTrue:[
- (selection includes:aNumber) ifFalse:[^ self].
- selection := selection copyWithout:aNumber.
-"/ selection remove:aNumber.
- selection size == 0 ifTrue:[
- selection := nil
- ]
- ] ifFalse:[
- (aNumber == selection) ifFalse:[^ self].
- selection := nil
- ].
- self redrawElement:aNumber
-
- "Modified: 15.11.1996 / 16:59:04 / cg"
-! !
-
-!SelectionInListView methodsFor:'change & update'!
-
-update:something with:aParameter from:changedObject
- |list start stop size idx|
-
- changedObject == model ifTrue:[
- something == aspectMsg ifTrue:[
- listChannel isNil ifTrue:[
- self getListFromModel
- ].
- self getSelectionFromModel.
- ^ self
- ].
- something == listMsg ifTrue:[
- self getListFromModel.
- ^ self
- ].
- something == initialSelectionMsg ifTrue:[
- self getSelectionFromModel.
- ^ self
- ].
- something == #empty ifTrue:[
- self list:nil.
- ^ self
- ].
- ].
- changedObject == listChannel ifFalse:[
- ^ super update:something with:aParameter from:changedObject
- ].
- list := listChannel value.
-
- something == #at: ifTrue:[
- idx := aParameter isCollection ifTrue:[aParameter at:1]
- ifFalse:[aParameter].
- ^ self at:aParameter put:(list at:idx).
- ].
-
- something == #insert: ifTrue:[
- ^ self add:(list at:aParameter) beforeIndex:aParameter
- ].
-
- something == #remove: ifTrue:[
- ^ self removeIndex:aParameter
- ].
-
- something == #insertCollection: ifTrue:[
- (size := aParameter last) ~~ 0 ifTrue:[
- self size == 0 ifTrue:[
- self getListFromModel
- ] ifFalse:[
- start := aParameter first.
-
- size timesRepeat:[
- self add:(list at:start) beforeIndex:start.
- start := start + 1
- ]
- ]
- ].
- ^ self
- ].
-
- something == #removeFrom: ifTrue:[
- start := aParameter first.
- stop := aParameter last.
-
- (start == 1 and:[stop == self size]) ifTrue:[
- self getListFromModel
- ] ifFalse:[
- (stop - start + 1) timesRepeat:[
- self removeIndex:start
- ]
- ].
- ^ self
- ].
-
- something == #replace: ifTrue:[
- start := aParameter first.
- stop := aParameter last.
-
- start to:stop do:[:anIndex|
- self at:anIndex put:(list at:anIndex)
- ].
- ^ self
- ].
-
- self getListFromModel.
-
- "Modified: / 14.11.1997 / 13:51:04 / cg"
- "Modified: / 30.3.1999 / 14:27:42 / stefan"
-! !
-
-!SelectionInListView methodsFor:'drag & drop - new'!
-
-canDrag
- "returns true if dragging is enabled
- "
- ^ (allowDrag or:[dropSource notNil])
-!
-
-dropSource
- "returns the dropSource or nil
- "
- ^ dropSource
-!
-
-dropSource:aDropSourceOrNil
- "set the dropSource or nil
- "
- dropSource := aDropSourceOrNil.
-
-
-!
-
-dropTarget
- "returns the dropTarget or nil
- "
- ^ dropTarget
-!
-
-dropTarget:aDropTragetOrNil
- "set the dropTarget or nil
- "
- dropTarget := aDropTragetOrNil.
-
-
-!
-
-startDragAt:aPoint
-
- dropSource isNil ifTrue:[
- self startDragX:aPoint x y:aPoint y
- ] ifFalse:[
- dropSource startDragIn:self at:aPoint
- ]
-! !
-
-!SelectionInListView methodsFor:'drag & drop - old'!
-
-allowDrag:aBoolean
- "enable/disable dragging support"
-
- allowDrag := aBoolean
-
- "Created: 14.11.1996 / 15:12:58 / cg"
-!
-
-collectionOfDragObjects
- "returns collection of dragable objects assigned to selection
- Here, by default, a collection of text-dragObjects is generated;
- however, if a dragObjectConverter is defined, that one gets a chance
- to convert as appropriate."
-
- |collection converted|
-
- collection := OrderedCollection new.
-
- self selectionDo:[:aNumber||text|
- text := self at:aNumber.
- collection add:(DropObject newText:text)
- ].
- dragObjectConverter notNil ifTrue:[
- converted := OrderedCollection new.
- collection do:[:o |
- |convertedObject|
-
- convertedObject := dragObjectConverter value:o.
- convertedObject notNil ifTrue:[
- converted add:convertedObject
- ]
- ].
- collection := converted
- ].
- ^ collection.
-
- "Modified: 6.4.1997 / 14:14:30 / cg"
-!
-
-endDragAction:aFourArgBlock
- "if dragging is enabled, this block will be evaluated
- at drag end time.
- It gets 4 args passed (see DragAndDropManager>>endDragAt:):
- - the targetView (if its a smalltalk view)
- - the targetViews windowID (useful, if its an alien view)
- - the dropPosition in screen coordinates
- - the dropPosition within the target view
- "
-
- endDragAction := aFourArgBlock
-
- "Created: 14.11.1996 / 15:42:38 / cg"
-!
-
-showDraggingIn:aView at:p
- |nItems items offs|
-
- items := self selectionValueAsCollection.
- (nItems := items size) > 1 ifTrue:[
- offs := 0.
- items do:[:item |
- item displayOn:aView at:p + (0@offs).
- offs := offs + (item heightOn:self)
- ]
- ] ifFalse:[
- nItems ~~ 0 ifTrue:[
- items first displayOn:aView at:p.
- ]
- ]
-
- "Created: 14.11.1996 / 15:31:31 / cg"
- "Modified: 14.11.1996 / 16:32:00 / cg"
-!
-
-startDragX:x y:y
- |xOffset w h dragAndDropMgr|
-
- dragIsActive := true.
- xOffset := x.
-
- h := 0.
- w := 0.
-
- self selectionDo:[:aNumber||e|
- e := self at:aNumber.
- h := h + (e heightOn:self).
- w := w max:(e widthOn:self).
- ].
-
- DragAndDropManager startDrag:(self collectionOfDragObjects)
- from:self
- offset:0 @ 0
- atEnd:endDragAction
- display:(self selectionValue).
-
-"/ dragAndDropMgr := DragAndDropManager new.
-"/ dragAndDropMgr dropObjects:(self collectionOfDragObjects).
-"/
-"/ dragAndDropMgr
-"/ startOpaqueDrag:[:aPoint :aView |
-"/ self
-"/ showDraggingIn:aView
-"/ at:aPoint - (xOffset@0)
-"/ ]
-"/ offset:(xOffset @ h)
-"/ extent:(w*5)@(h*2)
-"/ in:self
-"/ at:(x@y)
-"/ atEnd:endDragAction.
-"/
-"/ "Modified: 19.4.1997 / 10:00:16 / cg"
-"/
-"/
-"/
-! !
-
-!SelectionInListView methodsFor:'drawing'!
-
-drawRightArrowInVisibleLine:visLineNr
- "draw a right arrow (for submenus).
- This method is not used here, but provided for subclasses such
- as menus or file-lists."
-
- |y x form form2 topLeftColor botRightColor t itemHeight listLine item|
-
- x := width - 16.
- y := (self yOfVisibleLine:visLineNr).
-
- listLine := self visibleLineToListLine:visLineNr.
- item := self at:listLine.
- item isNil ifTrue:[
- itemHeight := fontHeight
- ] ifFalse:[
- itemHeight := item heightOn:self.
- ].
-
- (device depth == 1 or:[arrowLevel == 0]) ifTrue:[
- form := self class rightArrowFormOn:device.
- form notNil ifTrue:[
- y := y + ((itemHeight - form height) // 2).
- (self isInSelection:listLine) ifTrue:[
- self foreground:hilightFgColor
- ] ifFalse:[
- self foreground:fgColor.
- ].
- self displayForm:form x:x y:y.
- ]
- ] ifFalse:[
- smallArrow ifTrue:[
- form := self class smallRightArrowLightFormOn:device.
- form2 := self class smallRightArrowShadowFormOn:device.
- ] ifFalse:[
- form := self class rightArrowLightFormOn:device.
- form2 := self class rightArrowShadowFormOn:device.
- ].
- (form isNil or:[form2 isNil]) ifTrue:[
- "/ very bad conditions
- ^ self
- ].
- y := y + ((itemHeight - form height) // 2).
-
- topLeftColor := lightColor.
- botRightColor := shadowColor.
-
- "openwin arrow stays down"
- styleSheet name ~~ #openwin ifTrue:[
- (self isInSelection:listLine) ifTrue:[
- t := topLeftColor.
- topLeftColor := botRightColor.
- botRightColor := t.
- ]
- ].
- arrowLevel < 0 ifTrue:[
- t := topLeftColor.
- topLeftColor := botRightColor.
- botRightColor := t.
- ].
-
-"/ self foreground:topLeftColor.
-self paint:topLeftColor.
- self displayForm:form x:x y:y.
-"/ self foreground:botRightColor.
-self paint:botRightColor.
- self displayForm:form2 x:x y:y.
- ]
-!
-
-drawVisibleLineSelected:visLineNr
- "redraw a single line as selected."
-
- self drawVisibleLineSelected:visLineNr with:hilightFgColor and:hilightBgColor
-
- "Modified: / 31.8.1995 / 19:24:09 / claus"
- "Modified: / 21.6.1998 / 03:12:56 / cg"
-!
-
-drawVisibleLineSelected:visLineNr with:fg and:bg
- "redraw a single line as selected."
-
- |listLine
- y "{ Class: SmallInteger }"
- y2 "{ Class: SmallInteger }"
- wEdge dObj|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine notNil ifTrue:[
- selectedVisualBlock notNil ifTrue:[
- dObj := selectedVisualBlock value:self value:listLine.
- y := (self yOfVisibleLine:visLineNr) + font ascent.
- self paint:bg on:fg.
- dObj displayOn:self x:0 y:y opaque:true.
- ^ self
- ].
-
- strikeOut ifTrue:[
- self drawVisibleLine:visLineNr with:fgColor and:bgColor.
- y := self yOfVisibleLine:visLineNr.
-
- self paint:fgColor.
- y := y + (fontHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ^ self
- ].
-
- self drawVisibleLine:visLineNr with:fg and:bg.
- y := (self yOfVisibleLine:visLineNr) - (lineSpacing//2).
-
- "
- a line above and below
- "
- hilightFrameColor notNil ifTrue:[
- hilightLevel == 0 ifTrue:[
- self paint:hilightFrameColor.
- self displayLineFromX:0 y:y toX:width y:y.
- y2 := y + fontHeight - 1.
- self displayLineFromX:0 y:y2 toX:width y:y2.
- ^ self
- ]
- ] ifFalse:[
- hilightStyle == #motif ifTrue:[
- self paint:fg.
- self displayLineFromX:0 y:y+1 toX:width y:y+1.
- y2 := y + fontHeight - 1 - 1.
- self displayLineFromX:0 y:y2 toX:width y:y2.
- ]
- ].
-
- "
- an edge it around
- "
- (hilightLevel ~~ 0) ifTrue:[
- "
- let edge start at left, extending to the full width
- XXX: widthOfContents should be cached in ListView
- (instead of recomputing all over)
- "
- wEdge := width-(2 * margin).
- includesNonStrings ifFalse:[
- wEdge := wEdge max:(self widthOfContents).
- ].
- self drawEdgesForX:(margin - leftOffset) y:y
- width:wEdge+leftOffset height:fontHeight
- level:hilightLevel.
-
-
- ].
- ^ self
- ].
- ^ super drawVisibleLine:visLineNr with:fg and:bg
-
- "Modified: / 31.8.1995 / 19:24:09 / claus"
- "Created: / 28.2.1996 / 18:40:21 / cg"
- "Modified: / 21.6.1998 / 03:51:04 / cg"
-! !
-
-!SelectionInListView methodsFor:'event handling'!
-
-buttonControlPress:button x:x y:y
- "if multipleSelectOk: add to the selection;
- otherwise, behave like normal select"
-
- |oldSelection listLineNr|
-
- ((button == 1) or:[button == #select]) ifTrue:[
-"/ toggleSelect ifTrue:[
-"/ ^ self buttonPress:button x:x y:y
-"/ ].
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (self lineIsEnabled:listLineNr) ifFalse:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
- ].
- oldSelection := selection copy.
- listLineNr notNil ifTrue: [
- multipleSelectOk ifTrue:[
- (self isInSelection:listLineNr) ifTrue:[
- self removeFromSelection:listLineNr
- ] ifFalse:[
- self addToSelection:listLineNr
- ]
- ] ifFalse:[
- self selectWithoutScroll:listLineNr
- ]
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- self selectionChangedFrom:oldSelection.
- ].
- clickLine := listLineNr
- ]
- ] ifFalse:[
- super buttonPress:button x:x y:y
- ]
-
- "Created: / 14.11.1996 / 15:51:41 / cg"
- "Modified: / 8.8.1998 / 03:24:03 / cg"
-!
-
-buttonMotion:buttonMask x:x y:y
- "mouse-move while button was pressed - handle selection changes"
-
- (enabled not or:[dragIsActive]) ifTrue:[
- ^ self
- ].
-
- "is it the select or 1-button ?"
- self sensor leftButtonPressed ifFalse:[^ self].
-"/ (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
-"/ (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
-"/ ^ self
-"/ ].
-"/ ].
-
- clickLine isNil ifTrue:[^ self].
-
- (self canDrag and:[clickPosition notNil]) ifTrue:[ "mouse pressed but not released"
- (clickPosition dist:(x@y)) > 5.0 ifTrue:[
- ^ self startDragAt:clickPosition
- ].
- ^ self
- ].
-
- "if moved outside of view, start autoscroll"
- (y < 0) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollUp:y.
- ^ self
- ].
- (y > height) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollDown:(y - height).
- ^ self
- ].
-
- (self canDrag and:[x < -5]) ifTrue:[ "visible and left out of view"
- ^ self startDragAt:(0 @ y)
- ].
-
- "move inside - stop autoscroll if any"
- self stopAutoScroll.
-
- self expandSelectionToX:x y:y.
-
- "Modified: / 29.1.1997 / 12:15:31 / stefan"
- "Modified: / 28.7.1998 / 16:06:55 / cg"
-!
-
-buttonMultiPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
-"/ doubleClickActionBlock isNil ifTrue:[
-"/ self buttonPress:button x:x y:y
-"/ ].
- enabled ifFalse:[
- ^ self
- ].
- self doubleClicked.
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-
- "Modified: / 26.10.1997 / 18:50:58 / cg"
-!
-
-buttonPress:button x:x y:y
- |sensor lineNr|
-
- ((button == 1) or:[button == #select]) ifFalse:[
- ^ super buttonPress:button x:x y:y
- ].
- enabled ifFalse:[
- ^ self
- ].
-
- dragIsActive := false.
- clickPosition := nil.
-
- sensor := self sensor.
- sensor notNil ifTrue:[
- sensor ctrlDown ifTrue:[
- ^ self buttonControlPress:button x:x y:y
- ].
- sensor shiftDown ifTrue:[
- ^ self expandSelectionToX:x y:y
- ]
- ].
-
- self canDrag ifTrue:[
- "/ clicked into the selection ?
-
- lineNr := self visibleLineToListLine:(self visibleLineOfY:y).
-
- (self isInSelection:lineNr) ifTrue:[
- "wait for release button
- "
- clickPosition := x@y.
- clickLine := lineNr.
- ^ self
- ]
- ].
- self selectOrToggleAtX:x y:y
-
- "Modified: / 7.5.1998 / 02:02:20 / cg"
-!
-
-buttonRelease:button x:x y:y
- "stop any autoscroll"
-
- self stopAutoScroll.
-
- dragIsActive ifTrue:[
- dragIsActive := false
- ] ifFalse:[
- clickPosition notNil ifTrue:[
- enabled ifFalse:[
- ^ self
- ].
- self selectOrToggleAtX:(clickPosition x) y:(clickPosition y).
- ]
- ].
- clickPosition := nil.
-
- "Modified: / 26.10.1997 / 18:51:14 / cg"
-!
-
-buttonShiftPress:button x:x y:y
- "expand selection
- "
- self halt. "/ never called
-
- self expandSelectionToX:x y:y
-
- "Modified: 17.6.1997 / 18:03:24 / cg"
-!
-
-doubleClicked
- |actionArg|
-
- clickLine := nil.
-
- enabled ifFalse:[
- ^ self
- ].
- selection isNil ifTrue:[
- "/ can only happen if claus modifies the selection within
- "/ the selectAction ....
- ^ self
- ].
-
- actionArg := self argForChangeMessage.
-
- "/
- "/ the ST-80 way of notifying the model
- "/
- (model notNil and:[doubleClickMsg notNil]) ifTrue:[
- self sendChangeMessage:doubleClickMsg with:actionArg.
- ].
-
- "/
- "/ ST/X action blocks
- "/
- doubleClickActionBlock notNil ifTrue:[
- (doubleClickActionBlock numArgs == 1) ifTrue:[
- doubleClickActionBlock value:actionArg
- ] ifFalse:[
- doubleClickActionBlock value
- ]
- ].
-
- "Modified: / 26.10.1997 / 18:51:39 / cg"
-!
-
-key:key select:index x:x y:y
- "select an entry by a keyboard action.
- This is treated like a doubleClick on that entry"
-
- |oldSelection|
-
- enabled ifFalse:[
- ^ self
- ].
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- keyActionStyle notNil ifTrue:[
- keyActionStyle == #pass ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
- oldSelection := selection.
- self selection:index.
-"/
-"/ cg; 15-nov-1996
-"/ notification is already done in #selection:
-"/
-"/ self selectionChangedFrom:oldSelection.
-"/
-
- keyActionStyle == #selectAndDoubleClick ifTrue:[
- self doubleClicked
- ]
- ]
- ].
-
- "Modified: / 26.10.1997 / 18:51:57 / cg"
-!
-
-keyPress:key x:x y:y
- "handle keyboard input"
-
- <resource: #keyboard ( #CursorUp #CursorDown #BeginOfText #EndOfText
- #BeginOfLine #EndOfLine
- #Return ) >
-
- |index
- searchIndex "{Class: SmallInteger}"
- startSearch "{Class: SmallInteger}"
- backSearch searchPrefix item
- mySize sensor s|
-
- enabled ifFalse:[
- ^ self
- ].
- (key == #CursorUp) ifTrue:[
- index := self previousBeforeSelection.
- self key:key select:index x:x y:y.
- ^ self
- ].
- (key == #CursorDown) ifTrue:[
- index := self nextAfterSelection.
- self key:key select:index x:x y:y.
- ^ self
- ].
- "/
- "/ stupid: Home and End are caught in ScrollableView
- "/ we normally do not get them ...
- "/ (need to call handlesKey: from there ...
- "/ ... and implement it here)
- "/
- ((key == #BeginOfText) or:[key == #BeginOfLine]) ifTrue:[
- self key:key select:1 x:x y:y.
- ^ self
- ].
- ((key == #EndOfText) or:[key == #EndOfLine]) ifTrue:[
- index := self size.
- self key:key select:index x:x y:y.
- ^ self
- ].
- key == #Return ifTrue:[
- returnKeyActionStyle == #doubleClick ifTrue:[
- selection notNil ifTrue:[
- self doubleClicked
- ].
- ^ self
- ].
- returnKeyActionStyle ~~ #pass ifTrue:[
- ^ self
- ].
- ].
-
- mySize := self size.
-
- "
- alphabetic keys: search for next entry
- starting with keys character. If shift is pressed, search backward
- "
- (mySize > 0
- and:[key isCharacter
- and:[key isLetter]]) ifTrue:[
- keyActionStyle isNil ifTrue:[^ self].
-"/ multipleSelectOk ifTrue:[^ self].
-
- keyActionStyle == #pass ifFalse:[
- searchPrefix := key asLowercase asString.
-
-"/ ... isISearch... ifFalse:[
-"/ iSearchString := ''
-"/ ] ifTrue:[
-"/ iSearchString := iSearchString , searchPrefix.
-"/ searchPrefix := iSearchString
-"/ ].
-
- backSearch := false.
- sensor := self sensor.
- sensor notNil ifTrue:[
- backSearch := sensor shiftDown.
- ].
- backSearch ifTrue:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection first - 1
- ] ifFalse:[
- selection isCollection ifTrue:[
- startSearch := mySize
- ] ifFalse:[
- startSearch := selection - 1
- ]
- ]
- ] ifFalse:[
- startSearch := mySize
- ].
- startSearch < 1 ifTrue:[
- startSearch := mySize.
- ].
- ] ifFalse:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection last + 1
- ] ifFalse:[
- selection isCollection ifTrue:[
- startSearch := 1
- ] ifFalse:[
- startSearch := selection + 1
- ]
- ]
- ] ifFalse:[
- startSearch := 1
- ].
- startSearch > self size ifTrue:[
- startSearch := 1.
- ].
- ].
- searchIndex := startSearch.
- [true] whileTrue:[
- item := self at:searchIndex.
- item notNil ifTrue:[
- (Object errorSignal catch:[s := item asString])
- ifTrue:[s := item displayString].
- (s withoutSeparators asLowercase startsWith:searchPrefix) ifTrue:[
- searchIndex = selection ifTrue:[^ self].
- ^ self key:key select:searchIndex x:x y:y
- ].
- ].
- backSearch ifTrue:[
- searchIndex := searchIndex - 1.
- searchIndex < 1 ifTrue:[searchIndex := mySize]
- ] ifFalse:[
- searchIndex := searchIndex + 1.
- searchIndex > mySize ifTrue:[searchIndex := 1].
- ].
- searchIndex == startSearch ifTrue:[
- ^ self
- ]
- ]
- ].
- ].
- ^ super keyPress:key x:x y:y
-
- "Modified: / 15.9.1998 / 18:22:31 / cg"
-!
-
-pointerEnter:state x:x y:y
- "mouse pointer moved into my view;
- Since I process keyboard events (to position on an entry and/or
- for scrolling), request the focus."
-
- self wantsFocusWithPointerEnter ifTrue:[
- self requestFocus.
- ].
-!
-
-sizeChanged:how
- "if there is a selection, make certain, its visible
- after the sizechange"
-
- |first wasAtEnd selectionWasWisible|
-
- widthOfWidestLine := nil.
-
- wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
-
- selectionWasWisible := false.
- selection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- first := selection firstIfEmpty:nil
- ] ifFalse:[
- first := selection
- ].
- first notNil ifTrue:[
- selectionWasWisible := (first between:firstLineShown and:(firstLineShown + nFullLinesShown)).
- ]
- ].
-
- super sizeChanged:how.
-
- shown ifTrue:[
- selection notNil ifTrue:[
- selectionWasWisible ifTrue:[
- multipleSelectOk ifTrue:[
- first := selection firstIfEmpty:nil
- ] ifFalse:[
- first := selection
- ].
- first notNil ifTrue:[self makeLineVisible:first]
- ]
- ] ifFalse:[
- "
- if we where at the end before, move to the end again.
- Still to be seen, if this is better in real life ...
- "
- wasAtEnd ifTrue:[
- "at end"
- self scrollToBottom
- ]
- ]
- ]
-
- "Modified: / 1.12.1998 / 23:27:27 / cg"
-! !
-
-!SelectionInListView methodsFor:'focus handling'!
-
-wantsFocusWithPointerEnter
- "return true, if I want the focus when
- the mouse pointer enters"
-
- |pref|
-
- pref := UserPreferences current focusFollowsMouse.
- (pref ~~ false
- and:[(styleSheet at:#'selection.requestFocusOnPointerEnter' default:true)
- ]) ifTrue:[
- ^ true
- ].
-
- ^ false
-
-! !
-
-!SelectionInListView methodsFor:'initialization'!
-
-fetchDeviceResources
- "fetch device colors, to avoid reallocation at redraw time"
-
- super fetchDeviceResources.
-
- hilightFgColor notNil ifTrue:[hilightFgColor := hilightFgColor onDevice:device].
- hilightBgColor notNil ifTrue:[hilightBgColor := hilightBgColor onDevice:device].
- halfIntensityFgColor notNil ifTrue:[halfIntensityFgColor := halfIntensityFgColor onDevice:device].
- hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor onDevice:device].
-
- "Created: 14.1.1997 / 00:11:13 / cg"
-!
-
-initCursor
- "set the cursor - a hand"
-
- cursor := Cursor hand
-!
-
-initStyle
- "setup viewStyle specifics"
-
- super initStyle.
-
-"/ DefaultFont notNil ifTrue:[font := DefaultFont on:device].
-
- bgColor := viewBackground.
- hilightFrameColor := nil.
- hilightLevel := 0.
- hilightStyle := DefaultHilightStyle.
- arrowLevel := 1.
- smallArrow := false.
-
- device hasGrayscales ifTrue:[
- "
- must get rid of these hard codings
- "
- (hilightStyle == #next) ifTrue:[
- hilightFgColor := fgColor.
- hilightBgColor := White.
- hilightFrameColor := fgColor
- ] ifFalse:[
- (hilightStyle == #motif) ifTrue:[
- fgColor := White.
- bgColor := Grey.
- viewBackground := bgColor.
- hilightFgColor := bgColor "fgColor" "White".
- hilightBgColor := fgColor "bgColor lightened" "darkened".
- ] ifFalse:[
- (hilightStyle == #openwin) ifTrue:[
- hilightFgColor := fgColor.
- hilightBgColor := Color grey.
- smallArrow := true.
- ] ifFalse:[
- (hilightStyle == #win95) ifTrue:[
- smallArrow := true.
- ]
- ]
- ]
- ]
- ].
-
- hilightFgColor isNil ifTrue:[
- hilightFgColor := bgColor.
- ].
- hilightBgColor isNil ifTrue:[
- hilightBgColor := fgColor.
- ].
- DefaultForegroundColor notNil ifTrue:[
- fgColor := DefaultForegroundColor
- ].
- DefaultBackgroundColor notNil ifTrue:[
- bgColor := viewBackground := DefaultBackgroundColor
- ].
- DefaultHilightForegroundColor notNil ifTrue:[
- hilightFgColor := DefaultHilightForegroundColor
- ].
- DefaultHilightBackgroundColor notNil ifTrue:[
- hilightBgColor := DefaultHilightBackgroundColor
- ].
- DefaultHilightFrameColor notNil ifTrue:[
- hilightFrameColor := DefaultHilightFrameColor
- ].
- DefaultHilightLevel notNil ifTrue:[
- hilightLevel := DefaultHilightLevel
- ].
- DefaultRightArrowLevel notNil ifTrue:[
- arrowLevel := DefaultRightArrowLevel
- ].
-
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor
- ].
-
- (hilightLevel abs > 0) ifTrue:[
- lineSpacing := 3
- ] ifFalse:[
- lineSpacing := 2
- ].
-
- hilightFgColor isNil ifTrue:[
- hilightFgColor := bgColor.
- hilightBgColor := fgColor
- ].
-
- DefaultDisabledForegroundColor notNil ifTrue:[
- halfIntensityFgColor := DefaultDisabledForegroundColor
- ] ifFalse:[
- halfIntensityFgColor := Color darkGray.
- ].
-
- "Modified: / 5.8.1998 / 00:00:00 / cg"
-!
-
-initialize
- super initialize.
-
- fontHeight := font height + lineSpacing.
- enabled := true.
- ignoreReselect := true.
- multipleSelectOk := toggleSelect := strikeOut := printItems := false.
- useIndex := true.
- dragIsActive := allowDrag := false.
-
- keyActionStyle := #select.
- returnKeyActionStyle := #doubleClick.
-
- listMsg := self class defaultListMessage.
- initialSelectionMsg := self class defaultSelectionMessage.
-
- "Modified: 14.11.1996 / 15:12:33 / cg"
-!
-
-realize
- super realize.
-
- model notNil ifTrue:[
- self getSelectionFromModel.
- ].
-
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- selection notEmpty ifTrue:[
- self makeLineVisible:selection first
- ]
- ] ifFalse:[
- self makeLineVisible:selection
- ]
- ].
-
- "Modified: 27.2.1997 / 14:23:40 / cg"
-! !
-
-!SelectionInListView methodsFor:'private'!
-
-argForChangeMessage
- "return the argument for a selectionChange;
- depending on the setting of useIndex, this is either the numeric
- index of the selection or the value (i.e. the string)"
-
- useIndex ~~ false ifTrue:[ "/ i.e. everything except false
- multipleSelectOk ifTrue:[
- selection isNil ifTrue:[
- ^ #()
- ].
- ].
- ^ selection
- ].
-
- printItems ifFalse:[
- ^ self selectionValue
- ].
-
- items notNil ifTrue:[
- multipleSelectOk ifTrue:[
- ^ selection collect:[:nr | items at:nr]
- ].
- ^ items at:selection
- ].
-
- ^ nil "/ cannot happen
-
- "Modified: 26.10.1995 / 16:28:13 / cg"
-!
-
-checkRemovingSelection:lineNr
- "when a line is removed, we have to adjust selection"
-
- |newSelection|
-
- selection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- newSelection := OrderedCollection new.
- selection do:[:sel |
- sel < lineNr ifTrue:[
- newSelection add:sel
- ] ifFalse:[
- sel > lineNr ifTrue:[
- newSelection add:(sel - 1)
- ]
- "otherwise remove it from the selection"
- ]
- ].
- newSelection size == 0 ifTrue:[
- selection := nil
- ] ifFalse:[
- selection := newSelection
- ]
- ] ifFalse:[
- selection == lineNr ifTrue:[
- selection := nil
- ] ifFalse:[
- selection > lineNr ifTrue:[
- selection := selection - 1
- ]
- ]
- ]
- ]
-!
-
-getListFromModel
- "if I have a model, get my list from it using the listMessage.
- If listMessage is nil, try aspectMessage for backward compatibilty."
-
- |text msg|
-
- listChannel notNil ifTrue:[
- items := listChannel value copy
- ] ifFalse:[
- (model isNil or:[(msg := listMsg) isNil and:[(msg := aspectMsg) isNil]]) ifTrue:[
- ^ self
- ].
- items := model perform:msg.
- ].
- items notNil ifTrue:[
- printItems ifTrue:[
- text := items collect:[:element | element printString]
- ] ifFalse:[
- text := items
- ].
- text notNil ifTrue:[
- text isSequenceable ifFalse:[
- text := text asOrderedCollection
- ]
- ]
- ].
- self list:text keepSelection:true. "/ expandTabs:false
-!
-
-getSelectionFromModel
- "if I have a model and an initialSelectionMsg, get my selection from it"
-
- |sel|
-
- model notNil ifTrue:[
- listChannel notNil ifTrue:[
- sel := model value.
- sel isNil ifTrue:[
- self deselect.
- ^ self
- ]
- ] ifFalse:[
- initialSelectionMsg isNil ifTrue:[^ self].
- sel := model perform:initialSelectionMsg.
- ].
- (useIndex or:[sel isNumber]) ifTrue:[
- self setSelection:sel
- ] ifFalse:[
- self setSelectElement:sel.
- ]
- ].
-
- "Modified: 25.5.1996 / 16:34:54 / cg"
-!
-
-isValidSelection:aNumberOrCollection
- "return true, if aNumber is ok as a selection index"
-
- |sz|
-
- aNumberOrCollection isNil ifTrue:[^ false].
-
- sz := self size.
- (aNumberOrCollection isCollection) ifTrue:[
- multipleSelectOk ifFalse:[^ false].
- aNumberOrCollection do:[:index |
- (index between:1 and:sz) ifFalse:[^ false].
- (self lineIsEnabled:index) ifFalse:[^ false].
- ].
- ] ifFalse:[
- (aNumberOrCollection between:1 and:sz) ifFalse:[^ false].
- (self lineIsEnabled:aNumberOrCollection) ifFalse:[^ false].
- ].
- ^ true.
-
- "Modified: / 8.8.1998 / 03:34:27 / cg"
-!
-
-lineIsEnabled:lineNr
- ^ (self line:lineNr hasAttribute:#disabled) not
-
- "Modified: / 8.8.1998 / 03:22:50 / cg"
-!
-
-positionToSelectionX:x y:y
- "given a click position, return the selection lineNo"
-
- |visibleLine|
-
- (x between:0 and:width) ifTrue:[
- (y between:0 and:height) ifTrue:[
- visibleLine := self visibleLineOfY:y.
- ^ self visibleLineToListLine:visibleLine
- ]
- ].
- ^ nil
-!
-
-scrollSelectDown
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollDown.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-scrollSelectUp
- "auto scroll action; scroll and reinstall timed-block"
-
- self scrollUp.
- Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
-!
-
-selectOrToggleAtX:x y:y
- |oldSelection listLineNr|
-
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (toggleSelect
- and:[self isInSelection:listLineNr]) ifTrue:[
- oldSelection := selection copy.
- self removeFromSelection:listLineNr
- ] ifFalse:[
- (self lineIsEnabled:listLineNr) ifFalse:[^ self].
-
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
-
- (toggleSelect and:[multipleSelectOk]) ifTrue:[
- oldSelection := selection copy.
- self addToSelection:listLineNr
- ] ifFalse:[
- oldSelection := selection copy.
- self selectWithoutScroll:listLineNr.
- ].
- ].
- ((ignoreReselect not and:[selection notNil])
- or:[selection ~= oldSelection]) ifTrue:[
- self selectionChangedFrom:oldSelection.
- ].
- clickLine := listLineNr
- ]
-
- "Created: / 14.11.1996 / 16:27:17 / cg"
- "Modified: / 8.8.1998 / 03:22:26 / cg"
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |listLine|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine isNil ifTrue:[^ false].
- (self isInSelection:listLine) ifTrue:[^ true].
- visualBlock notNil ifTrue:[^true].
- listAttributes notNil ifTrue:[
- (listLine <= listAttributes size) ifTrue:[
- ^ (listAttributes at:listLine) notNil
- ]
- ].
- ^ false
-
- "Modified: / 21.6.1998 / 02:43:02 / cg"
-!
-
-widthForScrollBetween:start and:end
- "has to be redefined since WHOLE line is inverted/modified sometimes"
-
- | anySelectionInRange |
-
- selection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- anySelectionInRange := false.
- selection do:[:s |
- (s between:start and:end) ifTrue:[
- anySelectionInRange := true
- ]
- ]
- ] ifFalse:[
- anySelectionInRange := selection between:start and:end
- ]
- ] ifFalse:[
- anySelectionInRange := false
- ].
-
- anySelectionInRange ifTrue:[
- ^ width
-"
- self is3D ifFalse:[
- ^ width
- ].
- ( #(next openwin) includes:styleSheet name) ifTrue:[
- ^ width
- ].
- viewBackground = background ifFalse:[
- ^ width
- ]
-"
- ].
- ^ super widthForScrollBetween:start and:end
-! !
-
-!SelectionInListView methodsFor:'queries'!
-
-specClass
- "redefined, since the name of my specClass is nonStandard (i.e. not SelectionInListSpec)"
-
- self class == SelectionInListView ifTrue:[^ SequenceViewSpec].
- ^ super specClass
-
- "Modified: / 5.9.1995 / 23:05:53 / claus"
- "Modified: / 31.10.1997 / 19:48:44 / cg"
-! !
-
-!SelectionInListView methodsFor:'redrawing'!
-
-redrawElement:aNumber
- "redraw an individual element"
-
- ^ self redrawLine:aNumber
-!
-
-redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- "redraw a range of lines.
- Must check, if any is in the selection and handle this case.
- Otherwise draw it en-bloque using supers method."
-
- |special sel
- l1 "{ Class: SmallInteger }"
- l2 "{ Class: SmallInteger }"
- selNo "{ Class: SmallInteger }" |
-
- ((selection isCollection)
- or:[listAttributes notNil
- or:[visualBlock notNil
- or:[selectedVisualBlock notNil]]]) ifTrue:[
- "/ cannot do bulk-redraw ...
- l1 := startVisLineNr.
- l2 := endVisLineNr.
- l1 to:l2 do:[:visLine |
- self redrawVisibleLine:visLine
- ].
- ^ self
- ].
-
-"XXX only if -1/+1"
-"/ hilightLevel ~~ 0 ifTrue:[
-"/ self paint:bgColor.
-"/ self fillRectangleX:0 y:(self yOfVisibleLine:startVisLineNr)-1 width:width height:1
-"/ ].
- special := true.
- selection isNil ifTrue:[
- special := false
- ] ifFalse:[
- sel := self listLineToVisibleLine:selection.
- sel isNil ifTrue:[
- special := false
- ] ifFalse:[
- special := (sel between:startVisLineNr and:endVisLineNr)
- ]
- ].
- special ifFalse:[
- ^ super redrawFromVisibleLine:startVisLineNr to:endVisLineNr
- ].
-
- selNo := sel.
- selNo > startVisLineNr ifTrue:[
- super redrawFromVisibleLine:startVisLineNr to:(selNo - 1)
- ].
- self redrawVisibleLine:selNo.
- selNo < endVisLineNr ifTrue:[
- super redrawFromVisibleLine:(selNo + 1) to:endVisLineNr
- ]
-
- "Modified: / 21.6.1998 / 02:42:17 / cg"
-!
-
-redrawVisibleLine:visLineNr
- "redraw a single line.
- Must check, if any is in the selection and handle this case.
- Otherwise draw using supers method."
-
- |listLine fg bg newFont oldFont id dObj y|
-
- fg := fgColor.
- bg := bgColor.
- listLine := self visibleLineToListLine:visLineNr.
- listLine notNil ifTrue:[
- (self isInSelection:listLine) ifTrue:[
- ^ self drawVisibleLineSelected:visLineNr
- ].
-
- visualBlock notNil ifTrue:[
- dObj := visualBlock value:self value:listLine.
- y := (self yOfVisibleLine:visLineNr) + font ascent.
- self paint:fg on:bg.
- dObj displayOn:self x:0 y:y opaque:true.
- ^ self
- ].
- listAttributes notNil ifTrue:[
- ((self line:listLine hasAttribute:#halfIntensity)
- or:[ (self lineIsEnabled:listLine) not ]) ifTrue:[
- fg := halfIntensityFgColor
- ].
- (self line:listLine hasAttribute:#bold) ifTrue:[
- newFont := font asBold.
- (font bold
- or:[id := (newFont onDevice:device) fontId.
- id isNil])
- ifTrue:[
- "
- mhmh - what can be done, if the font is already bold ?
- or no such font is available
- "
- fgColor brightness > 0.5 ifTrue:[
- fg := fgColor darkened "darkened".
- ] ifFalse:[
- fg := fgColor lightened "lightened"
- ].
- (fg brightness - bg brightness) abs < 0.25 ifTrue:[
- bgColor brightness > 0.5 ifTrue:[
- fg := fg darkened.
- ] ifFalse:[
- fg := fg lightened
- ].
- ]
- ].
- id notNil ifTrue:[
- oldFont := font.
- self basicFont:newFont.
- self drawVisibleLine:visLineNr with:fg and:bg.
- self basicFont:oldFont.
- ] ifFalse:[
- self drawVisibleLine:visLineNr with:fg and:bg.
- ].
- ^ self
- ]
- ]
- ].
- ^ self drawVisibleLine:visLineNr with:fg and:bg
-
- "Modified: / 8.8.1998 / 03:42:13 / cg"
-!
-
-redrawVisibleLine:visLineNr col:colNr
- "redraw a single character.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr col:colNr
-!
-
-redrawVisibleLine:visLineNr from:startCol
- "redraw from a col to the right end.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol
-!
-
-redrawVisibleLine:visLineNr from:startCol to:endCol
- "redraw from a startCol to endCol.
- Must check, if its in the selection and handle this case."
-
- (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
- ^ self redrawVisibleLine:visLineNr
- ].
- super redrawVisibleLine:visLineNr from:startCol to:endCol
-! !
-
-!SelectionInListView methodsFor:'selections'!
-
-deselect
- "deselect; Model or actionBlock notifications are made.
- To deselect without notifications, use #setSelection:nil."
-
- self selection:nil
-
- "Modified: 25.5.1996 / 13:03:47 / cg"
-!
-
-deselectWithoutRedraw
- "deselect without redraw or notifications.
- No model or actionBlock notifications are made."
-
- selection := nil
-
- "Modified: 25.5.1996 / 13:04:14 / cg"
-!
-
-expandSelectionToX:x y:y
- "used with button-motion and shift-press;
- expand the selection to include all items from the clicked one,
- up to the one under the mouse pointer"
-
- |movedLine delta oldSel|
-
- clickLine isNil ifTrue:[^ self].
-
- movedLine := self visibleLineToAbsoluteLine:(self visibleLineOfY:y).
-
- multipleSelectOk ifTrue:[
- movedLine == clickLine ifFalse:[
- delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
- oldSel := selection copy.
-
- (clickLine+delta) to:movedLine by:delta do:[:ln |
- (self isInSelection:ln) ifTrue:[self removeFromSelection:ln]
- ifFalse:[self addToSelection:ln]
- ].
- self selectionChangedFrom:oldSel
- ]
- ].
- clickLine := movedLine.
-
- "Created: 14.11.1996 / 15:48:10 / cg"
- "Modified: 14.11.1996 / 15:50:03 / cg"
-
-!
-
-hasSelection
- "return true, if the view has a selection"
-
- ^ selection notNil
-!
-
-isInSelection:aNumber
- "return true, if line, aNumber is in the selection"
-
- selection isNil ifTrue:[^ false].
- multipleSelectOk ifTrue:[
- ^ (selection includes:aNumber)
- ].
- ^ (aNumber == selection)
-!
-
-makeSelectionVisible
- "scroll to make the selection line visible"
-
- |line|
-
- selection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- selection isEmpty ifTrue:[^ self].
- line := selection first.
- ] ifFalse:[
- line := selection
- ].
- self makeLineVisible:line
- ]
-!
-
-nextAfterSelection
- "return the index of the next selectable entry after the selection.
- Wrap at end."
-
- |next sz|
-
- selection isNil ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- selection isCollection ifTrue:[
- selection size == 0 ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- next := selection max + 1
- ]
- ] ifFalse:[
- next := selection + 1
- ].
- ].
-
- (self isValidSelection:next) ifFalse:[
- sz := self size.
- next > sz ifTrue:[
- next := 1.
- ] ifFalse:[
- [next <= sz
- and:[(self isValidSelection:next) not ]] whileTrue:[
- next := next + 1
- ].
- ].
- ].
-
- (self isValidSelection:next) ifFalse:[
- next := nil
- ].
- ^ next
-
- "Modified: / 8.8.1998 / 03:36:55 / cg"
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
- sz := selection size.
- sz > 0 ifTrue:[^ sz].
- ^ 1
-!
-
-previousBeforeSelection
- "return the index of the previous selectable entry before the selection.
- Wrap at beginning."
-
- |prev|
-
- selection isNil ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- selection isCollection ifTrue:[
- selection size == 0 ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- prev := selection min - 1
- ]
- ] ifFalse:[
- prev := selection - 1
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev < 1 ifTrue:[
- prev := self size.
- ] ifFalse:[
- [prev >= 1
- and:[(self isValidSelection:prev) not]] whileTrue:[
- prev := prev - 1
- ].
- ].
- ].
- (self isValidSelection:prev) ifFalse:[
- prev := nil
- ].
- ^ prev
-
-!
-
-selectAll
- "select all entries.
- Model and/or actionBlock notification IS done."
-
- |oldSelection|
-
- multipleSelectOk ifTrue:[
- oldSelection := selection.
- selection := OrderedCollection withAll:(1 to:self size).
- self invalidate.
- self selectionChangedFrom:oldSelection.
- ]
-
- "Modified: 15.11.1996 / 17:00:26 / cg"
-!
-
-selectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible.
- Model and/or actionBlock notification IS done."
-
- |lineNo|
-
- list notNil ifTrue:[
- items notNil ifTrue:[
- lineNo := items indexOf:anObject ifAbsent:nil
- ] ifFalse:[
- lineNo := list indexOf:(anObject printString) ifAbsent:nil.
- ].
- lineNo notNil ifTrue:[self selection:lineNo]
- ]
-
- "Modified: 15.11.1996 / 17:01:05 / cg"
-!
-
-selectElementWithoutScroll:anObject
- "select the element with same printString as the argument, anObject.
- Do not scroll.
- *** No model and/or actionBlock notification is done here."
-
- |lineNo|
-
- list notNil ifTrue:[
- items notNil ifTrue:[
- lineNo := items indexOf:anObject ifAbsent:nil
- ] ifFalse:[
- lineNo := list indexOf:(anObject printString) ifAbsent:nil.
- ].
- lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
- ]
-
- "Modified: 15.11.1996 / 17:01:17 / cg"
-!
-
-selectNext
- "select next line or first visible if there is currrently no selection.
- Wrap at end.
- Model and/or actionBlock notification IS done."
-
- self selection:(self nextAfterSelection)
-
- "Modified: 15.11.1996 / 17:01:27 / cg"
-!
-
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
- Wrap at beginning.
- Model and/or actionBlock notification IS done."
-
- self selection:(self previousBeforeSelection).
-
- "Modified: 26.9.1995 / 09:41:16 / stefan"
- "Modified: 15.11.1996 / 17:01:34 / cg"
-!
-
-selectWithoutScroll:aNumberOrNilOrCollection
- "select line, aNumber or deselect if argument is nil.
- *** No model and/or actionBlock notification is done here."
-
- |prevSelection newSelection|
-
- newSelection := aNumberOrNilOrCollection.
- newSelection notNil ifTrue:[
- (self isValidSelection:newSelection) ifFalse:[
- newSelection := nil
- ].
- newSelection == 0 ifTrue:[
- newSelection := nil
- ] ifFalse:[
- (newSelection isCollection
- and:[newSelection size == 0]) ifTrue:[
- newSelection := nil
- ]
- ].
-
- newSelection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- newSelection isCollection ifFalse:[
- newSelection := OrderedCollection with:newSelection
- ]
- ]
- ].
- ].
-
- (newSelection = selection) ifTrue: [^ self].
-
- "
- redraw old selection unhighlighted
- "
- selection notNil ifTrue: [
- prevSelection := selection.
- selection := nil.
- multipleSelectOk ifTrue:[
- prevSelection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:prevSelection
- ]
- ].
-
- selection := newSelection.
-
- "
- redraw new selection unhighlighted
- "
- newSelection notNil ifTrue:[
- multipleSelectOk ifTrue:[
-"/ newSelection isCollection ifFalse:[
-"/ selection := OrderedCollection with:newSelection.
-"/ ].
- selection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:selection
- ]
- ]
-
- "Modified: 15.11.1996 / 16:58:46 / cg"
-!
-
-selection
- "return the selection index or collection of indices (if multipleSelect is on)"
-
- ^ selection
-!
-
-selection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible.
- The model and/or actionBlock IS notified."
-
- |oldSelection|
-
- oldSelection := selection.
- self setSelection:aNumberOrNil.
- selection ~= oldSelection ifTrue:[
- self selectionChangedFrom:oldSelection
- ]
-
- "Modified: / 7.8.1998 / 13:36:34 / cg"
-!
-
-selectionAsCollection
- "return the selection as a collection of line numbers.
- This allows users of this class to enumerate independent of
- the multipleSelect style."
-
- selection isNil ifTrue:[^ #()].
-
-"/ multipleSelectOk ifTrue:[
-"/ ^ (OrderedCollection new) add:selection; yourself.
-"/ ].
- multipleSelectOk ifFalse:[
- ^ (OrderedCollection new) add:selection; yourself.
- ].
- ^ selection
-!
-
-selectionChangedFrom:oldSelection
- "selection has changed. Call actionblock and/or send changeMessage if defined"
-
- |changeArg actionArg nA|
-
- changeArg := actionArg := self argForChangeMessage.
-
- "/
- "/ the MVC way of doing things - notify model via changeMsg
- "/
- multipleSelectOk ifFalse:[
- "/ ST80 sends 0 as index, if the same selection is reselected ...
- selection == oldSelection ifTrue:[
- changeArg := 0
- ].
- ].
- self sendChangeMessageWith:changeArg.
-
- "/
- "/ the ST/X way of doing things - perform the actionBlock
- "/
- actionBlock notNil ifTrue:[
- (actionBlock numArgs) == 1 ifTrue:[
- actionBlock value:actionArg
- ] ifFalse:[
- actionBlock value
- ]
- ].
-
- "Modified: 14.2.1997 / 16:49:09 / cg"
-!
-
-selectionDo:aBlock
- "perform aBlock for each nr in the selection.
- For single selection, it is called once for the items nr.
- For multiple selections, it is called for each."
-
- selection notNil ifTrue:[
- multipleSelectOk ifTrue:[
- selection do:aBlock
- ] ifFalse:[
- aBlock value:selection
- ].
- ].
-
-!
-
-selectionValue
- "return the selection value i.e. the text in the selected line.
- For multiple selections a collection containing the entries is returned."
-
- multipleSelectOk ifTrue:[
- selection isNil ifTrue:[^ #()].
- ^ selection collect:[:nr | self at:nr]
- ].
- selection isNil ifTrue:[^ nil].
- ^ self at:selection
-!
-
-selectionValueAsCollection
- "return the selection values as a collection - allows selectionValues to
- be enumerated independent of the multiSelect settings"
-
- selection isNil ifTrue:[^ #()].
- multipleSelectOk ifTrue:[
- ^ selection collect:[:nr | self at:nr]
- ].
- ^ Array with:(self at:selection)
-!
-
-setSelectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible.
- *** No model and/or actionBlock notification is done here."
-
- |size lineNo coll|
-
- list isNil ifTrue:[
- ^ self
- ].
-
- multipleSelectOk ifTrue:[
- (size := anObject size) == 0 ifTrue:[
- ^ self setSelection:nil
- ].
- coll := OrderedCollection new:size.
-
- anObject do:[:o|
- items notNil ifTrue:[
- lineNo := items indexOf:o ifAbsent:nil.
- ] ifFalse:[
- lineNo := list indexOf:(o printString) ifAbsent:nil
- ].
- lineNo notNil ifTrue:[
- coll add:lineNo
- ]
- ].
- ^ self setSelection:coll
- ].
-
- items notNil ifTrue:[
- lineNo := items indexOf:anObject ifAbsent:nil
- ] ifFalse:[
- lineNo := list indexOf:(anObject printString) ifAbsent:nil.
- ].
- lineNo notNil ifTrue:[self setSelection:lineNo].
-!
-
-setSelection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible.
- *** No model and/or actionBlock notification is done here."
-
- self selectWithoutScroll:aNumberOrNil.
- selection notNil ifTrue:[
- self makeSelectionVisible
- ]
-
- "Created: / 25.5.1996 / 12:23:18 / cg"
- "Modified: / 7.8.1998 / 13:36:42 / cg"
-!
-
-toggleSelection:aNumber
- "toggle selection-state of entry, aNumber.
- *** No model and/or actionBlock notification is done here."
-
- (self isInSelection:aNumber) ifTrue:[
- self removeFromSelection:aNumber
- ] ifFalse:[
- self addToSelection:aNumber
- ]
-
- "Modified: 15.11.1996 / 17:02:08 / cg"
-!
-
-valueIsInSelection:someString
- "return true, if someString is in the selection"
-
- |sel|
-
- selection isNil ifTrue:[^ false].
- sel := self selectionValue.
- self numberOfSelections > 1 ifTrue:[
- ^ (sel includes:someString)
- ].
- ^ (someString = sel)
-! !
-
-!SelectionInListView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.150 1999-08-18 14:36:27 cg Exp $'
-! !
--- a/TextColl.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,745 +0,0 @@
-"
- 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.
-"
-
-EditTextView subclass:#TextCollector
- instanceVariableNames:'entryStream lineLimit destroyAction outstandingLines
- outstandingLine flushBlock flushPending inFlush collecting
- timeDelay access currentEmphasis alwaysAppendAtEnd collectSize'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Text'
-!
-
-!TextCollector 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.
-"
-!
-
-documentation
-"
- a view for editable text, which also understands some stream messages.
- Instances of this view can take the place of a stream and display the
- received text.
- Its main use in the system is the Transcript, but it can also be used for
- things like trace-windows, errorLogs etc.
-
- If collecting is turned on, a textcollector will not immediately display
- entered text, but wait for some short time (timeDelay) and collect incoming
- data - finally updating the whole chunk in one piece.
- This helps slow display devices, which would otherwise scroll a lot.
- (on fast displays this is less of a problem).
-
- The total number of lines kept is controlled by lineLimit, if more lines
- than this limit are added at the bottom, the textcollector will forget lines
- at the top.
- You can set linelimit to nil (i.e. no limit), but you may need a lot
- of memory then ...
-
- [StyleSheet paramters (transcript only):]
-
- transcriptForegroundColor defaults to textForegroundColor
- transcriptBackgroundColor' defaults to textBackgroundColor.
-
- transcriptCursorForegroundColor
- transcriptCursorBackgroundColor
-
- [author:]
- Claus Gittinger
-
- [see also:]
- CodeView EditTextView
- ActorStream
-"
-! !
-
-!TextCollector class methodsFor:'instance creation'!
-
-newTranscript
- "create and open a new transcript.
- This is a leftOver method from times were the Launcher & Transcript
- were two different views. It is no longer recommended."
-
- |topView transcript defSz f v lines cols|
-
- topView := StandardSystemView label:'Transcript' "minExtent:(100 @ 100)".
-
- v := HVScrollableView for:self miniScrollerH:true miniScrollerV:false in:topView.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- transcript := v scrolledView.
- "transcript partialLines:false."
-
- f := transcript font.
-
- "
- should add the height of the frame & scrollbars to be exact ...
- "
- defSz := self defaultTranscriptSize.
- cols := defSz x.
- lines := defSz y.
- topView extent:(((f widthOf:'x') * cols) @ (f height * lines)).
-
- transcript beTranscript.
-
- "
- run it at a slightly higher prio, to allow for
- delayed buffered updates to be performed
- "
- topView openWithPriority:(Processor userSchedulingPriority + 1).
-
- ^ transcript
-
- "
- TextCollector newTranscript.
- Transcript lineLimit:3000.
- "
-
- "Modified: 17.2.1997 / 18:20:27 / cg"
-! !
-
-!TextCollector class methodsFor:'defaults'!
-
-defaultCollectSize
- "the number of lines buffered for delayed update"
-
- ^ 50
-
- "Modified: / 27.7.1998 / 16:14:51 / cg"
-!
-
-defaultLineLimit
- "the number of lines remembered by default"
-
- ^ 600
-!
-
-defaultTimeDelay
- "the time in seconds to wait & collect by default"
-
- ^ 0.3
-!
-
-defaultTranscriptSize
- "the number of cols/lines by which the Transcript should come up"
-
- ^ 70@11
-! !
-
-!TextCollector methodsFor:'ST-80 compatibility'!
-
-deselect
- self unselect
-!
-
-flush
- self endEntry.
- super flush
-! !
-
-!TextCollector methodsFor:'accessing'!
-
-beginEntry
- "noop for now, ST80 compatibility"
-
- ^ self
-
- "Created: / 4.3.1998 / 11:08:14 / stefan"
-!
-
-collect:aBoolean
- "turn on/off collecting - if on, do not output immediately
- but collect text and output en-bloque after some time delta"
-
- collecting := aBoolean
-!
-
-collectSize:numberOfLines
- "set the collect buffer size. If collect is enabled,
- the receiver will force update of the view,
- whenever that many lines have been collected
- (or the updateTimeDelay interval has passed).
- With collect turned off, an immediate update is performed."
-
- collectSize := numberOfLines
-
- "Modified: / 27.7.1998 / 16:16:00 / cg"
-!
-
-destroyAction:aBlock
- "define the action to be performed when I get destroyed.
- This is a special feature, to allow resetting Transcript to Stderr
- when closed. (see TextCollectorclass>>newTranscript)"
-
- destroyAction := aBlock
-!
-
-endEntry
- "flush collected output; displaying all that has been buffered so far"
-
- |nLines lines|
-
- shown ifFalse:[
- "/ when iconified or not yet shown, keep
- "/ collecting. But not too much ...
- outstandingLines size < 300 ifTrue:[
- flushPending ifFalse:[
- self installDelayedUpdate.
- ].
- ^ self
- ]
- ].
-
- inFlush ifTrue:[^ self].
- flushBlock notNil ifTrue:[
- Processor removeTimedBlock:flushBlock.
- ].
- flushPending ifFalse:[^ self].
-
- access critical:[
- inFlush := true.
- [
- flushPending := false.
- outstandingLines size ~~ 0 ifTrue:[
- "insert the bunch of lines - if any"
- lines := outstandingLines.
- outstandingLines := nil.
-
- nLines := lines size.
- (nLines ~~ 0) ifTrue:[
- insertMode ifTrue:[
- self insertLines:lines withCR:true.
- ] ifFalse:[
- self replaceLines:lines withCR:true
- ].
- alwaysAppendAtEnd ifTrue:[
- self cursorToEnd.
- ].
- self withCursorOffDo:[
- (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[
- self scrollDown:nLines
- ]
- ].
- ].
- ].
-
- "and the last partial line - if any"
- outstandingLine size > 0 ifTrue:[
- insertMode ifTrue:[
- self insertStringAtCursor:outstandingLine.
- ] ifFalse:[
- self replaceStringAtCursor:outstandingLine.
- ].
- outstandingLine := ''.
- ].
- self checkLineLimit.
- device flush.
- ] valueNowOrOnUnwindDo:[
- inFlush := false.
- ]
- ].
- flushPending ifTrue:[
- flushPending := false.
- self installDelayedUpdate
- ]
-
- "Modified: / 9.11.1998 / 21:17:56 / cg"
-!
-
-lineLimit:aNumber
- "define the number of text-lines I am supposed to hold"
-
- lineLimit := aNumber
-
- "
- Transcript lineLimit:5000
- "
-
- "Modified: / 16.5.1998 / 01:33:52 / cg"
-!
-
-updateTimeDelay:seconds
- "if collect is enabled, the receiver will update its view,
- after that time delay (i.e. it collects more output during that period),
- or when collectSize lines have been collected without update.
- With collect turned off, an immediate update is performed."
-
- timeDelay := seconds
-
- "Modified: / 27.7.1998 / 16:16:41 / cg"
-! !
-
-!TextCollector methodsFor:'change & update'!
-
-getListFromModel
- "a textCollector always scrolls to the bottom"
-
- super getListFromModel.
- self scrollToBottom
-
- "Created: 12.2.1996 / 14:27:56 / stefan"
- "Modified: 11.1.1997 / 14:41:50 / cg"
-! !
-
-!TextCollector methodsFor:'events'!
-
-exposeX:x y:y width:w height:h
- "flush buffered text when exposed"
-
- super exposeX:x y:y width:w height:h.
- self endEntry
-! !
-
-!TextCollector methodsFor:'initialize / release'!
-
-destroy
- "destroy this view"
-
- destroyAction notNil ifTrue:[
- destroyAction value
- ].
- flushBlock notNil ifTrue:[
- Processor removeTimedBlock:flushBlock.
- ].
- flushBlock := nil.
- outstandingLines := nil.
- outstandingLine := ''.
-
- super destroy
-
- "Modified: / 9.11.1998 / 21:18:17 / cg"
-!
-
-editMenu
- "return my popUpMenu; thats the superClasses menu,
- minus any accept item."
-
- <resource: #programMenu>
-
- |m idx|
-
- m := super editMenu.
-
- "
- textcollectors do not support #accept
- remove it from the menu (and the preceeding separating line)
- "
- idx := m indexOf:#accept.
- idx ~~ 0 ifTrue:[
- m remove:idx.
- (m labels at:(idx - 1)) = '-' ifTrue:[
- m remove:idx - 1
- ].
- ].
- ^ m
-
- "Modified: 3.7.1997 / 13:54:11 / cg"
-!
-
-initialize
- super initialize.
-
- outstandingLines := nil.
- alwaysAppendAtEnd := true.
- collectSize := self class defaultCollectSize.
-
- flushPending := inFlush := false.
- collecting := true.
- timeDelay := self class defaultTimeDelay.
- access := RecursionLock new. "/ Semaphore forMutualExclusion.
-
- lineLimit := self class defaultLineLimit.
- entryStream := ActorStream new.
- entryStream nextPutBlock:[:something | self nextPut:something].
- entryStream nextPutAllBlock:[:something | self nextPutAll:something]
-
- "Modified: / 9.11.1998 / 14:33:46 / cg"
-!
-
-mapped
- "view became visible - show collected lines (if any)"
-
- super mapped.
- self endEntry
-!
-
-reinitialize
- "recreate access-semaphore; image could have been save (theoretically)
- with the semaphore locked - in this case, we had a deadlock"
-
- flushPending := false.
- access := RecursionLock new. "/ Semaphore forMutualExclusion.
- super reinitialize.
-
- "Modified: / 5.3.1998 / 10:09:14 / stefan"
-! !
-
-!TextCollector methodsFor:'private'!
-
-checkLineLimit
- "this method checks if the text has become too large (> lineLimit)
- and cuts off some lines at the top if so; it must be called whenever lines
- have been added to the bottom"
-
- |nDel|
-
- lineLimit notNil ifTrue:[
- (cursorLine > lineLimit) ifTrue:[
- nDel := list size - lineLimit.
- list removeFromIndex:1 toIndex:nDel.
- cursorLine := cursorLine - nDel.
- firstLineShown := firstLineShown - nDel.
- (firstLineShown < 1) ifTrue:[
- cursorLine := cursorLine - firstLineShown + 1.
- firstLineShown := 1
- ].
- self contentsChanged
- ]
- ]
-!
-
-installDelayedUpdate
- "arrange for collecting input for some time,
- and output all buffered strings at once after a while.
- This makes output to the transcript much faster on systems
- with poor scrolling performance (i.e. dumb vga cards ...)."
-
- |p|
-
- flushPending ifFalse:[
- flushPending := true.
- inFlush ifFalse:[
- "
- we could run under a process, which dies in the meantime;
- therefore, we have to arrange for the transcript process to
- be interrupted and do the update.
- "
- windowGroup isNil ifTrue:[
- p := Processor activeProcess
- ] ifFalse:[
- p := windowGroup process
- ].
- (p isNil or:[p isSystemProcess]) ifTrue:[
- self endEntry
- ] ifFalse:[
- flushBlock isNil ifTrue:[
- flushBlock := [self endEntry].
- ].
- Processor addTimedBlock:flushBlock for:p afterSeconds:timeDelay.
- ]
- ]
- ]
-
- "Modified: / 17.4.1997 / 13:03:15 / stefan"
- "Modified: / 9.11.1998 / 14:34:07 / cg"
-! !
-
-!TextCollector methodsFor:'queries'!
-
-current
- "return the current (your screens) transcript.
- In multiDisplay applications, this need NOT be the main transcript.
- But typically, this is the same as Transcript."
-
- ^ (self topView application class current transcript ? Stderr)
-
- "
- Transcript current flash
- "
-
- "Created: 5.7.1996 / 14:14:34 / cg"
- "Modified: 5.7.1996 / 14:14:52 / cg"
-! !
-
-!TextCollector methodsFor:'stream messages'!
-
-cr
- "output a carriage return, finishing the current line"
-
- access critical:[
- collecting ifTrue:[
- outstandingLine notNil ifTrue:[ "/ mhmh - is never nil
- outstandingLines isNil ifTrue:[
- outstandingLines := OrderedCollection with:outstandingLine
- ] ifFalse:[
- outstandingLines add:outstandingLine.
- ]
- ].
- outstandingLine := ''.
- ] ifFalse:[
- self cursorReturn.
- self checkLineLimit.
- self cursorToEnd.
- ].
- ].
-
- collecting ifTrue:[
- flushPending ifFalse:[
- self installDelayedUpdate
- ]
- ]
-
- "Modified: 11.1.1997 / 14:39:00 / cg"
-!
-
-doesNotUnderstand:aMessage
- "this is funny: all message we do not understand, are passed
- on to the stream which will send the characters via nextPut:
- This way, we understand all Stream messages - great isn't it !!
- "
- ^ entryStream perform:(aMessage selector) withArguments:(aMessage arguments)
-!
-
-lineLength
- "to make a textCollector (somewhat) compatible with printer
- streams, support the lineLength query"
-
- ^ width // (font width)
-
- "Modified: 11.1.1997 / 14:42:41 / cg"
-!
-
-nextPut:something
- "append somethings printString to my displayed text.
- This allows TextCollectors to be used Stream-wise"
-
- |txt|
-
- (something isCharacter) ifTrue:[
- ((something == Character cr) or:[something == Character nl]) ifTrue:[
- ^ self cr
- ].
- ].
-
- txt := something asString.
- currentEmphasis notNil ifTrue:[
- txt := txt emphasizeAllWith:currentEmphasis
- ].
- self show:txt.
-
-"/ flushPending ifTrue:[
-"/ self endEntry
-"/ ].
-"/ (something isMemberOf:Character) ifTrue:[
-"/ ((something == Character cr) or:[something == Character nl]) ifTrue:[
-"/ ^ self cr
-"/ ].
-"/ self insertCharAtCursor:something
-"/ ] ifFalse:[
-"/ self insertStringAtCursor:(something printString).
-"/ self checkLineLimit
-"/ ].
-"/ device flush
-
- "Modified: 11.1.1997 / 14:43:05 / cg"
-!
-
-nextPutAll:something
- "append all of something to my displayed text.
- This allows TextCollectors to be used Stream-wise"
-
- currentEmphasis notNil ifTrue:[
- ^ self show:(something emphasizeAllWith:currentEmphasis)
- ].
- ^ self show:something
-
- "Modified: 11.1.1997 / 14:43:26 / cg"
-!
-
-show:anObject
- "insert the argument aString at current cursor position"
-
- |aString lines|
-
- aString := anObject printString.
-
- (aString includes:(Character cr)) ifTrue:[
- lines := aString asStringCollection.
- lines keysAndValuesDo:[:nr :line |
- (nr == lines size
- and:[(aString endsWith:(Character cr)) not]) ifTrue:[
- "/ the last one.
- self show:line
- ] ifFalse:[
- self showCR:line
- ].
- ].
- ^ self.
- ].
-
- access critical:[
- outstandingLine size > 0 ifTrue:[
- outstandingLine := outstandingLine , aString
- ] ifFalse:[
- outstandingLine := aString
- ].
- collecting ifTrue:[
- flushPending ifFalse:[
- self installDelayedUpdate
- ] ifTrue:[
- outstandingLines size > collectSize ifTrue:[
- self endEntry
- ]
- ]
- ] ifFalse:[
- self endEntry
- ]
- ].
-
- "Modified: / 10.6.1998 / 19:34:25 / cg"
-!
-
-showCR:anObject
- "insert the argument aString at current cursor position,
- and advance to the next line. This is the same as a #show:
- followed by a #cr."
-
- |aString lines|
-
- aString := anObject printString.
- aString size == 0 ifTrue:[
- ^ self cr
- ].
-
- (aString includes:(Character cr)) ifTrue:[
- lines := aString asStringCollection.
- lines keysAndValuesDo:[:nr :line |
- (nr == lines size
- and:[(aString endsWith:(Character cr)) not]) ifTrue:[
- "/ the last one.
- self show:line
- ] ifFalse:[
- self showCR:line
- ].
- ].
- ^ self.
- ].
-
- access critical:[
- outstandingLine size > 0 ifTrue:[
- outstandingLine := outstandingLine , aString
- ] ifFalse:[
- outstandingLine := aString
- ].
- collecting ifTrue:[
- outstandingLines isNil ifTrue:[
- outstandingLines := OrderedCollection with:outstandingLine
- ] ifFalse:[
- outstandingLines add:outstandingLine.
- ].
- outstandingLine := ''.
-
- flushPending ifFalse:[
- self installDelayedUpdate
- ] ifTrue:[
- outstandingLines size > collectSize ifTrue:[
- self endEntry
- ]
- ]
- ] ifFalse:[
- self endEntry.
- self cursorReturn.
- self checkLineLimit.
- self cursorToEnd.
- ]
- ].
-
- "Created: / 28.7.1998 / 00:31:46 / cg"
- "Modified: / 28.7.1998 / 00:34:58 / cg"
-! !
-
-!TextCollector methodsFor:'stream messages - emphasis'!
-
-bold
- currentEmphasis := #bold
-
- "Modified: / 26.3.1999 / 14:28:58 / cg"
-!
-
-color:aColor
- currentEmphasis := #color->aColor
-
- "Modified: / 26.3.1999 / 14:29:21 / cg"
-!
-
-italic
- currentEmphasis := #italic
-!
-
-normal
- currentEmphasis := nil
-!
-
-reverse
- currentEmphasis := Array with:#color->bgColor
- with:#backgroundColor->fgColor.
-
- "Created: / 20.6.1998 / 20:10:45 / cg"
-!
-
-underline
- currentEmphasis := #underline
-
- "Created: / 26.3.1999 / 14:27:07 / cg"
-! !
-
-!TextCollector methodsFor:'transcript specials'!
-
-beTranscript
- "make the receiver be the systemTranscript; this one
- is accessable via the global Transcript and gets relevant
- system messages from various places."
-
- |fg bg cFg cBg|
-
- Smalltalk at:#Transcript put:self.
-
- "
- fancy feature: whenever Transcript is closed, reset to StdError
- "
- self destroyAction:[
- self == (Smalltalk at:#Transcript) ifTrue:[
- Smalltalk at:#Transcript put:Stderr
- ]
- ].
-
- "/ user may prefer a special color for this one;
- "/ look into the style definitions ...
-
- fg := styleSheet colorAt:'transcript.foregroundColor' default:self foregroundColor.
- bg := styleSheet colorAt:'transcript.backgroundColor' default:self backgroundColor.
- self foregroundColor:fg backgroundColor:bg.
- self viewBackground:bg.
-
- cFg := styleSheet colorAt:'transcript.cursorForegroundColor' default:bg.
- cBg := styleSheet colorAt:'transcript.cursorBackgroundColor' default:fg.
- self cursorForegroundColor:cFg backgroundColor:cBg.
-
- "self lineLimit:1000. " "or whatever you think makes sense"
-
- "Modified: / 2.11.1997 / 22:34:47 / cg"
-! !
-
-!TextCollector class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.58 1999-08-02 10:14:17 tm Exp $'
-! !
--- a/VPanelV.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1058 +0,0 @@
-"
- 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.
-"
-
-PanelView subclass:#VerticalPanelView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
-!
-
-!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.
-"
-!
-
-documentation
-"
- a View which arranges its child-views in a vertical column.
- All real work is done in PanelView - except the layout computation is
- redefined here.
-
- The layout is controlled by the instance variables:
- horizontalLayout and verticalLayout
- in addition to
- horizontalSpace and verticalSpace.
-
- The vertical layout can be any of:
-
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but resize the last element to fit
- #topSpaceFit like #topSpace, but resize the last element to fit
- #bottomFit like #bottom, but resize the first element to fit
- #bottomSpaceFit like #bottomSpace, but resize the first element to fit
-
- the horizontal layout can be:
-
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
-
- The defaults is #center for both directions.
-
- The layout is changed by the messages #verticalLayout: and #horizontalLayout:.
- For backward compatibility (to times, where only vLayout existed), the simple
- #layout: does the same as #verticalLayout:. Do not use this old method.
-
- The panel assumes, that the elements do not resize themselfes, after it
- became visible. This is not true for all widgets (buttons or labels may
- like to change). If you have changing elements, tell this to the panel
- with 'aPanel elementsChangeSize:true'. In that case, the panel will react
- to size changes, and reorganize things.
-
- If none of these layout/space combinations is exactly what you need in
- your application, create a subclass, and redefine the setChildPositions method.
-
- CAVEAT: this class started with #top and no horizontal alignments;
- as time went by, more layouts were added and the setup should be changed
- to use different selectors for space, max-resize and alignment
- (i.e. having more and more layout symbols makes things a bit confusing ...)
-
- [see also:]
- HorizontalPanelView
- VariableVerticalPanel VariableHorizontalPanel
- Label
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- These examples demonstrate the effect of different layout
- settings.
- You should try more examples, combining spacing and different
- verticalLayout:/horizontalLayout: combinations.
-
-
- example: default layout (centered)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'center (default)'.
- p := VerticalPanelView in:v.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'butt3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
-
- example: horizontal centerMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'hL=centerMax'.
- p := VerticalPanelView in:v.
- p horizontalLayout:#centerMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'butt3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
-
- example: horizontal leftMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'hL=leftMax'.
- p := VerticalPanelView in:v.
- p horizontalLayout:#leftMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'butt3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: horizontal leftSpaceMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'hL=leftMax'.
- p := VerticalPanelView in:v.
- p horizontalLayout:#leftSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'butt3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: horizontal rightMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'hL=rightMax'.
- p := VerticalPanelView in:v.
- p horizontalLayout:#rightMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'butt3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: horizontal rightSpaceMax
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'hL=rightMaxSpace'.
- p := VerticalPanelView in:v.
- p horizontalLayout:#rightSpaceMax.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'b2' in:p.
- b3 := Button label:'butt3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: top-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=top; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: topSpace-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=topSpace; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#topSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: top-layout; horizontal fit
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- p := VerticalPanelView in:v.
- v label:'vL=top; hL=fit'.
- p verticalLayout:#top.
- p horizontalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: top-layout; horizontal fit with space
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=top; hL=fitSpace'.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: topSpace-layout; horizontal fit with space
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=topSpace; hL=fitSpace'.
- p := VerticalPanelView in:v.
- p verticalLayout:#topSpace.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: bottom-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=bottom; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottom.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: bottomSpace-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=bottomSpace; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottomSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: topFit-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=topFit; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#topFit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: topSpaceFit-layout; combined with horizontal #fitSpace
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=topFit; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#topSpaceFit.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: bottomFit-layout (arrange at bottom; resize first to fit)
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=bottomFit; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottomFit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: bottomSpaceFit-layout (arrange at bottom; resize first to fit; with spacing
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=bottomSpaceFit; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#bottomSpaceFit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: spread-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=spread; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#spread.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: spreadSpace-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=spreadSpace; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#spreadSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: fit-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=fit; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#fit.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: fitSpace-layout
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=fitSpace; hL=center (default)'.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: fully fitSpace
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=fitSpace; hL=fitSpace'.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: combine fully fitSpace with scaling button labels
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=fitSpace; hL=fitSpace'.
- p := VerticalPanelView in:v.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fitSpace.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b1 adjust:#fit.
- b2 := Button label:'butt2' in:p.
- b2 adjust:#fit.
- b3 := Button label:'button3' in:p.
- b3 adjust:#fit.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: from top, each at left:
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=top; hL=left'.
- p := VerticalPanelView in:v.
- p verticalLayout:#top.
- p horizontalLayout:#left.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: center, right:
- [exBegin]
- |v p b1 b2 b3|
-
- v := StandardSystemView new.
- v label:'vL=center; hL=right'.
- p := VerticalPanelView in:v.
- p verticalLayout:#center.
- p horizontalLayout:#right.
- p origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- b1 := Button label:'button1' in:p.
- b2 := Button label:'butt2' in:p.
- b3 := Button label:'button3' in:p.
- v extent:100 @ 300.
- v open
- [exEnd]
-
- example: a panel in a panel
- [exBegin]
- |v hp p b1 b2 b3|
-
- v := StandardSystemView new.
-
- hp := HorizontalPanelView in:v.
- hp verticalLayout:#fit.
- hp horizontalLayout:#fitSpace.
- hp origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
-
- 1 to:3 do:[:i |
- p := VerticalPanelView in:hp.
- p borderWidth:0.
- p verticalLayout:#fitSpace.
- p horizontalLayout:#fit.
- b1 := Button label:('button1-' , i printString) in:p.
- b2 := Button label:('butt2-' , i printString) in:p.
- b3 := Button label:('button3-' , i printString) in:p.
- ].
-
- v extent:300 @ 100.
- v open
- [exEnd]
-
- example: checkToggles in a panel
- [exBegin]
- |panel|
-
- panel := VerticalPanelView new.
- panel horizontalLayout:#left.
-
- panel add:((CheckBox on:true asValue) label:'this is toggle number 1'; resize).
- panel add:((CheckBox on:false asValue) label:'nr 2 '; resize).
- panel add:((CheckBox on:true asValue) label:'number 3 '; resize).
-
- panel extent:(panel preferredExtent).
- panel open
- [exEnd]
- example: the topFit & bottomFit layouts are great to combine
- labels or enterFields with a selectionInList or textView:
- [exBegin]
- |panel|
-
- panel := VerticalPanelView new.
- panel horizontalLayout:#fit.
- panel verticalLayout:#topFit.
-
- panel add:(Label new label:'this is label number 1'; font:(Font family:'courier' size:16)).
- panel add:(EditField new).
- panel add:(Label new label:'this is label number 1').
- panel add:(ScrollableView for:SelectionInListView).
-
- panel extent:(panel preferredExtent).
- panel open
- [exEnd]
-"
-! !
-
-!VerticalPanelView methodsFor:'accessing'!
-
-horizontalLayout
- "return the horizontal layout as symbol.
- the returned value is one of
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
- the default is #centered
- "
-
- ^ hLayout
-!
-
-horizontalLayout:aSymbol
- "change the horizontal layout as symbol.
- The argument, aSymbol must be one of:
- #left place element at the left
- #leftSpace place element at the left, offset by horizontalSpace
- #center place elements horizontally centered; ignore horizontalSpace
- #right place it at the right
- #rightSpace place it at the right, offset by horizontalSpace
- #fit resize elements horizontally to fit this panel; ignore horizontalSpace
- #fitSpace like #fit, but add spacing; ignore horizontalSpace
-
- #leftMax like #left, but resize elements to max of them
- #leftSpaceMax like #leftSpace, but resize elements
- #centerMax like #center, but resize elements
- #rightMax like #right, but resize elements to max of them
- #rightSpaceMax like #rightSpace, but resize elements
- the default (if never changed) is #centered
- "
-
- (hLayout ~~ aSymbol) ifTrue:[
- hLayout := aSymbol.
- self layoutChanged
- ]
-!
-
-layout:something
- "OBSOLETE compatibility interface. Will vanish.
- leftover for historic reasons - do not use any more.
- In the meantime, try to figure out what is meant ... a kludge"
-
- something isLayout ifTrue:[^ super layout:something].
-
- self obsoleteMethodWarning:'use #verticalLayout:'.
- ^ self verticalLayout:something
-
- "Modified: 31.8.1995 / 23:08:54 / claus"
-!
-
-verticalLayout
- "return the vertical layout as a symbol.
- the returned value is one of
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but resize the last element to fit
- #topSpaceFit like #topSpace, but resize the last element to fit
- #bottomFit like #bottom, but resize the first element to fit
- #bottomSpaceFit like #bottomSpace, but extend the first element to fit
- the default is #centered
- "
-
- ^ vLayout
-
- "Modified: 17.8.1997 / 15:20:13 / cg"
-!
-
-verticalLayout:aSymbol
- "change the vertical layout as a symbol.
- The argument, aSymbol must be one of:
- #top arrange elements at the top
- #topSpace arrange elements at the top, start with spacing
- #bottom arrange elements at the bottom
- #bottomSpace arrange elements at the bottom, start with spacing
- #center arrange elements in the center; ignore verticalSpace
- #spread spread elements evenly; ignore verticalSpace
- #spreadSpace spread elements evenly with spacing at ends; ignore verticalSpace
- #fit like #spread, but resize elements for tight packing; ignore verticalSpace
- #fitSpace like #fit, with spacing; ignore verticalSpace
- #topFit like #top, but resize the last element to fit
- #topSpaceFit like #topSpace, but resize the last element to fit
- #bottomFit like #bottom, but resize the first element to fit
- #bottomSpaceFit like #bottomSpace, but extend the first element to fit
- the default (if never changed) is #centered
- "
-
- (vLayout ~~ aSymbol) ifTrue:[
- vLayout := aSymbol.
- self layoutChanged
- ]
-
- "Modified: 17.8.1997 / 15:19:58 / cg"
-! !
-
-!VerticalPanelView methodsFor:'layout'!
-
-setChildPositions
- "(re)compute position of every child"
-
- |ypos space sumOfHeights numChilds l hEach hInside hL vL
- maxWidth maxHeight resizeToMaxV resizeToMaxH m2 subViews ext restHeight|
-
- subViews := self subViewsToConsider.
- subViews size == 0 ifTrue:[^ self].
-
- extentChanged ifTrue:[
- ext := self computeExtent.
- width := ext x.
- height := ext y.
- ].
-
- space := verticalSpace.
- numChilds := subViews size.
-
- m2 := margin * 2.
- hInside := height - m2 + (borderWidth*2) - subViews last borderWidth.
-
- hL := hLayout.
- vL := vLayout.
-
- resizeToMaxV := false.
- (vL endsWith:'Max') ifTrue:[
- resizeToMaxV := true.
- hEach := maxHeight := subViews inject:0 into:[:maxSoFar :child | maxSoFar max:child heightIncludingBorder].
- vL := (vL copyWithoutLast:3) asSymbol.
- ].
-
- numChilds == 1 ifTrue:[
- (vL == #topFit or:[vL == #bottomFit]) ifTrue:[
- vL := #fit
- ].
- (vL == #topSpaceFit or:[vL == #bottomSpaceFit]) ifTrue:[
- vL := #fitSpace
- ].
- ].
-
- vL == #fitSpace ifTrue:[
- "
- adjust childs extents and set origins.
- Be careful to avoid accumulation of rounding errors
- "
- hEach := (hInside - (numChilds + 1 * space)) / numChilds.
- ypos := space + margin - borderWidth.
- ] ifFalse:[
- vL == #fit ifTrue:[
- "
- adjust childs extents and set origins.
- Be careful to avoid accumulation of rounding errors
- "
- hEach := (hInside - (numChilds - 1 * space)) / numChilds.
- ypos := margin - borderWidth.
- ] ifFalse:[
- l := vL.
-
- "/ adjust - do not include height of last(first) element if doing a fit
- (vL == #topFit or:[vL == #topSpaceFit]) ifTrue:[
- subViews last height:0.
- ].
- (vL == #bottomFit or:[vL == #bottomSpaceFit]) ifTrue:[
- subViews first height:0.
- ].
-
- "
- compute net height needed
- "
- resizeToMaxV ifTrue:[
- sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + maxHeight + (child borderWidth*2)].
- ] ifFalse:[
- sumOfHeights := subViews inject:0 into:[:sumSoFar :child | sumSoFar + child heightIncludingBorder].
- ].
-
- restHeight := height - sumOfHeights.
-
- ((l == #center) and:[numChilds == 1]) ifTrue:[l := #spread].
- (l == #spread and:[numChilds == 1]) ifTrue:[l := #spreadSpace].
-
- "
- compute position of topmost subview and space between them;
- if they do hardly fit, leave no space between them
- "
- ((sumOfHeights >= (height - m2))
- and:[l ~~ #fixTopSpace and:[l ~~ #fixTop]]) ifTrue:[
- "
- if we have not enough space for all the elements,
- fill them tight, and show what can be shown (at least)
- "
- ypos := margin.
- space := 0
- ] ifFalse:[
- l == #fixTopSpace ifTrue:[
- l := #topSpace
- ] ifFalse:[
- l == #fixTop ifTrue:[
- l := #top
- ]
- ].
- ((l == #bottom) or:[l == #bottomSpace
- or:[l == #bottomFit or:[l == #bottomSpaceFit]]]) ifTrue:[
- ypos := restHeight - (space * (numChilds - 1)).
-"/
-"/ borderWidth == 0 ifTrue:[
-"/ ypos := ypos + space
-"/ ].
-"/
- (l == #bottomSpace
- or:[l == #bottomSpaceFit]) ifTrue:[
- ypos >= space ifTrue:[
- ypos := ypos - space
- ]
- ].
- ypos := ypos - margin.
-
- ypos < 0 ifTrue:[
- space := space min:(restHeight // (numChilds + 1)).
- ypos := restHeight - (space * numChilds).
- ]
- ] ifFalse: [
- (l == #spread) ifTrue:[
- space := (restHeight - m2) // (numChilds - 1).
- ypos := margin.
- (space == 0) ifTrue:[
- ypos := restHeight // 2
- ]
- ] ifFalse: [
- (l == #spreadSpace) ifTrue:[
- space := (restHeight - m2) // (numChilds + 1).
- ypos := space + margin.
- (space == 0) ifTrue:[
- ypos := restHeight // 2
- ]
- ] ifFalse: [
- ((l == #top) or:[l == #topSpace
- or:[l == #topFit or:[l == #topSpaceFit]]]) ifTrue:[
- space := space min:(restHeight - m2) // (numChilds + 1).
- (vL == #fixTop or:[vL == #fixTopSpace]) ifTrue:[
- space := space max:verticalSpace.
- ] ifFalse:[
- space := space max:0.
- ].
- (l == #topSpace or:[l == #topSpaceFit]) ifTrue:[
- ypos := space + margin.
- ] ifFalse:[
- "/
- "/ if the very first view has a 0-level AND
- "/ my level is non-zero, begin with margin
- "/
- true "(margin ~~ 0 and:[subViews first level == 0])" ifTrue:[
- ypos := margin
- ] ifFalse:[
- ypos := 0
- ]
- ]
- ] ifFalse:[
- "center"
- ypos := (restHeight - ((numChilds - 1) * space)) // 2.
- ypos < 0 ifTrue:[
- space := restHeight // (numChilds + 1).
- ypos := (restHeight - ((numChilds - 1) * space)) // 2.
- ]
- ]
- ]
- ]
- ]
- ].
- ].
- ].
-
- resizeToMaxH := false.
- (hL endsWith:'Max') ifTrue:[
- resizeToMaxH := true.
- maxWidth := subViews inject:0 into:[:maxSoFar :child | maxSoFar max:child widthIncludingBorder].
- hL := (hL copyWithoutLast:3) asSymbol.
- ].
-
- "
- now set positions
- "
- subViews keysAndValuesDo:[:index :child |
- |xpos advance bwChild wChild newWChild x2|
-
- wChild := child widthIncludingBorder.
- bwChild := child borderWidth.
-
- resizeToMaxH ifTrue:[
- child width:(wChild := maxWidth - (bwChild * 2)).
- ].
-
- hL == #left ifTrue:[
- xpos := 0 - borderWidth + margin.
- ] ifFalse:[
- hL == #leftSpace ifTrue:[
- xpos := horizontalSpace + margin
- ] ifFalse:[
- hL == #right ifTrue:[
- xpos := width - wChild - margin
- ] ifFalse:[
- hL == #rightSpace ifTrue:[
- xpos := width - horizontalSpace - wChild - margin.
- ] ifFalse:[
- hL == #fitSpace ifTrue:[
- xpos := horizontalSpace + margin.
- newWChild := width - m2 - (horizontalSpace + bwChild * 2)
- ] ifFalse:[
- hL == #fit ifTrue:[
- newWChild := width "- (bwChild * 2)".
- borderWidth == 0 ifTrue:[
- newWChild := newWChild - (bwChild * 2)
- ].
- true "child level == 0" ifTrue:[
- xpos := margin - borderWidth.
- newWChild := newWChild - m2
- ] ifFalse:[
- xpos := 0 - borderWidth.
- ].
- ] ifFalse:[
- "centered"
- xpos := margin + ((width - m2 - wChild) // 2).
- ]
- ]
- ]
- ]
- ]
- ].
- newWChild notNil ifTrue:[
- child width:newWChild
- ].
-
-"/ (xpos < 0) ifTrue:[ xpos := 0 ].
-
- x2 := xpos + (child widthIncludingBorder - 1).
-
- (vL == #fit
- or:[vL == #fitSpace
- or:[resizeToMaxV]]) ifTrue:[
- child origin:(xpos @ ypos rounded)
- corner:(x2 @ (ypos + hEach - bwChild - 1) rounded).
- advance := hEach
- ] ifFalse:[
- child origin:(xpos@ypos).
- advance := child heightIncludingBorder
- ].
-
- index == numChilds ifTrue:[
- |y|
-
- (vL == #topFit or:[vL == #topSpaceFit]) ifTrue:[
- y := height - margin - 1.
- vL == #topSpaceFit ifTrue:[
- y := y - space
- ].
- child corner:x2 @ y
- ].
- ].
- index == 1 ifTrue:[
- |y yB|
-
- (vL == #bottomFit or:[vL == #bottomSpaceFit]) ifTrue:[
- y := margin + 0 + (child borderWidth * 2) - borderWidth.
- vL == #bottomSpaceFit ifTrue:[
- y := y + space
- ].
- yB := child corner y.
- child origin:((child origin x) @ y)
- corner:((child corner x) @ yB)
- ].
- ].
-
- ypos := ypos + advance + space.
- ]
-
- "Modified: / 4.9.1995 / 18:43:29 / claus"
- "Modified: / 27.1.1998 / 21:14:32 / cg"
-! !
-
-!VerticalPanelView methodsFor:'queries'!
-
-preferredExtent
- "return a good extent, one that makes subviews fit"
-
- |sumOfHeights maxWidth maxHeight m2 subViews|
-
- "/ If I have an explicit preferredExtent ..
-
- preferredExtent notNil ifTrue:[
- ^ preferredExtent
- ].
-
- subViews := self subViewsToConsider.
- (subViews size == 0) ifTrue:[
- ^ super preferredExtent.
- "/ ^ horizontalSpace @ verticalSpace].
- ].
-
-
- "compute net height needed"
-
- sumOfHeights := 0.
- maxWidth := 0.
- maxHeight := 0.
-
- subViews do:[:child |
- |childsPreference|
-
- childsPreference := child preferredExtent.
- sumOfHeights := sumOfHeights + childsPreference y.
- maxHeight := maxHeight max:childsPreference y.
- maxWidth := maxWidth max:childsPreference x.
-
-"/ sumOfHeights := sumOfHeights + child heightIncludingBorder.
-"/ maxWidth := maxWidth max:(child widthIncludingBorder).
-"/ maxHeight := maxHeight max:(child heightIncludingBorder).
- ].
-
- borderWidth ~~ 0 ifTrue:[
- sumOfHeights := sumOfHeights + (verticalSpace * 2).
- maxWidth := maxWidth + (horizontalSpace * 2).
- ].
-
- (vLayout == #fit or:[vLayout == #fitSpace]) ifTrue:[
- sumOfHeights := maxHeight * subViews size.
- borderWidth ~~ 0 ifTrue:[
- sumOfHeights := sumOfHeights + (verticalSpace * 2).
- ]
- ] ifFalse:[
- sumOfHeights := sumOfHeights + ((subViews size - 1) * verticalSpace).
- ((vLayout == #topSpace) or:[vLayout == #bottomSpace]) ifTrue:[
- sumOfHeights := sumOfHeights + verticalSpace
- ] ifFalse:[
- ((vLayout == #center) or:[vLayout == #spread]) ifTrue:[
- sumOfHeights := sumOfHeights + (verticalSpace * 2)
- ]
- ].
- ].
-
- ((hLayout == #leftSpace) or:[hLayout == #rightSpace]) ifTrue:[
- maxWidth := maxWidth + horizontalSpace
- ] ifFalse:[
- ((hLayout == #fitSpace) or:[hLayout == #center]) ifTrue:[
- maxWidth := maxWidth + (horizontalSpace * 2)
- ]
- ].
- m2 := margin * 2.
- ^ (maxWidth + m2) @ (sumOfHeights + m2)
-
- "Modified: / 17.1.1998 / 00:18:16 / cg"
-! !
-
-!VerticalPanelView class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VPanelV.st,v 1.34 1998-01-27 20:15:43 cg Exp $'
-! !
--- a/VarHPanel.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,214 +0,0 @@
-"
- 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.
-"
-
-VariablePanel subclass:#VariableHorizontalPanel
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
-!
-
-!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.
-"
-!
-
-documentation
-"
- This class is only here for backward compatibility;
- all functionality is now in VariablePanel. Its orientation can now
- be changed dynamically.
-
- 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:
-
- 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.
-
- See examples.
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- VariableHorizontalPanel is simply setting its orientation
- to #horizontal. See more examples there.
-
- dummy example: 2 views side-by-side
- [exBegin]
- |top p v1 v2|
-
- top := StandardSystemView new.
- top extent:300@200.
-
- p := VariableHorizontalPanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- v1 := View
- origin:0.0 @ 0.0
- corner:0.5 @ 1.0
- in:p.
- v1 viewBackground:Color red.
-
- v2 := View
- origin:0.5 @ 0.0
- corner:1.0 @ 1.0
- in:p.
- v2 viewBackground:Color green.
-
- top open
- [exEnd]
-
-
- concrete example: a selectionInListView and a TextView side-by-side
- (not useful - need scrollBars; see next example)
- [exBegin]
- |top p v1 v2|
-
- top := StandardSystemView new.
- top extent:400@300.
-
- 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.
- v1 list:('/etc' asFilename directoryContents).
- v1 useIndex:false.
- v1 action:[:name | v2 contents:('/etc/' , name)
- asFilename contentsOfEntireFile
- ].
-
- v2 := TextView
- origin:0.5 @ 0.0
- corner:1.0 @ 1.0
- in:p.
-
- top open
- [exEnd]
-
-
- better - with scrollBars (but thats another story ... see ScrollableView examples for more):
- [exBegin]
- |top p v1 v2|
-
- top := StandardSystemView new.
- top extent:400@300.
-
- p := VariableHorizontalPanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- v1 := ScrollableView for:SelectionInListView
- origin:0.0 @ 0.0
- corner:0.5 @ 1.0
- in:p.
- v1 list:('/etc' asFilename directoryContents).
- v1 useIndex:false.
- v1 action:[:name | v2 contents:('/etc/' , name)
- asFilename contentsOfEntireFile
- ].
-
- v2 := ScrollableView for:TextView
- origin:0.5 @ 0.0
- corner:1.0 @ 1.0
- in:p.
-
- top open
- [exEnd]
-
-
- another stupid example: 3-views side-by-side
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:550@200.
-
- p := VariableHorizontalPanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- v1 := SelectionInListView
- origin:0.0 @ 0.0
- corner:0.3 @ 1.0
- in:p.
- v1 level:-1.
- v1 list:#('one' 'two' 'three' nil 'dont expect' 'something' 'to happen here').
-
- v2 := EditTextView
- origin:0.3 @ 0.0
- corner:0.6 @ 1.0
- in:p.
- v2 contents:'nonScrollable\EditTextView' withCRs.
-
- v3 := ScrollableView
- for:TextView
- origin:0.6 @ 0.0
- corner:1.0 @ 1.0
- in:p.
- v3 contents:'scrollable\TextView\\(read only)\\\\\\\\\\\\\\\\\concratulations !!\you managed\to scroll down' withCRs.
- top open
- [exEnd]
-"
-! !
-
-!VariableHorizontalPanel methodsFor:'initializing'!
-
-initialize
- orientation := #horizontal.
- super initialize.
-
- "Modified: 7.3.1996 / 14:08:35 / cg"
-! !
-
-!VariableHorizontalPanel class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.22 1996-11-07 16:32:31 cg Exp $'
-! !
--- a/VarHPanelC.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,58 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-VariablePanelController subclass:#VariableHorizontalPanelController
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Controllers'
-!
-
-!VariableHorizontalPanelController class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- This is a leftover class - its no longer needed, but left for backward compatibility.
- All functionality is in the VariablePanelController class.
-
- Normally, not used directly by applications, these are created automatically
- whenever a variableVerticalPanel is created.
- Actually, these are simply panelControllers which initialize themself for
- horizontal orientation.
-
- [see also:]
- VariableHorizontalPanel
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!VariableHorizontalPanelController class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarHPanelC.st,v 1.9 1996-04-25 16:35:26 cg Exp $'
-! !
--- a/VarPanel.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1706 +0,0 @@
-"
- 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.
-"
-
-SimpleView subclass:#VariablePanel
- instanceVariableNames:'barHeight barWidth separatingLine shadowForm lightForm showHandle
- handlePosition handleColor handleStyle handleLevel noColor
- trackLine redrawLocked orientation handleLabels knobHeight
- realRelativeSizes'
- classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
- DefaultHandleLevel DefaultVCursor DefaultHCursor
- DefaultHandleImage'
- poolDictionaries:''
- category:'Views-Layout'
-!
-
-!VariablePanel 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.
-"
-!
-
-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.
-
- In order to correctly setup this kind of view, the subviews must
- be created with a relative origin & relative corner.
- The panel does not verify the relative subview bounds;
- therefore, it is your responsibility to set those relative sizes to fit
- according the orientation (see bad example below).
-
- The bar-handle is either an exposed knob (style == #motif)
- or the form defined in Scroller (style ~~ #motif)
- or nothing.
-
- Typically creation is done as:
-
- p := VariablePanel in:superView.
- p orientation:#vertical.
-
- 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.
-
- The two subclasses VariableHorizontalPanel and VariableVerticalPanel
- preset the orientation. They are a kept for backward compatibility
- (in previous versions, there used to be no common VariablePanel (super-) class).
-
- Notice: if it is required to insert a fixed-size view in the panel,
- use an extra view & insets, and place the subview into that extra view.
- See examples.
-
- [instance Variables:]
-
- barHeight <Integer> the height of the bar (for verticalPanels)
- barWidth <Integer> the width of the bar (for horizontalPanels)
-
- separatingLine <Boolean> show a separating line (as in motif style)
-
- shadowForm <Image/Form> form (shadow part) drawn as handle - if nonNil
-
- lightForm <Image/Form> form (light part) drawn as handle - if nonNil
-
- showHandle <Boolean> if false, no handle is drawn
-
- handlePosition <Symbol> where is the handle - one of #left, #center, #right
-
- handleColor <Color> inside color of handle - defaults to viewBackground
-
- handleStyle <Symbol> type of handle; one of #next, #motif or nil
-
- handleLevel <Integer> 3D level of handle (only valid if no form is given)
-
- trackLine <Boolean> if true, an inverted line is drawn for tracking;
- otherwise, the whole bar is inverted.
-
- redrawLocked internal - locks redraws while tracking
-
- orientation <Symbol> one of #horizontal / #vertical
-
-
- [styleSheet values:]
- variablePanel.showHandle true/false - should a handle be shown (default:true)
-
- variablePanel.handleStyle #next / #motif / #iris / #full / nil (special handles)
-
- variablePanel.handlePosition #left / #center / #right (default:#right)
-
- variablePanel.handleLevel 3D level of heandle (default:2)
-
- variablePanel.trackingLine when moved, track an inverted line (as in motif)
- as opposed to tracking the whole bar (default:false)
- (obsoleted by trackingStyle)
-
- variablePanel.trackingStyle #solidRectangle / #solidLine / #dashedLine
- detailed control over how to draw tracking
- (obsoletes trackingLine above)
-
- variablePanel.separatingLine draw a separating line in the bar as in motif (default:false)
-
- variablePanel.handleColor color of the handle. (default:Black)
-
- variablePanel.handleEnteredColor
- color of the handle when the pointer is in the bar (default:nil)
-
- [see also:]
- PanelView
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- example (notice that the subviews MUST have relative bounds):
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/2) in:p.
- v2 := View origin:0.0@(1/2) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
-
- change the handles level:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
- p handleLevel:-1.
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/3) in:p.
- v2 := View origin:0.0@(1/3) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
-
- change the handles style to nil makes it invisible:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
- p handleStyle:nil.
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/3) in:p.
- v2 := View origin:0.0@(1/3) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
-
- define your own handle (-bitmap):
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
- p handleImage:(Image fromFile:'bitmaps/ScrollLt.8.xbm').
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/3) in:p.
- v2 := View origin:0.0@(1/3) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
-
- another handle-bitmap:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
- p handleImage:(Form width:9
- height:11
- fromArray:#(
- 2r00000000 2r00000000
- 2r00001000 2r00000000
- 2r00011100 2r00000000
- 2r00111110 2r00000000
- 2r01111111 2r00000000
- 2r00000000 2r00000000
- 2r01111111 2r00000000
- 2r00111110 2r00000000
- 2r00011100 2r00000000
- 2r00001000 2r00000000
- 2r00000000 2r00000000
- )
- ).
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/3) in:p.
- v2 := View origin:0.0@(1/3) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
- placing scrolled and unscrolled views into a variablePanel:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
-
- 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
- ]
- ].
-
- v2 := TextView origin:0.0 @ 0.5 corner:1.0 @ 0.8 in:p.
-
- v3 := ScrollableView for:TextView in:p.
- v3 origin:0.0 @ 0.8 corner:1.0 @ 1.0.
- top open
- [exEnd]
-
-
- dynamically adding/removing views:
- [exBegin]
- |top p v1 v2 b|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- b := Toggle label:'show' in:top.
- b showLamp:false.
- b origin:0.0 @ 0.0 corner:(1.0 @ 40).
- b action:[:state |
- state ifTrue:[
- b label:'hide'.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 0.5.
- v2 := ScrollableView for:EditTextView.
- v2 origin:0.0 @ 0.5 corner:1.0 @ 1.0.
- v2 contents:'another text'.
- p addSubView:v2.
- v2 realize.
- ] ifFalse:[
- b label:'show'.
- v2 destroy.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 1.0
- ]
- ].
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
- p topInset:50.
-
- v1 := ScrollableView for:EditTextView in:p.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- v1 contents:'some text'.
-
- top open
- [exEnd]
-
-
- dynamically flipping orientation:
- Notice: you have to change the relative bounds of the subviews first.
- [exBegin]
- |top p v1 v2 b|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- b := Toggle label:'flip' in:top.
- b showLamp:false.
- b origin:0.0 @ 0.0 corner:(1.0 @ 40).
- b action:[:state |
- state ifTrue:[
- v1 origin:0.0 @ 0.0 corner:0.5 @ 1.0.
- v2 origin:0.5 @ 0.0 corner:1.0 @ 1.0.
- p orientation:#horizontal.
- ] ifFalse:[
- v1 origin:0.0 @ 0.0 corner:1.0 @ 0.5.
- v2 origin:0.0 @ 0.5 corner:1.0 @ 1.0.
- p orientation:#vertical.
- ].
- ].
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
- p topInset:50.
-
- v1 := ScrollableView for:EditTextView in:p.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 0.5.
- v1 contents:'some text'.
-
- v2 := ScrollableView for:EditTextView in:p.
- v2 origin:0.0 @ 0.5 corner:1.0 @ 1.0.
- v2 contents:'another text'.
-
- top open
- [exEnd]
-
-
- combining fix-size with variable size:
- (need 3 extra frame-views to place the extra labels into)
- [exBegin]
- |top p v1 l1 v2 l2 v3 l3 f1 f2 f3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- p orientation:#vertical.
-
- f1 := View origin:0.0@0.0 corner:1.0@0.3 in:p.
- f2 := View origin:0.0@0.3 corner:1.0@0.6 in:p.
- f3 := View origin:0.0@0.6 corner:1.0@1.0 in:p.
-
- v1 := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:f1.
- v2 := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:f2.
- v3 := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:f3.
-
- l1 := Label label:'sub1' in:f1.
- l2 := Label label:'sub2' in:f2.
- l3 := Label label:'sub3' in:f3.
-
- l1 origin:0.0 @ 0.0 corner:1.0 @ 0.0 ;
- bottomInset:(l1 preferredExtent y negated).
- l2 origin:0.0 @ 0.0 corner:1.0 @ 0.0 ;
- bottomInset:(l2 preferredExtent y negated).
- l3 origin:0.0 @ 0.0 corner:1.0 @ 0.0 ;
- bottomInset:(l3 preferredExtent y negated).
-
- v1 topInset:(l1 preferredExtent y); level:-1.
- v2 topInset:(l2 preferredExtent y); level:-1.
- v3 topInset:(l3 preferredExtent y); level:-1.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
- VerticalPansels allow a label to be associated with the
- handles; this looks much like the above, but is slightly
- more compact. Notice, no label can be placed above the first
- view - it has no handle.
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- p orientation:#vertical.
- p handleLabels:#('ignored' 'sub2' 'sub3').
-
- v1 := View origin:0.0@0.0 corner:1.0@0.3 in:p.
- v2 := View origin:0.0@0.3 corner:1.0@0.6 in:p.
- v3 := View origin:0.0@0.6 corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
- handle labels can be more than strings ....
- (however, they should have about the same height, since
- the largest defines heights of all bars;
- retry the example below with a larger bitmap image ...)
- [exBegin]
- |top e p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- p orientation:#vertical.
- e := Array with:#bold
- with:#color->Color red.
-
- p handleLabels:(Array with:nil
- with:('bold and red' asText emphasizeAllWith:e)
- with:(Image fromFile:'ScrollRt.xbm')).
-
- v1 := View origin:0.0@0.0 corner:1.0@0.3 in:p.
- v2 := View origin:0.0@0.3 corner:1.0@0.6 in:p.
- v3 := View origin:0.0@0.6 corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
-
- BAD EXAMPLE (wrong relative sizes - repaired on handle move):
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariablePanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p orientation:#vertical.
-
- v1 := View origin:0.0 @ 0.0 corner:1.0 @ (1/4) in:p.
- v2 := View origin:0.0 @ (1/2) corner:1.0 @ (3/4) in:p.
- v3 := View origin:0.0 @ (3/4) corner:1.0 @ 1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-"
-! !
-
-!VariablePanel class methodsFor:'defaults'!
-
-cursorForOrientation:orientation
- "return an appropriate cursor"
-
- ^ self cursorForOrientation:orientation onDevice:Display.
-
- "Modified: / 30.9.1998 / 18:21:10 / cg"
-!
-
-cursorForOrientation:orientation onDevice:device
- "return an appropriate cursor"
-
- |cursor|
-
- orientation == #vertical ifTrue:[
- DefaultVCursor notNil ifTrue:[
- cursor := DefaultVCursor
- ] ifFalse:[
- device platformName = 'WIN32' ifFalse:[
- cursor := Cursor
- sourceForm:(Image fromFile:'bitmaps/VVPanel.xbm')
- maskForm:(Image fromFile:'bitmaps/VVPanel_m.xbm')
- hotX:8
- hotY:8.
- ].
-
- "
- if bitmaps are not available or under Win95,
- use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
- ].
- DefaultVCursor := cursor
- ]
- ] ifFalse:[
- DefaultHCursor notNil ifTrue:[
- cursor := DefaultHCursor
- ] ifFalse:[
- device platformName = 'WIN32' ifFalse:[
- cursor := Cursor
- sourceForm:(Image fromFile:'bitmaps/VHPanel.xbm')
- maskForm:(Image fromFile:'bitmaps/VHPanel_m.xbm')
- hotX:8
- hotY:8.
- ].
- "
- if bitmaps are not available or under Win95,
- use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
- ].
- DefaultHCursor := cursor
- ]
- ].
-
- ^ cursor
-
- "
- DefaultVCursor := DefaultHCursor := nil.
- "
-
- "Created: / 30.9.1998 / 18:20:41 / cg"
- "Modified: / 30.9.1998 / 18:23:07 / cg"
-!
-
-lightFormOn:aDisplay
- "use same handle as Scroller"
-
- ^ Scroller handleLightFormOn:aDisplay
-!
-
-shadowFormOn:aDisplay
- "use same handle as Scroller"
-
- ^ Scroller handleShadowFormOn:aDisplay
-!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables"
-
- <resource: #style (#'variablePanel.showHandle'
- #'variablePanel.handleStyle'
- #'variablePanel.handleImage'
- #'variablePanel.handlePosition'
- #'variablePanel.handleLevel'
- #'variablePanel.trackingLine'
- #'variablePanel.trackingStyle'
- #'variablePanel.separatingLine'
- #'variablePanel.handleColor')>
-
- |lineModeBoolean|
-
- DefaultShowHandle := StyleSheet at:#'variablePanel.showHandle' default:true.
- DefaultHandleStyle := StyleSheet at:#'variablePanel.handleStyle'.
- DefaultHandlePosition := StyleSheet at:#'variablePanel.handlePosition' "default:#right".
- DefaultHandlePosition isNil ifTrue:[
- DefaultHandlePosition := ScrollableView defaultScrollBarPosition.
- ].
- DefaultHandleLevel := StyleSheet at:#'variablePanel.handleLevel' default:2.
- DefaultTrackingLine := StyleSheet at:#'variablePanel.trackingStyle'.
- DefaultTrackingLine isNil ifTrue:[
- lineModeBoolean := StyleSheet at:#'variablePanel.trackingLine' default:false.
- lineModeBoolean ifTrue:[
- DefaultTrackingLine := #solidLine
- ] ifFalse:[
- DefaultTrackingLine := #solidRectangle
- ]
- ].
-
- DefaultSeparatingLine := StyleSheet at:#'variablePanel.separatingLine' default:false.
- DefaultHandleColor := StyleSheet colorAt:#'variablePanel.handleColor' default:Black.
-
- DefaultHandleImage := StyleSheet at:#'variablePanel.handleImage'
-
- "
- VariablePanel updateStyleCache
- "
-
- "Modified: / 19.5.1998 / 16:08:54 / cg"
-! !
-
-!VariablePanel methodsFor:'accessing'!
-
-addSubView:aView
- "a view is added; adjust other subviews sizes"
-
- super addSubView:aView.
-
-"/ (aView relativeOrigin isNil
-"/ or:[aView relativeExtent isNil and:[aView relativeCorner isNil]]) ifTrue:[
-"/ aView geometryLayout:nil.
-"/ aView origin:0.0@0.0.
-"/ aView extent:1.0@0.5.
-"/ self setupSubviews
-"/ ].
-
- realized ifTrue:[
- self resizeSubviews.
- ]
-
- "Created: 17.1.1996 / 22:41:00 / cg"
- "Modified: 24.2.1996 / 19:05:05 / cg"
-!
-
-orientation
- "return my orientation; either #horizontal or #vertical"
-
- ^ orientation
-
- "Modified: 6.3.1996 / 18:08:45 / cg"
-!
-
-orientation:aSymbol
- "change my orientation; aSymbol must be one of #horizontal or #vertical.
- Changing implies a resize of my subViews."
-
- aSymbol ~~ orientation ifTrue:[
- orientation := aSymbol.
- self initCursor.
- self anyNonRelativeSubviews ifTrue:[
- self setupSubviews
- ].
- shown ifTrue:[
- self cursor:cursor.
- self sizeChanged:nil.
- self invalidate.
- ]
- ]
-
- "Modified: 29.5.1996 / 16:22:35 / cg"
-!
-
-removeSubView:aView
- "a view is removed; adjust other subviews sizes"
-
- super removeSubView:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviews.
- self resizeSubviews.
- ]
- ]
-! !
-
-!VariablePanel methodsFor:'accessing-look'!
-
-barHeight
- "return the height of the separating bar"
-
- ^ barHeight
-!
-
-barHeight:nPixel
- "set the height of the separating bar"
-
- barHeight := nPixel.
-
- "make certain bar is visible and catchable"
- (barHeight < 4) ifTrue:[
- barHeight := 4
- ].
-
- "make it even, so spacing is equally spreadable among subviews"
- barHeight odd ifTrue:[
- barHeight := barHeight + 1
- ]
-
- "Modified: 7.11.1996 / 20:07:11 / cg"
- "Modified: 28.4.1997 / 14:30:33 / dq"
-!
-
-handleImage:aBitmapOrImage
- "define the handles image"
-
- shadowForm := aBitmapOrImage.
- lightForm := nil.
- self computeBarHeight.
-
- "Created: 7.11.1996 / 20:21:10 / cg"
- "Modified: 7.11.1996 / 20:27:22 / cg"
-!
-
-handleLabels:aCollectionOfLabels
- "define special handle labels - typically a collection of
- bitmap images. Notice, that the first handle is not
- drawn, that is, the first element if the argument is useless."
-
- orientation == #horizontal ifTrue:[
- self error:'not allowed for horizontal panels'
- ].
-
- handleLabels := aCollectionOfLabels.
- self computeBarHeight.
- self resizeSubviews.
-
- "
- |top panel v1 v2|
-
- top := StandardSystemView new.
- panel := VariableVerticalPanel origin:0.0@0.0 corner:1.0@1.0 in:top.
- panel add:(EditTextView origin:0.0@0.0 corner:1.0@0.5).
- panel add:(EditTextView origin:0.0@0.5 corner:1.0@1.0).
- panel handleStyle:nil.
- panel handleLabels:#('foo' 'bar').
- top open
- "
-!
-
-handleLevel:aNumber
- "define the 3D level of the handle (only with some styles).
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
-
- handleLevel := aNumber
-!
-
-handlePosition
- "return the position of the handle"
-
- ^ handlePosition
-!
-
-handlePosition:aSymbol
- "define the position of the handle; the argument aSymbol
- may be one of #left, #right or #center"
-
- handlePosition := aSymbol
-!
-
-handleShadowImage:shadowImage lightImage:lightImage
- "define the handles image; both shadow and light parts"
-
- shadowForm := shadowImage.
- lightForm := lightImage.
- self computeBarHeight.
-
- "Created: 7.11.1996 / 20:21:51 / cg"
- "Modified: 7.11.1996 / 20:27:26 / cg"
-!
-
-handleStyle:styleSymbol
- "define the style of the handle;
- styleSymbol may be #motif to draw a little knob or
- anything else to draw scrollBars handleForm.
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
-
- (styleSymbol ~~ handleStyle) ifTrue:[
- handleStyle := styleSymbol.
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
- ] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- shadowForm notNil ifTrue:[
- (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
- ]
- ].
- shown ifTrue:[
- self resizeSubviews.
- self invalidate
- ]
- ]
-
- "Created: 24.2.1996 / 19:04:07 / cg"
- "Modified: 29.5.1996 / 16:22:24 / cg"
-!
-
-setBarHeight:nPixel
- "set the height of the separating bar"
-
- barHeight := nPixel.
-
-!
-
-style:styleSymbol
- "define the style of the handle;
- styleSymbol may be #motif to draw a little knob or
- anything else to draw scrollBars handleForm.
- Normally, this is defined via styleSheet files, but this entry allows
- individual views to be manipulated."
-
- self handleStyle:styleSymbol
-
- "Modified: 24.2.1996 / 19:04:19 / cg"
-! !
-
-!VariablePanel methodsFor:'drawing'!
-
-drawHandle:hIndex atX:hx y:hy
- "draw a single handle at hx/hy"
-
- |h w x y m xm ym lbl maxKnob
- mar "{ Class: SmallInteger }"
- barWidthInt "{ Class: SmallInteger }"
- barHeightInt "{ Class: SmallInteger }" |
-
- ((handleStyle isNil or:[handleStyle == #none])
- and:[handleLabels isNil]) ifTrue:[^ self].
-
- mar := margin.
- barHeightInt := barHeight.
- barWidthInt := barWidth.
-
- shadowForm notNil ifTrue:[
- h := shadowForm height.
- w := shadowForm width .
- maxKnob := h min:barHeightInt.
- ] ifFalse:[
- maxKnob := knobHeight min: barHeightInt.
- maxKnob := maxKnob max:4.
- handleStyle == #full ifTrue:[
- w := h := maxKnob
- ] ifFalse:[
- w := h := maxKnob - 4.
- ]
- ].
-
- self paint:viewBackground.
- self lineStyle:#solid.
-
- orientation == #vertical ifTrue:[
- self fillRectangleX:mar y:hy
- width:(width - mar - mar)
- height:barHeightInt.
-
- (handleStyle isNil
- or:[handleStyle == #none]) ifFalse:[
- (handleStyle ~~ #normal
- and:[handleStyle ~~ #mswindows]) ifTrue:[
- m := (maxKnob - h) // 2.
-
- shadowForm isNil ifTrue:[
-
- y := hy + (barHeightInt // 2). "/ center of the bar
-
- separatingLine ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:mar y:y toX:(width - mar) y:y.
- y := y + 1.
- self paint:lightColor.
- self displayLineFromX:mar y:y toX:(width - mar) y:y.
- self paint:viewBackground.
- ].
-
- self fillRectangleX:(hx - barWidthInt)
- y:hy
- width:(barWidthInt + barWidthInt)
- height:h.
-
- handleStyle == #line ifTrue:[
- self paint:handleColor.
- self displayLineFromX:hx - barWidthInt y:y toX:hx + barWidthInt y:y
- ] ifFalse:[
- y := hy.
- handleStyle == #st80 ifTrue:[
- y := y - 1
- ].
- ym := y + m.
-
- handleStyle == #full ifTrue:[
- handleLevel ~~ 0 ifTrue:[
- self
- drawEdgesForX:0 "/ -(handleLevel abs)
- y:ym "/-1
- width:width "/+(handleLevel+handleLevel)abs
- height:h-2
- level:handleLevel
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil
- ]
- ] ifFalse:[
- handleLevel ~~ 0 ifTrue:[
- self drawEdgesForX:(hx - barWidthInt)
- y:ym
- width:(barWidthInt + barWidthInt)
- height:h
- level:handleLevel.
- ].
-
- handleStyle == #iris ifTrue:[
- self paint:handleColor.
- self fillDeviceRectangleX:(hx - barWidthInt + 2)
- y:(ym + 2)
- width:(barWidthInt + barWidthInt - 4)
- height:h - 4
- ]
- ]
- ].
- ] ifFalse:[
- y := hy.
- (shadowForm notNil or:[lightForm notNil]) ifTrue:[
- self drawHandleFormAtX:hx y:(y + m)
- ]
- ].
-
- handleStyle == #st80 ifTrue:[
- y := hy - 1.
- self paint:lightColor.
- self displayLineFromX:mar y:y toX:(width - mar - mar - 1) y:y.
- self displayLineFromX:0 y:hy toX:0 y:(hy + knobHeight - 1).
- y := hy + knobHeight - 2.
- self paint:shadowColor.
- self displayLineFromX:mar y:y toX:(width - mar) y:y.
- "uncomment the -1 if you dont like the notch at the right end"
- " VVV"
- self displayLineFromX:width-1 y:hy" "-1" " toX:width-1 y:(hy + knobHeight - 1 - 1).
- ].
- ] ifFalse:[
- y := hy + barHeightInt - 1.
- self paint:handleColor.
- separatingLine ifTrue:[
- self displayLineFromX:0 y:hy+1 toX:width y:hy+1.
- self displayLineFromX:0 y:y toX:width y:y.
- ].
- self fillRectangleX:hx y:hy width:barWidthInt height:barHeightInt
- ].
- ].
- lbl := self handleLabelAt:hIndex.
- lbl notNil ifTrue:[
- hIndex ~~ 1 ifTrue:[
- self paint:Color black.
- lbl isImageOrForm ifTrue:[
- lbl displayOn:self x:mar y:hy
- ] ifFalse:[
- lbl displayOn:self x:mar y:hy + font ascent + 1
- ]
- ]
- ].
-
- ] ifFalse:[
- self fillRectangleX:hx y:mar
- width:barHeightInt
- height:(height - mar - mar).
-
- (handleStyle isNil
- or:[handleStyle == #none]) ifFalse:[
- (handleStyle ~~ #normal
- and:[handleStyle ~~ #mswindows]) ifTrue:[
- m := (barHeightInt - w) // 2.
- m := (maxKnob - w) // 2.
- shadowForm isNil ifTrue:[
- x := hx + (barHeightInt // 2).
- separatingLine ifTrue:[
- self paint:shadowColor.
- self displayLineFromX:x y:mar toX:x y:(height - mar).
- x := x + 1.
- self paint:lightColor.
- self displayLineFromX:x y:mar toX:x y:(height - mar).
- self paint:viewBackground.
- ].
- self fillRectangleX:hx y:(hy - barWidthInt)
- width:w
- height:(barWidthInt + barWidthInt).
-
- handleStyle == #line ifTrue:[
- self paint:handleColor.
- self displayLineFromX:x y:hy - barWidthInt toX:x y:hy + barWidthInt.
- ] ifFalse:[
- x := hx.
- handleStyle == #st80 ifTrue:[
- x := x - 1.
- ].
- xm := x + m.
- handleStyle == #full ifTrue:[
- handleLevel ~~ 0 ifTrue:[
- self
- drawEdgesForX:xm "/-1
- y:0 "/ -handleLevel
- width:w-2
- height:height "/ +handleLevel+handleLevel
- level:handleLevel
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil
- ]
- ] ifFalse:[
- handleLevel ~~ 0 ifTrue:[
- self drawEdgesForX:xm
- y:(hy - barWidthInt)
- width:w
- height:(barWidthInt + barWidthInt)
- level:handleLevel.
- ].
- handleStyle == #iris ifTrue:[
- self paint:handleColor.
- self fillDeviceRectangleX:(xm + 2)
- y:(hy - barWidthInt + 2)
- width:w - 4
- height:(barWidthInt + barWidthInt - 4)
- ].
- ].
- ]
- ] ifFalse:[
- x := hx.
- (shadowForm notNil or:[lightForm notNil]) ifTrue:[
- self drawHandleFormAtX:(x + m) y:hy
- ]
- ].
- handleStyle == #st80 ifTrue:[
- x := hx - 1.
- self paint:lightColor.
- self displayLineFromX:x y:mar toX:x y:(height - mar).
- self displayLineFromX:hx y:0 toX:(hx + barHeightInt - 1) y:0.
- x := hx + barHeightInt - 2.
- self paint:shadowColor.
- self displayLineFromX:x y:mar toX:x y:(height - mar).
- "uncomment the -1 if you dont like the notch at the bottom end"
- " VVV"
- self displayLineFromX:hx" "-1" " y:height-1 toX:(hx + barHeightInt - 1) y:height-1.
- ].
- ] ifFalse:[
- x := hx + barHeightInt - 1.
- self paint:handleColor.
- separatingLine ifTrue:[
- self displayLineFromX:hx+1 y:0 toX:hx+1 y:height.
- self displayLineFromX:x y:0 toX:x y:height.
- ].
- self fillRectangleX:hx y:hy width:barHeightInt height:barWidthInt
- ]
- ]
- ].
-
- "Modified: / 29.7.1998 / 22:48:33 / cg"
-!
-
-drawHandleFormAtX:hx y:hy
- "draw a handles bitmap at hx/hy"
-
- shadowForm notNil ifTrue:[
- self paint:shadowColor.
- self displayForm:shadowForm x:hx y:hy.
- ].
- lightForm notNil ifTrue:[
- self paint:lightColor.
- self displayForm:lightForm x:hx y:hy.
- ].
- self paint:viewBackground
-
- "Modified: 7.11.1996 / 20:25:33 / cg"
-!
-
-invertHandleBarAtX:hx y:hy
- |doLine oldStyle|
-
- doLine := (trackLine == #solidLine
- or:[trackLine == #dashedLine
- or:[trackLine == #dottedLine]]).
-
- trackLine == #dashedLine ifTrue:[
- oldStyle := lineStyle.
- self lineStyle:#dashed.
- ] ifFalse:[
- trackLine == #dottedLine ifTrue:[
- oldStyle := lineStyle.
- self lineStyle:#dotted.
- ]
- ].
-
- self clippedByChildren:false.
-
- self xoring:[
- |yL xL halfHeight|
-
- halfHeight := (barHeight // 2) - 1.
-
- orientation == #vertical ifTrue:[
- yL := hy + halfHeight.
- doLine ifTrue:[
- self displayLineFromX:0 y:yL toX:width y:yL.
- ] ifFalse:[
- self fillRectangleX:0 y:hy width:width height:barHeight
- ]
- ] ifFalse:[
- xL := hx + halfHeight.
- doLine ifTrue:[
- self displayLineFromX:xL y:0 toX:xL y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- ].
- self clippedByChildren:true.
-
- oldStyle notNil ifTrue:[
- self lineStyle:oldStyle.
- ].
-
- "Modified: / 28.4.1997 / 14:56:26 / dq"
- "Modified: / 3.5.1999 / 18:49:04 / cg"
-!
-
-lockRedraw
- redrawLocked := true
-!
-
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(self subViews size)
- ]
-
- "Modified: 28.1.1997 / 17:54:15 / cg"
-!
-
-redrawHandlesFrom:start to:stop
- "redraw some handles"
-
- (self subViews size > 0) ifTrue:[
- showHandle ifTrue:[
- self handleOriginsWithIndexFrom:start to:stop do:[:hPoint :hIndex |
- self drawHandle:hIndex atX:(hPoint x) y:(hPoint y)
- ].
- ]
- ]
-
- "Modified: 28.1.1997 / 17:54:33 / cg"
-!
-
-unlockRedraw
- redrawLocked := false
-! !
-
-!VariablePanel methodsFor:'enumerating subviews'!
-
-changeSequenceOrderFor:aSubView to:anIndex
- "change a subview's position in the subviews collection.
- "
- |success|
-
- success := super changeSequenceOrderFor:aSubView to:anIndex.
- success ifTrue:[
- self setupSubviews.
- self resizeSubviews.
- ].
- ^ success
-! !
-
-!VariablePanel methodsFor:'event handling'!
-
-sizeChanged:how
- "my size has changed; resize my subviews"
-
- shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviews
- ] ifFalse:[
- "/
- "/ do it in reverse order, to avoid some redraws
- "/
- self resizeSubviewsFrom:(self subViews size) to:1
- ]
- ].
- self changed:#sizeOfView with:how.
-
- "Modified: 28.1.1997 / 17:56:30 / cg"
-! !
-
-!VariablePanel methodsFor:'focus handling'!
-
-wantsFocusWithButtonPress
- "no, do not catch the keyboard focus on button click"
-
- ^ false
-
-
-! !
-
-!VariablePanel methodsFor:'initializing'!
-
-computeBarHeight
- "compute the height if the separating bar from either the
- form or an explicit height given in the styleSheet"
-
- <resource: #style (#'variablePanel.barHeight'
- #'variablePanel.barHeightMM')>
-
- |bH h lvl|
-
- shadowForm notNil ifTrue:[
- bH := shadowForm height + 2.
- ] ifFalse:[
- bH := styleSheet at:#'variablePanel.barHeight'.
- bH isNil ifTrue:[
- h := styleSheet at:#'variablePanel.barHeightMM' default:2.
- bH := (h * device verticalPixelPerMillimeter) rounded.
- ].
- ].
- lvl := styleSheet at:#'variablePanel.barLevel' default:0.
- lvl ~~ 0 ifTrue:[
- bH := bH + (lvl abs * 2).
- ].
-
- self barHeight:bH.
- knobHeight := bH.
-
- handleLabels notNil ifTrue:[
- font := font onDevice:device.
- bH := handleLabels inject:bH into:[:maxSoFar :thisLabel |
- thisLabel isNil ifTrue:[
- maxSoFar
- ] ifFalse:[
- maxSoFar max:(thisLabel heightOn:self)
- ]
- ].
- bH := bH + font descent - 1
- ].
-
- self barHeight:bH.
-
- "Modified: / 29.7.1998 / 14:47:21 / cg"
-!
-
-defaultControllerClass
- ^ VariablePanelController
-!
-
-fixSize
- super fixSize.
- extentChanged ifTrue:[
- self resizeSubviews
- ].
-
- "Modified: 22.3.1997 / 01:19:55 / stefan"
-!
-
-initCursor
- "set the cursor - a double arrow"
-
- cursor := self class
- cursorForOrientation:orientation
- onDevice:device
-
- "Modified: / 30.9.1998 / 18:20:35 / cg"
-!
-
-initStyle
- "setup viewStyle specifics"
-
- |mm|
-
- super initStyle.
-
- handleColor := DefaultHandleColor onDevice:device.
-
- DefaultHandleStyle isNil ifTrue:[
- handleStyle := styleSheet name
- ] ifFalse:[
- handleStyle := DefaultHandleStyle
- ].
-
- handleLevel := DefaultHandleLevel.
- showHandle := DefaultShowHandle.
- handlePosition := DefaultHandlePosition.
- trackLine := DefaultTrackingLine.
- separatingLine := DefaultSeparatingLine.
-
- DefaultHandleImage notNil ifTrue:[
- shadowForm := DefaultHandleImage onDevice:device.
- barWidth := shadowForm width.
- ] ifFalse:[
- handleStyle == #next ifTrue:[
- DefaultHandleImage notNil ifTrue:[
- shadowForm := DefaultHandleImage onDevice:device.
- ] ifFalse:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
- ].
- barWidth := shadowForm width.
- ] ifFalse:[
- shadowForm := lightForm := nil.
-
- mm := device verticalPixelPerMillimeter.
- barWidth := (1.5 * mm) rounded. "motif style width"
- ].
- ].
- self computeBarHeight.
-
- handleStyle == #mswindows ifTrue:[
- barWidth := (ArrowButton new direction:#up) width + 1
- ].
-
- "Modified: / 19.5.1998 / 16:21:02 / cg"
-!
-
-initialize
- orientation isNil ifTrue:[orientation := #vertical].
- super initialize.
- self bitGravity:nil.
-
- "Modified: / 29.7.1998 / 16:07:23 / cg"
-! !
-
-!VariablePanel methodsFor:'private'!
-
-anyNonRelativeSubviews
- "return true, if any of my subviews has no relative origin/extent"
-
- self subViews do:[:aComponent |
- aComponent relativeCorner isNil ifTrue:[^ true].
- aComponent relativeOrigin isNil ifTrue:[^ true]
- ].
- ^ false
-
- "Modified: 28.1.1997 / 17:57:26 / cg"
-!
-
-expandSubView:expandedView
- "expand one of my subviews to full size"
-
- |pos subViews|
-
- realRelativeSizes notNil ifTrue:[
- "/ already expanded ..
- ^ self
- ].
-
- pos := 0.0.
- subViews := self subViews.
-
- orientation == #vertical ifTrue:[
- realRelativeSizes := subViews collect:[:v | v relativeCorner y - v relativeOrigin y].
- ] ifFalse:[
- realRelativeSizes := subViews collect:[:v | v relativeCorner x - v relativeOrigin x].
- ].
-
- subViews do:[:aSubView |
- aSubView == expandedView ifTrue:[
- aSubView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- pos := 1.0
- ] ifFalse:[
- orientation == #vertical ifTrue:[
- aSubView origin:(0.0 @ pos) corner:(1.0 @ pos)
- ] ifFalse:[
- aSubView origin:(pos @ 0.0) corner:(pos @ 1.0)
- ]
- ]
- ].
- self resizeSubviews.
-
- "Modified: 28.1.1997 / 17:56:20 / cg"
-!
-
-handleLabelAt:hIndex
- handleLabels notNil ifTrue:[
- ^ handleLabels at:hIndex ifAbsent:nil
- ].
- ^ nil
-!
-
-handleOriginsWithIndexDo:aBlock
- "evaluate the argument block for every handle-origin"
-
- self handleOriginsWithIndexFrom:1 to:(self subViews size) do:aBlock
-
- "Modified: 28.1.1997 / 17:53:44 / cg"
-!
-
-handleOriginsWithIndexFrom:start to:stop do:aBlock
- "evaluate the argument block for some handle-origins"
-
- |x y hw hh hDelta vDelta subViews
- first "{ Class: SmallInteger }"
- last "{ Class: SmallInteger }"|
-
- (subViews := self subViews) notNil ifTrue:[
- shadowForm notNil ifTrue:[
- hw := shadowForm width.
- hh := shadowForm height.
- ] ifFalse:[
- hw := hh := barWidth
- ].
-
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- hDelta := barWidth // 2.
- vDelta := barWidth // 2.
- ] ifFalse:[
- hDelta := vDelta := 0
- ].
-
- (handlePosition == #left) ifTrue:[
- x := hDelta.
- y := vDelta.
-
- orientation == #vertical ifTrue:[
- x := x + barWidth
- ] ifFalse:[
- y := y + barWidth
- ].
- margin ~~ 0 ifTrue:[
- x := x + 2
- ].
- ] ifFalse:[
- (handlePosition == #right) ifTrue:[
- x := width - hw - margin - hDelta.
- y := height - hh - margin - vDelta.
- ] ifFalse:[
- x := width - barWidth // 2.
- y := height - barWidth // 2
- ]
- ].
- first := start + 1.
- last := stop.
-
- first to:last do:[:index |
- |view|
-
- view := subViews at:index.
- orientation == #vertical ifTrue:[
- y := view top "origin y" - barHeight + 1.
- ] ifFalse:[
- x := view left "origin x" - barHeight + 1.
- ].
- aBlock value:(x @ y) value:index
- ]
- ]
-
- "Modified: / 1.11.1997 / 11:53:40 / cg"
-!
-
-resizeSubviews
- "readjust size of all subviews"
-
- self resizeSubviewsFrom:1 to:(self subViews size)
-
- "Modified: 28.1.1997 / 17:54:42 / cg"
- "Modified: 22.3.1997 / 01:01:31 / stefan"
-!
-
-resizeSubviewsFrom:start to:stop
- "readjust size of some subviews"
-
- |step nSubviews subViews|
-
- (subViews := self subViews) size > 0 ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relOrg relCorner newOrg newCorner newExt|
-
- view := subViews at:index.
- bw := view borderWidth.
-
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
-
- newOrg := view computeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- orientation == #vertical ifTrue:[
- newOrg y:(newOrg y + o1)
- ] ifFalse:[
- newOrg x:(newOrg x + o1)
- ]
- ].
- ].
- newExt := view computeExtent.
- newExt notNil ifTrue:[
- orientation == #vertical ifTrue:[
- newExt y:(newExt y - o2 - o1)
- ] ifFalse:[
- newExt x:(newExt x - o2 - o1)
- ]
- ].
- view pixelOrigin:newOrg extent:newExt.
- ].
- shown ifTrue:[
- "/ must clear, since handles are copied automatically (by bitGravity)
- self clear.
- self invalidate.
- ]
- ]
-
- "Modified: 28.1.1997 / 17:55:03 / cg"
- "Modified: 22.3.1997 / 01:02:21 / stefan"
-!
-
-restoreSubViewRatios
- "restore my subviews sizes to the state before the full-expand"
-
- |pos subViews |
-
- realRelativeSizes == nil ifTrue:[
- "/ not expanded - ignore
- ^ self
- ].
-
- pos := 0.0.
- self subViews with:realRelativeSizes do:[:aSubView :aRelativeSize |
- orientation == #vertical ifTrue:[
- aSubView origin:(0.0 @ pos) corner:(1.0 @ (pos+aRelativeSize))
- ] ifFalse:[
- aSubView origin:(pos @ 0.0) corner:((pos+aRelativeSize) @ 1.0)
- ].
- pos := pos + aRelativeSize
- ].
- realRelativeSizes := nil.
- self resizeSubviews.
-
- "Modified: 28.1.1997 / 17:56:20 / cg"
-!
-
-setupSubviews
- "setup subviews sizes (in case of non-relative sizes)"
-
- |pos delta subViews nSubViews "{ Class: SmallInteger }"|
-
- "/ setup all subviews to spread evenly ...
-
- subViews := self subViews.
- nSubViews := subViews size.
- nSubViews == 0 ifTrue:[^ self].
-
- pos := 0.0.
- delta := 1.0 / nSubViews.
-
- 1 to:nSubViews do:[:index |
- |view|
-
- view := subViews at:index.
- orientation == #vertical ifTrue:[
- index == subViews size ifTrue:[
- view origin:(0.0 @ pos) corner:(1.0 @ 1.0)
- ] ifFalse:[
- view origin:(0.0 @ pos) corner:(1.0 @ (pos + delta))
- ].
- ] ifFalse:[
- index == subViews size ifTrue:[
- view origin:(pos @ 0.0) corner:(1.0 @ 1.0)
- ] ifFalse:[
- view origin:(pos @ 0.0) corner:((pos + delta) @ 1.0)
- ].
- ].
- pos := pos + delta
- ]
-
- "Modified: 28.1.1997 / 17:56:20 / cg"
-! !
-
-!VariablePanel methodsFor:'private tableView protocol'!
-
-setupSubviewOrigins
- "setup subviews origins
- if we only have relative extents
- (Variable Panels need relative origins and corners!!) (SV 16.1.95)"
-
- |x y e eX eY subViews n "{ Class: SmallInteger }"|
-
- x := y := 0.0.
-
- subViews := self subViews.
- n := subViews size.
- 1 to:n do:[:index |
- |view|
-
- view := subViews at:index.
- e := view relativeExtent.
- e notNil ifTrue:[
- view relativeExtent:nil.
- eX := e x.
- eY := e y.
- index == n ifTrue:[
- view origin:(x @ y) corner:(1.0 @ 1.0)
- ] ifFalse:[
- orientation == #vertical ifTrue:[
- view origin:(x @ y) corner:(1.0 @ (y+eY))
- ] ifFalse:[
- view origin:(x @ y) corner:((x+eX) @ 1.0)
- ].
- ].
- orientation == #vertical ifTrue:[
- y := y + eY.
- ] ifFalse:[
- x := x + eX.
- ]
- ] ifFalse: [
- view origin:(x @ y).
- orientation == #vertical ifTrue:[
- y := view relativeCorner y.
- ] ifFalse:[
- x := view relativeCorner x.
- ]
- ].
- ]
-
- "Modified: 21.8.1996 / 10:01:29 / stefan"
- "Modified: 28.1.1997 / 17:55:21 / cg"
-! !
-
-!VariablePanel class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarPanel.st,v 1.50 1999-08-18 14:30:07 cg Exp $'
-! !
--- a/VarPanelC.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,342 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-Controller subclass:#VariablePanelController
- instanceVariableNames:'movedHandle prevPos startPos clickPos'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Controllers'
-!
-
-!VariablePanelController class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- An abstract class for variablePanel controllers;
- normally, not used directly by applications, these are created automatically
- whenever a variablePanel is created.
- Instances are responsible for tracking the mouse pointer and resize the
- views (a panel) subviews as appropriate.
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!VariablePanelController class methodsFor:'defaults'!
-
-opaqueResize
- "return the sopaque-resizing flag setting.
- If off (the default), the resizing takes place at the end of
- the handle move operation (when the mouse button is released).
- If on, the resizing is syncronous with the move.
- On slow machines, it may make sense to leave it off."
-
- self obsoleteMethodWarning.
- ^ UserPreferences current opaqueVariablePanelResizing
-!
-
-opaqueResize:aBoolean
- "set/clear opaque-resizing.
- If off (the default), the resizing takes place at the end of
- the handle move operation (when the mouse button is released).
- If on, the resizing is syncronous with the move.
- On slow machines, it may make sense to leave it off."
-
- self obsoleteMethodWarning.
- ^ UserPreferences current opaqueVariablePanelResizing:aBoolean
-
- "
- self opaqueResize:true
- self opaqueResize:false
- "
-
- "Modified: / 13.11.1998 / 15:16:37 / cg"
-! !
-
-!VariablePanelController methodsFor:'event handling'!
-
-buttonMotion:state x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |pos limitMin limitMax subViews barHeight
- oldHx oldHy newHx newHy opaque|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
-
-"/ view buttonMotionEventPending ifTrue:[^ self].
-
- subViews := view subViews.
- barHeight := view barHeight.
-
- view orientation ~~ #vertical ifTrue:[
- pos := bx - startPos.
- "
- the two lines below will not allow resizing down to zero
- (so that some is always visible)
- "
-"/ limitMin := barHeight // 2.
-"/ limitMax := view width - barHeight.
- "
- these allow resizing to zero - which is better ?
- "
- limitMin := 0.
- limitMax := view innerWidth.
-
- movedHandle > 1 ifTrue:[
- limitMin := (subViews at:movedHandle) origin x + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitMax := (subViews at:(movedHandle + 2)) origin x - barHeight
- ].
- ] ifFalse:[
- pos := by - startPos.
- "
- the two lines below will not allow resizing down to zero
- (so that some is always visible)
- "
-"/ limitMin := barHeight // 2.
-"/ limitMax := view height - barHeight.
- "
- these allow resizing to zero - which is better ?
- "
- limitMin := 0.
- limitMax := view innerHeight.
-
- movedHandle > 1 ifTrue:[
- limitMin := (subViews at:movedHandle) origin y + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitMax := (subViews at:(movedHandle + 2)) origin y - barHeight
- ].
- ].
-
- limitMax := limitMax - barHeight.
- (pos < limitMin) ifTrue:[ "check against view limits"
- pos := limitMin
- ] ifFalse:[
- (pos > limitMax) ifTrue:[
- pos := limitMax
- ]
- ].
-
- prevPos == pos ifTrue:[^ self].
-
- view orientation ~~ #vertical ifTrue:[
- oldHx := prevPos.
- newHx := pos.
- oldHy := newHy := 0.
- ] ifFalse:[
- oldHy := prevPos.
- newHy := pos.
- oldHx := newHx := 0.
- ].
-
- opaque := UserPreferences current opaqueVariablePanelResizing.
- opaque ~~ true ifTrue:[
- view invertHandleBarAtX:oldHx y:oldHy.
- view invertHandleBarAtX:newHx y:newHy.
- ].
- prevPos := pos.
-
- opaque == true ifTrue:[
- self doResizeForX:bx y:by.
- ]
-
- "Modified: / 13.11.1998 / 15:13:47 / cg"
-!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
-
- |handle barHeight group isHorizontal|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- barHeight := view barHeight.
-
- isHorizontal := view orientation ~~ #vertical.
-
- "
- search the handle, invert the first time
- "
- view handleOriginsWithIndexDo:[:hPoint :hIndex |
- |hx hy thatsTheHandle|
-
- thatsTheHandle := false.
-
- isHorizontal ifTrue:[
- hx := hPoint x.
- hy := 0.
- (bx between:(hx - barHeight) and:(hx + barHeight)) ifTrue:[
- prevPos := hx.
- startPos := bx - hx.
- thatsTheHandle := true.
- ].
- ] ifFalse:[
- hx := 0.
- hy := hPoint y.
- (by between:(hy - barHeight) and:(hy + barHeight)) ifTrue:[
- prevPos := hy.
- startPos := by - hy.
- thatsTheHandle := true.
- ].
- ].
-
- thatsTheHandle ifTrue:[
- movedHandle := handle.
-
- UserPreferences current opaqueVariablePanelResizing == true ifTrue:[
- view grabPointerWithCursor:view cursor.
- ] ifFalse:[
- view invertHandleBarAtX:hx y:hy.
- (group := view windowGroup) notNil ifTrue:[
- group showCursor:view cursor
- ].
- ].
-
- clickPos := bx @ by.
- ^ self
- ].
-
- handle := handle + 1
- ].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
- ]
-
- "Modified: / 13.11.1998 / 15:18:10 / cg"
-!
-
-buttonRelease:button x:bx y:by
- "end bar-move"
-
- |group|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- view ungrabPointer.
- UserPreferences current opaqueVariablePanelResizing ~~ true ifTrue:[
- (group := view windowGroup) notNil ifTrue:[
- group restoreCursors
- ]
- ].
-
- self doResizeForX:bx y:by.
- movedHandle := nil.
-
- ] ifFalse:[
- super buttonRelease:button x:bx y:by
- ]
-
- "Modified: / 11.3.1999 / 16:31:29 / cg"
-!
-
-doResizeForX:bx y:by
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex
- newPos oldPos group subViews
- relCornerAbove fromIndex toIndex
- hX hY isHorizontal newCorner newOrigin|
-
- isHorizontal := view orientation ~~ #vertical.
-
- "undo the last invert"
-
- isHorizontal ifTrue:[
- hX := prevPos. hY := 0.
- ] ifFalse:[
- hX := 0. hY := prevPos.
- ].
- UserPreferences current opaqueVariablePanelResizing ~~ true ifTrue:[
- view invertHandleBarAtX:hX y:hY.
- ].
-
- "/ any change ?
- ((isHorizontal and:[bx == clickPos x])
- or:[isHorizontal not and:[by == clickPos y]]) ifTrue:[
- ^ self.
- ].
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- subViews := view subViews.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- relCornerAbove := aboveView relativeCorner.
- isHorizontal ifTrue:[
- oldPos := relCornerAbove x.
- newPos := (prevPos + startPos / view width) asFloat.
- newCorner := newPos @ relCornerAbove y.
- newOrigin := newPos @ belowView relativeOrigin y.
- ] ifFalse:[
- oldPos := relCornerAbove y.
- newPos := (prevPos + startPos / view height) asFloat.
- newCorner := relCornerAbove x @ newPos.
- newOrigin := belowView relativeOrigin x @ newPos.
- ].
- aboveView relativeCorner:newCorner.
- belowView relativeOrigin:newOrigin.
-
- view lockRedraw.
-
- oldPos > newPos ifTrue:[
- fromIndex := aboveIndex. toIndex := belowIndex.
- ] ifFalse:[
- fromIndex := belowIndex. toIndex := aboveIndex.
- ].
- view resizeSubviewsFrom:fromIndex to:toIndex.
- view redrawHandlesFrom:aboveIndex to:belowIndex.
- view unlockRedraw.
-
- "Modified: / 11.3.1999 / 16:31:29 / cg"
-!
-
-pointerEnter:state x:x y:y
- state == 0 ifTrue:[
- movedHandle notNil ifTrue:[self buttonRelease:1 x:x y:y]
- ]
-
- "Created: / 9.4.1998 / 12:34:22 / cg"
- "Modified: / 9.4.1998 / 12:35:05 / cg"
-! !
-
-!VariablePanelController class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarPanelC.st,v 1.23 1999-09-06 12:57:31 cg Exp $'
-! !
--- a/VarVPanel.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,215 +0,0 @@
-"
- 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.
-"
-
-VariablePanel subclass:#VariableVerticalPanel
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Layout'
-!
-
-!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.
-"
-!
-
-documentation
-"
- This class is only here for backward compatibility;
- all functionality is now in VariablePanel. Its orientation can now
- be changed dynamically.
-
- 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:
-
- 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.
-
-
- [see also:]
- VariableHorizontalPanel
- VerticalPanelView HorizontalPanelView PanelView
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- VariableVerticalPanel is simply setting its orientation
- to #vertical. See more examples there.
-
- example:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariableVerticalPanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/3) in:p.
- v2 := View origin:0.0@(1/3) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
-
- example:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- p := VariableVerticalPanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p handleLevel:-1.
-
- v1 := View origin:0.0@0.0 corner:1.0@(1/3) in:p.
- v2 := View origin:0.0@(1/3) corner:1.0@(2/3) in:p.
- v3 := View origin:0.0@(2/3) corner:1.0@1.0 in:p.
-
- v1 viewBackground:(Color red).
- v2 viewBackground:(Color green).
- v3 viewBackground:(Color yellow).
-
- top open
- [exEnd]
-
-
- example:
- [exBegin]
- |top p v1 v2 v3|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- 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
- ]
- ].
-
- v2 := TextView
- origin:0.0 @ 0.5 corner:1.0 @ 0.8 in:p.
-
- v3 := ScrollableView
- for:TextView
- in:p.
- v3 origin:0.0 @ 0.8 corner:1.0 @ 1.0.
- top open
- [exEnd]
-
- example: (dynamically adding/removing views):
- [exBegin]
- |top p v1 v2 b|
-
- top := StandardSystemView new.
- top extent:300@300.
-
- b := Toggle label:'show' in:top.
- b showLamp:false.
- b origin:0.0 @ 0.0 corner:(1.0 @ 40).
- b action:[:state |
- state ifTrue:[
- b label:'hide'.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 0.5.
- v2 := ScrollableView for:EditTextView.
- v2 origin:0.0 @ 0.5 corner:1.0 @ 1.0.
- v2 contents:'another text'.
- p addSubView:v2.
- ] ifFalse:[
- b label:'show'.
- v2 destroy.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 1.0
- ]
- ].
-
- p := VariableVerticalPanel
- origin:0.0 @ 0.0
- corner:1.0 @ 1.0
- in:top.
- p topInset:50.
-
- v1 := ScrollableView for:EditTextView in:p.
- v1 origin:0.0 @ 0.0 corner:1.0 @ 1.0.
- v1 contents:'some text'.
-
- top open
- [exEnd]
-"
-! !
-
-!VariableVerticalPanel methodsFor:'initializing'!
-
-initialize
- orientation := #vertical.
- super initialize.
-! !
-
-!VariableVerticalPanel class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.29 1996-11-07 16:32:48 cg Exp $'
-! !
--- a/VarVPanelC.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,58 +0,0 @@
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-VariablePanelController subclass:#VariableVerticalPanelController
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support-Controllers'
-!
-
-!VariableVerticalPanelController class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- This is a leftover class - its no longer needed, but left for backward compatibility.
- All functionality is in the VariablePanelController class.
-
- Normally, not used directly by applications, these are created automatically
- whenever a variableVerticalPanel is created.
- Actually, these are simply panelControllers which initialize themself for
- vertical orientation.
-
- [see also:]
- VariableVerticalPanel
-
- [author:]
- Claus Gittinger
-"
-! !
-
-!VariableVerticalPanelController class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/VarVPanelC.st,v 1.9 1996-04-25 16:35:39 cg Exp $'
-! !
--- a/WarnBox.st Wed Sep 08 20:14:57 1999 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,212 +0,0 @@
-"
- 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.
-"
-
-InfoBox subclass:#WarningBox
- instanceVariableNames:''
- classVariableNames:'WarnBitmap'
- poolDictionaries:''
- category:'Views-DialogBoxes'
-!
-
-!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.
-"
-!
-
-documentation
-"
- Historic note:
- originally, ST/X had separate classes for the various entry methods;
- there were YesNoBox, EnterBox, InfoBox and so on.
- In the meantime, the DialogBox class (and therefore its alias: Dialog)
- is going to duplicate most funcionality found in these classes.
-
- In the future, those existing subclasses' functionality is going to
- be moved fully into Dialog, and the subclasses will be replaced by dummy
- delegators. (They will be kept for backward compatibility, though).
-
-
-
- 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'.
-
- Since showing warnings is a common action, a convenient method has been
- added to Object; thus you can use:
-
- self warn:'oops - headcrash'
-
- everywhere in your code.
-
- [see also:]
- DialogBox InfoBox YesNoBox
- ( introduction to view programming :html: programming/viewintro.html )
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- standard warning dialogs
- (recommended, since these are ST-80 compatible interfaces)
- [exBegin]
- Dialog warn:'you should not do this'
- [exEnd]
- since all objects support the #warn message,
- you can also simply use (for any self):
- [exBegin]
- self warn:'you should not do this'
- [exEnd]
-
- with attributed text:
- [exBegin]
- Dialog warn:(Text string:'you should not do this'
- emphasis:#color->Color red)
- [exEnd]
-
- specifying more details of the warnBox (low level entries).
- label of OK-button:
- [exBegin]
- |aBox|
-
- aBox := WarningBox title:'Press ''OK'' to continue'.
- aBox okText:'OK'.
- aBox showAtPointer.
- [exEnd]
-
- accessing the ok-Button component and changing its color:
- [exBegin]
- |aBox|
-
- aBox := WarningBox title:'Do you really want to do this ?'.
- aBox okText:'yes, go on'.
- aBox okButton foregroundColor:Color red.
- aBox showAtPointer.
- [exEnd]
- since warnboxes are much like infoBoxes, all of look can be changed
- like described there:
- [exBegin]
- |image aBox|
-
- aBox := WarningBox title:'Press ''OK'' to continue'.
- aBox okText:'yes, continue'.
- image := Image fromFile:'bitmaps/SmalltalkX.xbm'.
- aBox form:image.
- aBox showAtPointer.
- [exEnd]
-"
-! !
-
-!WarningBox class methodsFor:'icon bitmap'!
-
-iconBitmap
- "return the bitmap shown as icon in my instances.
- This is the default image; you can overwrite this in a concrete
- instance with the image: message"
-
- <resource: #style (#'warningBox.icon' #'warningBox.iconFile')>
-
- |img imgFileName|
-
- WarnBitmap isNil ifTrue:[
- img := StyleSheet at:'warningBox.icon'.
- img isNil ifTrue:[
- imgFileName := StyleSheet at:'warningBox.iconFile' default:'bitmaps/Warning.xbm'.
- img := Image fromFile:imgFileName.
- ].
- img notNil ifTrue:[
- img := img onDevice:Display
- ].
- WarnBitmap := img
- ].
- ^ WarnBitmap
-
- "
- self warn:'foo bar'.
-
- |box|
- box := WarningBox title:'foo bar'.
- box showAtPointer.
-
- |box|
- box := WarningBox title:'foo bar'.
- box image:(Image fromFile:'bitmaps/QUESTION.xpm').
- box showAtPointer.
- "
-
- "Created: / 17.11.1995 / 18:16:47 / cg"
- "Modified: / 25.5.1999 / 15:22:25 / cg"
-! !
-
-!WarningBox class methodsFor:'styles'!
-
-updateStyleCache
- "extract values from the styleSheet and cache them in class variables.
- Here, the cached infoBitmap is simply flushed."
-
- WarnBitmap := nil
-
- "Modified: 1.4.1997 / 14:44:59 / cg"
-! !
-
-!WarningBox methodsFor:'initialization'!
-
-initialize
- super initialize.
- label := 'Warning'
-! !
-
-!WarningBox methodsFor:'realization'!
-
-openModal
- "added bell to wake up user"
-
- self beep.
- super openModal
-
- "
- self warn:'hello'
- "
-
- "Modified: 28.5.1996 / 16:59:01 / cg"
-! !
-
-!WarningBox class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/WarnBox.st,v 1.25 1999-08-18 14:29:45 cg Exp $'
-! !