SelListV.st
author Claus Gittinger <cg@exept.de>
Wed, 17 Jan 1996 12:18:40 +0100
changeset 291 71f4a66b3281
parent 271 2554fcf338ec
child 320 b2ca0310ead0
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
5
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
     3
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     4
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
125
claus
parents: 124
diff changeset
    13
'From Smalltalk/X, Version:2.10.5 on 8-may-1995 at 11:59:03 am'!
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
    14
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    15
ListView subclass:#SelectionInListView
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
    16
	 instanceVariableNames:'selection actionBlock enabled hilightFgColor hilightBgColor
128
claus
parents: 125
diff changeset
    17
		halfIntensityFgColor doubleClickActionBlock selectConditionBlock
claus
parents: 125
diff changeset
    18
		listAttributes multipleSelectOk clickLine initialSelectionMsg
claus
parents: 125
diff changeset
    19
		printItems oneItem useIndex hilightLevel hilightFrameColor
claus
parents: 125
diff changeset
    20
		ignoreReselect arrowLevel smallArrow keyActionStyle
claus
parents: 125
diff changeset
    21
		returnKeyActionStyle toggleSelect strikeOut iSearchString items
claus
parents: 125
diff changeset
    22
		doubleClickMsg'
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    23
	 classVariableNames:'RightArrowShadowForm RightArrowLightForm RightArrowForm
128
claus
parents: 125
diff changeset
    24
		SmallRightArrowShadowForm SmallRightArrowLightForm
claus
parents: 125
diff changeset
    25
		DefaultForegroundColor DefaultBackgroundColor
claus
parents: 125
diff changeset
    26
		DefaultHilightForegroundColor DefaultHilightBackgroundColor
claus
parents: 125
diff changeset
    27
		DefaultHilightFrameColor DefaultHilightLevel DefaultFont
claus
parents: 125
diff changeset
    28
		DefaultRightArrowStyle DefaultRightArrowLevel
claus
parents: 125
diff changeset
    29
		DefaultDisabledForegroundColor DefaultShadowColor
claus
parents: 125
diff changeset
    30
		DefaultLightColor'
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
    31
	 poolDictionaries:''
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
    32
	 category:'Views-Text'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    33
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    34
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
    35
!SelectionInListView class methodsFor:'documentation'!
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
    36
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    37
copyright
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    38
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    39
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    40
	      All Rights Reserved
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    41
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    42
 This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    43
 only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    44
 inclusion of the above copyright notice.   This software may not
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    45
 be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    46
 other person.  No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    47
 hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    48
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    49
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    50
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    51
version
271
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
    52
    ^ '$Header: /cvs/stx/stx/libwidg/Attic/SelListV.st,v 1.48 1995-12-30 00:29:22 cg Exp $'
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    53
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    54
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
    55
documentation
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
    56
"
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
    57
    this one is a ListView with a selected line (which is shown highlighted)
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    58
    If multipleSelectionsOk is true, it is also allowed to shift-click multiple 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    59
    entries.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    60
    If toggleSelect is true, clicking toggles (i.e. click on a seleted item
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    61
    will deselect).
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
    62
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    63
    Whenever the selection changes, an action-block is evaluated, passing the 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    64
    current selection as argument.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    65
    Currently, the selection can be nil, aNumber or a collection of numbers; 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    66
    this will change to be either nil or a collection, making selection handling 
70
14443a9ea4ec *** empty log message ***
claus
parents: 65
diff changeset
    67
    easier in the future. (this stupid behavior is due to the multiple
14443a9ea4ec *** empty log message ***
claus
parents: 65
diff changeset
    68
    select feature being added later - the first implementation used to support
14443a9ea4ec *** empty log message ***
claus
parents: 65
diff changeset
    69
    only single selections).
14443a9ea4ec *** empty log message ***
claus
parents: 65
diff changeset
    70
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    71
    The actionBlock is called with the current selection (single number or
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    72
    collection of numbers) as argument.
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    73
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    74
    Also, to support ST-80 MVC-style use, the model (if nonNil) is notified
155
claus
parents: 151
diff changeset
    75
    by the change mechanism (performs changeMsg) and vice versa, the view
