"
 COPYRIGHT (c) 1989-93 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

ListView subclass:#SelectionInListView
       instanceVariableNames:'selection actionBlock enabled
                              hilightFgColor hilightBgColor
                              halfIntensityFgColor
                              doubleClickActionBlock
                              listAttributes multipleSelectOk clickLine
                              listSymbol initialSelectionSymbol printItems oneItem'
       classVariableNames:   'hand'
       poolDictionaries:''
       category:'Views-Text'
!

SelectionInListView comment:'

COPYRIGHT (c) 1989-93 by Claus Gittinger
              All Rights Reserved

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.

%W% %E%

written spring/summer 89 by claus
3D Jan 90 by claus
multiselect Jun 92 my claus
'!

!SelectionInListView class methodsFor:'instance creation'!

on:aModel printItems:print oneItem:one aspect:aspect
              change:change list:list menu:menu
                         initialSelection:initial

    "for ST-80 compatibility"

    ^ (self new) on:aModel printItems:print oneItem:one aspect:aspect
                               change:change list:list menu:menu
                     initialSelection:initial
! !

!SelectionInListView methodsFor:'initialization'!

initialize
    super initialize.

    fontHeight := font height + lineSpacing.
    multipleSelectOk := false.
    enabled := true
!

initStyle
    super initStyle.

    bgColor := viewBackground.
    (style == #openwin) ifTrue:[
        lineSpacing := 3
    ] ifFalse:[
        lineSpacing := 2
    ].

    (style == #next) ifTrue:[
        device hasGreyscales ifTrue:[
            hilightFgColor := fgColor.
            hilightBgColor := White
        ] ifFalse:[
            hilightFgColor := White.
            hilightBgColor := Black
        ]
    ] ifFalse:[
        (style == #openwin) ifTrue:[
            device hasGreyscales ifTrue:[
                hilightFgColor := fgColor.
                hilightBgColor := Color grey
            ] ifFalse:[
                hilightFgColor := White.
                hilightBgColor := Black
            ]
        ] ifFalse:[
            (style == #iris) ifTrue:[
                device hasGreyscales ifTrue:[
                    hilightFgColor := bgColor.
                    hilightBgColor := Black
                ] ifFalse:[
                    hilightFgColor := White.
                    hilightBgColor := Black
                ]
            ] ifFalse:[
                self is3D ifTrue:[
                    device hasColors ifTrue:[
                        hilightFgColor := Color name:'yellow'
                    ] ifFalse:[
                        hilightFgColor := White
                    ].
                    device hasGreyscales ifTrue:[
                        hilightBgColor := viewBackground
                    ] ifFalse:[
                        hilightBgColor := Black
                    ]
                ]
            ]
        ]
    ].

    hilightFgColor isNil ifTrue:[
        hilightFgColor := bgColor.
        hilightBgColor := fgColor
    ].

    halfIntensityFgColor := Color darkGrey.
!

initCursor
    "set the cursor - a hand"

    cursor := Cursor hand
!

initEvents
    super initEvents.
    self enableButtonEvents
!

realize
    super realize.
    selection notNil ifTrue:[
        self makeLineVisible:selection
    ]
! !

!SelectionInListView methodsFor:'accessing'!

multipleSelectOk:aBoolean
    "allow/disallow multiple selections"

    multipleSelectOk := aBoolean.
    aBoolean ifTrue:[
        self enableButtonMotionEvents
    ] ifFalse:[
        self disableButtonMotionEvents
    ] 
!

setList:aCollection
    "set the list - redefined, since setting the list implies unselecting"

    selection := nil.
    super setList:aCollection
!

list:aCollection
    "set the list - redefined, since setting the list implies unselecting"

    selection := nil.
    super list:aCollection
!

attributes:aList
    "set the attribute list"

    listAttributes := attributes
!

attributeAt:index
    "return the line attribute of list line index"

    listAttributes isNil ifFalse:[
        (index > listAttributes size) ifFalse:[
            ^ listAttributes at:index
        ]
    ].
    ^ nil
!

