--- a/SelListV.st Mon May 08 17:19:27 1995 +0200
+++ b/SelListV.st Tue May 09 03:57:16 1995 +0200
@@ -10,23 +10,24 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:01:02 am'!
+'From Smalltalk/X, Version:2.10.5 on 8-may-1995 at 11:59:03 am'!
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 toggleSelect strikeOut
- iSearchString items doubleClickMsg'
+ halfIntensityFgColor doubleClickActionBlock selectConditionBlock
+ listAttributes multipleSelectOk clickLine initialSelectionMsg
+ printItems oneItem useIndex hilightLevel hilightFrameColor
+ ignoreReselect arrowLevel smallArrow keyActionStyle
+ returnKeyActionStyle toggleSelect strikeOut iSearchString items
+ doubleClickMsg'
classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
- SmallRightArrowShadowForm SmallRightArrowLightForm
- DefaultForegroundColor DefaultBackgroundColor
- DefaultHilightForegroundColor DefaultHilightBackgroundColor
- DefaultHilightFrameColor DefaultHilightLevel DefaultFont
- DefaultRightArrowStyle DefaultRightArrowLevel
- DefaultDisabledForegroundColor DefaultShadowColor
- DefaultLightColor'
+ SmallRightArrowShadowForm SmallRightArrowLightForm
+ DefaultForegroundColor DefaultBackgroundColor
+ DefaultHilightForegroundColor DefaultHilightBackgroundColor
+ DefaultHilightFrameColor DefaultHilightLevel DefaultFont
+ DefaultRightArrowStyle DefaultRightArrowLevel
+ DefaultDisabledForegroundColor DefaultShadowColor
+ DefaultLightColor'
poolDictionaries:''
category:'Views-Text'
!
@@ -35,7 +36,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.31 1995-05-08 15:19:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.32 1995-05-09 01:56:42 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
@@ -56,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.31 1995-05-08 15:19:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.32 1995-05-09 01:56:42 claus Exp $
"
!
@@ -157,6 +158,8 @@
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
@@ -170,202 +173,301 @@
or in the traditional mvc way.
with actions:
- simple:
-
- |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:slv in:(0.0@0.0 corner:1.0@1.0).
- top open
+ basic interface:
+
+ |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
+
+
+ get element instead of index:
+
+ |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
+
+
+ concrete example; show filenames:
+ (notice: normally, you would use a FileSelectionList)
+
+ |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
+
add a scrollbar:
- |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
+ |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
+
allow reselect (clicking on already selected entry):
- |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
+ |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
+
allow multiple selections:
- |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 multipleSelectOk:true.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |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
+
+
+ same, not using index:
+
+ |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
+
strikeout mode (single):
- |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
+ |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
+
strikeout mode (multiple):
- |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
+ |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
+
define what to do on double-click:
- |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 | slv selectionValue asFilename edit].
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open
+ |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
using a Model:
- |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
+ |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
notice, that the ST-80 behavaior on reselect is to send a selection change
with an index of 0.
+ same, with useIndex false:
+
+ |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
+
+
using a SelectionInList-Model:
(see how changes in the model (via list:...) are reflected in the view)
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- top := StandardSystemView new
- label:'select';
- minExtent:100@100;
- maxExtent:300@400;
- extent:200@200.
-
- slv := SelectionInListView
- on:model
- aspect:#list
- change:#selection:
- list:#list
- initialSelection:#selection.
-
- top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
- top open.
- model inspect
-
-
- since the above selectors are the default anyway, you can also use:
-
- |top slv model|
-
- model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
-
- 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.
- model inspect
+ |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.
+
+ model inspect
+
+
+ two selectionInListViews on the same selectionInList model:
+
+ |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.
"
! !
@@ -387,6 +489,18 @@
useIndex:useIndex
!
+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 printItems:print oneItem:one aspect:aspect
change:change list:list menu:menu initialSelection:initial
@@ -413,22 +527,26 @@
menu:menu
initialSelection:initial
useIndex:true
-!
-
-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
! !
!SelectionInListView class methodsFor:'defaults'!
+defaultListMessage
+ ^ #list
+!
+
+defaultChangeMessage
+ ^ #selectionIndex:
+!
+
+defaultAspectMessage
+ ^ nil
+!
+
+defaultSelectionMessage
+ ^ #selectionIndex
+!
+
rightArrowShadowFormOn:aDevice
"return the form used for the right arrow light pixels (3D only)"
@@ -604,14 +722,333 @@
^ f
! !
+!SelectionInListView methodsFor:'selections'!
+
+isInSelection:aNumber
+ "return true, if line, aNumber is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ multipleSelectOk ifTrue:[
+ ^ (selection includes:aNumber)
+ ].
+ ^ (aNumber == selection)
+!
+
+selectWithoutScroll:aNumberOrNilOrCollection
+ "select line, aNumber or deselect if argument is nil"
+
+ |prevSelection newSelection|
+
+ newSelection := aNumberOrNilOrCollection.
+ newSelection notNil ifTrue:[
+ (self isValidSelection:newSelection) ifFalse:[
+ newSelection := nil
+ ]
+ ].
+
+ (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
+ ]
+ ]
+
+!
+
+makeSelectionVisible
+ "scroll to make the selection line visible"
+
+ |line|
+
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ line := selection first.
+ ] ifFalse:[
+ line := selection
+ ].
+ self makeLineVisible:line
+ ]
+!
+
+selection:aNumberOrNil
+ "select line, aNumber or deselect if argument is nil;
+ scroll to make the selected line visible"
+
+ self selectWithoutScroll:aNumberOrNil.
+ selection notNil ifTrue:[self makeSelectionVisible]
+!
+
+selectionValue
+ "return the selection value i.e. the text in the selected line.
+ For multiple selections a collection containing the entries is returned."
+
+ selection isNil ifTrue:[^ nil].
+
+ multipleSelectOk ifTrue:[
+ ^ selection collect:[:nr | self at:nr]
+ ].
+ ^ self at:selection
+
+!
+
+hasSelection
+ "return true, if the view has a selection"
+
+ ^ selection notNil
+!
+
+selectElement:anObject
+ "select the element with same printString as the argument, anObject.
+ Scroll to make the new selection visible."
+
+ |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]
+ ]
+!
+
+selection
+ "return the selection index or collection of indices (if multipleSelect is on)"
+
+ ^ selection
+!
+
+selectionChangedFrom:oldSelection
+ "selection has changed. Call actionblock and/or send changeMessage if defined"
+
+ |arg|
+
+ arg := self argForChangeMessage.
+ "
+ the ST/X way of doing things - perform actionBlock
+ "
+ actionBlock notNil ifTrue:[actionBlock value:arg].
+ "
+ the ST-80 way of doing things - notify model via changeMsg
+ "
+ "/ ST80 sends 0 as index, if the same selection is reselected ...
+ selection == oldSelection ifTrue:[
+ arg := 0
+ ].
+ self sendChangeMessageWith:arg
+!
+
+deselect
+ "deselect"
+
+ self selection:nil
+!
+
+deselectWithoutRedraw
+ "deselect - no redraw"
+
+ selection := nil
+!
+
+numberOfSelections
+ "return the number of selected entries"
+
+ |sz|
+
+ selection isNil ifTrue:[^ 0].
+ sz := selection size.
+ sz > 0 ifTrue:[^ sz].
+ ^ 1
+!
+
+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)
+!
+
+selectElementWithoutScroll:anObject
+ "select the element with same printString as the argument, anObject.
+ Do not scroll."
+
+ |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]
+ ]
+!
+
+nextAfterSelection
+ "return the index of the next selectable entry after the selection.
+ Wrap at end."
+
+ |next|
+
+ selection isNil ifTrue:[
+ next := firstLineShown
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ next := selection max + 1
+ ] ifFalse:[
+ next := selection + 1
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next > self size ifTrue:[
+ next := 1.
+ ] ifFalse:[
+ [next <= self size
+ and:[(self isValidSelection:next) not]] whileTrue:[
+ next := next + 1
+ ].
+ ].
+ ].
+ (self isValidSelection:next) ifFalse:[
+ next := nil
+ ].
+ ^ next
+!
+
+previousBeforeSelection
+ "return the index of the previous selectable entry before the selection.
+ Wrap at beginning."
+
+ |prev|
+
+ selection isNil ifTrue:[
+ prev := firstLineShown - 1
+ ] ifFalse:[
+ selection size ~~ 0 ifTrue:[
+ 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."
+
+ |oldSelection|
+
+ multipleSelectOk ifTrue:[
+ oldSelection := selection.
+ selection := OrderedCollection withAll:(1 to:self size).
+ shown ifTrue:[self redraw].
+ self selectionChangedFrom:oldSelection.
+ ]
+!
+
+toggleSelection:aNumber
+ "toggle selection-state of entry, aNumber"
+
+ (self isInSelection:aNumber) ifTrue:[
+ self removeFromSelection:aNumber
+ ] ifFalse:[
+ self addToSelection:aNumber
+ ]
+!
+
+selectNext
+ "select next line or first visible if there is currrently no selection.
+ Wrap at end."
+
+ self selection:(self nextAfterSelection)
+!
+
+selectPrevious
+ "select previous line or previous visible if there is currently no selection.
+ Wrap at beginning."
+
+ self selection:(self previouseBeforeSelection).
+!
+
+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
+ ].
+ ].
+
+!
+
+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.
+ ].
+ ^ selection
+! !
+
!SelectionInListView methodsFor:'redrawing'!
-redrawElement:aNumber
- "redraw an individual element"
-
- ^ self redrawLine:aNumber
-!
-
redrawVisibleLine:visLineNr
"redraw a single line.
Must check, if any is in the selection and handle this case.
@@ -626,43 +1063,52 @@
(self isInSelection:listLine) ifTrue:[
^ self drawVisibleLineSelected:visLineNr
].
- (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
- fg := halfIntensityFgColor
- ] ifFalse:[
- (self line:listLine hasAttribute:#disabled) ifTrue:[
+
+ listAttributes notNil ifTrue:[
+ (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
fg := halfIntensityFgColor
+ ] ifFalse:[
+ (self line:listLine hasAttribute:#disabled) ifTrue:[
+ fg := halfIntensityFgColor
+ ].
].
- ].
- (self line:listLine hasAttribute:#bold) ifTrue:[
- font bold ifTrue:[
- "
- mhmh - what can be done, if the font is already bold ?
- "
- newFont := font.
- fgColor brightness > 0.5 ifTrue:[
- fg := fgColor darkened "darkened".
+ (self line:listLine hasAttribute:#bold) ifTrue:[
+ font bold ifTrue:[
+ "
+ mhmh - what can be done, if the font is already bold ?
+ "
+ newFont := font.
+ 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
+ ].
+ ]
] ifFalse:[
- fg := fgColor lightened "lightened"
+ newFont := font asBold
].
- (fg brightness - bg brightness) abs < 0.25 ifTrue:[
- bgColor brightness > 0.5 ifTrue:[
- fg := fg darkened.
- ] ifFalse:[
- fg := fg lightened
- ].
- ]
- ] ifFalse:[
- newFont := font asBold
- ].
- device setFont:(newFont on:device) fontId in:gcId.
- self drawVisibleLine:visLineNr with:fg and:bg.
- device setFont:(font on:device) fontId in:gcId.
- ^ self
+ device setFont:(newFont on:device) fontId in:gcId.
+ self drawVisibleLine:visLineNr with:fg and:bg.
+ device setFont:(font on:device) fontId in:gcId.
+ ^ self
+ ]
]
].
^ self drawVisibleLine:visLineNr with:fg and:bg
!
+redrawElement:aNumber
+ "redraw an individual element"
+
+ ^ self redrawLine:aNumber
+!
+
drawVisibleLineSelected:visLineNr
"redraw a single line as selected."
@@ -779,6 +1225,16 @@
]
!
+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
+!
+
drawRightArrowInVisibleLine:visLineNr
"draw a right arrow (for submenus).
This method is not used here, but provided for subclasses such
@@ -840,16 +1296,6 @@
super redrawVisibleLine:visLineNr col:colNr
!
-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
-!
-
redrawVisibleLine:visLineNr from:startCol
"redraw from a col to the right end.
Must check, if its in the selection and handle this case."
@@ -860,883 +1306,8 @@
super redrawVisibleLine:visLineNr from:startCol
! !
-!SelectionInListView methodsFor:'selections'!
-
-selectWithoutScroll:aNumberOrNil
- "select line, aNumber or deselect if argument is nil"
-
- |prevSelection newSelection|
-
- newSelection := aNumberOrNil.
- newSelection notNil ifTrue:[
- (self isValidSelection:newSelection) ifFalse:[
- newSelection := nil
- ]
- ].
-
- (newSelection == selection) ifTrue: [^ self].
-
- selection notNil ifTrue: [
- prevSelection := selection.
- selection := nil.
- (prevSelection isCollection) ifTrue:[
- prevSelection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:prevSelection
- ]
- ].
- selection := newSelection.
- (selection isCollection) ifTrue:[
- selection do:[:line |
- self redrawElement:line
- ]
- ] ifFalse:[
- self redrawElement:selection
- ]
-
-!
-
-selection:aNumberOrNil
- "select line, aNumber or deselect if argument is nil;
- scroll to make the selected line visible"
-
- self selectWithoutScroll:aNumberOrNil.
- selection notNil ifTrue:[self makeSelectionVisible]
-!
-
-makeSelectionVisible
- "scroll to make the selection line visible"
-
- |line|
-
- selection notNil ifTrue:[
- (selection isCollection) ifTrue:[
- line := selection first.
- ] ifFalse:[
- line := selection
- ].
- self makeLineVisible:line
- ]
-!
-
-isInSelection:aNumber
- "return true, if line, aNumber is in the selection"
-
- selection isNil ifTrue:[^ false].
- selection isCollection ifTrue:[
- ^ (selection includes:aNumber)
- ].
- ^ (aNumber == selection)
-!
-
-toggleSelect:aBoolean
- "turn on/off toggle select"
-
- toggleSelect := aBoolean.
-!
-
-multipleSelectOk:aBoolean
- "allow/disallow multiple selections"
-
- multipleSelectOk := aBoolean.
- aBoolean ifTrue:[
- self enableButtonMotionEvents
- ] ifFalse:[
- self disableButtonMotionEvents
- ]
-!
-
-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
-!
-
-strikeOut:aBoolean
- "turn on/off strikeOut mode"
-
- strikeOut := aBoolean.
-!
-
-selection
- "return the selection line nr or collection of line numbers"
-
- ^ selection
-!
-
-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)"
-
- ignoreReselect := aBoolean
-!
-
-enable
- "enable selections"
-
- enabled := true
-!
-
-disable
- "disable selections"
-
- enabled := false
-!
-
-selectionValue
- "return the selection value i.e. the text in the selected line.
- For multiple selections a collection containing the entries is returned."
-
- selection isNil ifTrue:[^ nil].
- (selection isCollection) ifTrue:[
- ^ selection collect:[:nr | self at:nr]
- ].
- ^ self at:selection
-
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
- sz := selection size.
- sz > 0 ifTrue:[^ sz].
- ^ 1
-!
-
-hasSelection
- "return true, if the view has a selection"
-
- ^ selection notNil
-!
-
-deselectWithoutRedraw
- "deselect - no redraw"
-
- selection := nil
-!
-
-deselect
- "deselect"
-
- self selection:nil
-!
-
-selectElement:anObject
- "select the element with same printString as the argument, anObject.
- Scroll to make the new selection visible."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selection:lineNo]
- ]
-!
-
-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)
-!
-
-selectElementWithoutScroll:anObject
- "select the element with same printString as the argument, anObject.
- Do not scroll."
-
- |lineNo|
-
- list notNil ifTrue:[
- lineNo := list indexOf:(anObject printString) ifAbsent:[].
- lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
- ]
-!
-
-selectAll
- "select all entries."
-
- |oldSelection|
-
- oldSelection := selection.
- selection := OrderedCollection withAll:(1 to:self size).
- shown ifTrue:[self redraw].
- self selectionChangedFrom:oldSelection.
-!
-
-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."
-
- |lineNo str|
-
- str := anObject printString.
- lineNo := list findFirst:[:entry | str = entry printString].
- lineNo ~~ 0 ifTrue:[
- self addToSelection:lineNo.
- ^ true
- ].
- ^ false
-!
-
-addToSelection:aNumber
- "add entry, aNumber to the selection. No scrolling is done."
-
- (self isValidSelection:aNumber) ifFalse:[^ self].
-
- selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifTrue:[^ self].
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
- selection add:aNumber
- ] ifFalse:[
- (aNumber == selection) ifTrue:[^ self].
- (selectConditionBlock notNil
- and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
- selection := OrderedCollection with:selection with:aNumber
- ].
- self redrawElement:aNumber
-!
-
-removeFromSelection:aNumber
- "remove entry, aNumber from the selection."
-
- selection isNil ifTrue:[^ self].
-
- selection isCollection ifTrue:[
- (selection includes:aNumber) ifFalse:[^ self].
- selection remove:aNumber.
- selection size == 1 ifTrue:[
- selection := selection first
- ] ifFalse:[
- selection size == 0 ifTrue:[
- selection := nil
- ]
- ]
- ] ifFalse:[
- (aNumber == selection) ifFalse:[^ self].
- selection := nil
- ].
- self redrawElement:aNumber
-!
-
-nextAfterSelection
- "return the number of the next selectable entry after the selection.
- Wrap at end."
-
- |next|
-
- selection isNil ifTrue:[
- next := firstLineShown
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- next := selection max + 1
- ] ifFalse:[
- next := selection + 1
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next > self size ifTrue:[
- next := 1.
- ] ifFalse:[
- [next <= self size
- and:[(self isValidSelection:next) not]] whileTrue:[
- next := next + 1
- ].
- ].
- ].
- (self isValidSelection:next) ifFalse:[
- next := nil
- ].
- ^ next
-!
-
-previousBeforeSelection
- "return the number of the previous selectable entry before the selection.
- Wrap at beginning."
-
- |prev|
-
- selection isNil ifTrue:[
- prev := firstLineShown - 1
- ] ifFalse:[
- selection size ~~ 0 ifTrue:[
- 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
-
-!
-
-toggleSelection:aNumber
- "toggle selection-state of entry, aNumber"
-
- (self isInSelection:aNumber) ifTrue:[
- self removeFromSelection:aNumber
- ] ifFalse:[
- self addToSelection:aNumber
- ]
-!
-
-selectNext
- "select next line or first visible if there is currrently no selection.
- Wrap at end."
-
- self selection:(self nextAfterSelection)
-!
-
-selectPrevious
- "select previous line or previous visible if there is currently no selection.
- Wrap at beginning."
-
- self selection:(self previouseBeforeSelection).
-!
-
-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."
-
- |sz|
-
- selection isNil ifTrue:[^ self].
- sz := selection size.
- sz > 0 ifTrue:[
- selection do:aBlock
- ] ifFalse:[
- aBlock value:selection
- ].
-!
-
-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:[
- printItems ifFalse:[
- ^ self selectionValue
- ].
- ^ items at:selection
- ].
- "true or nil - strange"
- ^ selection.
-!
-
-selectionChangedFrom:oldSelection
- "selection has changed. Call actionblock and/or send changeMessage if defined"
-
- |arg|
-
- arg := self argForChangeMessage.
- "
- the ST/X way of doing things - perform actionBlock
- "
- actionBlock notNil ifTrue:[actionBlock value:arg].
- "
- the ST-80 way of doing things - notify model via changeMsg
- "
- "/ ST80 sends 0 as index, if the same selection is reselected ...
- selection == oldSelection ifTrue:[
- arg := 0
- ].
- self sendChangeMessageWith:arg
-!
-
-selectionAsCollection
- "return the selection as a collection of line numbers"
-
- selection size = 0 ifTrue:[
- selection isNil ifTrue:[^ #()].
- ^ (OrderedCollection new) add:selection; yourself.
- ] ifFalse:[
- ^ selection
- ].
-! !
-
-!SelectionInListView methodsFor:'accessing'!
-
-line:lineNr hasAttribute:aSymbol
- "return true, if line nr has attribute, aSymbol;
- currently supported attributes are:
- #halfIntensity
- #disabled
- #bold
- "
-
- |attr|
-
- (lineNr > listAttributes size) ifTrue:[^ false].
- attr := listAttributes at:lineNr.
- attr isNil ifTrue:[^ false].
- attr isSymbol ifTrue:[^ attr == aSymbol].
- ^ (attr includes:aSymbol)
-!
-
-contents:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- selection := nil.
- listAttributes := nil.
- super contents:aCollection.
-!
-
-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
- ]
- ]
-
-!
-
-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.
-!
-
-list:aCollection
- "set the list - redefined, since setting the list implies unselecting
- and clearing attributes."
-
- "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).
- ].
- ].
-
- selection := nil.
- listAttributes := nil.
- super list:aCollection.
-!
-
-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
-!
-
-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
-!
-
-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
-!
-
-action:aBlock
- "set the action block to be performed on select"
-
- actionBlock := aBlock
-!
-
-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
-!
-
-doubleClickAction:aBlock
- "set the double click action block to be performed on select"
-
- doubleClickActionBlock := aBlock
-!
-
-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
-!
-
-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
-!
-
-removeIndex:lineNr
- "delete line - with redraw.
- Redefined since we have to care for selection"
-
- self checkRemovingSelection:lineNr.
- ^ super removeIndex:lineNr
-!
-
-add:aValue beforeIndex:index
- "must recompute our current selections"
-
- selection notNil ifTrue:[
- selection size = 0 ifTrue:[
- selection >= index ifTrue:[
- selection := selection + 1.
- ].
- ] ifFalse:[
- selection := selection collect:[ :sel |
- sel >= index ifTrue:[
- sel + 1
- ] ifFalse:[
- sel
- ]
- ].
- ].
- ].
- ^ super add:aValue beforeIndex:index.
-!
-
-useIndex:aBoolean
- "set/clear the useIndex flag. If set, both actionBlock and change-messages
- are passed the index of the selection as argument. If clear, the value
- (i.e. the selected string) is passed.
- Default is true."
-
- useIndex := aBoolean
-! !
-
-!SelectionInListView methodsFor:'accessing-mvc'!
-
-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.
-!
-
-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
-!
-
-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
-!
-
-selectionMessage
- "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
-!
-
-selectionMessage: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
-!
-
-addModelInterfaceTo:aDictionary
- "see comment in View>>modelInterface"
-
- super addModelInterfaceTo:aDictionary.
- aDictionary at:#doubleClickMessage put:doubleClickMsg.
- aDictionary at:#selectionMessage put:initialSelectionMsg.
-
- "
- SelectionInListView new modelInterface
- "
-! !
-
!SelectionInListView methodsFor:'private'!
-isValidSelection:aNumber
- "return true, if aNumber is ok for a selection lineNo"
-
- aNumber isNil ifTrue:[^ false].
- (aNumber isCollection) ifTrue:[
- (multipleSelectOk or:[aNumber size = 1]) ifFalse:[^ false].
- aNumber do:[ :line |
- (line between:1 and:self size) ifFalse:[^ false].
- ].
- ^ true.
- ] ifFalse:[
- ^ (aNumber between:1 and:self size).
- ].
-
-!
-
-widthForScrollBetween:start and:end
- "has to be redefined since WHOLE line is inverted/modified sometimes"
-
- | anySelectionInRange |
-
- selection notNil ifTrue:[
- selection isCollection 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:style) ifTrue:[
- ^ width
- ].
- viewBackground = background ifFalse:[
- ^ width
- ]
-"
- ].
- ^ super widthForScrollBetween:start and:end
-!
-
-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
-!
-
-visibleLineNeedsSpecialCare:visLineNr
- |listLine|
-
- listLine := self visibleLineToListLine:visLineNr.
- listLine isNil ifTrue:[^ false].
- (self isInSelection:listLine) ifTrue:[^ true].
- listAttributes notNil ifTrue:[
- (listLine <= listAttributes size) ifTrue:[
- ^ (listAttributes at:listLine) notNil
- ]
- ].
- ^ false
-!
-
-checkRemovingSelection:lineNr
- "when a line is removed, we have to adjust selection"
-
- |newSelection|
-
- selection notNil ifTrue:[
- (selection size > 0) 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 == 1 ifTrue:[
- selection := newSelection first
- ] ifFalse:[
- newSelection size == 0 ifTrue:[
- selection := nil
- ] ifFalse:[
- selection := newSelection
- ]
- ]
- ] ifFalse:[
- selection == lineNr ifTrue:[
- selection := nil
- ] ifFalse:[
- selection > lineNr ifTrue:[
- selection := selection - 1
- ]
- ]
- ]
- ]
-!
-
-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.
-!
-
getListFromModel
"if I have a model and a listMsg, get my list from it"
@@ -1775,6 +1346,795 @@
].
]
].
+!
+
+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
+ ^ selection
+ ].
+
+ printItems ifFalse:[
+ ^ self selectionValue
+ ].
+
+ items notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ ^ selection collect:[:nr | items at:nr]
+ ].
+ ^ items at:selection
+ ].
+
+ ^ nil "/ cannot happen
+!
+
+isValidSelection:aNumberOrCollection
+ "return true, if aNumber is ok as a selection index"
+
+ aNumberOrCollection isNil ifTrue:[^ false].
+
+ (aNumberOrCollection isCollection) ifTrue:[
+ multipleSelectOk ifFalse:[^ false].
+ aNumberOrCollection do:[:index |
+ (index between:1 and:self size) ifFalse:[^ false].
+ ].
+ ^ true.
+ ] ifFalse:[
+ ^ (aNumberOrCollection between:1 and:self size).
+ ].
+
+!
+
+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
+!
+
+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:style) ifTrue:[
+ ^ width
+ ].
+ viewBackground = background ifFalse:[
+ ^ width
+ ]
+"
+ ].
+ ^ super widthForScrollBetween:start and:end
+!
+
+visibleLineNeedsSpecialCare:visLineNr
+ |listLine|
+
+ listLine := self visibleLineToListLine:visLineNr.
+ listLine isNil ifTrue:[^ false].
+ (self isInSelection:listLine) ifTrue:[^ true].
+ listAttributes notNil ifTrue:[
+ (listLine <= listAttributes size) ifTrue:[
+ ^ (listAttributes at:listLine) notNil
+ ]
+ ].
+ ^ false
+!
+
+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
+ ]
+ ]
+ ]
+ ]
+!
+
+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.
+! !
+
+!SelectionInListView methodsFor:'event handling'!
+
+buttonRelease:button x:x y:y
+ "stop any autoscroll"
+
+ self stopAutoScroll
+!
+
+buttonPress:button x:x y:y
+ |oldSelection listLineNr|
+
+ ((button == 1) or:[button == #select]) ifTrue:[
+ enabled ifTrue:[
+ listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
+ listLineNr notNil ifTrue:[
+ (toggleSelect
+ and:[self isInSelection:listLineNr]) ifTrue:[
+ oldSelection := selection copy.
+ self removeFromSelection:listLineNr
+ ] ifFalse:[
+ (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ 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
+ ].
+ ]
+ ] ifFalse:[
+ super buttonPress:button x:x y:y
+ ]
+!
+
+sizeChanged:how
+ "if there is a selection, make certain, its visible
+ after the sizechange"
+
+ |first wasAtEnd|
+
+ wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
+
+ super sizeChanged:how.
+
+ shown ifTrue:[
+ selection notNil ifTrue:[
+ multipleSelectOk ifTrue:[
+ first := selection first
+ ] 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
+ ]
+ ]
+ ]
+!
+
+keyPress:key x:x y:y
+ "handle keyboard input"
+
+ |index startSearch backSearch searchPrefix|
+
+ (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 cought in ScrollableView
+ "/ we normally do not get them ...
+ "/ (need to call handlesKey: from there ...
+ "/ ... and implement it here)
+ "/
+ (key == #Home) ifTrue:[
+ self key:key select:1 x:x y:y.
+ ^ self
+ ].
+ (key == #End) 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
+ ].
+ ].
+
+ "
+ alphabetic keys: search for next entry
+ starting with keys character. If shift is pressed, search backward
+ "
+ (self size > 0
+ and:[key isCharacter
+ and:[key isLetter]]) ifTrue:[
+ keyActionStyle isNil ifTrue:[^ self].
+ keyActionStyle == #pass ifFalse:[
+ searchPrefix := key asLowercase asString.
+
+"/ ... isISearch... ifFalse:[
+"/ iSearchString := ''
+"/ ] ifTrue:[
+"/ iSearchString := iSearchString , searchPrefix.
+"/ searchPrefix := iSearchString
+"/ ].
+
+ backSearch := device shiftDown.
+ backSearch ifTrue:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection first - 1
+ ] ifFalse:[
+ startSearch := selection - 1
+ ]
+ ] ifFalse:[
+ startSearch := self size
+ ].
+ startSearch < 1 ifTrue:[
+ startSearch := self size.
+ ].
+ ] ifFalse:[
+ selection notNil ifTrue:[
+ selection size > 0 ifTrue:[
+ startSearch := selection last + 1
+ ] ifFalse:[
+ startSearch := selection + 1
+ ]
+ ] ifFalse:[
+ startSearch := 1
+ ].
+ startSearch > self size ifTrue:[
+ startSearch := 1.
+ ].
+ ].
+ index := startSearch.
+ [true] whileTrue:[
+ (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
+ index = selection ifTrue:[^ self].
+ ^ self key:key select:index x:x y:y
+ ].
+ backSearch ifTrue:[
+ index := index - 1.
+ index < 1 ifTrue:[index := self size]
+ ] ifFalse:[
+ index := index + 1.
+ index > self size ifTrue:[index := 1].
+ ].
+ index == startSearch ifTrue:[
+ ^ self
+ ]
+ ]
+ ].
+ ].
+ ^ super keyPress:key x:x y:y
+!
+
+buttonMotion:buttonMask x:x y:y
+ "mouse-move while button was pressed - handle selection changes"
+
+ |movedVisibleLine movedLine delta oldSelection oldSelCount|
+
+ "is it the select or 1-button ?"
+ (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
+ (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
+ ^ self
+ ].
+ ].
+
+ clickLine isNil ifTrue:[^ 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
+ ].
+
+ "move inside - stop autoscroll if any"
+ self stopAutoScroll.
+
+ movedVisibleLine := self visibleLineOfY:y.
+ movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
+ (movedLine == clickLine) ifTrue:[^ self].
+
+ multipleSelectOk ifTrue:[
+ delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
+
+ oldSelection := selection.
+ oldSelCount := selection size.
+
+ (clickLine+delta) to:movedLine by:delta do:[:line |
+ (self isInSelection:line) ifTrue:[
+ self removeFromSelection:line
+ ] ifFalse:[
+ self addToSelection:line
+ ]
+ ].
+ ((selection ~= oldSelection)
+ or:[selection size ~~ oldSelCount]) ifTrue:[
+ self selectionChangedFrom:oldSelection.
+ ]
+ ] ifFalse:[
+"/ self selectWithoutScroll:movedLine
+ ].
+
+ clickLine := movedLine
+!
+
+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|
+
+ (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.
+ self selectionChangedFrom:oldSelection.
+ keyActionStyle == #selectAndDoubleClick ifTrue:[
+ self doubleClicked
+ ]
+ ]
+ ].
+!
+
+buttonMultiPress:button x:x y:y
+ ((button == 1) or:[button == #select]) ifTrue:[
+"/ doubleClickActionBlock isNil ifTrue:[
+"/ self buttonPress:button x:x y:y
+"/ ].
+ self doubleClicked.
+ ] ifFalse:[
+ super buttonMultiPress:button x:x y:y
+ ]
+!
+
+buttonShiftPress:button x:x y:y
+ "add to the selection (if multipleSelectOk); 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 line:listLineNr hasAttribute:#disabled) ifTrue:[^ 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 buttonShiftPress:button x:x y:y
+ ]
+!
+
+doubleClicked
+ doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
+ (model notNil and:[doubleClickMsg notNil]) ifTrue:[
+ self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
+ ].
+! !
+
+!SelectionInListView methodsFor:'accessing-actions'!
+
+action:aBlock
+ "set the action block to be performed on select"
+
+ actionBlock := aBlock
+!
+
+doubleClickAction:aBlock
+ "set the double click action block to be performed on select"
+
+ doubleClickActionBlock := aBlock
+!
+
+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: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
+!
+
+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
+! !
+
+!SelectionInListView methodsFor:'accessing-attributes'!
+
+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
+!
+
+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
+ ]
+ ]
+
+!
+
+strikeOut:aBoolean
+ "turn on/off strikeOut mode"
+
+ strikeOut := aBoolean.
+!
+
+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 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
+! !
+
+!SelectionInListView methodsFor:'accessing-behavior'!
+
+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)"
+
+ ignoreReselect := aBoolean
+!
+
+toggleSelect:aBoolean
+ "turn on/off toggle select. If true, clicking on a selected entry
+ unselects it and vice versa. The default is false."
+
+ toggleSelect := aBoolean.
+!
+
+multipleSelectOk:aBoolean
+ "allow/disallow multiple selections"
+
+ multipleSelectOk := aBoolean.
+ aBoolean ifTrue:[
+ self enableButtonMotionEvents
+ ] ifFalse:[
+ self disableButtonMotionEvents
+ ]
+!
+
+enable
+ "enable the view - selection changes are allowed"
+
+ enabled := true
+!
+
+disable
+ "disable the view - no selection changes are allowed"
+
+ enabled := false
+! !
+
+!SelectionInListView methodsFor:'accessing-contents'!
+
+list:aCollection
+ "set the list - redefined, since setting the list implies unselecting
+ and clearing attributes."
+
+ "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).
+ ].
+ ].
+
+ selection := nil.
+ listAttributes := nil.
+ super list: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.
+!
+
+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
+!
+
+removeIndex:lineNr
+ "delete line - with redraw.
+ Redefined since we have to care for selection"
+
+ self checkRemovingSelection:lineNr.
+ ^ super removeIndex:lineNr
+!
+
+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.
! !
!SelectionInListView methodsFor:'initialization'!
@@ -1785,26 +2145,32 @@
cursor := Cursor hand
!
-realize
- super realize.
-
- selection notNil ifTrue:[
- self makeLineVisible:selection
- ].
- self getListFromModel.
- self getSelectionFromModel
-!
-
initialize
super initialize.
fontHeight := font height + lineSpacing.
enabled := true.
- multipleSelectOk := false.
ignoreReselect := true.
- toggleSelect := false.
- strikeOut := false.
+ multipleSelectOk := toggleSelect := strikeOut := printItems := false.
+ useIndex := true.
+
keyActionStyle := #select.
+ returnKeyActionStyle := #doubleClick.
+
+ listMsg := self class defaultListMessage.
+ initialSelectionMsg := self class defaultSelectionMessage.
+
+!
+
+realize
+ super realize.
+
+ self getListFromModel.
+ self getSelectionFromModel.
+
+ selection notNil ifTrue:[
+ self makeLineVisible:selection
+ ].
!
initStyle
@@ -1908,338 +2274,154 @@
hilightBgColor := hilightBgColor on:device.
! !
-!SelectionInListView methodsFor:'event handling'!
-
-buttonPress:button x:x y:y
- |oldSelection listLineNr|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- enabled ifTrue:[
- listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
- listLineNr notNil ifTrue:[
- (toggleSelect
- and:[self isInSelection:listLineNr]) ifTrue:[
- oldSelection := selection copy.
- self removeFromSelection:listLineNr
- ] ifFalse:[
- (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ 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
- ].
- ]
- ] ifFalse:[
- super buttonPress:button x:x y:y
- ]
-!
-
-sizeChanged:how
- "if there is a selection, make certain, its visible
- after the sizechange"
-
- |first wasAtEnd|
-
- wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
-
- super sizeChanged:how.
-
- shown ifTrue:[
- selection notNil ifTrue:[
- selection isCollection ifTrue:[
- selection notEmpty ifTrue:[
- first := selection first
- ]
- ] 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
- ]
- ]
- ]
-!
-
-buttonRelease:button x:x y:y
- "stop any autoscroll"
-
- self stopAutoScroll
-!
-
-key:key select:selectAction x:x y:y
- "perform keyaction after a key-select"
-
- |oldSelection|
-
- keyActionStyle notNil ifTrue:[
- keyActionStyle == #pass ifTrue:[
- ^ super keyPress:key x:x y:y
- ].
- oldSelection := selection.
- selectAction value.
- self selectionChangedFrom:oldSelection.
- keyActionStyle == #selectAndDoubleClick ifTrue:[
- doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
- ]
- ].
-!
-
-keyPress:key x:x y:y
- "handle keyboard input"
-
- |index startSearch backSearch searchPrefix|
-
- (key == #CursorUp) ifTrue:[
- index := self previousBeforeSelection.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- (key == #CursorDown) ifTrue:[
- index := self nextAfterSelection.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- (key == #Home) ifTrue:[
- (selectConditionBlock isNil or:[selectConditionBlock value:1]) ifTrue:[
- self key:key select:[self selection:1] x:x y:y
- ].
- ^ self
- ].
- (key == #End) ifTrue:[
- index := self size.
- (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
- self key:key select:[self selection:index] x:x y:y
- ].
- ^ self
- ].
- key == #Return ifTrue:[
- selection notNil ifTrue:[
- doubleClickActionBlock notNil ifTrue:[
- doubleClickActionBlock value:selection
- ].
- ].
- ^ self
- ].
- "
- alphabetic keys: search for next entry
- starting with keys character. If shift is pressed, search backward
- "
- (self size > 0
- and:[key isCharacter
- and:[key isLetter]]) ifTrue:[
- keyActionStyle isNil ifTrue:[^ self].
- keyActionStyle == #pass ifFalse:[
- searchPrefix := key asLowercase asString.
-
-"/ ... isISearch... ifFalse:[
-"/ iSearchString := ''
-"/ ] ifTrue:[
-"/ iSearchString := iSearchString , searchPrefix.
-"/ searchPrefix := iSearchString
-"/ ].
-
- backSearch := device shiftDown.
- backSearch ifTrue:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection first - 1
- ] ifFalse:[
- startSearch := selection - 1
- ]
- ] ifFalse:[
- startSearch := self size
- ].
- startSearch < 1 ifTrue:[
- startSearch := self size.
- ].
- ] ifFalse:[
- selection notNil ifTrue:[
- selection size > 0 ifTrue:[
- startSearch := selection last + 1
- ] ifFalse:[
- startSearch := selection + 1
- ]
- ] ifFalse:[
- startSearch := 1
- ].
- startSearch > self size ifTrue:[
- startSearch := 1.
- ].
- ].
- index := startSearch.
- [true] whileTrue:[
- (((self at:index) asString) asLowercase startsWith:searchPrefix) ifTrue:[
- index = selection ifTrue:[^ self].
- ^ self key:key select:[self selection:index] x:x y:y
- ].
- backSearch ifTrue:[
- index := index - 1.
- index < 1 ifTrue:[index := self size]
- ] ifFalse:[
- index := index + 1.
- index > self size ifTrue:[index := 1].
- ].
- index == startSearch ifTrue:[
- ^ self
- ]
- ]
- ].
- ].
- ^ super keyPress:key x:x y:y
-
-!
-
-buttonMultiPress:button x:x y:y
- ((button == 1) or:[button == #select]) ifTrue:[
- doubleClickActionBlock isNil ifTrue:[
- self buttonPress:button x:x y:y
- ] ifFalse:[
- doubleClickActionBlock value:selection
- ].
- (model notNil and:[doubleClickMsg notNil]) ifTrue:[
- self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
- ]
- ] ifFalse:[
- super buttonMultiPress:button x:x y:y
- ]
-!
-
-buttonShiftPress:button x:x y:y
- "add to the selection (if multipleSelectOk); 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 line:listLineNr hasAttribute:#disabled) ifTrue:[^ 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 buttonShiftPress:button x:x y:y
- ]
-!
+!SelectionInListView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
- something == aspectMsg ifTrue:[
- self getListFromModel.
- ^ self
- ].
- something == initialSelectionMsg ifTrue:[
- self getSelectionFromModel.
- ^ self
- ].
- something == #empty ifTrue:[
- self list:nil.
- ^ self
- ].
+ something == aspectMsg 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
+ ].
].
^ super update:something with:aParameter from:changedObject
-!
-
-buttonMotion:buttonMask x:x y:y
- "mouse-move while button was pressed - handle selection changes"
-
- |movedVisibleLine movedLine delta oldSelection oldSelCount|
-
- "is it the select or 1-button ?"
- (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
- (device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
- ^ self
- ].
+! !
+
+!SelectionInListView methodsFor:'accessing-selection'!
+
+addToSelection:aNumber
+ "add entry, aNumber to the selection. No scrolling is done."
+
+ (self isValidSelection:aNumber) ifFalse:[^ self].
+
+ selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
+ selection isCollection ifTrue:[
+ (selection includes:aNumber) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection add:aNumber
+ ] ifFalse:[
+ (aNumber == selection) ifTrue:[^ self].
+ (selectConditionBlock notNil
+ and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
+ selection := OrderedCollection with:selection with:aNumber
].
-
- clickLine isNil ifTrue:[^ self].
-
- "if moved outside of view, start autoscroll"
- (y < 0) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollUp:y.
- ^ self
+ self redrawElement:aNumber
+!
+
+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."
+
+ |lineNo str|
+
+ str := anObject printString.
+ lineNo := list findFirst:[:entry | str = entry printString].
+ lineNo ~~ 0 ifTrue:[
+ self addToSelection:lineNo.
+ ^ true
].
- (y > height) ifTrue:[
- self compressMotionEvents:false.
- self startAutoScrollDown:(y - height).
- ^ self
- ].
-
- "move inside - stop autoscroll if any"
- self stopAutoScroll.
-
- movedVisibleLine := self visibleLineOfY:y.
- movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
- (movedLine == clickLine) ifTrue:[^ self].
+ ^ false
+!
+
+removeFromSelection:aNumber
+ "remove entry, aNumber from the selection."
+
+ selection isNil ifTrue:[^ self].
multipleSelectOk ifTrue:[
- delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
-
- oldSelection := selection.
- oldSelCount := selection size.
-
- (clickLine+delta) to:movedLine by:delta do:[:line |
- (self isInSelection:line) ifTrue:[
- self removeFromSelection:line
- ] ifFalse:[
- self addToSelection:line
- ]
- ].
- ((selection ~= oldSelection)
- or:[selection size ~~ oldSelCount]) ifTrue:[
- self selectionChangedFrom:oldSelection.
+ (selection includes:aNumber) ifFalse:[^ self].
+ selection remove:aNumber.
+ selection size == 0 ifTrue:[
+ selection := nil
]
] ifFalse:[
-"/ self selectWithoutScroll:movedLine
+ (aNumber == selection) ifFalse:[^ self].
+ selection := nil
].
-
- clickLine := movedLine
+ self redrawElement:aNumber
! !
+
+!SelectionInListView methodsFor:'accessing-mvc'!
+
+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.
+!
+
+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
+!
+
+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
+!
+
+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
+!
+
+addModelInterfaceTo:aDictionary
+ "see comment in View>>modelInterface"
+
+ super addModelInterfaceTo:aDictionary.
+ aDictionary at:#doubleClickMessage put:doubleClickMsg.
+ aDictionary at:#initialSelectionMessage put:initialSelectionMsg.
+
+ "
+ SelectionInListView new modelInterface
+ "
+! !
+