claus
parents: 151
diff changeset
    76
    updates if the model changes (with aspect of either #list or #selectionIndex).
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    77
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    78
    Before actually adding entries to the the selection, a checkBlock (if non-nil) is evaluated 
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    79
    passing the number of the entry whch is about to be selected as argument.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    80
    The select change operation is only done if this returns true. This allows
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    81
    interception of select, for example to query the user if he/she wants to save
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    82
    the old contents before (see uses in SystemBrowser and FileBrowser), or to
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    83
    disable individual entries.
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
    84
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    85
    It is also possible to select entries with the keyboard; use the cursor up/
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    86
    down keys to select prev/next, Home- and End-keys to select first/last. 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    87
    Use the return key to apply the double-click-action to the current selection.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    88
    Also, alphabetic keys will select the next entry starting with that key.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    89
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    90
    The keyboard behavior can be further controlled with the keyActionStyle
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    91
    instance variable (see SelectionInListView>>keyActionStyle:).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    92
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    93
    Finally, ignoreReselect controls if pressing on an already selected item
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    94
    triggers the action or not. For some applications it is useful to allow
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    95
    reselects (for example, the SystemBrowsers method-list updates the
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
    96
    source code in this case).
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
    97
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    98
    Currently, some limited form of line attributes are supported. These
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
    99
    are kept in the instance variable lineAttributes.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   100
    This may change (using mechanisms similar to MultiColListEntry), so
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   101
    be prepared. (dont use the listAttributes instvar directly; if possible,
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   102
    use MultiColListEntry or subclasses of it.
120
claus
parents: 119
diff changeset
   103
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   104
    Although currently based on the listAttributes instVar, the implementation of
120
claus
parents: 119
diff changeset
   105
    text attributes will be changed in the near future (when Text/DisplayText are
claus
parents: 119
diff changeset
   106
    available). 
claus
parents: 119
diff changeset
   107
    However, the protocol will probably be kept for backward compatibility
claus
parents: 119
diff changeset
   108
    (i.e. use #attributeAt: / #attributeAt:put etc. - at least, these are easy to find
claus
parents: 119
diff changeset
   109
    when migrating to the new attributed text handling).
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   110
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   111
    InstanceVariables:
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   112
	selection               <misc>          the current selection. nil, a number or collection of numbers
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   113
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   114
	actionBlock             <Block>         block to be evaluated on selection changes
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   115
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   116
	enabled                 <Boolean>       true: selection changes allowed; false: ignore clicks
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   117
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   118
	hilightFgColor
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   119
	hilightBgColor          <Color>         how highlighted items are drawn
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   120
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   121
	halfIntensityColor      <Color>         foreground for disabled items
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   122
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   123
	selectConditionBlock    <Block>         if non-nil, this nlock can decide if selection is ok
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   124
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   125
	doubleClickActionBlock  <Block>         action to perform on double-click
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   126
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   127
	listAttributes                          dont use - will vanish
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   128
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   129
	hilightLevel            <Integer>       level to draw selections (i.e. for 3D effect)
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   130
	hilightFrameColor       <Color>         rectangle around highlighted items
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   131
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   132
	multipleSelectOk        <Boolean>       if true, multiple selections (with shift) are ok.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   133
						default: false
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   134
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   135
	ignoreReselect          <Boolean>       if true, selecting same again does not trigger action;
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   136
						if false, every select triggers it.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   137
						default: true
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   138
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   139
	toggleSelect            <Boolean>       if true, click toggles;
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   140
						if false, click selects.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   141
						default: false
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   142
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   143
	arrowLevel              <Integer>       level to draw right-arrows (for submenus etc.)
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   144
	smallArrow              <Boolean>       if true, uses a small arrow bitmap
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   145
119
claus
parents: 116
diff changeset
   146
	listMsg                                 if non-nil, use ST-80 style (model-access)
claus
parents: 116
diff changeset
   147
	initialSelectionMsg 
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   148
	printItems 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   149
	oneItem
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   150
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   151
	keyActionStyle          <Symbol>        controls how to respond to keyboard selects
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   152
125
claus
parents: 124
diff changeset
   153
	returnKeyActionStyle    <Symbol>        controls how to respond to return key
claus
parents: 124
diff changeset
   154
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   155
    written spring/summer 89 by claus
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   156
    3D Jan 90 by claus
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
   157
    multiselect Jun 92 by claus
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 31
diff changeset
   158
    keyboard-select jun 94 by claus
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
   159
"
119
claus
parents: 116
diff changeset
   160
!
claus
parents: 116
diff changeset
   161
claus
parents: 116
diff changeset
   162
examples
claus
parents: 116
diff changeset
   163
"
claus
parents: 116
diff changeset
   164
    SelectionInListView can be used both in the ST/X way, using action blocks
claus
parents: 116
diff changeset
   165
    or in the traditional mvc way.
claus
parents: 116
diff changeset
   166
    with actions:
claus
parents: 116
diff changeset
   167
125
claus
parents: 124
diff changeset
   168
      basic interface:
claus
parents: 124
diff changeset
   169
128
claus
parents: 125
diff changeset
   170
	|top slv|
claus
parents: 125
diff changeset
   171
claus
parents: 125
diff changeset
   172
	top := StandardSystemView new
claus
parents: 125
diff changeset
   173
		label:'select';
claus
parents: 125
diff changeset
   174
		minExtent:100@100;
claus
parents: 125
diff changeset
   175
		maxExtent:300@400;
claus
parents: 125
diff changeset
   176
		extent:200@200.
claus
parents: 125
diff changeset
   177
claus
parents: 125
diff changeset
   178
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   179
	slv list:#('one' 'two' 'three').
claus
parents: 125
diff changeset
   180
	slv action:[:index | Transcript showCr:'selected ' , index printString].
claus
parents: 125
diff changeset
   181
claus
parents: 125
diff changeset
   182
	top add:slv in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   183
	top open
125
claus
parents: 124
diff changeset
   184
claus
parents: 124
diff changeset
   185
claus
parents: 124
diff changeset
   186
      get element instead of index:
claus
parents: 124
diff changeset
   187
128
claus
parents: 125
diff changeset
   188
	|top slv|
claus
parents: 125
diff changeset
   189
claus
parents: 125
diff changeset
   190
	top := StandardSystemView new
claus
parents: 125
diff changeset
   191
		label:'select';
claus
parents: 125
diff changeset
   192
		minExtent:100@100;
claus
parents: 125
diff changeset
   193
		maxExtent:300@400;
claus
parents: 125
diff changeset
   194
		extent:200@200.
claus
parents: 125
diff changeset
   195
claus
parents: 125
diff changeset
   196
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   197
	slv list:#('one' 'two' 'three').
claus
parents: 125
diff changeset
   198
	slv action:[:element | Transcript showCr:'selected ' , element printString].
claus
parents: 125
diff changeset
   199
	slv useIndex:false.
claus
parents: 125
diff changeset
   200
claus
parents: 125
diff changeset
   201
	top add:slv in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   202
	top open
125
claus
parents: 124
diff changeset
   203
claus
parents: 124
diff changeset
   204
claus
parents: 124
diff changeset
   205
      concrete example; show filenames:
claus
parents: 124
diff changeset
   206
      (notice: normally, you would use a FileSelectionList)
claus
parents: 124
diff changeset
   207
128
claus
parents: 125
diff changeset
   208
	|top slv|
claus
parents: 125
diff changeset
   209
claus
parents: 125
diff changeset
   210
	top := StandardSystemView new
claus
parents: 125
diff changeset
   211
		label:'select';
claus
parents: 125
diff changeset
   212
		minExtent:100@100;
claus
parents: 125
diff changeset
   213
		maxExtent:300@400;
claus
parents: 125
diff changeset
   214
		extent:200@200.
claus
parents: 125
diff changeset
   215
claus
parents: 125
diff changeset
   216
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   217
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   218
	slv action:[:index | 
claus
parents: 125
diff changeset
   219
	    Transcript showCr:'selected ' , index printString.
claus
parents: 125
diff changeset
   220
	    Transcript showCr:' the value is: ', slv selectionValue].
claus
parents: 125
diff changeset
   221
claus
parents: 125
diff changeset
   222
	top add:slv in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   223
	top open
125
claus
parents: 124
diff changeset
   224
119
claus
parents: 116
diff changeset
   225
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   226
      add a scrollbar:
119
claus
parents: 116
diff changeset
   227
128
claus
parents: 125
diff changeset
   228
	|top slv|
claus
parents: 125
diff changeset
   229
claus
parents: 125
diff changeset
   230
	top := StandardSystemView new
claus
parents: 125
diff changeset
   231
		label:'select';
claus
parents: 125
diff changeset
   232
		minExtent:100@100;
claus
parents: 125
diff changeset
   233
		maxExtent:300@400;
claus
parents: 125
diff changeset
   234
		extent:200@200.
claus
parents: 125
diff changeset
   235
claus
parents: 125
diff changeset
   236
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   237
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   238
	slv action:[:index | Transcript showCr:'selected ' , index printString].
claus
parents: 125
diff changeset
   239
claus
parents: 125
diff changeset
   240
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   241
	top open
125
claus
parents: 124
diff changeset
   242
119
claus
parents: 116
diff changeset
   243
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   244
      allow reselect (clicking on already selected entry):
119
claus
parents: 116
diff changeset
   245
128
claus
parents: 125
diff changeset
   246
	|top slv|
claus
parents: 125
diff changeset
   247
claus
parents: 125
diff changeset
   248
	top := StandardSystemView new
claus
parents: 125
diff changeset
   249
		label:'select';
claus
parents: 125
diff changeset
   250
		minExtent:100@100;
claus
parents: 125
diff changeset
   251
		maxExtent:300@400;
claus
parents: 125
diff changeset
   252
		extent:200@200.
claus
parents: 125
diff changeset
   253
claus
parents: 125
diff changeset
   254
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   255
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   256
	slv action:[:index | Transcript showCr:'selected ' , index printString].
claus
parents: 125
diff changeset
   257
	slv ignoreReselect:false.
claus
parents: 125
diff changeset
   258
claus
parents: 125
diff changeset
   259
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   260
	top open
125
claus
parents: 124
diff changeset
   261
119
claus
parents: 116
diff changeset
   262
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   263
      allow multiple selections:
119
claus
parents: 116
diff changeset
   264
128
claus
parents: 125
diff changeset
   265
	|top slv|
claus
parents: 125
diff changeset
   266
claus
parents: 125
diff changeset
   267
	top := StandardSystemView new
claus
parents: 125
diff changeset
   268
		label:'select';
claus
parents: 125
diff changeset
   269
		minExtent:100@100;
claus
parents: 125
diff changeset
   270
		maxExtent:300@400;
claus
parents: 125
diff changeset
   271
		extent:200@200.
claus
parents: 125
diff changeset
   272
claus
parents: 125
diff changeset
   273
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   274
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   275
	slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
claus
parents: 125
diff changeset
   276
	slv multipleSelectOk:true.
claus
parents: 125
diff changeset
   277
claus
parents: 125
diff changeset
   278
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   279
	top open
125
claus
parents: 124
diff changeset
   280
claus
parents: 124
diff changeset
   281
claus
parents: 124
diff changeset
   282
      same, not using index:
claus
parents: 124
diff changeset
   283
128
claus
parents: 125
diff changeset
   284
	|top slv|
claus
parents: 125
diff changeset
   285
claus
parents: 125
diff changeset
   286
	top := StandardSystemView new
claus
parents: 125
diff changeset
   287
		label:'select';
claus
parents: 125
diff changeset
   288
		minExtent:100@100;
claus
parents: 125
diff changeset
   289
		maxExtent:300@400;
claus
parents: 125
diff changeset
   290
		extent:200@200.
claus
parents: 125
diff changeset
   291
claus
parents: 125
diff changeset
   292
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   293
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   294
	slv action:[:indexList | Transcript showCr:'selected ' , indexList printString].
claus
parents: 125
diff changeset
   295
	slv multipleSelectOk:true; useIndex:false.
claus
parents: 125
diff changeset
   296
claus
parents: 125
diff changeset
   297
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   298
	top open
125
claus
parents: 124
diff changeset
   299
119
claus
parents: 116
diff changeset
   300
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   301
      strikeout mode (single):
119
claus
parents: 116
diff changeset
   302
128
claus
parents: 125
diff changeset
   303
	|top slv|
claus
parents: 125
diff changeset
   304
claus
parents: 125
diff changeset
   305
	top := StandardSystemView new
claus
parents: 125
diff changeset
   306
		label:'select';
claus
parents: 125
diff changeset
   307
		minExtent:100@100;
claus
parents: 125
diff changeset
   308
		maxExtent:300@400;
claus
parents: 125
diff changeset
   309
		extent:200@200.
claus
parents: 125
diff changeset
   310
claus
parents: 125
diff changeset
   311
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   312
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   313
	slv action:[:index | Transcript showCr:'selected ' , index printString].
claus
parents: 125
diff changeset
   314
	slv strikeOut:true.
claus
parents: 125
diff changeset
   315
claus
parents: 125
diff changeset
   316
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   317
	top open
125
claus
parents: 124
diff changeset
   318
119
claus
parents: 116
diff changeset
   319
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   320
      strikeout mode (multiple):
119
claus
parents: 116
diff changeset
   321
128
claus
parents: 125
diff changeset
   322
	|top slv|
claus
parents: 125
diff changeset
   323
claus
parents: 125
diff changeset
   324
	top := StandardSystemView new
claus
parents: 125
diff changeset
   325
		label:'select';
claus
parents: 125
diff changeset
   326
		minExtent:100@100;
claus
parents: 125
diff changeset
   327
		maxExtent:300@400;
claus
parents: 125
diff changeset
   328
		extent:200@200.
claus
parents: 125
diff changeset
   329
claus
parents: 125
diff changeset
   330
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   331
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   332
	slv action:[:index | Transcript showCr:'selected ' , index printString].
claus
parents: 125
diff changeset
   333
	slv strikeOut:true; multipleSelectOk:true.
claus
parents: 125
diff changeset
   334
claus
parents: 125
diff changeset
   335
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   336
	top open
125
claus
parents: 124
diff changeset
   337
119
claus
parents: 116
diff changeset
   338
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   339
      define what to do on double-click:
119
claus
parents: 116
diff changeset
   340
128
claus
parents: 125
diff changeset
   341
	|top slv|
claus
parents: 125
diff changeset
   342
claus
parents: 125
diff changeset
   343
	top := StandardSystemView new
claus
parents: 125
diff changeset
   344
		label:'select';
claus
parents: 125
diff changeset
   345
		minExtent:100@100;
claus
parents: 125
diff changeset
   346
		maxExtent:300@400;
claus
parents: 125
diff changeset
   347
		extent:200@200.
claus
parents: 125
diff changeset
   348
claus
parents: 125
diff changeset
   349
	slv := SelectionInListView new.
claus
parents: 125
diff changeset
   350
	slv list:(Filename currentDirectory directoryContents).
claus
parents: 125
diff changeset
   351
	slv action:[:index | Transcript showCr:'selected ' , index printString].
claus
parents: 125
diff changeset
   352
	slv doubleClickAction:[:index | Transcript showCr:'doubleclick on ' , index printString].
claus
parents: 125
diff changeset
   353
claus
parents: 125
diff changeset
   354
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   355
	top open
119
claus
parents: 116
diff changeset
   356
124
7abd3a234296 last version before changing to collection in multipleSelect mode
claus
parents: 120
diff changeset
   357
119
claus
parents: 116
diff changeset
   358
    using a Model:
claus
parents: 116
diff changeset
   359
128
claus
parents: 125
diff changeset
   360
	|top slv model|
claus
parents: 125
diff changeset
   361
claus
parents: 125
diff changeset
   362
	model := Plug new.
claus
parents: 125
diff changeset
   363
	model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
claus
parents: 125
diff changeset
   364
	model respondTo:#initial with:[1].
claus
parents: 125
diff changeset
   365
	model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
claus
parents: 125
diff changeset
   366
claus
parents: 125
diff changeset
   367
	top := StandardSystemView new
claus
parents: 125
diff changeset
   368
		label:'select';
claus
parents: 125
diff changeset
   369
		minExtent:100@100;
claus
parents: 125
diff changeset
   370
		maxExtent:300@400;
claus
parents: 125
diff changeset
   371
		extent:200@200.
claus
parents: 125
diff changeset
   372
claus
parents: 125
diff changeset
   373
	slv := SelectionInListView 
claus
parents: 125
diff changeset
   374
		   on:model
claus
parents: 125
diff changeset
   375
		   aspect:#someAspect
claus
parents: 125
diff changeset
   376
		   change:#setSelection:
claus
parents: 125
diff changeset
   377
		   list:#getList
claus
parents: 125
diff changeset
   378
		   initialSelection:#initial.
claus
parents: 125
diff changeset
   379
claus
parents: 125
diff changeset
   380
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   381
	top open
119
claus
parents: 116
diff changeset
   382
claus
parents: 116
diff changeset
   383
      notice, that the ST-80 behavaior on reselect is to send a selection change
claus
parents: 116
diff changeset
   384
      with an index of 0.
claus
parents: 116
diff changeset
   385
claus
parents: 116
diff changeset
   386
125
claus
parents: 124
diff changeset
   387
    same, with useIndex false:
claus
parents: 124
diff changeset
   388
128
claus
parents: 125
diff changeset
   389
	|top slv model|
claus
parents: 125
diff changeset
   390
claus
parents: 125
diff changeset
   391
	model := Plug new.
claus
parents: 125
diff changeset
   392
	model respondTo:#getList with:[#('foo' 'bar' 'baz' 'hello')].
claus
parents: 125
diff changeset
   393
	model respondTo:#initial with:['bar'].
claus
parents: 125
diff changeset
   394
	model respondTo:#setSelection: with:[:arg | Transcript showCr:'model selected:', arg printString].
claus
parents: 125
diff changeset
   395
claus
parents: 125
diff changeset
   396
	top := StandardSystemView new
claus
parents: 125
diff changeset
   397
		label:'select';
claus
parents: 125
diff changeset
   398
		minExtent:100@100;
claus
parents: 125
diff changeset
   399
		maxExtent:300@400;
claus
parents: 125
diff changeset
   400
		extent:200@200.
claus
parents: 125
diff changeset
   401
claus
parents: 125
diff changeset
   402
	slv := SelectionInListView 
claus
parents: 125
diff changeset
   403
		   on:model
claus
parents: 125
diff changeset
   404
		   aspect:#someAspect
claus
parents: 125
diff changeset
   405
		   change:#setSelection:
claus
parents: 125
diff changeset
   406
		   list:#getList
claus
parents: 125
diff changeset
   407
		   initialSelection:#initial.
claus
parents: 125
diff changeset
   408
	slv useIndex:false.
claus
parents: 125
diff changeset
   409
claus
parents: 125
diff changeset
   410
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   411
	top open
125
claus
parents: 124
diff changeset
   412
claus
parents: 124
diff changeset
   413
155
claus
parents: 151
diff changeset
   414
    self changing list: 
claus
parents: 151
diff changeset
   415
    (selectionInListView updates itself when button changes initial selection):
claus
parents: 151
diff changeset
   416
claus
parents: 151
diff changeset
   417
	|top slv model sel changeButton|
claus
parents: 151
diff changeset
   418
claus
parents: 151
diff changeset
   419
	sel := 'bar'.
claus
parents: 151
diff changeset
   420
	model := Plug new.
claus
parents: 151
diff changeset
   421
	model respondTo:#getList with:['getList' printNL. #('foo' 'bar' 'baz' 'hello')].
claus
parents: 151
diff changeset
   422
	model respondTo:#initial with:['initial' printNL. sel].
claus
parents: 151
diff changeset
   423
	model respondTo:#setSelection: with:[:arg | ('model selected:', arg) printNL. sel := arg].
claus
parents: 151
diff changeset
   424
claus
parents: 151
diff changeset
   425
	changeButton := Button label:'change selection'.
claus
parents: 151
diff changeset
   426
	changeButton action:[sel := 'foo'. model changed:#initial].
claus
parents: 151
diff changeset
   427
	changeButton open.
claus
parents: 151
diff changeset
   428
claus
parents: 151
diff changeset
   429
	top := StandardSystemView new
claus
parents: 151
diff changeset
   430
		label:'select';
claus
parents: 151
diff changeset
   431
		minExtent:100@100;
claus
parents: 151
diff changeset
   432
		maxExtent:300@400;
claus
parents: 151
diff changeset
   433
		extent:200@200.
claus
parents: 151
diff changeset
   434
claus
parents: 151
diff changeset
   435
	slv := SelectionInListView 
claus
parents: 151
diff changeset
   436
		   on:model
claus
parents: 151
diff changeset
   437
		   aspect:#someAspect
claus
parents: 151
diff changeset
   438
		   change:#setSelection:
claus
parents: 151
diff changeset
   439
		   list:#getList
claus
parents: 151
diff changeset
   440
		   initialSelection:#initial.
claus
parents: 151
diff changeset
   441
	slv useIndex:false.
claus
parents: 151
diff changeset
   442
claus
parents: 151
diff changeset
   443
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 151
diff changeset
   444
	top open
claus
parents: 151
diff changeset
   445
claus
parents: 151
diff changeset
   446
119
claus
parents: 116
diff changeset
   447
    using a SelectionInList-Model:
claus
parents: 116
diff changeset
   448
    (see how changes in the model (via list:...) are reflected in the view)
claus
parents: 116
diff changeset
   449
128
claus
parents: 125
diff changeset
   450
	|top slv model|
claus
parents: 125
diff changeset
   451
claus
parents: 125
diff changeset
   452
	model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
claus
parents: 125
diff changeset
   453
	model selection:'bar'.
claus
parents: 125
diff changeset
   454
claus
parents: 125
diff changeset
   455
	top := StandardSystemView new
claus
parents: 125
diff changeset
   456
		label:'select';
claus
parents: 125
diff changeset
   457
		minExtent:100@100;
claus
parents: 125
diff changeset
   458
		maxExtent:300@400;
claus
parents: 125
diff changeset
   459
		extent:200@200.
claus
parents: 125
diff changeset
   460
claus
parents: 125
diff changeset
   461
	slv := SelectionInListView on:model.
claus
parents: 125
diff changeset
   462
claus
parents: 125
diff changeset
   463
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   464
	top open.
claus
parents: 125
diff changeset
   465
claus
parents: 125
diff changeset
   466
	model inspect
125
claus
parents: 124
diff changeset
   467
claus
parents: 124
diff changeset
   468
claus
parents: 124
diff changeset
   469
    two selectionInListViews on the same selectionInList model:
claus
parents: 124
diff changeset
   470
128
claus
parents: 125
diff changeset
   471
	|top1 slv1 top2 slv2 model|
claus
parents: 125
diff changeset
   472
claus
parents: 125
diff changeset
   473
	model := SelectionInList with:#('foo' 'bar' 'baz' 'hello').
claus
parents: 125
diff changeset
   474
claus
parents: 125
diff changeset
   475
	top1 := StandardSystemView new
claus
parents: 125
diff changeset
   476
		label:'select';
claus
parents: 125
diff changeset
   477
		minExtent:100@100;
claus
parents: 125
diff changeset
   478
		maxExtent:300@400;
claus
parents: 125
diff changeset
   479
		extent:200@200.
claus
parents: 125
diff changeset
   480
claus
parents: 125
diff changeset
   481
	slv1 := SelectionInListView on:model.
claus
parents: 125
diff changeset
   482
claus
parents: 125
diff changeset
   483
	top1 add:(ScrollableView forView:slv1) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   484
	top1 open.
claus
parents: 125
diff changeset
   485
claus
parents: 125
diff changeset
   486
	top2 := StandardSystemView new
claus
parents: 125
diff changeset
   487
		label:'select';
claus
parents: 125
diff changeset
   488
		minExtent:100@100;
claus
parents: 125
diff changeset
   489
		maxExtent:300@400;
claus
parents: 125
diff changeset
   490
		extent:200@200.
claus
parents: 125
diff changeset
   491
claus
parents: 125
diff changeset
   492
	slv2 := SelectionInListView on:model.
claus
parents: 125
diff changeset
   493
claus
parents: 125
diff changeset
   494
	top2 add:(ScrollableView forView:slv2) in:(0.0@0.0 corner:1.0@1.0).
claus
parents: 125
diff changeset
   495
	top2 open.
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   496
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   497
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   498
    a MultiSelectionInList model:
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   499
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   500
	|top slv model|
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   501
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   502
	model := MultiSelectionInList with:#('foo' 'bar' 'baz' 'hello').
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   503
	model selection:#('foo' 'bar').
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   504
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   505
	top := StandardSystemView new
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   506
		label:'select';
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   507
		minExtent:100@100;
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   508
		maxExtent:300@400;
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   509
		extent:200@200.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   510
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   511
	slv := SelectionInListView on:model.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   512
	slv multipleSelectOk:true.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   513
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   514
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   515
	top open.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   516
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   517
	model inspect
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   518
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   519
    with strikeOut:
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   520
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   521
	|top slv model|
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   522
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   523
	model := MultiSelectionInList with:#('foo' 'bar' 'baz' 'hello').
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   524
	model selection:#('foo' 'bar').
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   525
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   526
	top := StandardSystemView new
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   527
		label:'select';
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   528
		minExtent:100@100;
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   529
		maxExtent:300@400;
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   530
		extent:200@200.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   531
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   532
	slv := SelectionInListView on:model.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   533
	slv multipleSelectOk:true; toggleSelect:true; strikeOut:true.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   534
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   535
	top add:(ScrollableView forView:slv) in:(0.0@0.0 corner:1.0@1.0).
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   536
	top open.
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   537
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   538
	model inspect
119
claus
parents: 116
diff changeset
   539
"
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   540
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   541
    "Modified: 26.10.1995 / 16:42:02 / cg"
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
   542
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   543
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   544
!SelectionInListView class methodsFor:'instance creation'!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   545
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   546
on:aModel printItems:print oneItem:one aspect:aspect change:change 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   547
		list:list menu:menu initialSelection:initial useIndex:useIndex
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   548
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   549
    "for ST-80 compatibility"
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   550
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   551
    ^ (self new) on:aModel 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   552
		 printItems:print 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   553
		 oneItem:one 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   554
		 aspect:aspect
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   555
		 change:change 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   556
		 list:list 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   557
		 menu:menu
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   558
		 initialSelection:initial
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   559
		 useIndex:useIndex
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   560
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   561
125
claus
parents: 124
diff changeset
   562
on:aModel aspect:aspect change:change list:list initialSelection:initial
claus
parents: 124
diff changeset
   563
    ^ self on:aModel
claus
parents: 124
diff changeset
   564
	    printItems:true 
claus
parents: 124
diff changeset
   565
	    oneItem:false 
claus
parents: 124
diff changeset
   566
	    aspect:aspect
claus
parents: 124
diff changeset
   567
	    change:change 
claus
parents: 124
diff changeset
   568
	    list:list 
claus
parents: 124
diff changeset
   569
	    menu:nil 
claus
parents: 124
diff changeset
   570
	    initialSelection:initial 
claus
parents: 124
diff changeset
   571
	    useIndex:true 
claus
parents: 124
diff changeset
   572
!
claus
parents: 124
diff changeset
   573
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   574
on:aModel printItems:print oneItem:one aspect:aspect
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   575
	      change:change list:list menu:menu initialSelection:initial
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   576
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   577
    "for ST-80 compatibility"
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   578
119
claus
parents: 116
diff changeset
   579
    ^ self on:aModel 
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   580
	    printItems:print 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   581
	    oneItem:one 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   582
	    aspect:aspect
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   583
	    change:change 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   584
	    list:list 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   585
	    menu:menu
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   586
	    initialSelection:initial
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   587
	    useIndex:false 
119
claus
parents: 116
diff changeset
   588
!
claus
parents: 116
diff changeset
   589
claus
parents: 116
diff changeset
   590
on:aModel aspect:aspect change:change list:list menu:menu initialSelection:initial
claus
parents: 116
diff changeset
   591
    ^ self on:aModel
claus
parents: 116
diff changeset
   592
	    printItems:true 
claus
parents: 116
diff changeset
   593
	    oneItem:false 
claus
parents: 116
diff changeset
   594
	    aspect:aspect
claus
parents: 116
diff changeset
   595
	    change:change 
claus
parents: 116
diff changeset
   596
	    list:list 
claus
parents: 116
diff changeset
   597
	    menu:menu
claus
parents: 116
diff changeset
   598
	    initialSelection:initial 
claus
parents: 116
diff changeset
   599
	    useIndex:true 
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   600
! !
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   601
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   602
!SelectionInListView class methodsFor:'defaults'!
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   603
125
claus
parents: 124
diff changeset
   604
defaultListMessage
claus
parents: 124
diff changeset
   605
    ^ #list 
claus
parents: 124
diff changeset
   606
!
claus
parents: 124
diff changeset
   607
claus
parents: 124
diff changeset
   608
defaultChangeMessage
claus
parents: 124
diff changeset
   609
    ^ #selectionIndex: 
claus
parents: 124
diff changeset
   610
!
claus
parents: 124
diff changeset
   611
claus
parents: 124
diff changeset
   612
defaultAspectMessage
claus
parents: 124
diff changeset
   613
    ^ nil
claus
parents: 124
diff changeset
   614
!
claus
parents: 124
diff changeset
   615
claus
parents: 124
diff changeset
   616
defaultSelectionMessage
claus
parents: 124
diff changeset
   617
    ^ #selectionIndex 
claus
parents: 124
diff changeset
   618
!
claus
parents: 124
diff changeset
   619
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   620
rightArrowShadowFormOn:aDevice
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   621
    "return the form used for the right arrow light pixels (3D only)"
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   622
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   623
    |f|
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   624
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   625
    ((aDevice == Display) and:[RightArrowShadowForm notNil]) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   626
	^ RightArrowShadowForm
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   627
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   628
    f := Form fromFile:'RightArrowShadow.xbm' resolution:100 on:aDevice.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   629
    f isNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   630
	f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   631
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   632
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   633
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   634
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   635
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   636
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   637
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   638
						 2r00000000 2r00010000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   639
						 2r00000000 2r00100000
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   640
						 2r00000000 2r01000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   641
						 2r00000000 2r10000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   642
						 2r00000001 2r00000000
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   643
						 2r00000010 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   644
						 2r00000000 2r00000000 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   645
						 2r00000000 2r00000000]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   646
					      on:aDevice
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   647
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   648
    (aDevice == Display) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   649
	RightArrowShadowForm := f
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   650
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   651
    ^ f
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   652
!
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   653
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   654
rightArrowLightFormOn:aDevice
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   655
    "return the form used for the right arrow light pixels (3D only)"
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   656
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   657
    |f|
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   658
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   659
    ((aDevice == Display) and:[RightArrowLightForm notNil]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   660
	^ RightArrowLightForm
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   661
    ].
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   662
    f := Form fromFile:'RightArrowLight.xbm' resolution:100 on:aDevice.
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   663
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   664
	f := Form width:16 height:16 fromArray:#[2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   665
						 2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   666
						 2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   667
						 2r00000110 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   668
						 2r00000101 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   669
						 2r00000100 2r10000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   670
						 2r00000100 2r01000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   671
						 2r00000100 2r00100000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   672
						 2r00000100 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   673
						 2r00000100 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   674
						 2r00000100 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   675
						 2r00000100 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   676
						 2r00000100 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   677
						 2r00000100 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   678
						 2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   679
						 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   680
					      on:aDevice
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   681
    ].
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   682
    (aDevice == Display) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   683
	RightArrowLightForm := f
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   684
    ].
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   685
    ^ f
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   686
!
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   687
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   688
updateStyleCache
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   689
    DefaultDisabledForegroundColor := StyleSheet colorAt:'selectionDisabledForegroundColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   690
    DefaultHilightForegroundColor := StyleSheet colorAt:'selectionHilightForegroundColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   691
    DefaultHilightBackgroundColor := StyleSheet colorAt:'selectionHilightBackgroundColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   692
    DefaultHilightFrameColor := StyleSheet colorAt:'selectionHilightFrameColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   693
    DefaultHilightLevel := StyleSheet at:'selectionHilightLevel' default:0.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   694
    DefaultRightArrowStyle := StyleSheet at:'selectionRightArrowStyle'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   695
    DefaultRightArrowLevel := StyleSheet at:'selectionRightArrowLevel'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   696
    DefaultForegroundColor := StyleSheet colorAt:'selectionForegroundColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   697
    DefaultBackgroundColor := StyleSheet colorAt:'selectionBackgroundColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   698
    DefaultShadowColor := StyleSheet colorAt:'selectionShadowColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   699
    DefaultLightColor := StyleSheet colorAt:'selectionLightColor'.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   700
    DefaultFont := StyleSheet fontAt:'selectionFont'.
146
claus
parents: 133
diff changeset
   701
    RightArrowForm := nil.
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   702
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   703
    "
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   704
     self updateStyleCache
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
   705
    "
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   706
!
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   707
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   708
rightArrowFormOn:aDevice
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   709
    "return the form used for the right arrow (non 3D)"
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   710
146
claus
parents: 133
diff changeset
   711
    |f bits|
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   712
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   713
    ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   714
	^ RightArrowForm
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   715
    ].
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   716
    f := Form fromFile:'RightArrow.xbm' resolution:100 on:aDevice.
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   717
    f isNil ifTrue:[
146
claus
parents: 133
diff changeset
   718
	DefaultRightArrowStyle == #solid ifTrue:[
claus
parents: 133
diff changeset
   719
	    bits := #[2r00000000 2r00000000 
claus
parents: 133
diff changeset
   720
		      2r00000000 2r00000000 
claus
parents: 133
diff changeset
   721
		      2r00000000 2r00000000 
claus
parents: 133
diff changeset
   722
		      2r00000010 2r00000000 
claus
parents: 133
diff changeset
   723
		      2r00000011 2r00000000 
claus
parents: 133
diff changeset
   724
		      2r00000011 2r10000000 
claus
parents: 133
diff changeset
   725
		      2r00000011 2r11000000 
claus
parents: 133
diff changeset
   726
		      2r00000011 2r11100000 
claus
parents: 133
diff changeset
   727
		      2r00000011 2r11110000 
claus
parents: 133
diff changeset
   728
		      2r00000011 2r11100000
claus
parents: 133
diff changeset
   729
		      2r00000011 2r11000000 
claus
parents: 133
diff changeset
   730
		      2r00000011 2r10000000 
claus
parents: 133
diff changeset
   731
		      2r00000011 2r00000000
claus
parents: 133
diff changeset
   732
		      2r00000010 2r00000000 
claus
parents: 133
diff changeset
   733
		      2r00000000 2r00000000 
claus
parents: 133
diff changeset
   734
		      2r00000000 2r00000000]
claus
parents: 133
diff changeset
   735
	] ifFalse:[
claus
parents: 133
diff changeset
   736
	    bits := #[2r00000000 2r00000000 
claus
parents: 133
diff changeset
   737
		      2r00000000 2r00000000 
claus
parents: 133
diff changeset
   738
		      2r00000000 2r00000000 
claus
parents: 133
diff changeset
   739
		      2r00000110 2r00000000 
claus
parents: 133
diff changeset
   740
		      2r00000101 2r00000000 
claus
parents: 133
diff changeset
   741
		      2r00000100 2r10000000 
claus
parents: 133
diff changeset
   742
		      2r00000100 2r01000000 
claus
parents: 133
diff changeset
   743
		      2r00000100 2r00100000 
claus
parents: 133
diff changeset
   744
		      2r00000100 2r00010000 
claus
parents: 133
diff changeset
   745
		      2r00000100 2r00100000
claus
parents: 133
diff changeset
   746
		      2r00000100 2r01000000 
claus
parents: 133
diff changeset
   747
		      2r00000100 2r10000000 
claus
parents: 133
diff changeset
   748
		      2r00000101 2r00000000
claus
parents: 133
diff changeset
   749
		      2r00000110 2r00000000 
claus
parents: 133
diff changeset
   750
		      2r00000000 2r00000000 
claus
parents: 133
diff changeset
   751
		      2r00000000 2r00000000]