attributeAt:index put:aSymbol
    "set a line attribute; currently attributes are:
     #halfIntensity
    "

    (index > list size) ifFalse:[
        listAttributes isNil ifTrue:[
            listAttributes := VariableArray new:index
        ] ifFalse:[
            (index > listAttributes size) ifTrue:[
                listAttributes grow:index
            ]
        ].
        aSymbol == (listAttributes at:index) ifFalse:[
            listAttributes at:index put:aSymbol.
            self redrawLine:index
        ]
    ]
!

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
!

selectionValue
    "answer the selection value i.e. the text in the selected line"

    selection isNil ifTrue:[^ nil].
    ^ list at:selection
!

selection
    "answer the selection line nr"

    ^ selection
!

deselect
    "deselect"

    self selection:nil
!

deselectWithoutRedraw
    "deselect - no redraw"

    selection := nil
!

enable
    "enable selections"

    enabled := true
!

disable
    "disable selections"

    enabled := false
!

selectElement:anObject
    "select the element with same printString as the argument, anObject"

    |lineNo|

    list notNil ifTrue:[
        lineNo := list indexOf:(anObject printString) ifAbsent:[^ self].
        self selection:lineNo
    ]
!

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 isKindOf:Collection) ifTrue:[
            prevSelection do:[:line |
                self redrawElement:line
            ]
        ] ifFalse:[
            self redrawElement:prevSelection
        ]
    ].
    selection := newSelection.
    selection notNil ifTrue:[
        self redrawElement:selection
    ]
!

selection:aNumberOrNil
    "select line, aNumber or deselect if argument is nil;
     make the line visible"

    self selectWithoutScroll:aNumberOrNil.
    selection notNil ifTrue:[
        shown ifTrue:[
            self makeLineVisible:selection
        ]
    ]
!

selectNext
    "select next line or first if there is currrently no selection"

    selection isNil ifTrue:[
        self selection:1
    ] ifFalse:[
        self selection:(selection + 1).
        selection isNil ifTrue:[
            self selection:1
        ]
    ]
!

selectPrevious
    "select previous line or last if there is currently no selection"

    selection isNil ifTrue:[
        self selection:(list size)
    ] ifFalse:[
        self selection:(selection - 1).
        selection isNil ifTrue:[
            self selection:(list size)
        ]
    ]
!

on:aModel printItems:print oneItem:one aspect:aspect
              change:change list:list menu:menu
    initialSelection:initial

    "ST-80 compatibility"

    aspectSymbol := aspect.
    changeSymbol := change.
    listSymbol := list.
    menuSymbol := menu.
    initialSelectionSymbol := initial.
    printItems := print.
    oneItem := one.

    model := aModel.

    listSymbol notNil ifTrue:[
        self list:(aModel perform:listSymbol) asText
    ].
    model addDependent:self
! !

!SelectionInListView methodsFor:'private'!

isValidSelection:aNumber
    "answer true, if aNumber is ok for a selection lineNo"

    aNumber isNil ifTrue:[^ false].
    ^ (aNumber between:1 and:list size)
!

isInSelection:aNumber
    "return true, if line, aNumber is in the selection"

    selection isNil ifTrue:[^ false].
    (selection isKindOf:Collection) ifTrue:[
        ^ (selection includes:aNumber)
    ].
    ^ (aNumber == selection)
