.
"
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.
"
'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
returnKeyActionStyle toggleSelect strikeOut iSearchString items
doubleClickMsg'
classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
SmallRightArrowShadowForm SmallRightArrowLightForm
DefaultForegroundColor DefaultBackgroundColor
DefaultHilightForegroundColor DefaultHilightBackgroundColor
DefaultHilightFrameColor DefaultHilightLevel DefaultFont
DefaultRightArrowStyle DefaultRightArrowLevel
DefaultDisabledForegroundColor DefaultShadowColor
DefaultLightColor'
poolDictionaries:''
category:'Views-Text'
!
SelectionInListView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.32 1995-05-09 01:56:42 claus Exp $
'!
!SelectionInListView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libwidg/SelectionInListView.st,v 1.32 1995-05-09 01:56:42 claus Exp $
"
!
documentation
"
this one is a ListView with a selected line (which is shown highlighted)
If multipleSelectionsOk is true, it is also allowed to shift-click multiple
entries.
If 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).
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).
InstanceVariables:
selection <misc> the current selection. nil, a number or collection of numbers
actionBlock <Block> block to be evaluated on selection changes
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
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
"
!
examples
"
SelectionInListView can be used both in the ST/X way, using action blocks
or in the traditional mvc way.
with actions:
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
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
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:[: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
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
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 | 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
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').
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.
"
! !
!SelectionInListView class methodsFor:'instance creation'!
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
!
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
"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 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
! !
!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)"
|f|
((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
^ RightArrowShadowForm
].
f := Form fromFile:'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
!
rightArrowLightFormOn:aDevice
"return the form used for the right arrow light pixels (3D only)"
|f|
((aDevice == Display) and:[RightArrowLightForm notNil]) ifTrue:[
^ RightArrowLightForm
].
f := Form fromFile:'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
!
updateStyleCache
DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
DefaultFont := StyleSheet fontAt:'selectionFont'.
"
self updateStyleCache
"
!
rightArrowFormOn:aDevice
"return the form used for the right arrow (non 3D)"
|f|
((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
^ RightArrowForm
].
f := Form fromFile:'RightArrow.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 2r00010000
2r00000100 2r00100000
2r00000100 2r01000000
2r00000100 2r10000000
2r00000101 2r00000000
2r00000110 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000]
on:aDevice
].
(aDevice == Display) ifTrue:[
RightArrowForm := f
].
^ f
!
smallRightArrowLightFormOn:aDevice
"return the form used for the small right arrow light pixels (3D only)"
|f|
((aDevice == Display) and:[SmallRightArrowLightForm notNil]) ifTrue:[
^ SmallRightArrowLightForm
].
f := Form fromFile:'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
!
smallRightArrowShadowFormOn:aDevice
"return the form used for the small right arrow light pixels (3D only)"
|f|
((aDevice == Display) and:[SmallRightArrowShadowForm notNil]) ifTrue:[
^ SmallRightArrowShadowForm
].
f := Form fromFile:'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
! !
!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'!
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|
fg := fgColor.
bg := bgColor.
listLine := self visibleLineToListLine:visLineNr.
listLine notNil ifTrue:[
(self isInSelection:listLine) ifTrue:[
^ self drawVisibleLineSelected:visLineNr
].
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".
] 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:[
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
]
]
].
^ self drawVisibleLine:visLineNr with:fg and:bg
!
redrawElement:aNumber
"redraw an individual element"
^ self redrawLine:aNumber
!
drawVisibleLineSelected:visLineNr
"redraw a single line as selected."
|listLine fg bg
y "{ Class: SmallInteger }"
wEdge|
bg := hilightBgColor.
fg := hilightFgColor.
listLine := self visibleLineToListLine:visLineNr.
listLine notNil ifTrue:[
"XXX only if -1/+1"
"/ hilightLevel ~~ 0 ifTrue:[
"/ self paint:bg.
"/ self fillRectangleX:0 y:(self yOfVisibleLine:visLineNr)-1 width:width height:1
"/ ].
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.
"
a line above and below
"
hilightFrameColor notNil ifTrue:[
self paint:hilightFrameColor.
self displayLineFromX:0 y:y toX:width y:y.
y := y + fontHeight - 1.
self displayLineFromX:0 y:y toX:width y:y.
^ self
].
"
an edge it around
"
(hilightLevel ~~ 0) ifTrue:[
"XXX the -1/+1 need some more work"
"/ self drawEdgesForX:0 y:y-1
"/ width:width height:fontHeight+1
"/ level:hilightLevel.
"
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 height:fontHeight
level:hilightLevel.
^ self
]
].
^ super drawVisibleLine:visLineNr with:fg and:bg
!
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
selNo "{ Class: SmallInteger }" |
((selection isCollection) or:[listAttributes notNil]) ifTrue:[
startVisLineNr to:endVisLineNr 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
]
!
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
as menus or file-lists."
|y x form form2 topLeftColor botRightColor t|
x := width - 16.
y := (self yOfVisibleLine:visLineNr).
device depth == 1 ifTrue:[
form := self class rightArrowFormOn:device.
y := y + ((font height - form height) // 2).
self foreground:Black.
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.
].
y := y + ((font height - form height) // 2).
topLeftColor := lightColor.
botRightColor := shadowColor.
"openwin arrow stays down"
style ~~ #openwin ifTrue:[
(self isInSelection:(self visibleLineToListLine:visLineNr)) 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.
]
!
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
! !
!SelectionInListView methodsFor:'private'!
getListFromModel
"if I have a model and a listMsg, get my list from it"
|text|
model notNil ifTrue:[
listMsg notNil ifTrue:[
items := model perform:listMsg.
items notNil ifTrue:[
printItems ifTrue:[
text := items collect:[:element | element printString]
] ifFalse:[
text := items
].
text notNil ifTrue:[
text := text asStringCollection.
]
].
self list:text
].
].
!
getSelectionFromModel
"if I have a model and an initialSelectionMsg, get my selection from it"
|sel|
model notNil ifTrue:[
initialSelectionMsg notNil ifTrue:[
sel := model perform:initialSelectionMsg.
useIndex ifTrue:[
self selection:sel
] ifFalse:[
self selectElement:sel.
].
]
].
!
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'!
initCursor
"set the cursor - a hand"
cursor := Cursor hand
!
initialize
super initialize.
fontHeight := font height + lineSpacing.
enabled := true.
ignoreReselect := true.
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
|nm|
super initStyle.
DefaultFont notNil ifTrue:[
font := DefaultFont on:device
].
bgColor := viewBackground.
hilightFrameColor := nil.
hilightLevel := 0.
arrowLevel := 1.
smallArrow := false.
device hasGreyscales ifTrue:[
"
must get rid of these hard codings
"
nm := StyleSheet name asSymbol.
(nm == #next) ifTrue:[
hilightFgColor := fgColor.
hilightBgColor := White.
hilightFrameColor := fgColor
] ifFalse:[
(nm == #motif) ifTrue:[
fgColor := White.
bgColor := Grey.
viewBackground := bgColor.
hilightFgColor := bgColor "fgColor" "White".
hilightBgColor := fgColor "bgColor lightened" "darkened".
] ifFalse:[
(nm == #openwin) ifTrue:[
hilightFgColor := fgColor.
hilightBgColor := Color grey.
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 on:device
].
DefaultLightColor notNil ifTrue:[
lightColor := DefaultLightColor on:device
].
(hilightLevel abs > 0) ifTrue:[
lineSpacing := 3
] ifFalse:[
lineSpacing := 2
].
hilightFgColor isNil ifTrue:[
hilightFgColor := bgColor.
hilightBgColor := fgColor
].
DefaultDisabledForegroundColor notNil ifTrue:[
halfIntensityFgColor := DefaultDisabledForegroundColor
] ifFalse:[
halfIntensityFgColor := Color darkGrey.
].
fgColor := fgColor on:device.
bgColor := bgColor on:device.
halfIntensityFgColor := halfIntensityFgColor on:device.
hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor on:device].
hilightFgColor := hilightFgColor on:device.
hilightBgColor := hilightBgColor on:device.
! !
!SelectionInListView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == model ifTrue:[
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
! !
!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
].
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
].
^ false
!
removeFromSelection:aNumber
"remove entry, aNumber from the selection."
selection isNil ifTrue:[^ self].
multipleSelectOk ifTrue:[
(selection includes:aNumber) ifFalse:[^ self].
selection remove:aNumber.
selection size == 0 ifTrue:[
selection := nil
]
] ifFalse:[
(aNumber == selection) ifFalse:[^ self].
selection := nil
].
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
"
! !