claus
parents: 133
diff changeset
   752
	].
claus
parents: 133
diff changeset
   753
	f := Form width:16 height:16 fromArray:bits on:aDevice
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   754
    ].
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   755
    (aDevice == Display) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   756
	RightArrowForm := f
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   757
    ].
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   758
    ^ f
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   759
!
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   760
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   761
smallRightArrowLightFormOn:aDevice
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   762
    "return the form used for the small right arrow light pixels (3D only)"
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   763
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   764
    |f|
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   765
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   766
    ((aDevice == Display) and:[SmallRightArrowLightForm notNil]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   767
	^ SmallRightArrowLightForm
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   768
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   769
    f := Form fromFile:'SmallRightArrowLight.xbm' resolution:100 on:aDevice.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   770
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   771
	f := Form width:9 height:9 fromArray:#[2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   772
					       2r01100000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   773
					       2r01011000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   774
					       2r01000110 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   775
					       2r01000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   776
					       2r01000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   777
					       2r01000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   778
					       2r01000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   779
					       2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   780
					      on:aDevice
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   781
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   782
    (aDevice == Display) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   783
	SmallRightArrowLightForm := f
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   784
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   785
    ^ f
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   786
!
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   787
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   788
smallRightArrowShadowFormOn:aDevice
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   789
    "return the form used for the small right arrow light pixels (3D only)"
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   790
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   791
    |f|
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   792
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   793
    ((aDevice == Display) and:[SmallRightArrowShadowForm notNil]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   794
	^ SmallRightArrowShadowForm
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   795
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   796
    f := Form fromFile:'SmallRightArrowShadow.xbm' resolution:100 on:aDevice.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   797
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   798
	f := Form width:9 height:9 fromArray:#[2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   799
					       2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   800
					       2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   801
					       2r00000000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   802
					       2r00000001 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   803
					       2r00000110 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   804
					       2r00011000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   805
					       2r00100000 2r00000000 
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   806
					       2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   807
					      on:aDevice
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   808
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   809
    (aDevice == Display) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
   810
	SmallRightArrowShadowForm := f
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   811
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
   812
    ^ f
22
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   813
! !
ac872628ef2d *** empty log message ***
claus
parents: 15
diff changeset
   814
125
claus
parents: 124
diff changeset
   815
!SelectionInListView methodsFor:'selections'!
claus
parents: 124
diff changeset
   816
claus
parents: 124
diff changeset
   817
isInSelection:aNumber
claus
parents: 124
diff changeset
   818
    "return true, if line, aNumber is in the selection"
claus
parents: 124
diff changeset
   819
claus
parents: 124
diff changeset
   820
    selection isNil ifTrue:[^ false].
claus
parents: 124
diff changeset
   821
    multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
   822
	^ (selection includes:aNumber)
claus
parents: 124
diff changeset
   823
    ].
claus
parents: 124
diff changeset
   824
    ^ (aNumber == selection)
claus
parents: 124
diff changeset
   825
!
claus
parents: 124
diff changeset
   826
claus
parents: 124
diff changeset
   827
selectWithoutScroll:aNumberOrNilOrCollection
claus
parents: 124
diff changeset
   828
    "select line, aNumber or deselect if argument is nil"
claus
parents: 124
diff changeset
   829
claus
parents: 124
diff changeset
   830
    |prevSelection newSelection|
claus
parents: 124
diff changeset
   831
claus
parents: 124
diff changeset
   832
    newSelection := aNumberOrNilOrCollection.
claus
parents: 124
diff changeset
   833
    newSelection notNil ifTrue:[
claus
parents: 124
diff changeset
   834
	(self isValidSelection:newSelection) ifFalse:[
claus
parents: 124
diff changeset
   835
	    newSelection := nil
claus
parents: 124
diff changeset
   836
	]
claus
parents: 124
diff changeset
   837
    ].
claus
parents: 124
diff changeset
   838
claus
parents: 124
diff changeset
   839
    (newSelection = selection) ifTrue: [^ self].
claus
parents: 124
diff changeset
   840
claus
parents: 124
diff changeset
   841
    "
claus
parents: 124
diff changeset
   842
     redraw old selection unhighlighted
claus
parents: 124
diff changeset
   843
    "
claus
parents: 124
diff changeset
   844
    selection notNil ifTrue: [
claus
parents: 124
diff changeset
   845
	prevSelection := selection.
claus
parents: 124
diff changeset
   846
	selection := nil.
claus
parents: 124
diff changeset
   847
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
   848
	    prevSelection do:[:line |
claus
parents: 124
diff changeset
   849
		self redrawElement:line
claus
parents: 124
diff changeset
   850
	    ]
claus
parents: 124
diff changeset
   851
	] ifFalse:[
claus
parents: 124
diff changeset
   852
	    self redrawElement:prevSelection
claus
parents: 124
diff changeset
   853
	]
claus
parents: 124
diff changeset
   854
    ].
claus
parents: 124
diff changeset
   855
claus
parents: 124
diff changeset
   856
    selection := newSelection.
claus
parents: 124
diff changeset
   857
claus
parents: 124
diff changeset
   858
    "
claus
parents: 124
diff changeset
   859
     redraw new selection unhighlighted
claus
parents: 124
diff changeset
   860
    "
claus
parents: 124
diff changeset
   861
    newSelection notNil ifTrue:[
claus
parents: 124
diff changeset
   862
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
   863
	    newSelection isCollection ifFalse:[
claus
parents: 124
diff changeset
   864
		selection := OrderedCollection with:newSelection.
claus
parents: 124
diff changeset
   865
	    ].
claus
parents: 124
diff changeset
   866
	    selection do:[:line |
claus
parents: 124
diff changeset
   867
		self redrawElement:line
claus
parents: 124
diff changeset
   868
	    ]
claus
parents: 124
diff changeset
   869
	] ifFalse:[
claus
parents: 124
diff changeset
   870
	    self redrawElement:selection
claus
parents: 124
diff changeset
   871
	]
claus
parents: 124
diff changeset
   872
    ]
claus
parents: 124
diff changeset
   873
claus
parents: 124
diff changeset
   874
!
claus
parents: 124
diff changeset
   875
claus
parents: 124
diff changeset
   876
makeSelectionVisible
claus
parents: 124
diff changeset
   877
    "scroll to make the selection line visible"
claus
parents: 124
diff changeset
   878
claus
parents: 124
diff changeset
   879
    |line|
claus
parents: 124
diff changeset
   880
claus
parents: 124
diff changeset
   881
    selection notNil ifTrue:[
claus
parents: 124
diff changeset
   882
	multipleSelectOk ifTrue:[
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   883
	    selection isEmpty ifTrue:[^ self].
125
claus
parents: 124
diff changeset
   884
	    line := selection first.
claus
parents: 124
diff changeset
   885
	] ifFalse:[
claus
parents: 124
diff changeset
   886
	    line := selection
claus
parents: 124
diff changeset
   887
	].
claus
parents: 124
diff changeset
   888
	self makeLineVisible:line 
claus
parents: 124
diff changeset
   889
    ]
claus
parents: 124
diff changeset
   890
!
claus
parents: 124
diff changeset
   891
claus
parents: 124
diff changeset
   892
selection:aNumberOrNil
claus
parents: 124
diff changeset
   893
    "select line, aNumber or deselect if argument is nil;
claus
parents: 124
diff changeset
   894
     scroll to make the selected line visible"
claus
parents: 124
diff changeset
   895
claus
parents: 124
diff changeset
   896
    self selectWithoutScroll:aNumberOrNil.
claus
parents: 124
diff changeset
   897
    selection notNil ifTrue:[self makeSelectionVisible]
claus
parents: 124
diff changeset
   898
!
claus
parents: 124
diff changeset
   899
claus
parents: 124
diff changeset
   900
selectionValue
claus
parents: 124
diff changeset
   901
    "return the selection value i.e. the text in the selected line.
claus
parents: 124
diff changeset
   902
     For multiple selections a collection containing the entries is returned."
claus
parents: 124
diff changeset
   903
claus
parents: 124
diff changeset
   904
    multipleSelectOk ifTrue:[
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   905
	selection isNil ifTrue:[^ #()].
125
claus
parents: 124
diff changeset
   906
	^ selection collect:[:nr | self at:nr]
claus
parents: 124
diff changeset
   907
    ].
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   908
    selection isNil ifTrue:[^ nil].
125
claus
parents: 124
diff changeset
   909
    ^ self at:selection
claus
parents: 124
diff changeset
   910
!
claus
parents: 124
diff changeset
   911
claus
parents: 124
diff changeset
   912
hasSelection
claus
parents: 124
diff changeset
   913
    "return true, if the view has a selection"
claus
parents: 124
diff changeset
   914
claus
parents: 124
diff changeset
   915
    ^ selection notNil 
claus
parents: 124
diff changeset
   916
!
claus
parents: 124
diff changeset
   917
claus
parents: 124
diff changeset
   918
selectElement:anObject
claus
parents: 124
diff changeset
   919
    "select the element with same printString as the argument, anObject.
claus
parents: 124
diff changeset
   920
     Scroll to make the new selection visible."
claus
parents: 124
diff changeset
   921
claus
parents: 124
diff changeset
   922
    |lineNo|
claus
parents: 124
diff changeset
   923
claus
parents: 124
diff changeset
   924
    list notNil ifTrue:[
claus
parents: 124
diff changeset
   925
	items notNil ifTrue:[
claus
parents: 124
diff changeset
   926
	    lineNo := items indexOf:anObject ifAbsent:nil
claus
parents: 124
diff changeset
   927
	] ifFalse:[
claus
parents: 124
diff changeset
   928
	    lineNo := list indexOf:(anObject printString) ifAbsent:nil.
claus
parents: 124
diff changeset
   929
	].
claus
parents: 124
diff changeset
   930
	lineNo notNil ifTrue:[self selection:lineNo]
claus
parents: 124
diff changeset
   931
    ]
claus
parents: 124
diff changeset
   932
!
claus
parents: 124
diff changeset
   933
claus
parents: 124
diff changeset
   934
selection
claus
parents: 124
diff changeset
   935
    "return the selection index or collection of indices (if multipleSelect is on)"
claus
parents: 124
diff changeset
   936
claus
parents: 124
diff changeset
   937
    ^ selection
claus
parents: 124
diff changeset
   938
!
claus
parents: 124
diff changeset
   939
claus
parents: 124
diff changeset
   940
selectionChangedFrom:oldSelection
claus
parents: 124
diff changeset
   941
    "selection has changed. Call actionblock and/or send changeMessage if defined"
claus
parents: 124
diff changeset
   942
claus
parents: 124
diff changeset
   943
    |arg|
claus
parents: 124
diff changeset
   944
claus
parents: 124
diff changeset
   945
    arg := self argForChangeMessage.
claus
parents: 124
diff changeset
   946
    "
claus
parents: 124
diff changeset
   947
     the ST/X way of doing things - perform actionBlock
claus
parents: 124
diff changeset
   948
    "
claus
parents: 124
diff changeset
   949
    actionBlock notNil ifTrue:[actionBlock value:arg].
claus
parents: 124
diff changeset
   950
    "
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   951
     the MVC way of doing things - notify model via changeMsg
125
claus
parents: 124
diff changeset
   952
    "
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   953
    multipleSelectOk ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   954
	"/ ST80 sends 0 as index, if the same selection is reselected ...
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   955
	selection == oldSelection ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   956
	    arg := 0
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   957
	].
125
claus
parents: 124
diff changeset
   958
    ].
claus
parents: 124
diff changeset
   959
    self sendChangeMessageWith:arg
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   960
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
   961
    "Modified: 26.10.1995 / 16:33:54 / cg"
125
claus
parents: 124
diff changeset
   962
!
claus
parents: 124
diff changeset
   963
claus
parents: 124
diff changeset
   964
deselect
claus
parents: 124
diff changeset
   965
    "deselect"
claus
parents: 124
diff changeset
   966
claus
parents: 124
diff changeset
   967
    self selection:nil
claus
parents: 124
diff changeset
   968
!
claus
parents: 124
diff changeset
   969
claus
parents: 124
diff changeset
   970
deselectWithoutRedraw
claus
parents: 124
diff changeset
   971
    "deselect - no redraw"
claus
parents: 124
diff changeset
   972
claus
parents: 124
diff changeset
   973
    selection := nil
claus
parents: 124
diff changeset
   974
!
claus
parents: 124
diff changeset
   975
claus
parents: 124
diff changeset
   976
numberOfSelections
claus
parents: 124
diff changeset
   977
    "return the number of selected entries"
claus
parents: 124
diff changeset
   978
claus
parents: 124
diff changeset
   979
    |sz|
claus
parents: 124
diff changeset
   980
claus
parents: 124
diff changeset
   981
    selection isNil ifTrue:[^ 0].
claus
parents: 124
diff changeset
   982
    sz := selection size.
claus
parents: 124
diff changeset
   983
    sz > 0 ifTrue:[^ sz].
claus
parents: 124
diff changeset
   984
    ^ 1
claus
parents: 124
diff changeset
   985
!
claus
parents: 124
diff changeset
   986
claus
parents: 124
diff changeset
   987
valueIsInSelection:someString
claus
parents: 124
diff changeset
   988
    "return true, if someString is in the selection"
claus
parents: 124
diff changeset
   989
claus
parents: 124
diff changeset
   990
    |sel|
claus
parents: 124
diff changeset
   991
claus
parents: 124
diff changeset
   992
    selection isNil ifTrue:[^ false].
claus
parents: 124
diff changeset
   993
    sel := self selectionValue.
claus
parents: 124
diff changeset
   994
    self numberOfSelections > 1 ifTrue:[
claus
parents: 124
diff changeset
   995
	^ (sel includes:someString)
claus
parents: 124
diff changeset
   996
    ].
claus
parents: 124
diff changeset
   997
    ^ (someString = sel)
claus
parents: 124
diff changeset
   998
!
claus
parents: 124
diff changeset
   999
claus
parents: 124
diff changeset
  1000
selectElementWithoutScroll:anObject
claus
parents: 124
diff changeset
  1001
    "select the element with same printString as the argument, anObject.
claus
parents: 124
diff changeset
  1002
     Do not scroll."
claus
parents: 124
diff changeset
  1003
claus
parents: 124
diff changeset
  1004
    |lineNo|
claus
parents: 124
diff changeset
  1005
claus
parents: 124
diff changeset
  1006
    list notNil ifTrue:[
claus
parents: 124
diff changeset
  1007
	items notNil ifTrue:[
claus
parents: 124
diff changeset
  1008
	    lineNo := items indexOf:anObject ifAbsent:nil
claus
parents: 124
diff changeset
  1009
	] ifFalse:[
claus
parents: 124
diff changeset
  1010
	    lineNo := list indexOf:(anObject printString) ifAbsent:nil.
claus
parents: 124
diff changeset
  1011
	].
claus
parents: 124
diff changeset
  1012
	lineNo notNil ifTrue:[self selectWithoutScroll:lineNo]
claus
parents: 124
diff changeset
  1013
    ]
claus
parents: 124
diff changeset
  1014
!
claus
parents: 124
diff changeset
  1015
claus
parents: 124
diff changeset
  1016
nextAfterSelection
claus
parents: 124
diff changeset
  1017
    "return the index of the next selectable entry after the selection.
claus
parents: 124
diff changeset
  1018
     Wrap at end."
claus
parents: 124
diff changeset
  1019
claus
parents: 124
diff changeset
  1020
    |next|
claus
parents: 124
diff changeset
  1021
claus
parents: 124
diff changeset
  1022
    selection isNil ifTrue:[
claus
parents: 124
diff changeset
  1023
	next := firstLineShown
claus
parents: 124
diff changeset
  1024
    ] ifFalse:[
claus
parents: 124
diff changeset
  1025
	selection size ~~ 0 ifTrue:[
claus
parents: 124
diff changeset
  1026
	    next := selection max + 1
claus
parents: 124
diff changeset
  1027
	] ifFalse:[
claus
parents: 124
diff changeset
  1028
	    next := selection + 1
claus
parents: 124
diff changeset
  1029
	].
claus
parents: 124
diff changeset
  1030
    ].
claus
parents: 124
diff changeset
  1031
    (self isValidSelection:next) ifFalse:[
claus
parents: 124
diff changeset
  1032
	next > self size ifTrue:[
claus
parents: 124
diff changeset
  1033
	    next := 1.
claus
parents: 124
diff changeset
  1034
	] ifFalse:[
claus
parents: 124
diff changeset
  1035
	    [next <= self size
claus
parents: 124
diff changeset
  1036
	     and:[(self isValidSelection:next) not]] whileTrue:[
claus
parents: 124
diff changeset
  1037
		next := next + 1
claus
parents: 124
diff changeset
  1038
	    ].
claus
parents: 124
diff changeset
  1039
	].
claus
parents: 124
diff changeset
  1040
    ].
claus
parents: 124
diff changeset
  1041
    (self isValidSelection:next) ifFalse:[
claus
parents: 124
diff changeset
  1042
	next := nil
claus
parents: 124
diff changeset
  1043
    ].
claus
parents: 124
diff changeset
  1044
    ^ next
claus
parents: 124
diff changeset
  1045
!
claus
parents: 124
diff changeset
  1046
claus
parents: 124
diff changeset
  1047
previousBeforeSelection
claus
parents: 124
diff changeset
  1048
    "return the index of the previous selectable entry before the selection.
claus
parents: 124
diff changeset
  1049
     Wrap at beginning."
claus
parents: 124
diff changeset
  1050
claus
parents: 124
diff changeset
  1051
    |prev|
claus
parents: 124
diff changeset
  1052
claus
parents: 124
diff changeset
  1053
    selection isNil ifTrue:[
claus
parents: 124
diff changeset
  1054
	prev := firstLineShown - 1 
claus
parents: 124
diff changeset
  1055
    ] ifFalse:[
claus
parents: 124
diff changeset
  1056
	selection size ~~ 0 ifTrue:[
claus
parents: 124
diff changeset
  1057
	    prev := selection min - 1
claus
parents: 124
diff changeset
  1058
	] ifFalse:[
claus
parents: 124
diff changeset
  1059
	    prev := selection - 1
claus
parents: 124
diff changeset
  1060
	].
claus
parents: 124
diff changeset
  1061
    ].
claus
parents: 124
diff changeset
  1062
    (self isValidSelection:prev) ifFalse:[
claus
parents: 124
diff changeset
  1063
	prev < 1 ifTrue:[
claus
parents: 124
diff changeset
  1064
	    prev := self size.
claus
parents: 124
diff changeset
  1065
	] ifFalse:[
claus
parents: 124
diff changeset
  1066
	    [prev >= 1
claus
parents: 124
diff changeset
  1067
	     and:[(self isValidSelection:prev) not]] whileTrue:[
claus
parents: 124
diff changeset
  1068
		prev := prev - 1
claus
parents: 124
diff changeset
  1069
	    ].
claus
parents: 124
diff changeset
  1070
	].
claus
parents: 124
diff changeset
  1071
    ].
claus
parents: 124
diff changeset
  1072
    (self isValidSelection:prev) ifFalse:[
claus
parents: 124
diff changeset
  1073
	prev := nil
claus
parents: 124
diff changeset
  1074
    ].
claus
parents: 124
diff changeset
  1075
    ^ prev
claus
parents: 124
diff changeset
  1076
claus
parents: 124
diff changeset
  1077
!
claus
parents: 124
diff changeset
  1078
