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

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

ListView subclass:#SelectionInListView
       instanceVariableNames:'selection actionBlock enabled
			      hilightFgColor hilightBgColor
			      halfIntensityFgColor
			      doubleClickActionBlock
			      selectConditionBlock
			      listAttributes multipleSelectOk clickLine
			      listSymbol initialSelectionSymbol printItems oneItem
			      hilightLevel hilightFrameColor ignoreReselect
			      arrowLevel smallArrow keyActionStyle'
	 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.12 1994-10-28 03:25:26 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.12 1994-10-28 03:25:26 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.

    Whenever the selection changes, an action-block is evaluated, passing the 
    current selection as argument.
    Currently, the selection can be nil, aNumber or a collection of numbers; 
    this will change to be either nil or a collection, making selection handling 
    easier in the future.
    The actionBlock is called with the current selection (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 changeSymbol).

    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 attributes, if possible - use MultiColListEntry or
    subclasses of it).

    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

	multipleSelectOk        <Boolean>       if true, multiple selections (with shift) are ok
	hilightLevel            <Integer>       level to draw selections (i.e. for 3D effect)
	hilightFrameColor       <Color>         rectangle around highlighted items

	ignoreReselect          <Boolean>       if true, selecting same again does not trigger action;
						if false, every select triggers it

	arrowLevel              <Integer>       level to draw right-arrows (for submenus etc.)
	smallArrow              <Boolean>       if true, uses a small arrow bitmap

	listSymbol                              if non-nil, use ST-80 style (model-access)
	initialSelectionSymbol 
	printItems 
	oneItem

	keyActionStyle          <Symbol>        controls how to respond to keyboard selects

    written spring/summer 89 by claus
    3D Jan 90 by claus
    multiselect Jun 92 by claus
    keyboard-select jun 94 by claus
"
! !

!SelectionInListView class methodsFor:'defaults'!

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
    "
!

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
!

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
!

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 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.
    ignoreReselect := true.
    keyActionStyle := #select.
!

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 explicit name-checks
	"
	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 := 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.
!

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'!

keyActionStyle:aSymbol
    "defines how the view should respond to alpha-keys pressed.
     Possible values are:
	#select               -> will select next entry starting with that
				 character and perform the click-action

	#selectAndDoubleclick -> will select next & perform double-click action

	#pass                 -> will pass key to superclass (i.e. no special treatment)

	nil                   -> will ignore key
    "

    keyActionStyle := aSymbol
!

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

    selection := nil.
    super setList:aCollection
!

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

    "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.
    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:aSymbolOrCollectionOfSymbolsOrNil
    "set a line attribute; 
     currently supported are:
	 #halfIntensity
	 #disabled
    "

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

line:lineNr hasAttribute:aSymbol
    "return true, if line nr has attribute, aSymbol; 
     currently suppoerted attributes are:
	 #halfIntensity
	 #disabled
    "

    |attr|

    (lineNr > listAttributes size) ifTrue:[^ false].
    attr := listAttributes at:lineNr.
    attr isNil ifTrue:[^ false].
    attr isSymbol ifTrue:[^ attr == aSymbol].
    ^ (attr includes:aSymbol)
!

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
!

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
!

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:'selections'!

multipleSelectOk:aBoolean
    "allow/disallow multiple selections"

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

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
!

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
!

numberOfSelections
    "return the number of selected entries"

    |sz|

    selection isNil ifTrue:[^ 0].
    sz := selection size.
    sz > 0 ifTrue:[^ sz].
    ^ 1
!

hasSelection
    ^ selection isNil
!

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 isKindOf:Collection) ifTrue:[
	^ selection collect:[:nr | list at:nr]
    ].
    ^ list at:selection
!

selection
    "return the selection line nr or collection of line numbers"

    ^ selection
!

deselect
    "deselect"

    self selection:nil
!

deselectWithoutRedraw
    "deselect - no redraw"

    selection := nil
!

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:[0].
	lineNo ~~ 0 ifTrue:[self selectWithoutScroll:lineNo]
    ]
!

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:[0].
	lineNo ~~ 0 ifTrue:[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;
     scroll to make the selected line visible"

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

addElementToSelection:anObject
    "add the element with the same printstring as the argument, anObject
     to the selection. No scrolling is done"

    |lineNo|

    lineNo := list indexOf:(anObject printString) ifAbsent:[0].
    lineNo ~~ 0 ifTrue:[self addToSelection:lineNo]
!

addToSelection:aNumber
    "add line, aNumber to the selection. No scrolling is done."

    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
!

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 := 1
    ].
    (self isValidSelection:next) ifFalse:[
	next := nil
    ].
    ^ next