!

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:[
        (selection isKindOf:Collection) 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:[
        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
!

removeFromSelection:aNumber
    "remove line, aNumber from the selection"

    selection isNil ifTrue:[^ self].

    (selection isKindOf:Collection) ifTrue:[
        (selection includes:aNumber) ifFalse:[^ self].
        selection remove:aNumber.
        (selection size == 1) ifTrue:[
            selection := selection at:1
        ]
    ] ifFalse:[
        (aNumber == selection) ifFalse:[^ self].
        selection := nil
    ].
    self redrawElement:aNumber
!

addToSelection:aNumber
    "add line, aNumber to the selection"

    selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].

    (self isValidSelection:aNumber) ifFalse:[^ self].
    (selection isKindOf:Collection) ifTrue:[
        (selection includes:aNumber) ifTrue:[^ self].
        selection add:aNumber
    ] ifFalse:[
        (aNumber == selection) ifTrue:[^ self].
        selection := OrderedCollection with:selection
                                       with:aNumber
    ].
    self redrawElement:aNumber
!

scrollSelectDown
    "auto scroll action; scroll and reinstall timed-block"

    device addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
    self scrollDown
!

scrollSelectUp
    "auto scroll action; scroll and reinstall timed-block"

    device addTimedBlock:autoScrollBlock after:autoScrollDeltaT.
    self scrollUp
! !

!SelectionInListView methodsFor:'drawing'!

drawVisibleLine:visLineNr with:fg and:bg
    "draw a visible line in fg/bg
     - redefined to clear edge of selection"

    |y "{ Class:SmallInteger }" 
     line|

    y := self yOfLine:visLineNr.
    line := self visibleAt:visLineNr.
    self paint:bg.
    (style == #openwin) ifTrue:[
        self fillRectangleX:margin y:y - 1
                      width:(width - (margin * 2)) 
                     height:fontHeight + 1
    ] ifFalse:[
        self fillRectangleX:margin y:y
                      width:(width - (margin * 2)) 
                     height:fontHeight
    ].
    line notNil ifTrue:[
        self paint:fg.
        self displayString:line x:(textStartLeft - leftOffset) y:(y + fontAscent)
    ]
! !

!SelectionInListView methodsFor:'redrawing'!

redrawElement:aNumber
    "redraw an individual element"

    ^ self redrawLine:aNumber
!

redrawVisibleLine:visLineNr col:colNr
    (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
        ^ self redrawVisibleLine:visLineNr
    ].
    super redrawVisibleLine:visLineNr col:colNr
!

redrawVisibleLine:visLineNr from:startCol
    (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
        ^ self redrawVisibleLine:visLineNr
    ].
    super redrawVisibleLine:visLineNr from:startCol
!

redrawVisibleLine:visLineNr from:startCol to:endCol
    (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
        ^ self redrawVisibleLine:visLineNr
    ].
    super redrawVisibleLine:visLineNr from:startCol to:endCol
!

redrawFromVisibleLine:startVisLineNr to:endVisLineNr
    |special sel
     selNo "{ Class: SmallInteger }" |

    ((selection isKindOf:Collection) or:[listAttributes notNil]) ifTrue:[
        startVisLineNr to:endVisLineNr do:[:visLine |
            self redrawVisibleLine:visLine
        ].
        ^ self
    ].

    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
    |listLine fg bg
     y "{ Class: SmallInteger }" |

    fg := fgColor.
    bg := bgColor.
    listLine := self visibleLineToListLine:visLineNr.
    listLine notNil ifTrue:[
        (self attributeAt:listLine) == #halfIntensity ifTrue:[
            fg := halfIntensityFgColor
        ].
        (self isInSelection:listLine) ifTrue:[
            bg := hilightBgColor.
            fg := hilightFgColor.
            (style == #next) ifTrue:[
                self drawVisibleLine:visLineNr with:fg and:bg.
                y := self yOfLine:visLineNr.
                self paint:fg.
                self displayLineFromX:0 y:y toX:width y:y.
                y := y + fontHeight - 1.
                self displayLineFromX:0 y:y toX:width y:y.
                ^ self
            ].
            (style == #openwin) ifTrue:[
                self drawVisibleLine:visLineNr with:fg and:bg.
                y := self yOfLine:visLineNr.
                self paint:fg.
                self drawEdgesForX:0 y:y - 1
                             width:width height:fontHeight + 1
                             level:-1.
                ^ self
            ]
        ]
    ].
    ^ self drawVisibleLine:visLineNr with:fg and:bg
! !

!SelectionInListView methodsFor:'event handling'!

sizeChanged:how
    "if there is a selection, make certain, its visible
     after the sizechange"

    |first|

    super sizeChanged:how.
    shown ifTrue:[
        selection notNil ifTrue:[
            (selection isKindOf:Collection) ifTrue:[
                first := selection first
            ] ifFalse:[
                first := selection
            ].
            self makeLineVisible:first
        ]
    ]
!