claus
parents: 124
diff changeset
  1079
selectAll
claus
parents: 124
diff changeset
  1080
    "select all entries."
claus
parents: 124
diff changeset
  1081
claus
parents: 124
diff changeset
  1082
    |oldSelection|
claus
parents: 124
diff changeset
  1083
claus
parents: 124
diff changeset
  1084
    multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1085
	oldSelection := selection.
claus
parents: 124
diff changeset
  1086
	selection := OrderedCollection withAll:(1 to:self size).
claus
parents: 124
diff changeset
  1087
	shown ifTrue:[self redraw].
claus
parents: 124
diff changeset
  1088
	self selectionChangedFrom:oldSelection.
claus
parents: 124
diff changeset
  1089
    ]
claus
parents: 124
diff changeset
  1090
!
claus
parents: 124
diff changeset
  1091
claus
parents: 124
diff changeset
  1092
toggleSelection:aNumber
claus
parents: 124
diff changeset
  1093
    "toggle selection-state of entry, aNumber"
claus
parents: 124
diff changeset
  1094
claus
parents: 124
diff changeset
  1095
    (self isInSelection:aNumber) ifTrue:[
claus
parents: 124
diff changeset
  1096
	self removeFromSelection:aNumber
claus
parents: 124
diff changeset
  1097
    ] ifFalse:[
claus
parents: 124
diff changeset
  1098
	self addToSelection:aNumber
claus
parents: 124
diff changeset
  1099
    ]
claus
parents: 124
diff changeset
  1100
!
claus
parents: 124
diff changeset
  1101
claus
parents: 124
diff changeset
  1102
selectNext
claus
parents: 124
diff changeset
  1103
    "select next line or first visible if there is currrently no selection.
claus
parents: 124
diff changeset
  1104
     Wrap at end."
claus
parents: 124
diff changeset
  1105
claus
parents: 124
diff changeset
  1106
    self selection:(self nextAfterSelection)
claus
parents: 124
diff changeset
  1107
!
claus
parents: 124
diff changeset
  1108
claus
parents: 124
diff changeset
  1109
selectPrevious
claus
parents: 124
diff changeset
  1110
    "select previous line or previous visible if there is currently no selection.
claus
parents: 124
diff changeset
  1111
     Wrap at beginning."
claus
parents: 124
diff changeset
  1112
164
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
  1113
    self selection:(self previousBeforeSelection).
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
  1114
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
  1115
    "Modified: 26.9.1995 / 09:41:16 / stefan"
125
claus
parents: 124
diff changeset
  1116
!
claus
parents: 124
diff changeset
  1117
claus
parents: 124
diff changeset
  1118
selectionDo:aBlock
claus
parents: 124
diff changeset
  1119
    "perform aBlock for each nr in the selection.
claus
parents: 124
diff changeset
  1120
     For single selection, it is called once for the items nr.
claus
parents: 124
diff changeset
  1121
     For multiple selections, it is called for each."
claus
parents: 124
diff changeset
  1122
claus
parents: 124
diff changeset
  1123
    selection notNil ifTrue:[
claus
parents: 124
diff changeset
  1124
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1125
	    selection do:aBlock
claus
parents: 124
diff changeset
  1126
	] ifFalse:[
claus
parents: 124
diff changeset
  1127
	    aBlock value:selection
claus
parents: 124
diff changeset
  1128
	].
claus
parents: 124
diff changeset
  1129
    ].
claus
parents: 124
diff changeset
  1130
claus
parents: 124
diff changeset
  1131
!
claus
parents: 124
diff changeset
  1132
claus
parents: 124
diff changeset
  1133
selectionAsCollection
claus
parents: 124
diff changeset
  1134
    "return the selection as a collection of line numbers.
claus
parents: 124
diff changeset
  1135
     This allows users of this class to enumerate independent of
claus
parents: 124
diff changeset
  1136
     the multipleSelect style."
claus
parents: 124
diff changeset
  1137
claus
parents: 124
diff changeset
  1138
    selection isNil ifTrue:[^ #()].
claus
parents: 124
diff changeset
  1139
130
claus
parents: 128
diff changeset
  1140
"/    multipleSelectOk ifTrue:[
claus
parents: 128
diff changeset
  1141
"/        ^ (OrderedCollection new) add:selection; yourself.
claus
parents: 128
diff changeset
  1142
"/    ].
claus
parents: 128
diff changeset
  1143
    multipleSelectOk ifFalse:[
claus
parents: 128
diff changeset
  1144
	^ (OrderedCollection new) add:selection; yourself.
125
claus
parents: 124
diff changeset
  1145
    ].
claus
parents: 124
diff changeset
  1146
    ^ selection
claus
parents: 124
diff changeset
  1147
! !
claus
parents: 124
diff changeset
  1148
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1149
!SelectionInListView methodsFor:'redrawing'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1150
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1151
redrawVisibleLine:visLineNr
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1152
    "redraw a single line.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1153
     Must check, if any is in the selection and handle this case.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1154
     Otherwise draw using supers method."
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1155
131
claus
parents: 130
diff changeset
  1156
    |listLine fg bg newFont id|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1157
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1158
    fg := fgColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1159
    bg := bgColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1160
    listLine := self visibleLineToListLine:visLineNr.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1161
    listLine notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1162
	(self isInSelection:listLine) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1163
	    ^ self drawVisibleLineSelected:visLineNr
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1164
	].
125
claus
parents: 124
diff changeset
  1165
claus
parents: 124
diff changeset
  1166
	listAttributes notNil ifTrue:[
claus
parents: 124
diff changeset
  1167
	    (self line:listLine hasAttribute:#halfIntensity) ifTrue:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1168
		fg := halfIntensityFgColor
125
claus
parents: 124
diff changeset
  1169
	    ] ifFalse:[
claus
parents: 124
diff changeset
  1170
		(self line:listLine hasAttribute:#disabled) ifTrue:[
claus
parents: 124
diff changeset
  1171
		    fg := halfIntensityFgColor
claus
parents: 124
diff changeset
  1172
		].
65
b33e4f3a264e *** empty log message ***
claus
parents: 63
diff changeset
  1173
	    ].
125
claus
parents: 124
diff changeset
  1174
	    (self line:listLine hasAttribute:#bold) ifTrue:[
131
claus
parents: 130
diff changeset
  1175
		newFont := font asBold.
claus
parents: 130
diff changeset
  1176
		(font bold 
claus
parents: 130
diff changeset
  1177
		or:[id := (newFont on:device) fontId.
claus
parents: 130
diff changeset
  1178
		    id isNil]) 
claus
parents: 130
diff changeset
  1179
		ifTrue:[
125
claus
parents: 124
diff changeset
  1180
		    "
claus
parents: 124
diff changeset
  1181
		     mhmh - what can be done, if the font is already bold ?
claus
parents: 124
diff changeset
  1182
		    "
claus
parents: 124
diff changeset
  1183
		    newFont := font.
claus
parents: 124
diff changeset
  1184
		    fgColor brightness > 0.5 ifTrue:[
claus
parents: 124
diff changeset
  1185
			fg := fgColor darkened "darkened". 
claus
parents: 124
diff changeset
  1186
		    ] ifFalse:[
claus
parents: 124
diff changeset
  1187
			fg := fgColor lightened "lightened"
claus
parents: 124
diff changeset
  1188
		    ].
claus
parents: 124
diff changeset
  1189
		    (fg brightness - bg brightness) abs < 0.25 ifTrue:[
claus
parents: 124
diff changeset
  1190
			bgColor brightness > 0.5 ifTrue:[
claus
parents: 124
diff changeset
  1191
			    fg := fg darkened. 
claus
parents: 124
diff changeset
  1192
			] ifFalse:[
claus
parents: 124
diff changeset
  1193
			    fg := fg lightened
claus
parents: 124
diff changeset
  1194
			].
claus
parents: 124
diff changeset
  1195
		    ]
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
  1196
		].
131
claus
parents: 130
diff changeset
  1197
		id notNil ifTrue:[
claus
parents: 130
diff changeset
  1198
		    device setFont:id in:gcId.
claus
parents: 130
diff changeset
  1199
		].
125
claus
parents: 124
diff changeset
  1200
		self drawVisibleLine:visLineNr with:fg and:bg.
claus
parents: 124
diff changeset
  1201
		device setFont:(font on:device) fontId in:gcId.
claus
parents: 124
diff changeset
  1202
		^ self
claus
parents: 124
diff changeset
  1203
	    ]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1204
	]
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1205
    ].
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1206
    ^ self drawVisibleLine:visLineNr with:fg and:bg
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1207
!
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1208
125
claus
parents: 124
diff changeset
  1209
redrawElement:aNumber
claus
parents: 124
diff changeset
  1210
    "redraw an individual element"
claus
parents: 124
diff changeset
  1211
claus
parents: 124
diff changeset
  1212
    ^ self redrawLine:aNumber
claus
parents: 124
diff changeset
  1213
!
claus
parents: 124
diff changeset
  1214
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1215
drawVisibleLineSelected:visLineNr
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1216
    "redraw a single line as selected."
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1217
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1218
    |listLine fg bg
182
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1219
     y  "{ Class: SmallInteger }" 
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1220
     y2 "{ Class: SmallInteger }" 
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1221
     wEdge|
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1222
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1223
    bg := hilightBgColor.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1224
    fg := hilightFgColor.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1225
    listLine := self visibleLineToListLine:visLineNr.
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1226
    listLine notNil ifTrue:[
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1227
	strikeOut ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1228
	    self drawVisibleLine:visLineNr with:fgColor and:bgColor.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1229
	    y := self yOfVisibleLine:visLineNr.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1230
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1231
	    self paint:fgColor.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1232
	    y := y + (fontHeight // 2).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1233
	    self displayLineFromX:0 y:y toX:width y:y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1234
	    ^ self
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1235
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1236
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1237
	self drawVisibleLine:visLineNr with:fg and:bg.
191
5ccbde40bb6b draw strings half a lineSpacing lower - highlight frames look better
Claus Gittinger <cg@exept.de>
parents: 182
diff changeset
  1238
	y := (self yOfVisibleLine:visLineNr) - (lineSpacing//2).
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1239
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1240
	"
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1241
	 a line above and below
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1242
	"
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1243
	hilightFrameColor notNil ifTrue:[
182
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1244
	    hilightLevel == 0 ifTrue:[
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1245
		self paint:hilightFrameColor.
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1246
		self displayLineFromX:0 y:y toX:width y:y.
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1247
		y2 := y + fontHeight - 1.
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1248
		self displayLineFromX:0 y:y2 toX:width y:y2.
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1249
		^ self
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1250
	    ]
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1251
	].
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1252
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1253
	"
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1254
	 an edge it around
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1255
	"
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1256
	(hilightLevel ~~ 0) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1257
	    "
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1258
	     let edge start at left, extending to the full width
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1259
	     XXX: widthOfContents should be cached in ListView
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1260
		  (instead of recomputing all over)
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1261
	    "
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1262
	    wEdge := width-(2 * margin).
191
5ccbde40bb6b draw strings half a lineSpacing lower - highlight frames look better
Claus Gittinger <cg@exept.de>
parents: 182
diff changeset
  1263
	    includesNonStrings ifFalse:[
5ccbde40bb6b draw strings half a lineSpacing lower - highlight frames look better
Claus Gittinger <cg@exept.de>
parents: 182
diff changeset
  1264
		wEdge := wEdge max:(self widthOfContents).
5ccbde40bb6b draw strings half a lineSpacing lower - highlight frames look better
Claus Gittinger <cg@exept.de>
parents: 182
diff changeset
  1265
	    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1266
	    self drawEdgesForX:(margin - leftOffset) y:y 
224
ebec7c7c015a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 210
diff changeset
  1267
			 width:wEdge+leftOffset height:fontHeight 
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  1268
			 level:hilightLevel.
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1269
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1270
155
claus
parents: 151
diff changeset
  1271
	].
claus
parents: 151
diff changeset
  1272
	^ self
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1273
    ].
31
2224b4d173f7 *** empty log message ***
claus
parents: 24
diff changeset
  1274
    ^ super drawVisibleLine:visLineNr with:fg and:bg
155
claus
parents: 151
diff changeset
  1275
claus
parents: 151
diff changeset
  1276
    "Modified: 31.8.1995 / 19:24:09 / claus"
182
e59e03f374b2 fixed: highlight drawing wrong if frameColor was non-nil (os/2 style)
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1277
    "Modified: 17.11.1995 / 09:36:25 / cg"
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1278
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1279
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1280
redrawFromVisibleLine:startVisLineNr to:endVisLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1281
    "redraw a range of lines.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1282
     Must check, if any is in the selection and handle this case.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1283
     Otherwise draw it en-bloque using supers method."
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1284
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1285
    |special sel
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1286
     selNo "{ Class: SmallInteger }" |
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1287
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1288
    ((selection isCollection) or:[listAttributes notNil]) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1289
	startVisLineNr to:endVisLineNr do:[:visLine |
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1290
	    self redrawVisibleLine:visLine
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1291
	].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1292
	^ self
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1293
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1294
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1295
"XXX only if -1/+1"
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1296
"/    hilightLevel ~~ 0 ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1297
"/     self paint:bgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1298
"/     self fillRectangleX:0 y:(self yOfVisibleLine:startVisLineNr)-1 width:width height:1
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1299
"/  ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1300
    special := true.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1301
    selection isNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1302
	special := false
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1303
    ] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1304
	sel := self listLineToVisibleLine:selection.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1305
	sel isNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1306
	    special := false
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1307
	] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1308
	    special := (sel between:startVisLineNr and:endVisLineNr)
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1309
	]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1310
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1311
    special ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1312
      ^ super redrawFromVisibleLine:startVisLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1313
				 to:endVisLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1314
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1315
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1316
    selNo := sel.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1317
    selNo > startVisLineNr ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1318
	super redrawFromVisibleLine:startVisLineNr to:(selNo - 1)
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1319
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1320
    self redrawVisibleLine:selNo.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1321
    selNo < endVisLineNr ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1322
	super redrawFromVisibleLine:(selNo + 1) to:endVisLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1323
    ]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1324
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1325
125
claus
parents: 124
diff changeset
  1326
redrawVisibleLine:visLineNr from:startCol to:endCol
claus
parents: 124
diff changeset
  1327
    "redraw from a startCol to endCol.
claus
parents: 124
diff changeset
  1328
     Must check, if its in the selection and handle this case."
claus
parents: 124
diff changeset
  1329
claus
parents: 124
diff changeset
  1330
    (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
claus
parents: 124
diff changeset
  1331
	^ self redrawVisibleLine:visLineNr
claus
parents: 124
diff changeset
  1332
    ].
claus
parents: 124
diff changeset
  1333
    super redrawVisibleLine:visLineNr from:startCol to:endCol
claus
parents: 124
diff changeset
  1334
!
claus
parents: 124
diff changeset
  1335
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1336
drawRightArrowInVisibleLine:visLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1337
    "draw a right arrow (for submenus).
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1338
     This method is not used here, but provided for subclasses such
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1339
     as menus or file-lists."
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1340
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1341
    |y x form form2 topLeftColor botRightColor t|
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1342
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1343
    x := width - 16.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1344
    y := (self yOfVisibleLine:visLineNr).
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1345
146
claus
parents: 133
diff changeset
  1346
    (device depth == 1 or:[arrowLevel == 0]) ifTrue:[
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1347
	form := self class rightArrowFormOn:device.
271
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1348
	form notNil ifTrue:[
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1349
	    y := y + ((font height - form height) // 2).
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1350
	    (self isInSelection:(self visibleLineToListLine:visLineNr)) ifTrue:[
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1351
	        self foreground:hilightFgColor
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1352
	    ] ifFalse:[
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1353
	        self foreground:fgColor.
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1354
	    ].
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1355
	    self displayForm:form x:x y:y.
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1356
	]
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1357
    ] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1358
	smallArrow ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1359
	    form := self class smallRightArrowLightFormOn:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1360
	    form2 := self class smallRightArrowShadowFormOn:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1361
	] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1362
	    form := self class rightArrowLightFormOn:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1363
	    form2 := self class rightArrowShadowFormOn:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1364
	].
271
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1365
	(form isNil or:[form2 isNil]) ifTrue:[
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1366
	    "/ very bad conditions
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1367
	    ^ self
2554fcf338ec handle bad cases where the (arrow) bitmaps are not available
Claus Gittinger <cg@exept.de>
parents: 224
diff changeset
  1368
	].
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1369
	y := y + ((font height - form height) // 2).
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1370
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1371
	topLeftColor := lightColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1372
	botRightColor := shadowColor. 
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1373
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1374
	"openwin arrow stays down"
130
claus
parents: 128
diff changeset
  1375
	styleSheet name ~~ #openwin ifTrue:[
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1376
	    (self isInSelection:(self visibleLineToListLine:visLineNr)) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1377
		t := topLeftColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1378
		topLeftColor := botRightColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1379
		botRightColor := t.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1380
	    ]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1381
	].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1382
	arrowLevel < 0 ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1383
	    t := topLeftColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1384
	    topLeftColor := botRightColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1385
	    botRightColor := t.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1386
	].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1387
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1388
"/        self foreground:topLeftColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1389
self paint:topLeftColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1390
	self displayForm:form x:x y:y.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1391
"/        self foreground:botRightColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1392
self paint:botRightColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1393
	self displayForm:form2 x:x y:y.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1394
    ]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1395
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1396
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1397
redrawVisibleLine:visLineNr col:colNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1398
    "redraw a single character.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1399
     Must check, if its in the selection and handle this case."
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1400
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1401
    (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1402
	^ self redrawVisibleLine:visLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1403
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1404
    super redrawVisibleLine:visLineNr col:colNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1405
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1406
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1407
redrawVisibleLine:visLineNr from:startCol
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1408
    "redraw from a col to the right end.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1409
     Must check, if its in the selection and handle this case."
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1410
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1411
    (self visibleLineNeedsSpecialCare:visLineNr) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1412
	^ self redrawVisibleLine:visLineNr
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1413
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1414
    super redrawVisibleLine:visLineNr from:startCol
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1415
! !
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1416
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1417
!SelectionInListView methodsFor:'private'!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1418
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1419
getListFromModel
119
claus
parents: 116
diff changeset
  1420
    "if I have a model and a listMsg, get my list from it"
claus
parents: 116
diff changeset
  1421
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1422
    |text|
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1423
119
claus
parents: 116
diff changeset
  1424
    model notNil ifTrue:[
claus
parents: 116
diff changeset
  1425
	listMsg notNil ifTrue:[
claus
parents: 116
diff changeset
  1426
	    items := model perform:listMsg.
claus
parents: 116
diff changeset
  1427
	    items notNil ifTrue:[
claus
parents: 116
diff changeset
  1428
		printItems ifTrue:[
claus
parents: 116
diff changeset
  1429
		    text := items collect:[:element | element printString]
claus
parents: 116
diff changeset
  1430
		] ifFalse:[
claus
parents: 116
diff changeset
  1431
		    text := items
claus
parents: 116
diff changeset
  1432
		].
128
claus
parents: 125
diff changeset
  1433
"/                text notNil ifTrue:[
claus
parents: 125
diff changeset
  1434
"/                    text := text asStringCollection.
claus
parents: 125
diff changeset
  1435
"/                ]
119
claus
parents: 116
diff changeset
  1436
	    ].
133
claus
parents: 132
diff changeset
  1437
	    self list:text keepSelection:true. "/ expandTabs:false
119
claus
parents: 116
diff changeset
  1438
	].
claus
parents: 116
diff changeset
  1439
    ].
claus
parents: 116
diff changeset
  1440
!
claus
parents: 116
diff changeset
  1441
claus
parents: 116
diff changeset
  1442
getSelectionFromModel
claus
parents: 116
diff changeset
  1443
    "if I have a model and an initialSelectionMsg, get my selection from it"
claus
parents: 116
diff changeset
  1444
claus
parents: 116
diff changeset
  1445
    |sel|
claus
parents: 116
diff changeset
  1446
claus
parents: 116
diff changeset
  1447
    model notNil ifTrue:[
claus
parents: 116
diff changeset
  1448
	initialSelectionMsg notNil ifTrue:[
claus
parents: 116
diff changeset
  1449
	    sel := model perform:initialSelectionMsg.
claus
parents: 116
diff changeset
  1450
	    useIndex ifTrue:[
claus
parents: 116
diff changeset
  1451
		self selection:sel 
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1452
	    ] ifFalse:[
119
claus
parents: 116
diff changeset
  1453
		self selectElement:sel.
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1454
	    ].
119
claus
parents: 116
diff changeset
  1455
	]
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  1456
    ].
125
claus
parents: 124
diff changeset
  1457
!
claus
parents: 124
diff changeset
  1458
claus
parents: 124
diff changeset
  1459
argForChangeMessage
claus
parents: 124
diff changeset
  1460
    "return the argument for a selectionChange;
claus
parents: 124
diff changeset
  1461
     depending on the setting of useIndex, this is either the numeric
claus
parents: 124
diff changeset
  1462
     index of the selection or the value (i.e. the string)"
claus
parents: 124
diff changeset
  1463
claus
parents: 124
diff changeset
  1464
    useIndex ~~ false ifTrue:[  "/ i.e. everything except false
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1465
	multipleSelectOk ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1466
	    selection isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1467
		^ #() 
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1468
	    ].
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1469
	].