!

selectNext
    "select next line or first visible if there is currrently no selection.
     Wrap at end."

    self selection:(self nextAfterSelection)
!

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 := list size
    ].
    (self isValidSelection:prev) ifFalse:[
	prev := nil
    ].
    ^ prev
!

selectPrevious
    "select previous line or previous visible if there is currently no selection.
     Wrap at beginning."

    self selection:(self previouseBeforeSelection).
! !

!SelectionInListView methodsFor:'private'!

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
		]
	    ]
	]
    ]
!

isValidSelection:aNumber
    "return 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:[
	^ 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
!

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
!

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:'redrawing'!

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.
    ]
!

redrawElement:aNumber
    "redraw an individual element"

    ^ self redrawLine:aNumber
!

redrawVisibleLine:visLineNr col:colNr
    "redraw a single character.
     Must check, if its in the selection and handle this case."

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

redrawVisibleLine:visLineNr from:startCol
    "redraw from a col to the right end.
     Must check, if its in the selection and handle this case."

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

redrawVisibleLine:visLineNr from:startCol to:endCol
    "redraw from a startCol to endCol.
     Must check, if its in the selection and handle this case."

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

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 isKindOf:Collection) 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
    "redraw a single line.
     Must check, if any is in the selection and handle this case.
     Otherwise draw using supers method."

    |listLine fg bg attr|

    fg := fgColor.
    bg := bgColor.
    listLine := self visibleLineToListLine:visLineNr.
    listLine notNil ifTrue:[
	(self isInSelection:listLine) ifTrue:[
	    ^ self drawVisibleLineSelected:visLineNr
	].
	attr := self attributeAt:listLine.
	attr notNil ifTrue:[
	    (attr == #halfIntensity 
	    or:[attr isSymbol not and:[attr includes:#halfIntensity]]) ifTrue:[
		fg := halfIntensityFgColor
	    ].
	    (attr == #disbled 
	    or:[attr isSymbol not and:[attr includes:#disabled]]) ifTrue:[
		fg := halfIntensityFgColor
	    ]
	].
    ].
    ^ self drawVisibleLine:visLineNr with:fg and:bg
!

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
"/      ].

	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
! !

!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
	]
    ]
!

key:key select:selectAction x:x y:y
    "perform keyaction after a key-select"

    keyActionStyle notNil ifTrue:[
	keyActionStyle == #pass ifTrue:[
	    ^ super keyPress:key x:x y:y
	].
	selectAction value.
	actionBlock notNil ifTrue:[actionBlock value:selection].
	keyActionStyle == #selectAndDoubleClick ifTrue:[
	    doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
	]
    ].
!

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

    |index startSearch|

    (keyboardHandler notNil
    and:[keyboardHandler canHandle:key]) ifTrue:[
	keyboardHandler keyPress:key x:x y:y.
	^ self
    ].
    (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 := list 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
    "
    list size > 0 ifTrue:[
	key isCharacter ifTrue:[
	    key isLetter ifTrue:[
		keyActionStyle isNil ifTrue:[^ self].
		keyActionStyle == #pass ifFalse:[
		    selection notNil ifTrue:[
			selection size > 0 ifTrue:[
			    startSearch := selection last + 1
			] ifFalse:[
			    startSearch := selection + 1
			]
		    ] ifFalse:[
			startSearch := 1
		    ].
		    startSearch > list size ifTrue:[
			startSearch := 1.
		    ].
		    index := startSearch.
		    [true] whileTrue:[
			(((list at:index) asString at:1) asLowercase == key asLowercase) ifTrue:[
			    ^ self key:key select:[self selection:index] x:x y:y
			].
			index := index + 1.
			index > list size ifTrue:[
			    index := 1
			].
			index == startSearch ifTrue:[
			    ^ self
			]
		    ]
		]
	    ]
	].
    ].
    ^ super keyPress:key x:x y:y
!

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:[
		(self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].

		(selectConditionBlock notNil 
		 and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
	    ].

	    oldSelection := selection.
	    listLineNr notNil ifTrue: [
		self selectWithoutScroll:listLineNr
	    ].
	    ((ignoreReselect not and:[selection notNil])
	     or:[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) or:[button == #select]) ifTrue:[
	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
		]
	    ].
	    (selection ~= oldSelection) ifTrue:[
		actionBlock notNil ifTrue:[actionBlock value:selection].
		"the ST-80 way of doing things"
		(model notNil and:[changeSymbol 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) or:[button == #select]) 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:[
	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:[
	    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
	]
    ]
! !