keyPress:key x:x y:y
    "handle keyboard input"

    (keyboardHandler notNil
    and:[keyboardHandler canHandle:key]) ifTrue:[
        keyboardHandler keyPress:key x:x y:y.
        ^ self
    ].
    (selection isKindOf:Collection) ifFalse:[
        (key isMemberOf:Character) ifFalse: [
            (key == #CursorUp)        ifTrue:[
                self selectPrevious.
                actionBlock notNil ifTrue:[actionBlock value:selection].
                ^ self
            ].
            (key == #CursorDown)      ifTrue:[
                self selectNext.
                actionBlock notNil ifTrue:[actionBlock value:selection].
                ^ self
            ].
            (key == #Home)      ifTrue:[
                self selection:1. 
                actionBlock notNil ifTrue:[actionBlock value:selection].
                ^ self
            ].
            (key == #End)       ifTrue:[
                self selection:list size. 
                actionBlock notNil ifTrue:[actionBlock value:selection].
                ^ self
            ].
        ]
    ]
!

buttonPress:button x:x y:y
    |oldSelection listLineNr menu menuSelector|

    (button == 1) ifTrue:[
        enabled ifTrue:[
            oldSelection := selection.
            listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
            listLineNr notNil ifTrue: [
                self selectWithoutScroll:listLineNr
            ].
            (selection ~= oldSelection) ifTrue:[
                actionBlock notNil ifTrue:[actionBlock value:selection].
                "the ST-80 way of doing things"
                model notNil ifTrue:[
                    model perform:changeSymbol with:(self selectionValue)
                ]
            ].
            clickLine := listLineNr
        ]
    ] ifFalse:[
        super buttonPress:button x:x y:y
    ]
!

buttonShiftPress:button x:x y:y
    |oldSelection listLineNr|

    (button == 1) ifTrue:[
        enabled ifTrue:[
            oldSelection := selection copy.
            listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
            listLineNr notNil ifTrue: [
                multipleSelectOk ifTrue:[
                    (self isInSelection:listLineNr) ifTrue:[
                        self removeFromSelection:listLineNr
                    ] ifFalse:[
                        self addToSelection:listLineNr
                    ]
                ] ifFalse:[
                    self selectWithoutScroll:listLineNr
                ]
            ].
            (selection ~= oldSelection) ifTrue:[
                actionBlock notNil ifTrue:[actionBlock value:selection].
                "the ST-80 way of doing things"
                model notNil ifTrue:[model perform:changeSymbol with:(self selectionValue)]
            ].
            clickLine := listLineNr
        ]
    ] ifFalse:[
        super buttonShiftPress:button x:x y:y
    ]
!

buttonMultiPress:button x:x y:y
    (button == 1) ifTrue:[
        doubleClickActionBlock isNil ifTrue:[
            self buttonPress:button x:x y:y
        ] ifFalse:[
            doubleClickActionBlock value:selection
        ]
    ] ifFalse:[
        super buttonMultiPress:button x:x y:y
    ]
!

buttonRelease:button x:x y:y
    "stop any autoscroll"

    self stopAutoScroll
!

buttonMotion:button x:x y:y
    "mouse-move while button was pressed - handle selection changes"

    |movedVisibleLine movedLine delta oldSelection oldSelCount|

    clickLine isNil ifTrue:[^ self].

    "if moved outside of view, start autoscroll"
    (y < 0) ifTrue:[
        device compressMotionEvents:false.
        self startScrollUp:y.
        ^ self
    ].
    (y > height) ifTrue:[
        device compressMotionEvents:false.
        self startScrollDown:(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:[
            actionBlock notNil ifTrue:[actionBlock value:selection]
        ]
    ] ifFalse:[
        self selectWithoutScroll:movedLine
    ].

    clickLine := movedLine
!

update:aParameter
    |newList|

    (aParameter == initialSelectionSymbol) ifTrue:[
        self selectElement:(model perform:initialSelectionSymbol).
        ^ self
    ].
    (aParameter == listSymbol) ifTrue:[
        newList := (model perform:listSymbol) asText.
        (newList = list) ifFalse:[
            self list:newList
        ]
    ]
! !