125
claus
parents: 124
diff changeset
  1470
	^ selection
claus
parents: 124
diff changeset
  1471
    ].
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1472
125
claus
parents: 124
diff changeset
  1473
    printItems ifFalse:[
claus
parents: 124
diff changeset
  1474
	^ self selectionValue
claus
parents: 124
diff changeset
  1475
    ].
claus
parents: 124
diff changeset
  1476
claus
parents: 124
diff changeset
  1477
    items notNil ifTrue:[
claus
parents: 124
diff changeset
  1478
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1479
	    ^ selection collect:[:nr | items at:nr]
claus
parents: 124
diff changeset
  1480
	].
claus
parents: 124
diff changeset
  1481
	^ items at:selection
claus
parents: 124
diff changeset
  1482
    ].
claus
parents: 124
diff changeset
  1483
claus
parents: 124
diff changeset
  1484
    ^ nil       "/ cannot happen
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1485
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  1486
    "Modified: 26.10.1995 / 16:28:13 / cg"
125
claus
parents: 124
diff changeset
  1487
!
claus
parents: 124
diff changeset
  1488
claus
parents: 124
diff changeset
  1489
isValidSelection:aNumberOrCollection
claus
parents: 124
diff changeset
  1490
    "return true, if aNumber is ok as a selection index"
claus
parents: 124
diff changeset
  1491
claus
parents: 124
diff changeset
  1492
    aNumberOrCollection isNil ifTrue:[^ false].
claus
parents: 124
diff changeset
  1493
claus
parents: 124
diff changeset
  1494
    (aNumberOrCollection isCollection) ifTrue:[
claus
parents: 124
diff changeset
  1495
	multipleSelectOk ifFalse:[^ false].
claus
parents: 124
diff changeset
  1496
	aNumberOrCollection do:[:index |
claus
parents: 124
diff changeset
  1497
	    (index between:1 and:self size) ifFalse:[^ false].
claus
parents: 124
diff changeset
  1498
	].
claus
parents: 124
diff changeset
  1499
	^ true.
claus
parents: 124
diff changeset
  1500
    ] ifFalse:[
claus
parents: 124
diff changeset
  1501
	^ (aNumberOrCollection between:1 and:self size).
claus
parents: 124
diff changeset
  1502
    ].
claus
parents: 124
diff changeset
  1503
claus
parents: 124
diff changeset
  1504
!
claus
parents: 124
diff changeset
  1505
claus
parents: 124
diff changeset
  1506
positionToSelectionX:x y:y
claus
parents: 124
diff changeset
  1507
    "given a click position, return the selection lineNo"
claus
parents: 124
diff changeset
  1508
claus
parents: 124
diff changeset
  1509
    |visibleLine|
claus
parents: 124
diff changeset
  1510
claus
parents: 124
diff changeset
  1511
    (x between:0 and:width) ifTrue:[
claus
parents: 124
diff changeset
  1512
	(y between:0 and:height) ifTrue:[
claus
parents: 124
diff changeset
  1513
	    visibleLine := self visibleLineOfY:y.
claus
parents: 124
diff changeset
  1514
	    ^ self visibleLineToListLine:visibleLine
claus
parents: 124
diff changeset
  1515
	]
claus
parents: 124
diff changeset
  1516
    ].
claus
parents: 124
diff changeset
  1517
    ^ nil
claus
parents: 124
diff changeset
  1518
!
claus
parents: 124
diff changeset
  1519
claus
parents: 124
diff changeset
  1520
widthForScrollBetween:start and:end
claus
parents: 124
diff changeset
  1521
    "has to be redefined since WHOLE line is inverted/modified sometimes"
claus
parents: 124
diff changeset
  1522
claus
parents: 124
diff changeset
  1523
    | anySelectionInRange |
claus
parents: 124
diff changeset
  1524
claus
parents: 124
diff changeset
  1525
    selection notNil ifTrue:[
claus
parents: 124
diff changeset
  1526
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1527
	    anySelectionInRange := false.
claus
parents: 124
diff changeset
  1528
	    selection do:[:s |
claus
parents: 124
diff changeset
  1529
		(s between:start and:end) ifTrue:[
claus
parents: 124
diff changeset
  1530
		    anySelectionInRange := true
claus
parents: 124
diff changeset
  1531
		]
claus
parents: 124
diff changeset
  1532
	    ]
claus
parents: 124
diff changeset
  1533
	] ifFalse:[
claus
parents: 124
diff changeset
  1534
	    anySelectionInRange := selection between:start and:end
claus
parents: 124
diff changeset
  1535
	]
claus
parents: 124
diff changeset
  1536
    ] ifFalse:[
claus
parents: 124
diff changeset
  1537
	anySelectionInRange := false
claus
parents: 124
diff changeset
  1538
    ].
claus
parents: 124
diff changeset
  1539
claus
parents: 124
diff changeset
  1540
    anySelectionInRange ifTrue:[
claus
parents: 124
diff changeset
  1541
	^ width
claus
parents: 124
diff changeset
  1542
"
claus
parents: 124
diff changeset
  1543
	self is3D ifFalse:[
claus
parents: 124
diff changeset
  1544
	    ^ width 
claus
parents: 124
diff changeset
  1545
	].
130
claus
parents: 128
diff changeset
  1546
	( #(next openwin) includes:styleSheet name) ifTrue:[
125
claus
parents: 124
diff changeset
  1547
	    ^ width 
claus
parents: 124
diff changeset
  1548
	].
claus
parents: 124
diff changeset
  1549
	viewBackground = background ifFalse:[
claus
parents: 124
diff changeset
  1550
	    ^ width 
claus
parents: 124
diff changeset
  1551
	]
claus
parents: 124
diff changeset
  1552
"
claus
parents: 124
diff changeset
  1553
    ].
claus
parents: 124
diff changeset
  1554
    ^ super widthForScrollBetween:start and:end
claus
parents: 124
diff changeset
  1555
!
claus
parents: 124
diff changeset
  1556
claus
parents: 124
diff changeset
  1557
visibleLineNeedsSpecialCare:visLineNr
claus
parents: 124
diff changeset
  1558
    |listLine|
claus
parents: 124
diff changeset
  1559
claus
parents: 124
diff changeset
  1560
    listLine := self visibleLineToListLine:visLineNr.
claus
parents: 124
diff changeset
  1561
    listLine isNil ifTrue:[^ false].
claus
parents: 124
diff changeset
  1562
    (self isInSelection:listLine) ifTrue:[^ true].
claus
parents: 124
diff changeset
  1563
    listAttributes notNil ifTrue:[
claus
parents: 124
diff changeset
  1564
	(listLine <= listAttributes size) ifTrue:[
claus
parents: 124
diff changeset
  1565
	    ^ (listAttributes at:listLine) notNil
claus
parents: 124
diff changeset
  1566
	]
claus
parents: 124
diff changeset
  1567
    ].
claus
parents: 124
diff changeset
  1568
    ^ false
claus
parents: 124
diff changeset
  1569
!
claus
parents: 124
diff changeset
  1570
claus
parents: 124
diff changeset
  1571
checkRemovingSelection:lineNr
claus
parents: 124
diff changeset
  1572
    "when a line is removed, we have to adjust selection"
claus
parents: 124
diff changeset
  1573
claus
parents: 124
diff changeset
  1574
    |newSelection|
claus
parents: 124
diff changeset
  1575
claus
parents: 124
diff changeset
  1576
    selection notNil ifTrue:[
claus
parents: 124
diff changeset
  1577
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1578
	    newSelection := OrderedCollection new.
claus
parents: 124
diff changeset
  1579
	    selection do:[:sel |
claus
parents: 124
diff changeset
  1580
		sel < lineNr ifTrue:[
claus
parents: 124
diff changeset
  1581
		    newSelection add:sel
claus
parents: 124
diff changeset
  1582
		] ifFalse:[
claus
parents: 124
diff changeset
  1583
		    sel > lineNr ifTrue:[
claus
parents: 124
diff changeset
  1584
			newSelection add:(sel - 1)
claus
parents: 124
diff changeset
  1585
		    ]
claus
parents: 124
diff changeset
  1586
		    "otherwise remove it from the selection"
claus
parents: 124
diff changeset
  1587
		]
claus
parents: 124
diff changeset
  1588
	    ].
claus
parents: 124
diff changeset
  1589
	    newSelection size == 0 ifTrue:[
claus
parents: 124
diff changeset
  1590
		selection := nil
claus
parents: 124
diff changeset
  1591
	    ] ifFalse:[
claus
parents: 124
diff changeset
  1592
		selection := newSelection
claus
parents: 124
diff changeset
  1593
	    ]
claus
parents: 124
diff changeset
  1594
	] ifFalse:[
claus
parents: 124
diff changeset
  1595
	    selection == lineNr ifTrue:[
claus
parents: 124
diff changeset
  1596
		selection := nil
claus
parents: 124
diff changeset
  1597
	    ] ifFalse:[
claus
parents: 124
diff changeset
  1598
		selection > lineNr ifTrue:[
claus
parents: 124
diff changeset
  1599
		    selection := selection - 1
claus
parents: 124
diff changeset
  1600
		]
claus
parents: 124
diff changeset
  1601
	    ]
claus
parents: 124
diff changeset
  1602
	]
claus
parents: 124
diff changeset
  1603
    ]
claus
parents: 124
diff changeset
  1604
!
claus
parents: 124
diff changeset
  1605
claus
parents: 124
diff changeset
  1606
scrollSelectDown
claus
parents: 124
diff changeset
  1607
    "auto scroll action; scroll and reinstall timed-block"
claus
parents: 124
diff changeset
  1608
claus
parents: 124
diff changeset
  1609
    self scrollDown.
claus
parents: 124
diff changeset
  1610
    Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
claus
parents: 124
diff changeset
  1611
!
claus
parents: 124
diff changeset
  1612
claus
parents: 124
diff changeset
  1613
scrollSelectUp
claus
parents: 124
diff changeset
  1614
    "auto scroll action; scroll and reinstall timed-block"
claus
parents: 124
diff changeset
  1615
claus
parents: 124
diff changeset
  1616
    self scrollUp.
claus
parents: 124
diff changeset
  1617
    Processor addTimedBlock:autoScrollBlock afterSeconds:autoScrollDeltaT.
claus
parents: 124
diff changeset
  1618
! !
claus
parents: 124
diff changeset
  1619
claus
parents: 124
diff changeset
  1620
!SelectionInListView methodsFor:'event handling'!
claus
parents: 124
diff changeset
  1621
claus
parents: 124
diff changeset
  1622
buttonRelease:button x:x y:y
claus
parents: 124
diff changeset
  1623
    "stop any autoscroll"
claus
parents: 124
diff changeset
  1624
claus
parents: 124
diff changeset
  1625
    self stopAutoScroll
claus
parents: 124
diff changeset
  1626
!
claus
parents: 124
diff changeset
  1627
claus
parents: 124
diff changeset
  1628
buttonPress:button x:x y:y
claus
parents: 124
diff changeset
  1629
    |oldSelection listLineNr|
claus
parents: 124
diff changeset
  1630
claus
parents: 124
diff changeset
  1631
    ((button == 1) or:[button == #select]) ifTrue:[
claus
parents: 124
diff changeset
  1632
	enabled ifTrue:[
claus
parents: 124
diff changeset
  1633
	    listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
claus
parents: 124
diff changeset
  1634
	    listLineNr notNil ifTrue:[
claus
parents: 124
diff changeset
  1635
		(toggleSelect 
claus
parents: 124
diff changeset
  1636
		and:[self isInSelection:listLineNr]) ifTrue:[
claus
parents: 124
diff changeset
  1637
		    oldSelection := selection copy.
claus
parents: 124
diff changeset
  1638
		    self removeFromSelection:listLineNr
claus
parents: 124
diff changeset
  1639
		] ifFalse:[
claus
parents: 124
diff changeset
  1640
		    (self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
claus
parents: 124
diff changeset
  1641
claus
parents: 124
diff changeset
  1642
		    (selectConditionBlock notNil 
claus
parents: 124
diff changeset
  1643
		     and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
claus
parents: 124
diff changeset
  1644
claus
parents: 124
diff changeset
  1645
		    (toggleSelect and:[multipleSelectOk]) ifTrue:[
claus
parents: 124
diff changeset
  1646
			oldSelection := selection copy.
claus
parents: 124
diff changeset
  1647
			self addToSelection:listLineNr
claus
parents: 124
diff changeset
  1648
		    ] ifFalse:[
claus
parents: 124
diff changeset
  1649
			oldSelection := selection copy.
claus
parents: 124
diff changeset
  1650
			self selectWithoutScroll:listLineNr.
claus
parents: 124
diff changeset
  1651
		    ].
claus
parents: 124
diff changeset
  1652
		].
claus
parents: 124
diff changeset
  1653
		((ignoreReselect not and:[selection notNil])
claus
parents: 124
diff changeset
  1654
		 or:[selection ~= oldSelection]) ifTrue:[
claus
parents: 124
diff changeset
  1655
		    self selectionChangedFrom:oldSelection.
claus
parents: 124
diff changeset
  1656
		].
claus
parents: 124
diff changeset
  1657
		clickLine := listLineNr
claus
parents: 124
diff changeset
  1658
	    ].
claus
parents: 124
diff changeset
  1659
	]
claus
parents: 124
diff changeset
  1660
    ] ifFalse:[
claus
parents: 124
diff changeset
  1661
	super buttonPress:button x:x y:y
claus
parents: 124
diff changeset
  1662
    ]
claus
parents: 124
diff changeset
  1663
!
claus
parents: 124
diff changeset
  1664
claus
parents: 124
diff changeset
  1665
sizeChanged:how
claus
parents: 124
diff changeset
  1666
    "if there is a selection, make certain, its visible
claus
parents: 124
diff changeset
  1667
     after the sizechange"
claus
parents: 124
diff changeset
  1668
claus
parents: 124
diff changeset
  1669
    |first wasAtEnd|
claus
parents: 124
diff changeset
  1670
claus
parents: 124
diff changeset
  1671
    wasAtEnd := (firstLineShown + nFullLinesShown) >= self size.
claus
parents: 124
diff changeset
  1672
claus
parents: 124
diff changeset
  1673
    super sizeChanged:how.
claus
parents: 124
diff changeset
  1674
claus
parents: 124
diff changeset
  1675
    shown ifTrue:[
claus
parents: 124
diff changeset
  1676
	selection notNil ifTrue:[
claus
parents: 124
diff changeset
  1677
	    multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1678
		first := selection first
claus
parents: 124
diff changeset
  1679
	    ] ifFalse:[
claus
parents: 124
diff changeset
  1680
		first := selection
claus
parents: 124
diff changeset
  1681
	    ].
claus
parents: 124
diff changeset
  1682
	    first notNil ifTrue:[self makeLineVisible:first]
claus
parents: 124
diff changeset
  1683
	] ifFalse:[
claus
parents: 124
diff changeset
  1684
	    "
claus
parents: 124
diff changeset
  1685
	     if we where at the end before, move to the end again.
claus
parents: 124
diff changeset
  1686
	     Still to be seen, if this is better in real life ...
claus
parents: 124
diff changeset
  1687
	    "
claus
parents: 124
diff changeset
  1688
	    wasAtEnd ifTrue:[
claus
parents: 124
diff changeset
  1689
		"at end"
claus
parents: 124
diff changeset
  1690
		self scrollToBottom
claus
parents: 124
diff changeset
  1691
	    ]
claus
parents: 124
diff changeset
  1692
	]
claus
parents: 124
diff changeset
  1693
    ]
claus
parents: 124
diff changeset
  1694
!
claus
parents: 124
diff changeset
  1695
claus
parents: 124
diff changeset
  1696
keyPress:key x:x y:y
claus
parents: 124
diff changeset
  1697
    "handle keyboard input"
claus
parents: 124
diff changeset
  1698
132
claus
parents: 131
diff changeset
  1699
    <resource: #keyboard ( #BeginOfText #EndOfText ) >
claus
parents: 131
diff changeset
  1700
210
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1701
    |index       
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1702
     searchIndex "{Class: SmallInteger}"
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1703
     startSearch "{Class: SmallInteger}"
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1704
     backSearch searchPrefix|
125
claus
parents: 124
diff changeset
  1705
claus
parents: 124
diff changeset
  1706
    (key == #CursorUp) ifTrue:[
128
claus
parents: 125
diff changeset
  1707
	index := self previousBeforeSelection.
claus
parents: 125
diff changeset
  1708
	self key:key select:index x:x y:y.
claus
parents: 125
diff changeset
  1709
	^ self
125
claus
parents: 124
diff changeset
  1710
    ].
claus
parents: 124
diff changeset
  1711
    (key == #CursorDown) ifTrue:[
128
claus
parents: 125
diff changeset
  1712
	index := self nextAfterSelection.
claus
parents: 125
diff changeset
  1713
	self key:key select:index x:x y:y.
claus
parents: 125
diff changeset
  1714
	^ self
125
claus
parents: 124
diff changeset
  1715
    ].
claus
parents: 124
diff changeset
  1716
    "/
claus
parents: 124
diff changeset
  1717
    "/ stupid: Home and End are cought in ScrollableView
claus
parents: 124
diff changeset
  1718
    "/ we normally do not get them ...
claus
parents: 124
diff changeset
  1719
    "/ (need to call handlesKey: from there ...
claus
parents: 124
diff changeset
  1720
    "/  ... and implement it here)
claus
parents: 124
diff changeset
  1721
    "/
132
claus
parents: 131
diff changeset
  1722
    (key == #BeginOfText) ifTrue:[
128
claus
parents: 125
diff changeset
  1723
	self key:key select:1 x:x y:y.
claus
parents: 125
diff changeset
  1724
	^ self
125
claus
parents: 124
diff changeset
  1725
    ].
132
claus
parents: 131
diff changeset
  1726
    (key == #EndOfText) ifTrue:[
128
claus
parents: 125
diff changeset
  1727
	index := self size.
claus
parents: 125
diff changeset
  1728
	self key:key select:index x:x y:y.
claus
parents: 125
diff changeset
  1729
	^ self
125
claus
parents: 124
diff changeset
  1730
    ].
claus
parents: 124
diff changeset
  1731
    key == #Return ifTrue:[
128
claus
parents: 125
diff changeset
  1732
	returnKeyActionStyle == #doubleClick ifTrue:[
claus
parents: 125
diff changeset
  1733
	    selection notNil ifTrue:[
claus
parents: 125
diff changeset
  1734
		self doubleClicked
claus
parents: 125
diff changeset
  1735
	    ].
claus
parents: 125
diff changeset
  1736
	    ^ self
claus
parents: 125
diff changeset
  1737
	].
claus
parents: 125
diff changeset
  1738
	returnKeyActionStyle ~~ #pass ifTrue:[
claus
parents: 125
diff changeset
  1739
	    ^ self
claus
parents: 125
diff changeset
  1740
	].
125
claus
parents: 124
diff changeset
  1741
    ].
claus
parents: 124
diff changeset
  1742
claus
parents: 124
diff changeset
  1743
    "
claus
parents: 124
diff changeset
  1744
     alphabetic keys: search for next entry
claus
parents: 124
diff changeset
  1745
     starting with keys character. If shift is pressed, search backward
claus
parents: 124
diff changeset
  1746
    "
claus
parents: 124
diff changeset
  1747
    (self size > 0
claus
parents: 124
diff changeset
  1748
    and:[key isCharacter
claus
parents: 124
diff changeset
  1749
    and:[key isLetter]]) ifTrue:[
128
claus
parents: 125
diff changeset
  1750
	keyActionStyle isNil ifTrue:[^ self].
claus
parents: 125
diff changeset
  1751
	keyActionStyle == #pass ifFalse:[
claus
parents: 125
diff changeset
  1752
	    searchPrefix := key asLowercase asString.
125
claus
parents: 124
diff changeset
  1753
claus
parents: 124
diff changeset
  1754
"/            ... isISearch... ifFalse:[
claus
parents: 124
diff changeset
  1755
"/                iSearchString := ''
claus
parents: 124
diff changeset
  1756
"/            ] ifTrue:[
claus
parents: 124
diff changeset
  1757
"/                iSearchString := iSearchString , searchPrefix.
claus
parents: 124
diff changeset
  1758
"/                searchPrefix := iSearchString
claus
parents: 124
diff changeset
  1759
"/            ].
claus
parents: 124
diff changeset
  1760
128
claus
parents: 125
diff changeset
  1761
	    backSearch := device shiftDown.
claus
parents: 125
diff changeset
  1762
	    backSearch ifTrue:[
claus
parents: 125
diff changeset
  1763
		selection notNil ifTrue:[
claus
parents: 125
diff changeset
  1764
		    selection size > 0 ifTrue:[
claus
parents: 125
diff changeset
  1765
			startSearch := selection first - 1
claus
parents: 125
diff changeset
  1766
		    ] ifFalse:[
claus
parents: 125
diff changeset
  1767
			startSearch := selection - 1
claus
parents: 125
diff changeset
  1768
		    ]
claus
parents: 125
diff changeset
  1769
		] ifFalse:[
claus
parents: 125
diff changeset
  1770
		    startSearch := self size
claus
parents: 125
diff changeset
  1771
		].
claus
parents: 125
diff changeset
  1772
		startSearch < 1 ifTrue:[
claus
parents: 125
diff changeset
  1773
		    startSearch := self size.
claus
parents: 125
diff changeset
  1774
		].
claus
parents: 125
diff changeset
  1775
	    ] ifFalse:[    
claus
parents: 125
diff changeset
  1776
		selection notNil ifTrue:[
claus
parents: 125
diff changeset
  1777
		    selection size > 0 ifTrue:[
claus
parents: 125
diff changeset
  1778
			startSearch := selection last + 1
claus
parents: 125
diff changeset
  1779
		    ] ifFalse:[
claus
parents: 125
diff changeset
  1780
			startSearch := selection + 1
claus
parents: 125
diff changeset
  1781
		    ]
claus
parents: 125
diff changeset
  1782
		] ifFalse:[
claus
parents: 125
diff changeset
  1783
		    startSearch := 1
claus
parents: 125
diff changeset
  1784
		].
claus
parents: 125
diff changeset
  1785
		startSearch > self size ifTrue:[
claus
parents: 125
diff changeset
  1786
		    startSearch := 1.
claus
parents: 125
diff changeset
  1787
		].
claus
parents: 125
diff changeset
  1788
	    ].
210
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1789
	    searchIndex := startSearch.
128
claus
parents: 125
diff changeset
  1790
	    [true] whileTrue:[
210
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1791
		(((self at:searchIndex) asString) withoutSeparators asLowercase startsWith:searchPrefix) ifTrue:[
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1792
		    searchIndex = selection ifTrue:[^ self].
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1793
		    ^ self key:key select:searchIndex x:x y:y
128
claus
parents: 125
diff changeset
  1794
		].
claus
parents: 125
diff changeset
  1795
		backSearch ifTrue:[
210
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1796
		    searchIndex := searchIndex - 1.
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1797
		    searchIndex < 1 ifTrue:[searchIndex := self size]
128
claus
parents: 125
diff changeset
  1798
		] ifFalse:[
210
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1799
		    searchIndex := searchIndex + 1.
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1800
		    searchIndex > self size ifTrue:[searchIndex := 1].
128
claus
parents: 125
diff changeset
  1801
		].
210
f7d44c195776 search fixed for lines which start with a separator
Claus Gittinger <cg@exept.de>
parents: 191
diff changeset
  1802
		searchIndex == startSearch ifTrue:[
128
claus
parents: 125
diff changeset
  1803
		    ^ self
claus
parents: 125
diff changeset
  1804
		]
claus
parents: 125
diff changeset
  1805
	    ]
claus
parents: 125
diff changeset
  1806
	].
125
claus
parents: 124
diff changeset
  1807
    ].
claus
parents: 124
diff changeset
  1808
    ^ super keyPress:key x:x y:y
claus
parents: 124
diff changeset
  1809
!
claus
parents: 124
diff changeset
  1810
claus
parents: 124
diff changeset
  1811
buttonMotion:buttonMask x:x y:y
claus
parents: 124
diff changeset
  1812
    "mouse-move while button was pressed - handle selection changes"
claus
parents: 124
diff changeset
  1813
claus
parents: 124
diff changeset
  1814
    |movedVisibleLine movedLine delta oldSelection oldSelCount|
claus
parents: 124
diff changeset
  1815
claus
parents: 124
diff changeset
  1816
    "is it the select or 1-button ?"
claus
parents: 124
diff changeset
  1817
    (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
claus
parents: 124
diff changeset
  1818
	(device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
claus
parents: 124
diff changeset
  1819
	    ^ self
claus
parents: 124
diff changeset
  1820
	].
claus
parents: 124
diff changeset
  1821
    ].
claus
parents: 124
diff changeset
  1822
claus
parents: 124
diff changeset
  1823
    clickLine isNil ifTrue:[^ self].
claus
parents: 124
diff changeset
  1824
claus
parents: 124
diff changeset
  1825
    "if moved outside of view, start autoscroll"
claus
parents: 124
diff changeset
  1826
    (y < 0) ifTrue:[
claus
parents: 124
diff changeset
  1827
	self compressMotionEvents:false.
claus
parents: 124
diff changeset
  1828
	self startAutoScrollUp:y.
claus
parents: 124
diff changeset
  1829
	^ self
claus
parents: 124
diff changeset
  1830
    ].
claus
parents: 124
diff changeset
  1831
    (y > height) ifTrue:[
claus
parents: 124
diff changeset
  1832
	self compressMotionEvents:false.
claus
parents: 124
diff changeset
  1833
	self startAutoScrollDown:(y - height).
claus
parents: 124
diff changeset
  1834
	^ self
claus
parents: 124
diff changeset
  1835
    ].
claus
parents: 124
diff changeset
  1836
claus
parents: 124
diff changeset
  1837
    "move inside - stop autoscroll if any"
claus
parents: 124
diff changeset
  1838
    self stopAutoScroll.
claus
parents: 124
diff changeset
  1839
claus
parents: 124
diff changeset
  1840
    movedVisibleLine := self visibleLineOfY:y.
claus
parents: 124
diff changeset
  1841
    movedLine := self visibleLineToAbsoluteLine:movedVisibleLine.
claus
parents: 124
diff changeset
  1842
    (movedLine == clickLine) ifTrue:[^ self].
claus
parents: 124
diff changeset
  1843
claus
parents: 124
diff changeset
  1844
    multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1845
	delta := (clickLine < movedLine) ifTrue:[1] ifFalse:[-1].
claus
parents: 124
diff changeset
  1846
claus
parents: 124
diff changeset
  1847
	oldSelection := selection.
claus
parents: 124
diff changeset
  1848
	oldSelCount := selection size.
claus
parents: 124
diff changeset
  1849
claus
parents: 124
diff changeset
  1850
	(clickLine+delta) to:movedLine by:delta do:[:line |
claus
parents: 124
diff changeset
  1851
	    (self isInSelection:line) ifTrue:[
claus
parents: 124
diff changeset
  1852
		self removeFromSelection:line
claus
parents: 124
diff changeset
  1853
	    ] ifFalse:[
claus
parents: 124
diff changeset
  1854
		self addToSelection:line
claus
parents: 124
diff changeset
  1855
	    ]
claus
parents: 124
diff changeset
  1856
	].
claus
parents: 124
diff changeset
  1857
	((selection ~= oldSelection)
claus
parents: 124
diff changeset
  1858
	 or:[selection size ~~ oldSelCount]) ifTrue:[
claus
parents: 124
diff changeset
  1859
	    self selectionChangedFrom:oldSelection.
claus
parents: 124
diff changeset
  1860
	]
claus
parents: 124
diff changeset
  1861
    ] ifFalse:[
claus
parents: 124
diff changeset
  1862
"/        self selectWithoutScroll:movedLine
claus
parents: 124
diff changeset
  1863
    ].
claus
parents: 124
diff changeset
  1864
claus
parents: 124
diff changeset
  1865
    clickLine := movedLine
claus
parents: 124
diff changeset
  1866
!
claus
parents: 124
diff changeset
  1867
claus
parents: 124
diff changeset
  1868
key:key select:index x:x y:y
claus
parents: 124
diff changeset
  1869
    "select an entry by a keyboard action.
claus
parents: 124
diff changeset
  1870
     This is treated like a doubleClick on that entry"
claus
parents: 124
diff changeset
  1871
claus
parents: 124
diff changeset
  1872
    |oldSelection|
claus
parents: 124
diff changeset
  1873
claus
parents: 124
diff changeset
  1874
    (selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
128
claus
parents: 125
diff changeset
  1875
	keyActionStyle notNil ifTrue:[
claus
parents: 125
diff changeset
  1876
	    keyActionStyle == #pass ifTrue:[
claus
parents: 125
diff changeset
  1877
		^ super keyPress:key x:x y:y
claus
parents: 125
diff changeset
  1878
	    ].
claus
parents: 125
diff changeset
  1879
	    oldSelection := selection.
claus
parents: 125
diff changeset
  1880
	    self selection:index.
claus
parents: 125
diff changeset
  1881
	    self selectionChangedFrom:oldSelection.
claus
parents: 125
diff changeset
  1882
	    keyActionStyle == #selectAndDoubleClick ifTrue:[
claus
parents: 125
diff changeset
  1883
		self doubleClicked
claus
parents: 125
diff changeset
  1884
	    ]
claus
parents: 125
diff changeset
  1885
	]
125
claus
parents: 124
diff changeset
  1886
    ].
claus
parents: 124
diff changeset
  1887
!
claus
parents: 124
diff changeset
  1888
claus
parents: 124
diff changeset
  1889
buttonMultiPress:button x:x y:y
claus
parents: 124
diff changeset
  1890
    ((button == 1) or:[button == #select]) ifTrue:[
claus
parents: 124
diff changeset
  1891
"/        doubleClickActionBlock isNil ifTrue:[
claus
parents: 124
diff changeset
  1892
"/            self buttonPress:button x:x y:y
claus
parents: 124
diff changeset
  1893
"/        ].
claus
parents: 124
diff changeset
  1894
	self doubleClicked.
claus
parents: 124
diff changeset
  1895
    ] ifFalse:[
claus
parents: 124
diff changeset
  1896
	super buttonMultiPress:button x:x y:y
claus
parents: 124
diff changeset
  1897
    ]
claus
parents: 124
diff changeset
  1898
!
claus
parents: 124
diff changeset
  1899
claus
parents: 124
diff changeset
  1900
buttonShiftPress:button x:x y:y
claus
parents: 124
diff changeset
  1901
    "add to the selection (if multipleSelectOk); otherwise,
claus
parents: 124
diff changeset
  1902
     behave like normal select"
claus
parents: 124
diff changeset
  1903
claus
parents: 124
diff changeset
  1904
    |oldSelection listLineNr|
claus
parents: 124
diff changeset
  1905
claus
parents: 124
diff changeset
  1906
    ((button == 1) or:[button == #select]) ifTrue:[
claus
parents: 124
diff changeset
  1907
	toggleSelect ifTrue:[
claus
parents: 124
diff changeset
  1908
	    ^ self buttonPress:button x:x y:y
claus
parents: 124
diff changeset
  1909
	].
claus
parents: 124
diff changeset
  1910
	enabled ifTrue:[
claus
parents: 124
diff changeset
  1911
	    listLineNr := self visibleLineToListLine:(self visibleLineOfY:y).
claus
parents: 124
diff changeset
  1912
	    listLineNr notNil ifTrue:[
claus
parents: 124
diff changeset
  1913
		(self line:listLineNr hasAttribute:#disabled) ifTrue:[^ self].
claus
parents: 124
diff changeset
  1914
claus
parents: 124
diff changeset
  1915
		(selectConditionBlock notNil 
claus
parents: 124
diff changeset
  1916
		 and:[(selectConditionBlock value:listLineNr) not]) ifTrue:[^ self].
claus
parents: 124
diff changeset
  1917
	    ].
claus
parents: 124
diff changeset
  1918
	    oldSelection := selection copy.
claus
parents: 124
diff changeset
  1919
	    listLineNr notNil ifTrue: [
claus
parents: 124
diff changeset
  1920
		multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  1921
		    (self isInSelection:listLineNr) ifTrue:[
claus
parents: 124
diff changeset
  1922
			self removeFromSelection:listLineNr
claus
parents: 124
diff changeset
  1923
		    ] ifFalse:[
claus
parents: 124
diff changeset
  1924
			self addToSelection:listLineNr
claus
parents: 124
diff changeset
  1925
		    ]
claus
parents: 124
diff changeset
  1926
		] ifFalse:[
claus
parents: 124
diff changeset
  1927
		    self selectWithoutScroll:listLineNr
claus
parents: 124
diff changeset
  1928
		]
claus
parents: 124
diff changeset
  1929
	    ].
claus
parents: 124
diff changeset
  1930
	    ((ignoreReselect not and:[selection notNil])
claus
parents: 124
diff changeset
  1931
	     or:[selection ~= oldSelection]) ifTrue:[
claus
parents: 124
diff changeset
  1932
		self selectionChangedFrom:oldSelection.
claus
parents: 124
diff changeset
  1933
	    ].
claus
parents: 124
diff changeset
  1934
	    clickLine := listLineNr
claus
parents: 124
diff changeset
  1935
	]
claus
parents: 124
diff changeset
  1936
    ] ifFalse:[
claus
parents: 124
diff changeset
  1937
	super buttonShiftPress:button x:x y:y
claus
parents: 124
diff changeset
  1938
    ]
claus
parents: 124
diff changeset
  1939
!
claus
parents: 124
diff changeset
  1940
claus
parents: 124
diff changeset
  1941
doubleClicked
claus
parents: 124
diff changeset
  1942
    doubleClickActionBlock notNil ifTrue:[doubleClickActionBlock value:selection].
claus
parents: 124
diff changeset
  1943
    (model notNil and:[doubleClickMsg notNil]) ifTrue:[
claus
parents: 124
diff changeset
  1944
	self sendChangeMessage:doubleClickMsg with:(self argForChangeMessage).
claus
parents: 124
diff changeset
  1945
    ].
claus
parents: 124
diff changeset
  1946
! !
claus
parents: 124
diff changeset
  1947
claus
parents: 124
diff changeset
  1948
!SelectionInListView methodsFor:'accessing-actions'!
claus
parents: 124
diff changeset
  1949
claus
parents: 124
diff changeset
  1950
action:aBlock
claus
parents: 124
diff changeset
  1951
    "set the action block to be performed on select"
claus
parents: 124
diff changeset
  1952
claus
parents: 124
diff changeset
  1953
    actionBlock := aBlock
claus
parents: 124
diff changeset
  1954
!
claus
parents: 124
diff changeset
  1955
claus
parents: 124
diff changeset
  1956
doubleClickAction:aBlock
claus
parents: 124
diff changeset
  1957
    "set the double click action block to be performed on select"
claus
parents: 124
diff changeset
  1958
claus
parents: 124
diff changeset
  1959
    doubleClickActionBlock := aBlock
claus
parents: 124
diff changeset
  1960
!
claus
parents: 124
diff changeset
  1961
claus
parents: 124
diff changeset
  1962
selectConditionBlock:aBlock
claus
parents: 124
diff changeset
  1963
    "set the conditionBlock; this block is evaluated before a selection
claus
parents: 124
diff changeset
  1964
     change is performed; the change will not be done, if the evaluation
claus
parents: 124
diff changeset
  1965
     returns false. For example, this allows confirmation queries in
claus
parents: 124
diff changeset
  1966
     the SystemBrowser"
claus
parents: 124
diff changeset
  1967
claus
parents: 124
diff changeset
  1968
    selectConditionBlock := aBlock
claus
parents: 124
diff changeset
  1969
!
claus
parents: 124
diff changeset
  1970
claus
parents: 124
diff changeset
  1971
useIndex:aBoolean
claus
parents: 124
diff changeset
  1972
    "set/clear the useIndex flag. If set, both actionBlock and change-messages
claus
parents: 124
diff changeset
  1973
     are passed the index(indices) of the selection as argument. 
claus
parents: 124
diff changeset
  1974
     If clear, the value(s) (i.e. the selected string) is passed.
claus
parents: 124
diff changeset
  1975
     Default is true."
claus
parents: 124
diff changeset
  1976
claus
parents: 124
diff changeset
  1977
    useIndex := aBoolean
claus
parents: 124
diff changeset
  1978
!
claus
parents: 124
diff changeset
  1979
claus
parents: 124
diff changeset
  1980
keyActionStyle:aSymbol
claus
parents: 124
diff changeset
  1981
    "defines how the view should respond to alpha-keys pressed.
claus
parents: 124
diff changeset
  1982
     Possible values are:
claus
parents: 124
diff changeset
  1983
	#select               -> will select next entry starting with that
claus
parents: 124
diff changeset
  1984
				 character and perform the click-action
claus
parents: 124
diff changeset
  1985
claus
parents: 124
diff changeset
  1986
	#selectAndDoubleclick -> will select next & perform double-click action
claus
parents: 124
diff changeset
  1987
claus
parents: 124
diff changeset
  1988
	#pass                 -> will pass key to superclass (i.e. no special treatment)
claus
parents: 124
diff changeset
  1989
claus
parents: 124
diff changeset
  1990
	nil                   -> will ignore key
claus
parents: 124
diff changeset
  1991
claus
parents: 124
diff changeset
  1992
     the default (set in #initialize) is #select
claus
parents: 124
diff changeset
  1993
    "
claus
parents: 124
diff changeset
  1994
claus
parents: 124
diff changeset
  1995
    keyActionStyle := aSymbol
claus
parents: 124
diff changeset
  1996
!
claus
parents: 124
diff changeset
  1997
claus
parents: 124
diff changeset
  1998
returnKeyActionStyle:aSymbol
claus
parents: 124
diff changeset
  1999
    "defines how the view should respond to a return key pressed.
claus
parents: 124
diff changeset
  2000
     Possible values are:
claus
parents: 124
diff changeset
  2001
	#doubleClick          -> perform double-click action
claus
parents: 124
diff changeset
  2002
claus
parents: 124
diff changeset
  2003
	#pass                 -> will pass key to superclass (i.e. no special treatment)
claus
parents: 124
diff changeset
  2004
claus
parents: 124
diff changeset
  2005
	nil                   -> will ignore key
claus
parents: 124
diff changeset
  2006
claus
parents: 124
diff changeset
  2007
     the default (set in #initialize) is #doubleClick 
claus
parents: 124
diff changeset
  2008
    "
claus
parents: 124
diff changeset
  2009
claus
parents: 124
diff changeset
  2010
    returnKeyActionStyle := aSymbol
claus
parents: 124
diff changeset
  2011
! !
claus
parents: 124
diff changeset
  2012
claus
parents: 124
diff changeset
  2013
!SelectionInListView methodsFor:'accessing-attributes'!
claus
parents: 124
diff changeset
  2014
claus
parents: 124
diff changeset
  2015
line:lineNr hasAttribute:aSymbol
claus
parents: 124
diff changeset
  2016
    "return true, if line nr has attribute, aSymbol; 
claus
parents: 124
diff changeset
  2017
     currently supported attributes are:
claus
parents: 124
diff changeset
  2018
	 #halfIntensity
claus
parents: 124
diff changeset
  2019
	 #disabled
claus
parents: 124
diff changeset
  2020
	 #bold 
claus
parents: 124
diff changeset
  2021
    "
claus
parents: 124
diff changeset
  2022
claus
parents: 124
diff changeset
  2023
    |attr|
claus
parents: 124
diff changeset
  2024
claus
parents: 124
diff changeset
  2025
    listAttributes isNil ifTrue:[^ false].
claus
parents: 124
diff changeset
  2026
    (lineNr > listAttributes size) ifTrue:[^ false].
claus
parents: 124
diff changeset
  2027
    attr := listAttributes at:lineNr.
claus
parents: 124
diff changeset
  2028
    attr isNil ifTrue:[^ false].
claus
parents: 124
diff changeset
  2029
    attr isSymbol ifTrue:[^ attr == aSymbol].
claus
parents: 124
diff changeset
  2030
    ^ (attr includes:aSymbol)
claus
parents: 124
diff changeset
  2031
!
claus
parents: 124
diff changeset
  2032
claus
parents: 124
diff changeset
  2033
setAttributes:aList
claus
parents: 124
diff changeset
  2034
    "set the attribute list.
claus
parents: 124
diff changeset
  2035
     No redraw is done - the caller should make sure to redraw afterwards
claus
parents: 124
diff changeset
  2036
     (or use this only before the view is visible)."
claus
parents: 124
diff changeset
  2037
claus
parents: 124
diff changeset
  2038
    listAttributes := aList
claus
parents: 124
diff changeset
  2039
!
claus
parents: 124
diff changeset
  2040
claus
parents: 124
diff changeset
  2041
attributeAt:index put:aSymbolOrCollectionOfSymbolsOrNil
claus
parents: 124
diff changeset
  2042
    "set a lines attribute(s); 
claus
parents: 124
diff changeset
  2043
     currently supported are:
claus
parents: 124
diff changeset
  2044
	 #halfIntensity
claus
parents: 124
diff changeset
  2045
	 #disabled
claus
parents: 124
diff changeset
  2046
	 #bold 
claus
parents: 124
diff changeset
  2047
    "
claus
parents: 124
diff changeset
  2048
claus
parents: 124
diff changeset
  2049
    (index > self size) ifFalse:[
claus
parents: 124
diff changeset
  2050
	listAttributes isNil ifTrue:[
claus
parents: 124
diff changeset
  2051
	    listAttributes := (OrderedCollection new:index) grow:index
claus
parents: 124
diff changeset
  2052
	] ifFalse:[
claus
parents: 124
diff changeset
  2053
	    (index > listAttributes size) ifTrue:[
claus
parents: 124
diff changeset
  2054
		listAttributes grow:index
claus
parents: 124
diff changeset
  2055
	    ]
claus
parents: 124
diff changeset
  2056
	].
claus
parents: 124
diff changeset
  2057
	aSymbolOrCollectionOfSymbolsOrNil = (listAttributes at:index) ifFalse:[
claus
parents: 124
diff changeset
  2058
	    listAttributes at:index put:aSymbolOrCollectionOfSymbolsOrNil.
claus
parents: 124
diff changeset
  2059
	    self redrawLine:index
claus
parents: 124
diff changeset
  2060
	]
claus
parents: 124
diff changeset
  2061
    ]
claus
parents: 124
diff changeset
  2062
claus
parents: 124
diff changeset
  2063
!
claus
parents: 124
diff changeset
  2064
claus
parents: 124
diff changeset
  2065
strikeOut:aBoolean
claus
parents: 124
diff changeset
  2066
    "turn on/off strikeOut mode"
claus
parents: 124
diff changeset
  2067
claus
parents: 124
diff changeset
  2068
    strikeOut := aBoolean.
claus
parents: 124
diff changeset
  2069
!
claus
parents: 124
diff changeset
  2070
claus
parents: 124
diff changeset
  2071
attributeAt:index
claus
parents: 124
diff changeset
  2072
    "return the line attribute of list line index.
claus
parents: 124
diff changeset
  2073
     currently supported are:
claus
parents: 124
diff changeset
  2074
	 #halfIntensity
claus
parents: 124
diff changeset
  2075
	 #disabled
claus
parents: 124
diff changeset
  2076
	 #bold
claus
parents: 124
diff changeset
  2077
    "
claus
parents: 124
diff changeset
  2078
claus
parents: 124
diff changeset
  2079
    listAttributes isNil ifFalse:[
claus
parents: 124
diff changeset
  2080
	(index > listAttributes size) ifFalse:[
claus
parents: 124
diff changeset
  2081
	    ^ listAttributes at:index
claus
parents: 124
diff changeset
  2082
	]
claus
parents: 124
diff changeset
  2083
    ].
claus
parents: 124
diff changeset
  2084
    ^ nil
claus
parents: 124
diff changeset
  2085
!
claus
parents: 124
diff changeset
  2086
claus
parents: 124
diff changeset
  2087
attributeAt:index add:aSymbolOrCollectionOfSymbols
claus
parents: 124
diff changeset
  2088
    "add to a lines attribute(s); 
claus
parents: 124
diff changeset
  2089
     currently supported are:
claus
parents: 124
diff changeset
  2090
	 #halfIntensity
claus
parents: 124
diff changeset
  2091
	 #disabled
claus
parents: 124
diff changeset
  2092
	 #bold 
claus
parents: 124
diff changeset
  2093
    "
claus
parents: 124
diff changeset
  2094
claus
parents: 124
diff changeset
  2095
    |current|
claus
parents: 124
diff changeset
  2096
claus
parents: 124
diff changeset
  2097
    current := self attributeAt:index.
claus
parents: 124
diff changeset
  2098
    current isNil ifTrue:[
claus
parents: 124
diff changeset
  2099
	current := Set new.
claus
parents: 124
diff changeset
  2100
    ] ifFalse:[
claus
parents: 124
diff changeset
  2101
	current isSymbol ifTrue:[
claus
parents: 124
diff changeset
  2102
	    current == aSymbolOrCollectionOfSymbols ifTrue:[^ self].
claus
parents: 124
diff changeset
  2103
	    current := Set with:current
claus
parents: 124
diff changeset
  2104
	]
claus
parents: 124
diff changeset
  2105
    ].
claus
parents: 124
diff changeset
  2106
claus
parents: 124
diff changeset
  2107
    aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
claus
parents: 124
diff changeset
  2108
	current := current add:aSymbolOrCollectionOfSymbols
claus
parents: 124
diff changeset
  2109
    ] ifFalse:[
claus
parents: 124
diff changeset
  2110
	(current includes:aSymbolOrCollectionOfSymbols) ifTrue:[^ self].
claus
parents: 124
diff changeset
  2111
	current addAll:aSymbolOrCollectionOfSymbols
claus
parents: 124
diff changeset
  2112
    ].
claus
parents: 124
diff changeset
  2113
    self attributeAt:index put:current
claus
parents: 124
diff changeset
  2114
!
claus
parents: 124
diff changeset
  2115
claus
parents: 124
diff changeset
  2116
attributeAt:index remove:aSymbolOrCollectionOfSymbols
claus
parents: 124
diff changeset
  2117
    "remove a line attribute; 
claus
parents: 124
diff changeset
  2118
     currently supported are:
claus
parents: 124
diff changeset
  2119
	 #halfIntensity
claus
parents: 124
diff changeset
  2120
	 #disabled
claus
parents: 124
diff changeset
  2121
	 #bold 
claus
parents: 124
diff changeset
  2122
    "
claus
parents: 124
diff changeset
  2123
claus
parents: 124
diff changeset
  2124
    |current|
claus
parents: 124
diff changeset
  2125
claus
parents: 124
diff changeset
  2126
    current := self attributeAt:index.
claus
parents: 124
diff changeset
  2127
    current isNil ifTrue:[^ self].
claus
parents: 124
diff changeset
  2128
    current isSymbol ifTrue:[
claus
parents: 124
diff changeset
  2129
	aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
claus
parents: 124
diff changeset
  2130
	    current == aSymbolOrCollectionOfSymbols ifTrue:[current := nil]
claus
parents: 124
diff changeset
  2131
	] ifFalse:[
claus
parents: 124
diff changeset
  2132
	    (aSymbolOrCollectionOfSymbols includes:current) ifTrue:[
claus
parents: 124
diff changeset
  2133
		current := nil
claus
parents: 124
diff changeset
  2134
	    ]
claus
parents: 124
diff changeset
  2135
	]
claus
parents: 124
diff changeset
  2136
    ] ifFalse:[
claus
parents: 124
diff changeset
  2137
	aSymbolOrCollectionOfSymbols isSymbol ifTrue:[
claus
parents: 124
diff changeset
  2138
	    current := current remove:aSymbolOrCollectionOfSymbols ifAbsent:[]
claus
parents: 124
diff changeset
  2139
	] ifFalse:[
claus
parents: 124
diff changeset
  2140
	    aSymbolOrCollectionOfSymbols removeAll:aSymbolOrCollectionOfSymbols
claus
parents: 124
diff changeset
  2141
	]
claus
parents: 124
diff changeset
  2142
    ].
claus
parents: 124
diff changeset
  2143
    self attributeAt:index put:current
claus
parents: 124
diff changeset
  2144
! !
claus
parents: 124
diff changeset
  2145
claus
parents: 124
diff changeset
  2146
!SelectionInListView methodsFor:'accessing-behavior'!
claus
parents: 124
diff changeset
  2147
claus
parents: 124
diff changeset
  2148
ignoreReselect:aBoolean
claus
parents: 124
diff changeset
  2149
    "set/clear the ignoreReselect flag - 
claus
parents: 124
diff changeset
  2150
     if set, a click on an already selected entry is ignored.
claus
parents: 124
diff changeset
  2151
     Otherwise the notification is done, even if no
claus
parents: 124
diff changeset
  2152
     change in the selection occurs.
130
claus
parents: 128
diff changeset
  2153
     (for example, in browser to update a method).
claus
parents: 128
diff changeset
  2154
     Setting ignoreReselect to false makes sense if data is shown
claus
parents: 128
diff changeset
  2155
     which may change by itself (i.e. without the user doing anything)
claus
parents: 128
diff changeset
  2156
     For example, the inspector uses this, and redisplays the value,
claus
parents: 128
diff changeset
  2157
     if the selection is the same.
claus
parents: 128
diff changeset
  2158
     The default is true, meaning that a click on an already selected
claus
parents: 128
diff changeset
  2159
     does not lead to a notification via the actionBlock/change mechanism."
125
claus
parents: 124
diff changeset
  2160
claus
parents: 124
diff changeset
  2161
    ignoreReselect := aBoolean
claus
parents: 124
diff changeset
  2162
!
claus
parents: 124
diff changeset
  2163
claus
parents: 124
diff changeset
  2164
toggleSelect:aBoolean
claus
parents: 124
diff changeset
  2165
    "turn on/off toggle select. If true, clicking on a selected entry
130
claus
parents: 128
diff changeset
  2166
     unselects it and vice versa. The default is false, which means
claus
parents: 128
diff changeset
  2167
     that clicking on an already selected entry does not change its
claus
parents: 128
diff changeset
  2168
     select status (see also ignoreReselect:)."
125
claus
parents: 124
diff changeset
  2169
claus
parents: 124
diff changeset
  2170
    toggleSelect := aBoolean.
claus
parents: 124
diff changeset
  2171
!
claus
parents: 124
diff changeset
  2172
claus
parents: 124
diff changeset
  2173
multipleSelectOk:aBoolean
130
claus
parents: 128
diff changeset
  2174
    "allow/disallow multiple selections. If enabled, the
claus
parents: 128
diff changeset
  2175
     user may select multiple entries in the list, and the program
claus
parents: 128
diff changeset
  2176
     always gets a collection of selected items (indexes if useIndex is true,
claus
parents: 128
diff changeset
  2177
     values otherwise). The default is false, for single selections."
125
claus
parents: 124
diff changeset
  2178
claus
parents: 124
diff changeset
  2179
    multipleSelectOk := aBoolean.
claus
parents: 124
diff changeset
  2180
    aBoolean ifTrue:[
claus
parents: 124
diff changeset
  2181
	self enableButtonMotionEvents
claus
parents: 124
diff changeset
  2182
    ] ifFalse:[
claus
parents: 124
diff changeset
  2183
	self disableButtonMotionEvents
claus
parents: 124
diff changeset
  2184
    ] 
claus
parents: 124
diff changeset
  2185
!
claus
parents: 124
diff changeset
  2186
claus
parents: 124
diff changeset
  2187
enable
claus
parents: 124
diff changeset
  2188
    "enable the view - selection changes are allowed"
claus
parents: 124
diff changeset
  2189
claus
parents: 124
diff changeset
  2190
    enabled := true
claus
parents: 124
diff changeset
  2191
!
claus
parents: 124
diff changeset
  2192
claus
parents: 124
diff changeset
  2193
disable
claus
parents: 124
diff changeset
  2194
    "disable the view - no selection changes are allowed"
claus
parents: 124
diff changeset
  2195
claus
parents: 124
diff changeset
  2196
    enabled := false
claus
parents: 124
diff changeset
  2197
! !
claus
parents: 124
diff changeset
  2198
claus
parents: 124
diff changeset
  2199
!SelectionInListView methodsFor:'accessing-contents'!
claus
parents: 124
diff changeset
  2200
128
claus
parents: 125
diff changeset
  2201
printItems:aBoolean
claus
parents: 125
diff changeset
  2202
    "set/clear the printItems flag. If set, items (as set via #list: or
claus
parents: 125
diff changeset
  2203
     as returned from the model) are sent #printString to display them.
claus
parents: 125
diff changeset
  2204
     If false, items are assumed to be either strings, or know how to
claus
parents: 125
diff changeset
  2205
     display themself in a GC (i.e. they are instances of ListEntry).
claus
parents: 125
diff changeset
  2206
     The default is false.
claus
parents: 125
diff changeset
  2207
     Caveat: printString seems to be too specialized - I'd rather have
claus
parents: 125
diff changeset
  2208
     a definable printSelector or - better - a printConverter.
claus
parents: 125
diff changeset
  2209
     This may be added in the future."
claus
parents: 125
diff changeset
  2210
claus
parents: 125
diff changeset
  2211
    printItems := aBoolean
claus
parents: 125
diff changeset
  2212
!
claus
parents: 125
diff changeset
  2213
125
claus
parents: 124
diff changeset
  2214
list:aCollection
claus
parents: 124
diff changeset
  2215
    "set the list - redefined, since setting the list implies unselecting
claus
parents: 124
diff changeset
  2216
     and clearing attributes."
claus
parents: 124
diff changeset
  2217
133
claus
parents: 132
diff changeset
  2218
    self list:aCollection keepSelection:false 
claus
parents: 132
diff changeset
  2219
!
claus
parents: 132
diff changeset
  2220
claus
parents: 132
diff changeset
  2221
list:aCollection keepSelection:aBoolean
claus
parents: 132
diff changeset
  2222
    "set the list - redefined, since setting the list implies unselecting
claus
parents: 132
diff changeset
  2223
     and clearing attributes."
claus
parents: 132
diff changeset
  2224
claus
parents: 132
diff changeset
  2225
    |oldSelection|
claus
parents: 132
diff changeset
  2226
125
claus
parents: 124
diff changeset
  2227
    "somewhat of a kludge: if selection is first line,
claus
parents: 124
diff changeset
  2228
     we have to remove the highlight frame by hand here"
claus
parents: 124
diff changeset
  2229
claus
parents: 124
diff changeset
  2230
    (shown and:[hilightLevel ~~ 0]) ifTrue:[
claus
parents: 124
diff changeset
  2231
	selection == firstLineShown ifTrue:[
claus
parents: 124
diff changeset
  2232
	   self paint:bgColor.
claus
parents: 124
diff changeset
  2233
	   self fillRectangleX:margin y:margin
claus
parents: 124
diff changeset
  2234
			  width:(width - (margin * 2)) 
claus
parents: 124
diff changeset
  2235
			 height:(hilightLevel abs).
claus
parents: 124
diff changeset
  2236
	].
claus
parents: 124
diff changeset
  2237
    ].
claus
parents: 124
diff changeset
  2238
133
claus
parents: 132
diff changeset
  2239
    aBoolean ifTrue:[
claus
parents: 132
diff changeset
  2240
	oldSelection := selection.
claus
parents: 132
diff changeset
  2241
	selection := nil.
claus
parents: 132
diff changeset
  2242
    ].
125
claus
parents: 124
diff changeset
  2243
    listAttributes := nil.
151
911bc7db22ce update and printItems false bug fixed
claus
parents: 146
diff changeset
  2244
    super list:aCollection expandTabs:printItems.
133
claus
parents: 132
diff changeset
  2245
    self selection:oldSelection. "/ nil if keep is false
125
claus
parents: 124
diff changeset
  2246
!
claus
parents: 124
diff changeset
  2247
claus
parents: 124
diff changeset
  2248
setList:aCollection
claus
parents: 124
diff changeset
  2249
    "set the list - redefined, since setting the list implies unselecting
claus
parents: 124
diff changeset
  2250
     and clearing attributes.
claus
parents: 124
diff changeset
  2251
     No redraw is done - the caller should make sure to redraw afterwards
claus
parents: 124
diff changeset
  2252
     (or use this only before the view is visible)."
claus
parents: 124
diff changeset
  2253
claus
parents: 124
diff changeset
  2254
    selection := nil.
claus
parents: 124
diff changeset
  2255
    listAttributes := nil.
claus
parents: 124
diff changeset
  2256
    super setList:aCollection.
claus
parents: 124
diff changeset
  2257
!
claus
parents: 124
diff changeset
  2258
133
claus
parents: 132
diff changeset
  2259
setContents:aCollection
claus
parents: 132
diff changeset
  2260
    "set the list - redefined, since setting the list implies unselecting
claus
parents: 132
diff changeset
  2261
     and clearing attributes.
claus
parents: 132
diff changeset
  2262
     No redraw is done - the caller should make sure to redraw afterwards
claus
parents: 132
diff changeset
  2263
     (or use this only before the view is visible)."
claus
parents: 132
diff changeset
  2264
claus
parents: 132
diff changeset
  2265
    selection := nil.
claus
parents: 132
diff changeset
  2266
    listAttributes := nil.
claus
parents: 132
diff changeset
  2267
    super setContents:aCollection.
claus
parents: 132
diff changeset
  2268
!
claus
parents: 132
diff changeset
  2269
claus
parents: 132
diff changeset
  2270
contents:aCollection
claus
parents: 132
diff changeset
  2271
    "set the list - redefined, since setting the list implies unselecting
claus
parents: 132
diff changeset
  2272
     and clearing attributes.
claus
parents: 132
diff changeset
  2273
     No redraw is done - the caller should make sure to redraw afterwards
claus
parents: 132
diff changeset
  2274
     (or use this only before the view is visible)."
claus
parents: 132
diff changeset
  2275
claus
parents: 132
diff changeset
  2276
    selection := nil.
claus
parents: 132
diff changeset
  2277
    listAttributes := nil.
claus
parents: 132
diff changeset
  2278
    super contents:aCollection.
claus
parents: 132
diff changeset
  2279
!
claus
parents: 132
diff changeset
  2280
125
claus
parents: 124
diff changeset
  2281
removeIndexWithoutRedraw:lineNr
claus
parents: 124
diff changeset
  2282
    "delete line - no redraw;
claus
parents: 124
diff changeset
  2283
     return true, if something was really deleted.
claus
parents: 124
diff changeset
  2284
     Redefined since we have to care for selection"
claus
parents: 124
diff changeset
  2285
claus
parents: 124
diff changeset
  2286
    self checkRemovingSelection:lineNr.
claus
parents: 124
diff changeset
  2287
    ^ super removeIndexWithoutRedraw:lineNr
claus
parents: 124
diff changeset
  2288
!
claus
parents: 124
diff changeset
  2289
claus
parents: 124
diff changeset
  2290
removeIndex:lineNr
claus
parents: 124
diff changeset
  2291
    "delete line - with redraw.
claus
parents: 124
diff changeset
  2292
     Redefined since we have to care for selection"
claus
parents: 124
diff changeset
  2293
claus
parents: 124
diff changeset
  2294
    self checkRemovingSelection:lineNr.
claus
parents: 124
diff changeset
  2295
    ^ super removeIndex:lineNr
claus
parents: 124
diff changeset
  2296
!
claus
parents: 124
diff changeset
  2297
claus
parents: 124
diff changeset
  2298
add:aValue beforeIndex:index
claus
parents: 124
diff changeset
  2299
    "must recompute our current selections"
claus
parents: 124
diff changeset
  2300
claus
parents: 124
diff changeset
  2301
    selection notNil ifTrue:[
claus
parents: 124
diff changeset
  2302
	multipleSelectOk ifTrue:[
claus
parents: 124
diff changeset
  2303
	    selection := selection collect:[ :sel |
claus
parents: 124
diff changeset
  2304
		sel >= index ifTrue:[
claus
parents: 124
diff changeset
  2305
		    sel + 1
claus
parents: 124
diff changeset
  2306
		] ifFalse:[
claus
parents: 124
diff changeset
  2307
		    sel
claus
parents: 124
diff changeset
  2308
		]
claus
parents: 124
diff changeset
  2309
	    ].
claus
parents: 124
diff changeset
  2310
	] ifFalse:[
claus
parents: 124
diff changeset
  2311
	    selection >= index ifTrue:[
claus
parents: 124
diff changeset
  2312
		selection := selection + 1.
claus
parents: 124
diff changeset
  2313
	    ].
claus
parents: 124
diff changeset
  2314
	].
claus
parents: 124
diff changeset
  2315
    ].
claus
parents: 124
diff changeset
  2316
    ^ super add:aValue beforeIndex:index.
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2317
! !
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2318
155
claus
parents: 151
diff changeset
  2319
!SelectionInListView methodsFor:'queries'!
claus
parents: 151
diff changeset
  2320
claus
parents: 151
diff changeset
  2321
specClass
claus
parents: 151
diff changeset
  2322
    self class == SelectionInListView ifTrue:[^ SequenceViewSpec].
claus
parents: 151
diff changeset
  2323
    ^ nil
claus
parents: 151
diff changeset
  2324
claus
parents: 151
diff changeset
  2325
    "Modified: 5.9.1995 / 23:05:53 / claus"
claus
parents: 151
diff changeset
  2326
! !
claus
parents: 151
diff changeset
  2327
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2328
!SelectionInListView methodsFor:'initialization'!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2329
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2330
initCursor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2331
    "set the cursor - a hand"
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2332
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2333
    cursor := Cursor hand
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2334
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2335
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2336
initialize
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2337
    super initialize.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2338
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2339
    fontHeight := font height + lineSpacing.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2340
    enabled := true.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2341
    ignoreReselect := true.
125
claus
parents: 124
diff changeset
  2342
    multipleSelectOk := toggleSelect := strikeOut := printItems := false.
claus
parents: 124
diff changeset
  2343
    useIndex := true.
claus
parents: 124
diff changeset
  2344
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2345
    keyActionStyle := #select.
125
claus
parents: 124
diff changeset
  2346
    returnKeyActionStyle := #doubleClick.
claus
parents: 124
diff changeset
  2347
claus
parents: 124
diff changeset
  2348
    listMsg := self class defaultListMessage.
claus
parents: 124
diff changeset
  2349
    initialSelectionMsg := self class defaultSelectionMessage.
claus
parents: 124
diff changeset
  2350
claus
parents: 124
diff changeset
  2351
!
claus
parents: 124
diff changeset
  2352
claus
parents: 124
diff changeset
  2353
realize
claus
parents: 124
diff changeset
  2354
    super realize.
claus
parents: 124
diff changeset
  2355
128
claus
parents: 125
diff changeset
  2356
"/    self getListFromModel.   -- not needed; superclass did it already
125
claus
parents: 124
diff changeset
  2357
    self getSelectionFromModel.
claus
parents: 124
diff changeset
  2358
claus
parents: 124
diff changeset
  2359
    selection notNil ifTrue:[
130
claus
parents: 128
diff changeset
  2360
	selection isCollection ifTrue:[
166
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  2361
	    selection notEmpty ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  2362
		self makeLineVisible:selection first
Claus Gittinger <cg@exept.de>
parents: 164
diff changeset
  2363
	    ]
130
claus
parents: 128
diff changeset
  2364
	] ifFalse:[
claus
parents: 128
diff changeset
  2365
	    self makeLineVisible:selection
claus
parents: 128
diff changeset
  2366
	]
125
claus
parents: 124
diff changeset
  2367
    ].
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2368
!
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2369
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2370
initStyle
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2371
    |nm|
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2372
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2373
    super initStyle.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2374
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2375
    DefaultFont notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2376
	font := DefaultFont on:device
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2377
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2378
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2379
    bgColor := viewBackground.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2380
    hilightFrameColor := nil.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2381
    hilightLevel := 0.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2382
    arrowLevel := 1.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2383
    smallArrow := false.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2384
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2385
    device hasGreyscales ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2386
	"
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2387
	 must get rid of these hard codings
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2388
	"
130
claus
parents: 128
diff changeset
  2389
	nm := styleSheet name.
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2390
	(nm == #next) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2391
	    hilightFgColor := fgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2392
	    hilightBgColor := White.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2393
	    hilightFrameColor := fgColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2394
	] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2395
	    (nm == #motif) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2396
		fgColor := White.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2397
		bgColor := Grey.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2398
		viewBackground := bgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2399
		hilightFgColor := bgColor  "fgColor" "White".
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2400
		hilightBgColor := fgColor "bgColor lightened" "darkened".
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2401
	    ] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2402
		(nm == #openwin) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2403
		    hilightFgColor := fgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2404
		    hilightBgColor := Color grey.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2405
		    smallArrow := true.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2406
		]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2407
	    ]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2408
	]
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2409
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2410
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2411
    hilightFgColor isNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2412
	hilightFgColor := bgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2413
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2414
    hilightBgColor isNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2415
	hilightBgColor := fgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2416
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2417
    DefaultForegroundColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2418
	fgColor := DefaultForegroundColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2419
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2420
    DefaultBackgroundColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2421
	bgColor := viewBackground := DefaultBackgroundColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2422
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2423
    DefaultHilightForegroundColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2424
	hilightFgColor := DefaultHilightForegroundColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2425
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2426
    DefaultHilightBackgroundColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2427
	hilightBgColor := DefaultHilightBackgroundColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2428
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2429
    DefaultHilightFrameColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2430
	hilightFrameColor := DefaultHilightFrameColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2431
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2432
    DefaultHilightLevel notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2433
	hilightLevel := DefaultHilightLevel
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2434
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2435
    DefaultRightArrowLevel notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2436
	arrowLevel := DefaultRightArrowLevel
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2437
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2438
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2439
    DefaultShadowColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2440
	shadowColor := DefaultShadowColor on:device
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2441
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2442
    DefaultLightColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2443
	lightColor := DefaultLightColor on:device
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2444
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2445
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2446
    (hilightLevel abs > 0) ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2447
	lineSpacing := 3
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2448
    ] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2449
	lineSpacing := 2
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2450
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2451
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2452
    hilightFgColor isNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2453
	hilightFgColor := bgColor.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2454
	hilightBgColor := fgColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2455
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2456
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2457
    DefaultDisabledForegroundColor notNil ifTrue:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2458
	halfIntensityFgColor := DefaultDisabledForegroundColor
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2459
    ] ifFalse:[
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2460
	halfIntensityFgColor := Color darkGrey.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2461
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2462
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2463
    fgColor := fgColor on:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2464
    bgColor := bgColor on:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2465
    halfIntensityFgColor := halfIntensityFgColor on:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2466
    hilightFrameColor notNil ifTrue:[hilightFrameColor := hilightFrameColor on:device].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2467
    hilightFgColor := hilightFgColor on:device.
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2468
    hilightBgColor := hilightBgColor on:device.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2469
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2470
125
claus
parents: 124
diff changeset
  2471
!SelectionInListView methodsFor:'change & update'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2472
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2473
update:something with:aParameter from:changedObject
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2474
    changedObject == model ifTrue:[
128
claus
parents: 125
diff changeset
  2475
	something == aspectMsg ifTrue:[
claus
parents: 125
diff changeset
  2476
	    self getListFromModel.
claus
parents: 125
diff changeset
  2477
	    self getSelectionFromModel.
claus
parents: 125
diff changeset
  2478
	    ^ self
claus
parents: 125
diff changeset
  2479
	].
claus
parents: 125
diff changeset
  2480
	something == listMsg ifTrue:[
claus
parents: 125
diff changeset
  2481
	    self getListFromModel.
claus
parents: 125
diff changeset
  2482
	    ^ self
claus
parents: 125
diff changeset
  2483
	].
claus
parents: 125
diff changeset
  2484
	something == initialSelectionMsg ifTrue:[
claus
parents: 125
diff changeset
  2485
	    self getSelectionFromModel.
claus
parents: 125
diff changeset
  2486
	    ^ self
claus
parents: 125
diff changeset
  2487
	].
claus
parents: 125
diff changeset
  2488
	something == #empty ifTrue:[
claus
parents: 125
diff changeset
  2489
	    self list:nil.
claus
parents: 125
diff changeset
  2490
	    ^ self
claus
parents: 125
diff changeset
  2491
	].
105
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2492
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 97
diff changeset
  2493
    ^ super update:something with:aParameter from:changedObject
125
claus
parents: 124
diff changeset
  2494
! !
claus
parents: 124
diff changeset
  2495
claus
parents: 124
diff changeset
  2496
!SelectionInListView methodsFor:'accessing-selection'!
claus
parents: 124
diff changeset
  2497
claus
parents: 124
diff changeset
  2498
addToSelection:aNumber
claus
parents: 124
diff changeset
  2499
    "add entry, aNumber to the selection. No scrolling is done."
claus
parents: 124
diff changeset
  2500
claus
parents: 124
diff changeset
  2501
    (self isValidSelection:aNumber) ifFalse:[^ self].
claus
parents: 124
diff changeset
  2502
claus
parents: 124
diff changeset
  2503
    selection isNil ifTrue:[^ self selectWithoutScroll:aNumber].
claus
parents: 124
diff changeset
  2504
    selection isCollection ifTrue:[
claus
parents: 124
diff changeset
  2505
	(selection includes:aNumber) ifTrue:[^ self].
claus
parents: 124
diff changeset
  2506
	(selectConditionBlock notNil 
claus
parents: 124
diff changeset
  2507
		     and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
claus
parents: 124
diff changeset
  2508
	selection add:aNumber
claus
parents: 124
diff changeset
  2509
    ] ifFalse:[
claus
parents: 124
diff changeset
  2510
	(aNumber == selection) ifTrue:[^ self].
claus
parents: 124
diff changeset
  2511
	(selectConditionBlock notNil 
claus
parents: 124
diff changeset
  2512
		     and:[(selectConditionBlock value:aNumber) not]) ifTrue:[^ self].
claus
parents: 124
diff changeset
  2513
	selection := OrderedCollection with:selection with:aNumber
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2514
    ].
125
claus
parents: 124
diff changeset
  2515
    self redrawElement:aNumber
claus
parents: 124
diff changeset
  2516
!
claus
parents: 124
diff changeset
  2517
claus
parents: 124
diff changeset
  2518
addElementToSelection:anObject
claus
parents: 124
diff changeset
  2519
    "add the element with the same printstring as the argument, anObject
claus
parents: 124
diff changeset
  2520
     to the selection. The entry is searched by comparing printStrings.
claus
parents: 124
diff changeset
  2521
     No scrolling is done. Returns true, if ok, false if no such entry
claus
parents: 124
diff changeset
  2522
     was found."
claus
parents: 124
diff changeset
  2523
claus
parents: 124
diff changeset
  2524
    |lineNo str|
claus
parents: 124
diff changeset
  2525
claus
parents: 124
diff changeset
  2526
    str := anObject printString.
claus
parents: 124
diff changeset
  2527
    lineNo := list findFirst:[:entry | str = entry printString].
claus
parents: 124
diff changeset
  2528
    lineNo ~~ 0 ifTrue:[
claus
parents: 124
diff changeset
  2529
	self addToSelection:lineNo.
claus
parents: 124
diff changeset
  2530
	^ true
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2531
    ].
125
claus
parents: 124
diff changeset
  2532
    ^ false
claus
parents: 124
diff changeset
  2533
!
claus
parents: 124
diff changeset
  2534
claus
parents: 124
diff changeset
  2535
removeFromSelection:aNumber
claus
parents: 124
diff changeset
  2536
    "remove entry, aNumber from the selection."
claus
parents: 124
diff changeset
  2537
claus
parents: 124
diff changeset
  2538
    selection isNil ifTrue:[^ self].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2539
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2540
    multipleSelectOk ifTrue:[
125
claus
parents: 124
diff changeset
  2541
	(selection includes:aNumber) ifFalse:[^ self].
claus
parents: 124
diff changeset
  2542
	selection remove:aNumber.
claus
parents: 124
diff changeset
  2543
	selection size == 0 ifTrue:[
claus
parents: 124
diff changeset
  2544
	    selection := nil
59
450ce95a72a4 *** empty log message ***
claus
parents: 51
diff changeset
  2545
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2546
    ] ifFalse:[
125
claus
parents: 124
diff changeset
  2547
	(aNumber == selection) ifFalse:[^ self].
claus
parents: 124
diff changeset
  2548
	selection := nil
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2549
    ].
125
claus
parents: 124
diff changeset
  2550
    self redrawElement:aNumber
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2551
! !
125
claus
parents: 124
diff changeset
  2552
claus
parents: 124
diff changeset
  2553
!SelectionInListView methodsFor:'accessing-mvc'!
claus
parents: 124
diff changeset
  2554
claus
parents: 124
diff changeset
  2555
on:aModel printItems:print oneItem:one aspect:aspectSymbol change:changeSymbol 
claus
parents: 124
diff changeset
  2556
		list:listSymbol menu:menuSymbol initialSelection:initialSymbol useIndex:use
claus
parents: 124
diff changeset
  2557
claus
parents: 124
diff changeset
  2558
    "ST-80 compatibility"
claus
parents: 124
diff changeset
  2559
claus
parents: 124
diff changeset
  2560
    aspectMsg := aspectSymbol.
claus
parents: 124
diff changeset
  2561
    changeMsg := changeSymbol.
claus
parents: 124
diff changeset
  2562
    listMsg := listSymbol.
claus
parents: 124
diff changeset
  2563
    menuMsg := menuSymbol.
claus
parents: 124
diff changeset
  2564
    initialSelectionMsg := initialSymbol.
claus
parents: 124
diff changeset
  2565
    printItems := print.
claus
parents: 124
diff changeset
  2566
    oneItem := one.
claus
parents: 124
diff changeset
  2567
    useIndex := use.
claus
parents: 124
diff changeset
  2568
    ignoreReselect := false.    "/ ST80 behavior
claus
parents: 124
diff changeset
  2569
    self model:aModel.
claus
parents: 124
diff changeset
  2570
!
claus
parents: 124
diff changeset
  2571
claus
parents: 124
diff changeset
  2572
doubleClickMessage
claus
parents: 124
diff changeset
  2573
    "return the symbol with which the model (if any) is informed about 
claus
parents: 124
diff changeset
  2574
     double-click. If nil (which is the default), it is not informed."
claus
parents: 124
diff changeset
  2575
claus
parents: 124
diff changeset
  2576
    ^ doubleClickMsg
claus
parents: 124
diff changeset
  2577
!
claus
parents: 124
diff changeset
  2578
claus
parents: 124
diff changeset
  2579
doubleClickMessage:aSymbol
claus
parents: 124
diff changeset
  2580
    "set the symbol with which the model (if any) is informed about double-click.
claus
parents: 124
diff changeset
  2581
     If nil (which is the default), it is not informed."
claus
parents: 124
diff changeset
  2582
claus
parents: 124
diff changeset
  2583
    doubleClickMsg := aSymbol
claus
parents: 124
diff changeset
  2584
!
claus
parents: 124
diff changeset
  2585
claus
parents: 124
diff changeset
  2586
doubleClick:aSymbol
claus
parents: 124
diff changeset
  2587
    "set the symbol with which the model is informed about double-click.
claus
parents: 124
diff changeset
  2588
     OBSOLETE: please use #doubleClickMessage:"
claus
parents: 124
diff changeset
  2589
claus
parents: 124
diff changeset
  2590
    self obsoleteMethodWarning:'please use #doubleClickMessage:'.
claus
parents: 124
diff changeset
  2591
    doubleClickMsg := aSymbol
claus
parents: 124
diff changeset
  2592
!
claus
parents: 124
diff changeset
  2593
claus
parents: 124
diff changeset
  2594
initialSelectionMessage
claus
parents: 124
diff changeset
  2595
    "return the symbol by which the model informes me about a changed
claus
parents: 124
diff changeset
  2596
     selectionIndex. This is used both in change notification and to
claus
parents: 124
diff changeset
  2597
     actually aquire a new selection value."
claus
parents: 124
diff changeset
  2598
claus
parents: 124
diff changeset
  2599
    ^ initialSelectionMsg
claus
parents: 124
diff changeset
  2600
!
claus
parents: 124
diff changeset
  2601
claus
parents: 124
diff changeset
  2602
initialSelectionMessage:aSymbol
claus
parents: 124
diff changeset
  2603
    "set the symbol by which the model informes me about a changed
claus
parents: 124
diff changeset
  2604
     selectionIndex. This is used both in change notification and to
claus
parents: 124
diff changeset
  2605
     actually aquire a new selection value."
claus
parents: 124
diff changeset
  2606
claus
parents: 124
diff changeset
  2607
    initialSelectionMsg := aSymbol
claus
parents: 124
diff changeset
  2608
!
claus
parents: 124
diff changeset
  2609
claus
parents: 124
diff changeset
  2610
addModelInterfaceTo:aDictionary
claus
parents: 124
diff changeset
  2611
    "see comment in View>>modelInterface"
claus
parents: 124
diff changeset
  2612
claus
parents: 124
diff changeset
  2613
    super addModelInterfaceTo:aDictionary.
claus
parents: 124
diff changeset
  2614
    aDictionary at:#doubleClickMessage put:doubleClickMsg.
claus
parents: 124
diff changeset
  2615
    aDictionary at:#initialSelectionMessage put:initialSelectionMsg.
claus
parents: 124
diff changeset
  2616
claus
parents: 124
diff changeset
  2617
    "
claus
parents: 124
diff changeset
  2618
     SelectionInListView new modelInterface 
claus
parents: 124
diff changeset
  2619
    "
claus
parents: 124
diff changeset
  2620
! !