1#==============================================================================
2# Contains public and private procedures used in tablelist bindings.
3#
4# Structure of the module:
5#   - Public helper procedures
6#   - Binding tag Tablelist
7#   - Binding tag TablelistWindow
8#   - Binding tag TablelistBody
9#   - Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow
10#
11# Copyright (c) 2000-2008  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
12#==============================================================================
13
14#
15# Public helper procedures
16# ========================
17#
18
19#------------------------------------------------------------------------------
20# tablelist::getTablelistPath
21#
22# Gets the path name of the tablelist widget from the path name w of one of its
23# descendants.  It is assumed that all of the ancestors of w exist (but w
24# itself needn't exist).
25#------------------------------------------------------------------------------
26proc tablelist::getTablelistPath w {
27    return [mwutil::getAncestorByClass $w Tablelist]
28}
29
30#------------------------------------------------------------------------------
31# tablelist::convEventFields
32#
33# Gets the path name of the tablelist widget and the x and y coordinates
34# relative to the latter from the path name w of one of its descendants and
35# from the x and y coordinates relative to the latter.
36#------------------------------------------------------------------------------
37proc tablelist::convEventFields {w x y} {
38    return [mwutil::convEventFields $w $x $y Tablelist]
39}
40
41#
42# Binding tag Tablelist
43# =====================
44#
45
46#------------------------------------------------------------------------------
47# tablelist::addActiveTag
48#
49# This procedure is invoked when the tablelist widget win gains the keyboard
50# focus.  It adds the "active" tag to the line or cell that displays the active
51# item or element of the widget in its body text child.
52#------------------------------------------------------------------------------
53proc tablelist::addActiveTag win {
54    upvar ::tablelist::ns${win}::data data
55    set line [expr {$data(activeRow) + 1}]
56    set col $data(activeCol)
57    if {[string compare $data(-selecttype) "row"] == 0} {
58	$data(body) tag add active $line.0 $line.end
59    } elseif {$data(itemCount) > 0 && $data(colCount) > 0 &&
60	      $line > 0 && !$data($col-hide)} {
61	findTabs $win $line $col $col tabIdx1 tabIdx2
62	$data(body) tag add active $tabIdx1 $tabIdx2+1c
63    }
64
65    set data(ownsFocus) 1
66}
67
68#------------------------------------------------------------------------------
69# tablelist::removeActiveTag
70#
71# This procedure is invoked when the tablelist widget win loses the keyboard
72# focus.  It removes the "active" tag from the body text child of the widget.
73#------------------------------------------------------------------------------
74proc tablelist::removeActiveTag win {
75    upvar ::tablelist::ns${win}::data data
76    $data(body) tag remove active 1.0 end
77
78    set data(ownsFocus) 0
79}
80
81#------------------------------------------------------------------------------
82# tablelist::cleanup
83#
84# This procedure is invoked when the tablelist widget win is destroyed.  It
85# executes some cleanup operations.
86#------------------------------------------------------------------------------
87proc tablelist::cleanup win {
88    #
89    # Cancel the execution of all delayed adjustSeps,
90    # makeStripes, showLineNumbers, stretchColumns, updateColors,
91    # updateScrlColOffset, updateHScrlbar, updateVScrlbar,
92    # adjustElidedText, synchronize, displayItems, horizAutoScan,
93    # doCellConfig, redisplay, and redisplayCol commands
94    #
95    upvar ::tablelist::ns${win}::data data
96    foreach id {sepsId stripesId lineNumsId stretchId colorId offsetId \
97		hScrlbarId vScrlbarId elidedId syncId dispId afterId
98		reconfigId} {
99	if {[info exists data($id)]} {
100	    after cancel $data($id)
101	}
102    }
103    foreach name [array names data *redispId] {
104	after cancel $data($name)
105    }
106
107    #
108    # If there is a list variable associated with the
109    # widget then remove the trace set on this variable
110    #
111    if {$data(hasListVar) && [info exists $data(-listvariable)]} {
112	upvar #0 $data(-listvariable) var
113	trace vdelete var wu $data(listVarTraceCmd)
114    }
115
116    namespace delete ::tablelist::ns$win
117    catch {rename ::$win ""}
118}
119
120#------------------------------------------------------------------------------
121# tablelist::updateConfigSpecs
122#
123# This procedure handles the virtual event <<ThemeChanged>> by updating the
124# theme-specific default values of some tablelist configuration options.
125#------------------------------------------------------------------------------
126proc tablelist::updateConfigSpecs win {
127    #
128    # This might be an "after idle" callback; check whether the window exists
129    #
130    if {![winfo exists $win]} {
131	return ""
132    }
133
134    set currentTheme [getCurrentTheme]
135    upvar ::tablelist::ns${win}::data data
136    if {[string compare $currentTheme $data(currentTheme)] == 0} {
137	if {[string compare $currentTheme "tileqt"] == 0} {
138	    set widgetStyle [tileqt_currentThemeName]
139	    set colorScheme [getKdeConfigVal "KDE" "colorScheme"]
140	    if {[string compare $widgetStyle $data(widgetStyle)] == 0 &&
141		[string compare $colorScheme $data(colorScheme)] == 0} {
142		return ""
143	    }
144	} else {
145	    return ""
146	}
147    }
148
149    variable themeDefaults
150    variable configSpecs
151
152    #
153    # Populate the array tmp with values corresponding to the old theme
154    # and the array themeDefaults with values corresponding to the new one
155    #
156    array set tmp $data(themeDefaults)
157    setThemeDefaults
158
159    #
160    # Update the default values in the array configSpecs and
161    # set those configuration options whose values equal the old
162    # theme-specific defaults to the new theme-specific ones
163    #
164    foreach opt {-background -foreground -disabledforeground -stripebackground
165		 -selectbackground -selectforeground -selectborderwidth -font
166		 -labelbackground -labelforeground -labelfont
167		 -labelborderwidth -labelpady
168		 -arrowcolor -arrowdisabledcolor -arrowstyle} {
169	lset configSpecs($opt) 3 $themeDefaults($opt)
170	if {[string compare $data($opt) $tmp($opt)] == 0} {
171	    doConfig $win $opt $themeDefaults($opt)
172	}
173    }
174    foreach opt {-background -foreground} {
175	doConfig $win $opt $data($opt)	;# sets the bg color of the separators
176    }
177
178    #
179    # Destroy and recreate the edit window if present
180    #
181    if {[set editCol $data(editCol)] >= 0} {
182	set editRow $data(editRow)
183	saveEditData $win
184	destroy $data(bodyFr)
185	doEditCell $win $editRow $editCol 1
186    }
187
188    #
189    # Destroy and recreate the embedded windows
190    #
191    if {$data(winCount) != 0} {
192	for {set row 0} {$row < $data(itemCount)} {incr row} {
193	    for {set col 0} {$col < $data(colCount)} {incr col} {
194		set key [lindex [lindex $data(itemList) $row] end]
195		if {[info exists data($key,$col-window)]} {
196		    set val $data($key,$col-window)
197		    doCellConfig $row $col $win -window ""
198		    doCellConfig $row $col $win -window $val
199		}
200	    }
201	}
202    }
203
204    set data(currentTheme) $currentTheme
205    set data(themeDefaults) [array get themeDefaults]
206    if {[string compare $currentTheme "tileqt"] == 0} {
207	set data(widgetStyle) [tileqt_currentThemeName]
208	set data(colorScheme) [getKdeConfigVal "KDE" "colorScheme"]
209    } else {
210	set data(widgetStyle) ""
211	set data(colorScheme) ""
212    }
213}
214
215#
216# Binding tag TablelistWindow
217# ===========================
218#
219
220#------------------------------------------------------------------------------
221# tablelist::cleanupWindow
222#
223# This procedure is invoked when a window aux embedded into a tablelist widget
224# is destroyed.  It invokes the cleanup script associated with the cell
225# containing the window, if any.
226#------------------------------------------------------------------------------
227proc tablelist::cleanupWindow aux {
228    regexp {^(.+)\.body\.f(k[0-9]+),([0-9]+)$} $aux dummy win key col
229    upvar ::tablelist::ns${win}::data data
230    if {[info exists data($key,$col-windowdestroy)]} {
231	set row [lsearch $data(itemList) "* $key"]
232	uplevel #0 $data($key,$col-windowdestroy) [list $win $row $col $aux.w]
233    }
234}
235
236#
237# Binding tag TablelistBody
238# =========================
239#
240
241#------------------------------------------------------------------------------
242# tablelist::defineTablelistBody
243#
244# Defines the bindings for the binding tag TablelistBody.
245#------------------------------------------------------------------------------
246proc tablelist::defineTablelistBody {} {
247    variable priv
248    array set priv {
249	x			""
250	y			""
251	afterId			""
252	prevRow			""
253	prevCol			""
254	selection		{}
255	clicked			0
256	clickTime		0
257	clickedInEditWin	0
258    }
259
260    foreach event {<Enter> <Motion> <Leave>} {
261	bind TablelistBody $event {
262	    foreach {tablelist::W tablelist::x tablelist::y} \
263		[tablelist::convEventFields %W %x %y] {}
264
265	    tablelist::showOrHideTooltip $tablelist::W \
266		$tablelist::x $tablelist::y %X %Y
267	}
268    }
269    bind TablelistBody <Button-1> {
270	if {[winfo exists %W]} {
271	    foreach {tablelist::W tablelist::x tablelist::y} \
272		[tablelist::convEventFields %W %x %y] {}
273
274	    set tablelist::priv(x) $tablelist::x
275	    set tablelist::priv(y) $tablelist::y
276	    set tablelist::priv(row) [$tablelist::W nearest       $tablelist::y]
277	    set tablelist::priv(col) [$tablelist::W nearestcolumn $tablelist::x]
278	    set tablelist::priv(clicked) 1
279	    set tablelist::priv(clickTime) %t
280	    set tablelist::priv(clickedInEditWin) 0
281	    if {[$tablelist::W cget -setfocus] &&
282		[string compare [$tablelist::W cget -state] "normal"] == 0} {
283		focus [$tablelist::W bodypath]
284	    }
285	    tablelist::condEditContainingCell $tablelist::W \
286		$tablelist::x $tablelist::y
287	    tablelist::condBeginMove $tablelist::W $tablelist::priv(row)
288	    tablelist::beginSelect $tablelist::W \
289		$tablelist::priv(row) $tablelist::priv(col)
290	}
291    }
292    bind TablelistBody <Double-Button-1> {
293	# Empty script
294    }
295    bind TablelistBody <B1-Motion> {
296	if {$tablelist::priv(clicked) &&
297	    %t - $tablelist::priv(clickTime) < 300} {
298	    continue
299	}
300	foreach {tablelist::W tablelist::x tablelist::y} \
301	    [tablelist::convEventFields %W %x %y] {}
302
303	if {[string compare $tablelist::priv(x) ""] == 0 ||
304	    [string compare $tablelist::priv(y) ""] == 0} {
305	    set tablelist::priv(x) $tablelist::x
306	    set tablelist::priv(y) $tablelist::y
307	}
308	set tablelist::priv(prevX) $tablelist::priv(x)
309	set tablelist::priv(prevY) $tablelist::priv(y)
310	set tablelist::priv(x) $tablelist::x
311	set tablelist::priv(y) $tablelist::y
312	tablelist::condAutoScan $tablelist::W
313	tablelist::motion $tablelist::W \
314	    [$tablelist::W nearest       $tablelist::y] \
315	    [$tablelist::W nearestcolumn $tablelist::x]
316	tablelist::condShowTarget $tablelist::W $tablelist::y
317    }
318    bind TablelistBody <ButtonRelease-1> {
319	foreach {tablelist::W tablelist::x tablelist::y} \
320	    [tablelist::convEventFields %W %x %y] {}
321
322	set tablelist::priv(x) ""
323	set tablelist::priv(y) ""
324	set tablelist::priv(clicked) 0
325	after cancel $tablelist::priv(afterId)
326	set tablelist::priv(afterId) ""
327	set tablelist::priv(releasedInEditWin) 0
328	if {$tablelist::priv(clicked) &&
329	    %t - $tablelist::priv(clickTime) < 300} {
330	    tablelist::moveOrActivate $tablelist::W \
331		$tablelist::priv(row) $tablelist::priv(col)
332	} else {
333	    tablelist::moveOrActivate $tablelist::W \
334		[$tablelist::W nearest       $tablelist::y] \
335		[$tablelist::W nearestcolumn $tablelist::x]
336	}
337	tablelist::condEvalInvokeCmd $tablelist::W
338    }
339    bind TablelistBody <Shift-Button-1> {
340	foreach {tablelist::W tablelist::x tablelist::y} \
341	    [tablelist::convEventFields %W %x %y] {}
342
343	tablelist::beginExtend $tablelist::W \
344	    [$tablelist::W nearest       $tablelist::y] \
345	    [$tablelist::W nearestcolumn $tablelist::x]
346    }
347    bind TablelistBody <Control-Button-1> {
348	foreach {tablelist::W tablelist::x tablelist::y} \
349	    [tablelist::convEventFields %W %x %y] {}
350
351	tablelist::beginToggle $tablelist::W \
352	    [$tablelist::W nearest       $tablelist::y] \
353	    [$tablelist::W nearestcolumn $tablelist::x]
354    }
355
356    bind TablelistBody <Return> {
357	tablelist::condEditActiveCell [tablelist::getTablelistPath %W]
358    }
359    bind TablelistBody <KP_Enter> {
360	tablelist::condEditActiveCell [tablelist::getTablelistPath %W]
361    }
362    bind TablelistBody <Tab> {
363	tablelist::nextPrevCell [tablelist::getTablelistPath %W] 1
364    }
365    bind TablelistBody <Shift-Tab> {
366	tablelist::nextPrevCell [tablelist::getTablelistPath %W] -1
367    }
368    bind TablelistBody <<PrevWindow>> {
369	tablelist::nextPrevCell [tablelist::getTablelistPath %W] -1
370    }
371    bind TablelistBody <Up> {
372	tablelist::upDown [tablelist::getTablelistPath %W] -1
373    }
374    bind TablelistBody <Down> {
375	tablelist::upDown [tablelist::getTablelistPath %W] 1
376    }
377    bind TablelistBody <Left> {
378	tablelist::leftRight [tablelist::getTablelistPath %W] -1
379    }
380    bind TablelistBody <Right> {
381	tablelist::leftRight [tablelist::getTablelistPath %W] 1
382    }
383    bind TablelistBody <Prior> {
384	tablelist::priorNext [tablelist::getTablelistPath %W] -1
385    }
386    bind TablelistBody <Next> {
387	tablelist::priorNext [tablelist::getTablelistPath %W] 1
388    }
389    bind TablelistBody <Home> {
390	tablelist::homeEnd [tablelist::getTablelistPath %W] Home
391    }
392    bind TablelistBody <End> {
393	tablelist::homeEnd [tablelist::getTablelistPath %W] End
394    }
395    bind TablelistBody <Control-Home> {
396	tablelist::firstLast [tablelist::getTablelistPath %W] first
397    }
398    bind TablelistBody <Control-End> {
399	tablelist::firstLast [tablelist::getTablelistPath %W] last
400    }
401    bind TablelistBody <Shift-Up> {
402	tablelist::extendUpDown [tablelist::getTablelistPath %W] -1
403    }
404    bind TablelistBody <Shift-Down> {
405	tablelist::extendUpDown [tablelist::getTablelistPath %W] 1
406    }
407    bind TablelistBody <Shift-Left> {
408	tablelist::extendLeftRight [tablelist::getTablelistPath %W] -1
409    }
410    bind TablelistBody <Shift-Right> {
411	tablelist::extendLeftRight [tablelist::getTablelistPath %W] 1
412    }
413    bind TablelistBody <Shift-Home> {
414	tablelist::extendToHomeEnd [tablelist::getTablelistPath %W] Home
415    }
416    bind TablelistBody <Shift-End> {
417	tablelist::extendToHomeEnd [tablelist::getTablelistPath %W] End
418    }
419    bind TablelistBody <Shift-Control-Home> {
420	tablelist::extendToFirstLast [tablelist::getTablelistPath %W] first
421    }
422    bind TablelistBody <Shift-Control-End> {
423	tablelist::extendToFirstLast [tablelist::getTablelistPath %W] last
424    }
425    bind TablelistBody <space> {
426	set tablelist::W [tablelist::getTablelistPath %W]
427
428	tablelist::beginSelect $tablelist::W \
429	    [$tablelist::W index active] [$tablelist::W columnindex active]
430    }
431    bind TablelistBody <Select> {
432	set tablelist::W [tablelist::getTablelistPath %W]
433
434	tablelist::beginSelect $tablelist::W \
435	    [$tablelist::W index active] [$tablelist::W columnindex active]
436    }
437    bind TablelistBody <Control-Shift-space> {
438	set tablelist::W [tablelist::getTablelistPath %W]
439
440	tablelist::beginExtend $tablelist::W \
441	    [$tablelist::W index active] [$tablelist::W columnindex active]
442    }
443    bind TablelistBody <Shift-Select> {
444	set tablelist::W [tablelist::getTablelistPath %W]
445
446	tablelist::beginExtend $tablelist::W \
447	    [$tablelist::W index active] [$tablelist::W columnindex active]
448    }
449    bind TablelistBody <Escape> {
450	tablelist::cancelSelection [tablelist::getTablelistPath %W]
451    }
452    bind TablelistBody <Control-slash> {
453	tablelist::selectAll [tablelist::getTablelistPath %W]
454    }
455    bind TablelistBody <Control-backslash> {
456	set tablelist::W [tablelist::getTablelistPath %W]
457
458	if {[string compare [$tablelist::W cget -selectmode] "browse"] != 0} {
459	    $tablelist::W selection clear 0 end
460	    event generate $tablelist::W <<TablelistSelect>>
461	}
462    }
463    foreach pattern {Tab Shift-Tab ISO_Left_Tab hpBackTab} {
464	catch {
465	    foreach modifier {Control Meta} {
466		bind TablelistBody <$modifier-$pattern> [format {
467		    mwutil::processTraversal %%W Tablelist <%s>
468		} $pattern]
469	    }
470	}
471    }
472
473    variable winSys
474    if {[string compare $winSys "classic"] == 0 ||
475	[string compare $winSys "aqua"] == 0} {
476	bind TablelistBody <MouseWheel> {
477	    [tablelist::getTablelistPath %W] yview scroll [expr {-%D}] units
478	    break
479	}
480	bind TablelistBody <Shift-MouseWheel> {
481	    [tablelist::getTablelistPath %W] xview scroll [expr {-%D}] units
482	    break
483	}
484	bind TablelistBody <Option-MouseWheel> {
485	    [tablelist::getTablelistPath %W] yview scroll \
486		[expr {-10 * %D}] units
487	    break
488	}
489	bind TablelistBody <Shift-Option-MouseWheel> {
490	    [tablelist::getTablelistPath %W] xview scroll \
491		[expr {-10 * %D}] units
492	    break
493	}
494    } else {
495	bind TablelistBody <MouseWheel> {
496	    [tablelist::getTablelistPath %W] yview scroll \
497		[expr {-(%D / 120) * 4}] units
498	    break
499	}
500	bind TablelistBody <Shift-MouseWheel> {
501	    [tablelist::getTablelistPath %W] xview scroll \
502		[expr {-(%D / 120) * 4}] units
503	    break
504	}
505    }
506
507    if {[string compare $winSys "x11"] == 0} {
508	bind TablelistBody <Button-4> {
509	    if {!$tk_strictMotif} {
510		[tablelist::getTablelistPath %W] yview scroll -5 units
511		break
512	    }
513	}
514	bind TablelistBody <Button-5> {
515	    if {!$tk_strictMotif} {
516		[tablelist::getTablelistPath %W] yview scroll 5 units
517		break
518	    }
519	}
520	bind TablelistBody <Shift-Button-4> {
521	    if {!$tk_strictMotif} {
522		[tablelist::getTablelistPath %W] xview scroll -5 units
523		break
524	    }
525	}
526	bind TablelistBody <Shift-Button-5> {
527	    if {!$tk_strictMotif} {
528		[tablelist::getTablelistPath %W] xview scroll 5 units
529		break
530	    }
531	}
532    }
533
534    foreach event {<<Copy>> <Control-Left> <Control-Right>
535		   <Control-Prior> <Control-Next> <Button-2> <B2-Motion>} {
536	set script [strMap {
537	    "%W" "$tablelist::W"  "%x" "$tablelist::x"  "%y" "$tablelist::y"
538	} [bind Listbox $event]]
539
540	if {[string compare $script ""] != 0} {
541	    bind TablelistBody $event [format {
542		foreach {tablelist::W tablelist::x tablelist::y} \
543		    [tablelist::convEventFields %%W %%x %%y] {}
544		%s
545	    } $script]
546	}
547    }
548}
549
550#------------------------------------------------------------------------------
551# tablelist::showOrHideTooltip
552#
553# This procedure is invoked when the mouse pointer enters or leaves the body of
554# a tablelist widget win or one of its separators, or is moving within it.  If
555# the pointer has crossed a cell boundary then the procedure removes the old
556# tooltip and displays the one corresponding to the new cell.
557#------------------------------------------------------------------------------
558proc tablelist::showOrHideTooltip {win x y X Y} {
559    upvar ::tablelist::ns${win}::data data
560    if {[string compare $data(-tooltipaddcommand) ""] == 0 ||
561	[string compare $data(-tooltipdelcommand) ""] == 0} {
562	return ""
563    }
564
565    #
566    # Get the containing cell from the coordinates relative to the parent
567    #
568    set row [containingRow $win $y]
569    set col [containingCol $win $x]
570    if {[string compare $row,$col $data(prevCell)] == 0} {
571	return ""
572    }
573
574    #
575    # Remove the old tooltip, if any.  Then, if we are within a
576    # cell, display the new tooltip corresponding to that cell.
577    #
578    event generate $win <Leave>
579    catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
580    set data(prevCell) $row,$col
581    if {$row >= 0 && $col >= 0} {
582	set focus [focus -displayof $win]
583	if {[string compare $focus ""] == 0 ||
584	    [string first $win $focus] != 0 ||
585	    [string compare [winfo toplevel $focus] \
586	     [winfo toplevel $win]] == 0} {
587	    uplevel #0 $data(-tooltipaddcommand) [list $win $row $col]
588	    event generate $win <Enter> -rootx $X -rooty $Y
589	}
590    }
591}
592
593#------------------------------------------------------------------------------
594# tablelist::condEditContainingCell
595#
596# This procedure is invoked when mouse button 1 is pressed in the body of a
597# tablelist widget win or in one of its separators.  If the mouse click
598# occurred inside an editable cell and the latter is not already being edited,
599# then the procedure starts the interactive editing in that cell.  Otherwise it
600# finishes a possibly active cell editing.
601#------------------------------------------------------------------------------
602proc tablelist::condEditContainingCell {win x y} {
603    #
604    # Get the containing cell from the coordinates relative to the parent
605    #
606    set row [containingRow $win $y]
607    set col [containingCol $win $x]
608
609    upvar ::tablelist::ns${win}::data data
610    if {$row >= 0 && $col >= 0 && [isCellEditable $win $row $col]} {
611	#
612	# Get the coordinates relative to the
613	# tablelist body and invoke doEditCell
614	#
615	set w $data(body)
616	incr x -[winfo x $w]
617	incr y -[winfo y $w]
618	scan [$w index @$x,$y] "%d.%d" line charPos
619	doEditCell $win $row $col 0 "" $charPos
620    } else {
621	#
622	# Finish a possibly active cell editing
623	#
624	if {$data(editRow) >= 0} {
625	    doFinishEditing $win
626	}
627    }
628}
629
630#------------------------------------------------------------------------------
631# tablelist::condBeginMove
632#
633# This procedure is typically invoked on button-1 presses in the body of a
634# tablelist widget or in one of its separators.  It begins the process of
635# moving the nearest row if the rows are movable and the selection mode is not
636# browse or extended.
637#------------------------------------------------------------------------------
638proc tablelist::condBeginMove {win row} {
639    upvar ::tablelist::ns${win}::data data
640    if {$data(isDisabled) || !$data(-movablerows) || $data(itemCount) == 0 ||
641	[string compare $data(-selectmode) "browse"] == 0 ||
642	[string compare $data(-selectmode) "extended"] == 0} {
643	return ""
644    }
645
646    set data(sourceRow) $row
647    set data(targetRow) $row
648
649    set topWin [winfo toplevel $win]
650    set data(topEscBinding) [bind $topWin <Escape>]
651    bind $topWin <Escape> \
652	[list tablelist::cancelMove [strMap {"%" "%%"} $win]]
653}
654
655#------------------------------------------------------------------------------
656# tablelist::beginSelect
657#
658# This procedure is typically invoked on button-1 presses in the body of a
659# tablelist widget or in one of its separators.  It begins the process of
660# making a selection in the widget.  Its exact behavior depends on the
661# selection mode currently in effect for the widget.
662#------------------------------------------------------------------------------
663proc tablelist::beginSelect {win row col} {
664    upvar ::tablelist::ns${win}::data data
665    switch $data(-selecttype) {
666	row {
667	    if {[string compare $data(-selectmode) "multiple"] == 0} {
668		if {[::$win selection includes $row]} {
669		    ::$win selection clear $row
670		} else {
671		    ::$win selection set $row
672		}
673	    } else {
674		::$win selection clear 0 end
675		::$win selection set $row
676		::$win selection anchor $row
677		variable priv
678		set priv(selection) {}
679		set priv(prevRow) $row
680	    }
681	}
682
683	cell {
684	    if {[string compare $data(-selectmode) "multiple"] == 0} {
685		if {[::$win cellselection includes $row,$col]} {
686		    ::$win cellselection clear $row,$col
687		} else {
688		    ::$win cellselection set $row,$col
689		}
690	    } else {
691		::$win cellselection clear 0,0 end
692		::$win cellselection set $row,$col
693		::$win cellselection anchor $row,$col
694		variable priv
695		set priv(selection) {}
696		set priv(prevRow) $row
697		set priv(prevCol) $col
698	    }
699	}
700    }
701
702    event generate $win <<TablelistSelect>>
703}
704
705#------------------------------------------------------------------------------
706# tablelist::condAutoScan
707#
708# This procedure is invoked when the mouse leaves or enters the scrollable part
709# of a tablelist widget's body text child.  It either invokes the autoScan
710# procedure or cancels its invocation as an "after" command.
711#------------------------------------------------------------------------------
712proc tablelist::condAutoScan win {
713    variable priv
714    set w [::$win bodypath]
715    set wX [winfo x $w]
716    set wY [winfo y $w]
717    set wWidth  [winfo width  $w]
718    set wHeight [winfo height $w]
719    set x [expr {$priv(x) - $wX}]
720    set y [expr {$priv(y) - $wY}]
721    set prevX [expr {$priv(prevX) - $wX}]
722    set prevY [expr {$priv(prevY) - $wY}]
723    set minX [minScrollableX $win]
724
725    if {($y >= $wHeight && $prevY < $wHeight) ||
726	($y < 0 && $prevY >= 0) ||
727	($x >= $wWidth && $prevX < $wWidth) ||
728	($x < $minX && $prevX >= $minX)} {
729	if {[string compare $priv(afterId) ""] == 0} {
730	    autoScan $win
731	}
732    } elseif {($y < $wHeight && $prevY >= $wHeight) ||
733	      ($y >= 0 && $prevY < 0) ||
734	      ($x < $wWidth && $prevX >= $wWidth) ||
735	      ($x >= $minX && $prevX < $minX)} {
736	after cancel $priv(afterId)
737	set priv(afterId) ""
738    }
739}
740
741#------------------------------------------------------------------------------
742# tablelist::autoScan
743#
744# This procedure is invoked when the mouse leaves the scrollable part of a
745# tablelist widget's body text child.  It scrolls the child up, down, left, or
746# right, depending on where the mouse left the scrollable part of the
747# tablelist's body, and reschedules itself as an "after" command so that the
748# child continues to scroll until the mouse moves back into the window or the
749# mouse button is released.
750#------------------------------------------------------------------------------
751proc tablelist::autoScan win {
752    if {![winfo exists $win] || [string compare [::$win editwinpath] ""] != 0} {
753	return ""
754    }
755
756    upvar ::tablelist::ns${win}::data data
757    variable priv
758    set w [::$win bodypath]
759    set x [expr {$priv(x) - [winfo x $w]}]
760    set y [expr {$priv(y) - [winfo y $w]}]
761    set minX [minScrollableX $win]
762
763    if {$y >= [winfo height $w]} {
764	::$win yview scroll 1 units
765	set ms 50
766    } elseif {$y < 0} {
767	::$win yview scroll -1 units
768	set ms 50
769    } elseif {$x >= [winfo width $w]} {
770	if {$data(-titlecolumns) == 0} {
771	    ::$win xview scroll 2 units
772	    set ms 50
773	} else {
774	    ::$win xview scroll 1 units
775	    set ms 250
776	}
777    } elseif {$x < $minX} {
778	if {$data(-titlecolumns) == 0} {
779	    ::$win xview scroll -2 units
780	    set ms 50
781	} else {
782	    ::$win xview scroll -1 units
783	    set ms 250
784	}
785    } else {
786	return ""
787    }
788
789    motion $win [::$win nearest $priv(y)] [::$win nearestcolumn $priv(x)]
790    set priv(afterId) [after $ms [list tablelist::autoScan $win]]
791}
792
793#------------------------------------------------------------------------------
794# tablelist::minScrollableX
795#
796# Returns the least x coordinate within the scrollable part of the body of the
797# tablelist widget win.
798#------------------------------------------------------------------------------
799proc tablelist::minScrollableX win {
800    upvar ::tablelist::ns${win}::data data
801    if {$data(-titlecolumns) == 0} {
802	return 0
803    } else {
804	set sep [::$win separatorpath]
805	if {[winfo viewable $sep]} {
806	    return [expr {[winfo x $sep] - [winfo x [::$win bodypath]] + 1}]
807	} else {
808	    return 0
809	}
810    }
811}
812
813#------------------------------------------------------------------------------
814# tablelist::motion
815#
816# This procedure is called to process mouse motion events in the body of a
817# tablelist widget or in one of its separators. while button 1 is down.  It may
818# move or extend the selection, depending on the widget's selection mode.
819#------------------------------------------------------------------------------
820proc tablelist::motion {win row col} {
821    upvar ::tablelist::ns${win}::data data
822    variable priv
823    switch $data(-selecttype) {
824	row {
825	    if {$row == $priv(prevRow)} {
826		return ""
827	    }
828
829	    switch -- $data(-selectmode) {
830		browse {
831		    ::$win selection clear 0 end
832		    ::$win selection set $row
833		    set priv(prevRow) $row
834		    event generate $win <<TablelistSelect>>
835		}
836		extended {
837		    if {[string compare $priv(prevRow) ""] != 0} {
838			::$win selection clear anchor $priv(prevRow)
839		    }
840		    ::$win selection set anchor $row
841		    set priv(prevRow) $row
842		    event generate $win <<TablelistSelect>>
843		}
844	    }
845	}
846
847	cell {
848	    if {$row == $priv(prevRow) && $col == $priv(prevCol)} {
849		return ""
850	    }
851
852	    switch -- $data(-selectmode) {
853		browse {
854		    ::$win cellselection clear 0,0 end
855		    ::$win cellselection set $row,$col
856		    set priv(prevRow) $row
857		    set priv(prevCol) $col
858		    event generate $win <<TablelistSelect>>
859		}
860		extended {
861		    if {[string compare $priv(prevRow) ""] != 0 &&
862			[string compare $priv(prevCol) ""] != 0} {
863			::$win cellselection clear anchor \
864			       $priv(prevRow),$priv(prevCol)
865		    }
866		    ::$win cellselection set anchor $row,$col
867		    set priv(prevRow) $row
868		    set priv(prevCol) $col
869		    event generate $win <<TablelistSelect>>
870		}
871	    }
872	}
873    }
874}
875
876#------------------------------------------------------------------------------
877# tablelist::condShowTarget
878#
879# This procedure is called to process mouse motion events in the body of a
880# tablelist widget or in one of its separators. while button 1 is down.  It
881# visualizes the would-be target position of the clicked row if a move
882# operation is in progress.
883#------------------------------------------------------------------------------
884proc tablelist::condShowTarget {win y} {
885    upvar ::tablelist::ns${win}::data data
886    if {![info exists data(sourceRow)]} {
887	return ""
888    }
889
890    set w $data(body)
891    incr y -[winfo y $w]
892    set textIdx [$w index @0,$y]
893    set row [expr {int($textIdx) - 1}]
894    set dlineinfo [$w dlineinfo $textIdx]
895    set lineY [lindex $dlineinfo 1]
896    set lineHeight [lindex $dlineinfo 3]
897    if {$y < $lineY + $lineHeight/2} {
898	set data(targetRow) $row
899	set gapY $lineY
900    } else {
901	set data(targetRow) [expr {$row + 1}]
902	set gapY [expr {$lineY + $lineHeight}]
903    }
904
905    if {$row == $data(sourceRow)} {
906	$w configure -cursor $data(-cursor)
907	place forget $data(rowGap)
908    } else {
909	$w configure -cursor $data(-movecursor)
910	place $data(rowGap) -anchor w -relwidth 1.0 -y $gapY
911	raise $data(rowGap)
912    }
913}
914
915#------------------------------------------------------------------------------
916# tablelist::moveOrActivate
917#
918# This procedure is invoked whenever mouse button 1 is released in the body of
919# a tablelist widget or in one of its separators.  It either moves the
920# previously clicked row before or after the one containing the mouse cursor,
921# or activates the given nearest item or element (depending on the widget's
922# selection type).
923#------------------------------------------------------------------------------
924proc tablelist::moveOrActivate {win row col} {
925    #
926    # Return if both <Button-1> and <ButtonRelease-1> occurred in the
927    # temporary embedded widget used for interactive cell editing
928    #
929    variable priv
930    if {$priv(clickedInEditWin) && $priv(releasedInEditWin)} {
931	return ""
932    }
933
934    upvar ::tablelist::ns${win}::data data
935    if {[info exists data(sourceRow)]} {
936	set sourceRow $data(sourceRow)
937	unset data(sourceRow)
938	bind [winfo toplevel $win] <Escape> $data(topEscBinding)
939	$data(body) configure -cursor $data(-cursor)
940	place forget $data(rowGap)
941
942	if {$data(targetRow) != $sourceRow &&
943	    $data(targetRow) != $sourceRow + 1} {
944	    ::$win move $sourceRow $data(targetRow)
945	    event generate $win <<TablelistRowMoved>>
946	}
947    } else {
948	switch $data(-selecttype) {
949	    row  { ::$win activate $row }
950	    cell { ::$win activatecell $row,$col }
951	}
952    }
953}
954
955#------------------------------------------------------------------------------
956# tablelist::condEvalInvokeCmd
957#
958# This procedure is invoked when mouse button 1 is released in the body of a
959# tablelist widget win or in one of its separators.  If interactive cell
960# editing is in progress in a column whose associated edit window has an invoke
961# command that hasn't yet been called in the current edit session, then the
962# procedure evaluates that command.
963#------------------------------------------------------------------------------
964proc tablelist::condEvalInvokeCmd win {
965    upvar ::tablelist::ns${win}::data data
966    if {$data(editCol) < 0} {
967	return ""
968    }
969
970    variable editWin
971    set name [getEditWindow $win $data(editRow) $data(editCol)]
972    if {[string compare $editWin($name-invokeCmd) ""] == 0 || $data(invoked)} {
973	return ""
974    }
975
976    #
977    # Return if both <Button-1> and <ButtonRelease-1> occurred in the
978    # temporary embedded widget used for interactive cell editing
979    #
980    variable priv
981    if {$priv(clickedInEditWin) && $priv(releasedInEditWin)} {
982	return ""
983    }
984
985    #
986    # Return if the edit window is an editable combobox widgets
987    #
988    set w $data(bodyFrEd)
989    switch [winfo class $w] {
990	TCombobox {
991	    if {[string compare [$w cget -state] "normal"] == 0} {
992		return ""
993	    }
994	}
995	ComboBox -
996	Combobox {
997	    if {[$w cget -editable]} {
998		return ""
999	    }
1000	}
1001    }
1002
1003    #
1004    # Evaluate the edit window's invoke command
1005    #
1006    update
1007    eval [strMap {"%W" "$w"} $editWin($name-invokeCmd)]
1008    set data(invoked) 1
1009}
1010
1011#------------------------------------------------------------------------------
1012# tablelist::cancelMove
1013#
1014# This procedure is invoked to process <Escape> events in the top-level window
1015# containing the tablelist widget win during a row move operation.  It cancels
1016# the action in progress.
1017#------------------------------------------------------------------------------
1018proc tablelist::cancelMove win {
1019    upvar ::tablelist::ns${win}::data data
1020    if {![info exists data(sourceRow)]} {
1021	return ""
1022    }
1023
1024    unset data(sourceRow)
1025    bind [winfo toplevel $win] <Escape> $data(topEscBinding)
1026    $data(body) configure -cursor $data(-cursor)
1027    place forget $data(rowGap)
1028}
1029
1030#------------------------------------------------------------------------------
1031# tablelist::beginExtend
1032#
1033# This procedure is typically invoked on shift-button-1 presses in the body of
1034# a tablelist widget or in one of its separators.  It begins the process of
1035# extending a selection in the widget.  Its exact behavior depends on the
1036# selection mode currently in effect for the widget.
1037#------------------------------------------------------------------------------
1038proc tablelist::beginExtend {win row col} {
1039    if {[string compare [::$win cget -selectmode] "extended"] != 0} {
1040	return ""
1041    }
1042
1043    if {[::$win selection includes anchor]} {
1044	motion $win $row $col
1045    } else {
1046	beginSelect $win $row $col
1047    }
1048}
1049
1050#------------------------------------------------------------------------------
1051# tablelist::beginToggle
1052#
1053# This procedure is typically invoked on control-button-1 presses in the body
1054# of a tablelist widget or in one of its separators.  It begins the process of
1055# toggling a selection in the widget.  Its exact behavior depends on the
1056# selection mode currently in effect for the widget.
1057#------------------------------------------------------------------------------
1058proc tablelist::beginToggle {win row col} {
1059    upvar ::tablelist::ns${win}::data data
1060    if {[string compare $data(-selectmode) "extended"] != 0} {
1061	return ""
1062    }
1063
1064    variable priv
1065    switch $data(-selecttype) {
1066	row {
1067	    set priv(selection) [::$win curselection]
1068	    set priv(prevRow) $row
1069	    ::$win selection anchor $row
1070	    if {[::$win selection includes $row]} {
1071		::$win selection clear $row
1072	    } else {
1073		::$win selection set $row
1074	    }
1075	}
1076
1077	cell {
1078	    set priv(selection) [::$win curcellselection]
1079	    set priv(prevRow) $row
1080	    set priv(prevCol) $col
1081	    ::$win cellselection anchor $row,$col
1082	    if {[::$win cellselection includes $row,$col]} {
1083		::$win cellselection clear $row,$col
1084	    } else {
1085		::$win cellselection set $row,$col
1086	    }
1087	}
1088    }
1089
1090    event generate $win <<TablelistSelect>>
1091}
1092
1093#------------------------------------------------------------------------------
1094# tablelist::condEditActiveCell
1095#
1096# This procedure is invoked whenever Return or KP_Enter is pressed in the body
1097# of a tablelist widget.  If the selection type is cell and the active cell is
1098# editable then the procedure starts the interactive editing in that cell.
1099#------------------------------------------------------------------------------
1100proc tablelist::condEditActiveCell win {
1101    upvar ::tablelist::ns${win}::data data
1102    if {[string compare $data(-selecttype) "cell"] != 0 ||
1103	[firstVisibleRow $win] < 0 || [firstVisibleCol $win] < 0} {
1104	return ""
1105    }
1106
1107    set row $data(activeRow)
1108    set col $data(activeCol)
1109    if {[isCellEditable $win $row $col]} {
1110	doEditCell $win $row $col 0
1111    }
1112}
1113
1114#------------------------------------------------------------------------------
1115# tablelist::nextPrevCell
1116#
1117# Does nothing unless the selection type is cell; in this case it moves the
1118# location cursor (active element) to the next or previous element, and changes
1119# the selection if we are in browse or extended selection mode.
1120#------------------------------------------------------------------------------
1121proc tablelist::nextPrevCell {win amount} {
1122    upvar ::tablelist::ns${win}::data data
1123    switch $data(-selecttype) {
1124	row {
1125	    # Nothing
1126	}
1127
1128	cell {
1129	    if {$data(editRow) >= 0} {
1130		return -code break ""
1131	    }
1132
1133	    set row $data(activeRow)
1134	    set col $data(activeCol)
1135	    set oldRow $row
1136	    set oldCol $col
1137
1138	    while 1 {
1139		incr col $amount
1140		if {$col < 0} {
1141		    incr row $amount
1142		    if {$row < 0} {
1143			set row $data(lastRow)
1144		    }
1145		    set col $data(lastCol)
1146		} elseif {$col > $data(lastCol)} {
1147		    incr row $amount
1148		    if {$row > $data(lastRow)} {
1149			set row 0
1150		    }
1151		    set col 0
1152		}
1153
1154		if {$row == $oldRow && $col == $oldCol} {
1155		    return -code break ""
1156		} elseif {![doRowCget $row $win -hide] && !$data($col-hide)} {
1157		    condChangeSelection $win $row $col
1158		    return -code break ""
1159		}
1160	    }
1161	}
1162    }
1163}
1164
1165#------------------------------------------------------------------------------
1166# tablelist::upDown
1167#
1168# Moves the location cursor (active item or element) up or down by one line,
1169# and changes the selection if we are in browse or extended selection mode.
1170#------------------------------------------------------------------------------
1171proc tablelist::upDown {win amount} {
1172    upvar ::tablelist::ns${win}::data data
1173    if {$data(editRow) >= 0} {
1174	return ""
1175    }
1176
1177    switch $data(-selecttype) {
1178	row {
1179	    set row $data(activeRow)
1180	    set col -1
1181	}
1182
1183	cell {
1184	    set row $data(activeRow)
1185	    set col $data(activeCol)
1186	}
1187    }
1188
1189    while 1 {
1190	incr row $amount
1191	if {$row < 0 || $row > $data(lastRow)} {
1192	    return ""
1193	} elseif {![doRowCget $row $win -hide]} {
1194	    condChangeSelection $win $row $col
1195	    return ""
1196	}
1197    }
1198}
1199
1200#------------------------------------------------------------------------------
1201# tablelist::leftRight
1202#
1203# If the tablelist widget's selection type is "row" then this procedure scrolls
1204# the widget's view left or right by the width of the character "0".  Otherwise
1205# it moves the location cursor (active element) left or right by one column,
1206# and changes the selection if we are in browse or extended selection mode.
1207#------------------------------------------------------------------------------
1208proc tablelist::leftRight {win amount} {
1209    upvar ::tablelist::ns${win}::data data
1210    switch $data(-selecttype) {
1211	row {
1212	    ::$win xview scroll $amount units
1213	}
1214
1215	cell {
1216	    if {$data(editRow) >= 0} {
1217		return ""
1218	    }
1219
1220	    set row $data(activeRow)
1221	    set col $data(activeCol)
1222	    while 1 {
1223		incr col $amount
1224		if {$col < 0 || $col > $data(lastCol)} {
1225		    return ""
1226		} elseif {!$data($col-hide)} {
1227		    condChangeSelection $win $row $col
1228		    return ""
1229		}
1230	    }
1231	}
1232    }
1233}
1234
1235#------------------------------------------------------------------------------
1236# tablelist::priorNext
1237#
1238# Scrolls the tablelist view up or down by one page.
1239#------------------------------------------------------------------------------
1240proc tablelist::priorNext {win amount} {
1241    upvar ::tablelist::ns${win}::data data
1242    if {$data(editRow) >= 0} {
1243	return ""
1244    }
1245
1246    ::$win yview scroll $amount pages
1247    ::$win activate @0,0
1248}
1249
1250#------------------------------------------------------------------------------
1251# tablelist::homeEnd
1252#
1253# If selecttype is row then the procedure scrolls the tablelist widget
1254# horizontally to its left or right edge.  Otherwise it sets the location
1255# cursor (active element) to the first/last element of the active row, selects
1256# that element, and deselects everything else in the widget.
1257#------------------------------------------------------------------------------
1258proc tablelist::homeEnd {win key} {
1259    upvar ::tablelist::ns${win}::data data
1260    switch $data(-selecttype) {
1261	row {
1262	    switch $key {
1263		Home { ::$win xview moveto 0 }
1264		End  { ::$win xview moveto 1 }
1265	    }
1266	}
1267
1268	cell {
1269	    set row $data(activeRow)
1270	    switch $key {
1271		Home { set col [firstVisibleCol $win] }
1272		End  { set col [ lastVisibleCol $win] }
1273	    }
1274	    changeSelection $win $row $col
1275	}
1276    }
1277}
1278
1279#------------------------------------------------------------------------------
1280# tablelist::firstLast
1281#
1282# Sets the location cursor (active item or element) to the first/last item or
1283# element in the tablelist widget, selects that item or element, and deselects
1284# everything else in the widget.
1285#------------------------------------------------------------------------------
1286proc tablelist::firstLast {win target} {
1287    switch $target {
1288	first {
1289	    set row [firstVisibleRow $win]
1290	    set col [firstVisibleCol $win]
1291	}
1292
1293	last {
1294	    set row [lastVisibleRow $win]
1295	    set col [lastVisibleCol $win]
1296	}
1297    }
1298
1299    changeSelection $win $row $col
1300}
1301
1302#------------------------------------------------------------------------------
1303# tablelist::extendUpDown
1304#
1305# Does nothing unless we are in extended selection mode; in this case it moves
1306# the location cursor (active item or element) up or down by one line, and
1307# extends the selection to that point.
1308#------------------------------------------------------------------------------
1309proc tablelist::extendUpDown {win amount} {
1310    upvar ::tablelist::ns${win}::data data
1311    if {[string compare $data(-selectmode) "extended"] != 0} {
1312	return ""
1313    }
1314
1315    switch $data(-selecttype) {
1316	row {
1317	    set row $data(activeRow)
1318	    while 1 {
1319		incr row $amount
1320		if {$row < 0 || $row > $data(lastRow)} {
1321		    return ""
1322		} elseif {![doRowCget $row $win -hide]} {
1323		    ::$win activate $row
1324		    ::$win see active
1325		    motion $win $data(activeRow) -1
1326		    return ""
1327		}
1328	    }
1329	}
1330
1331	cell {
1332	    set row $data(activeRow)
1333	    set col $data(activeCol)
1334	    while 1 {
1335		incr row $amount
1336		if {$row < 0 || $row > $data(lastRow)} {
1337		    return ""
1338		} elseif {![doRowCget $row $win -hide]} {
1339		    ::$win activatecell $row,$col
1340		    ::$win seecell active
1341		    motion $win $data(activeRow) $data(activeCol)
1342		    return ""
1343		}
1344	    }
1345	}
1346    }
1347}
1348
1349#------------------------------------------------------------------------------
1350# tablelist::extendLeftRight
1351#
1352# Does nothing unless we are in extended selection mode and the selection type
1353# is cell; in this case it moves the location cursor (active element) left or
1354# right by one column, and extends the selection to that point.
1355#------------------------------------------------------------------------------
1356proc tablelist::extendLeftRight {win amount} {
1357    upvar ::tablelist::ns${win}::data data
1358    if {[string compare $data(-selectmode) "extended"] != 0} {
1359	return ""
1360    }
1361
1362    switch $data(-selecttype) {
1363	row {
1364	    # Nothing
1365	}
1366
1367	cell {
1368	    set row $data(activeRow)
1369	    set col $data(activeCol)
1370	    while 1 {
1371		incr col $amount
1372		if {$col < 0 || $col > $data(lastCol)} {
1373		    return ""
1374		} elseif {!$data($col-hide)} {
1375		    ::$win activatecell $row,$col
1376		    ::$win seecell active
1377		    motion $win $data(activeRow) $data(activeCol)
1378		    return ""
1379		}
1380	    }
1381	}
1382    }
1383}
1384
1385#------------------------------------------------------------------------------
1386# tablelist::extendToHomeEnd
1387#
1388# Does nothing unless the selection mode is multiple or extended and the
1389# selection type is cell; in this case it moves the location cursor (active
1390# element) to the first/last element of the active row, and, if we are in
1391# extended mode, it extends the selection to that point.
1392#------------------------------------------------------------------------------
1393proc tablelist::extendToHomeEnd {win key} {
1394    upvar ::tablelist::ns${win}::data data
1395    switch $data(-selecttype) {
1396	row {
1397	    # Nothing
1398	}
1399
1400	cell {
1401	    set row $data(activeRow)
1402	    switch $key {
1403		Home { set col [firstVisibleCol $win] }
1404		End  { set col [ lastVisibleCol $win] }
1405	    }
1406
1407	    switch -- $data(-selectmode) {
1408		multiple {
1409		    ::$win activatecell $row,$col
1410		    ::$win seecell $row,$col
1411		}
1412		extended {
1413		    ::$win activatecell $row,$col
1414		    ::$win seecell $row,$col
1415		    if {[::$win selection includes anchor]} {
1416			motion $win $row $col
1417		    }
1418		}
1419	    }
1420	}
1421    }
1422}
1423
1424#------------------------------------------------------------------------------
1425# tablelist::extendToFirstLast
1426#
1427# Does nothing unless the selection mode is multiple or extended; in this case
1428# it moves the location cursor (active item or element) to the first/last item
1429# or element in the tablelist widget, and, if we are in extended mode, it
1430# extends the selection to that point.
1431#------------------------------------------------------------------------------
1432proc tablelist::extendToFirstLast {win target} {
1433    switch $target {
1434	first {
1435	    set row [firstVisibleRow $win]
1436	    set col [firstVisibleCol $win]
1437	}
1438
1439	last {
1440	    set row [lastVisibleRow $win]
1441	    set col [lastVisibleCol $win]
1442	}
1443    }
1444
1445    upvar ::tablelist::ns${win}::data data
1446    switch $data(-selecttype) {
1447	row {
1448	    switch -- $data(-selectmode) {
1449		multiple {
1450		    ::$win activate $row
1451		    ::$win see $row
1452		}
1453		extended {
1454		    ::$win activate $row
1455		    ::$win see $row
1456		    if {[::$win selection includes anchor]} {
1457			motion $win $row -1
1458		    }
1459		}
1460	    }
1461	}
1462
1463	cell {
1464	    switch -- $data(-selectmode) {
1465		multiple {
1466		    ::$win activatecell $row,$col
1467		    ::$win seecell $row,$col
1468		}
1469		extended {
1470		    ::$win activatecell $row,$col
1471		    ::$win seecell $row,$col
1472		    if {[::$win selection includes anchor]} {
1473			motion $win $row $col
1474		    }
1475		}
1476	    }
1477	}
1478    }
1479}
1480
1481#------------------------------------------------------------------------------
1482# tablelist::cancelSelection
1483#
1484# This procedure is invoked to cancel an extended selection in progress.  If
1485# there is an extended selection in progress, it restores all of the items or
1486# elements between the active one and the anchor to their previous selection
1487# state.
1488#------------------------------------------------------------------------------
1489proc tablelist::cancelSelection win {
1490    upvar ::tablelist::ns${win}::data data
1491    if {[string compare $data(-selectmode) "extended"] != 0} {
1492	return ""
1493    }
1494
1495    variable priv
1496    switch $data(-selecttype) {
1497	row {
1498	    set first $data(anchorRow)
1499	    set last $priv(prevRow)
1500	    if {[string compare $last ""] == 0} {
1501		return ""
1502	    }
1503
1504	    if {$last < $first} {
1505		set tmp $first
1506		set first $last
1507		set last $tmp
1508	    }
1509
1510	    ::$win selection clear $first $last
1511	    for {set row $first} {$row <= $last} {incr row} {
1512		if {[lsearch -exact $priv(selection) $row] >= 0} {
1513		    ::$win selection set $row
1514		}
1515	    }
1516	    event generate $win <<TablelistSelect>>
1517	}
1518
1519	cell {
1520	    set firstRow $data(anchorRow)
1521	    set firstCol $data(anchorCol)
1522	    set lastRow $priv(prevRow)
1523	    set lastCol $priv(prevCol)
1524	    if {[string compare $lastRow ""] == 0 ||
1525		[string compare $lastCol ""] == 0} {
1526		return ""
1527	    }
1528
1529	    if {$lastRow < $firstRow} {
1530		set tmp $firstRow
1531		set firstRow $lastRow
1532		set lastRow $tmp
1533	    }
1534	    if {$lastCol < $firstCol} {
1535		set tmp $firstCol
1536		set firstCol $lastCol
1537		set lastCol $tmp
1538	    }
1539
1540	    ::$win cellselection clear $firstRow,$firstCol $lastRow,$lastCol
1541	    for {set row $firstRow} {$row <= $lastRow} {incr row} {
1542		for {set col $firstCol} {$col <= $lastCol} {incr col} {
1543		    if {[lsearch -exact $priv(selection) $row,$col] >= 0} {
1544			::$win cellselection set $row,$col
1545		    }
1546		}
1547	    }
1548	    event generate $win <<TablelistSelect>>
1549	}
1550    }
1551}
1552
1553#------------------------------------------------------------------------------
1554# tablelist::selectAll
1555#
1556# This procedure is invoked to handle the "select all" operation.  For single
1557# and browse mode, it just selects the active item or element.  Otherwise it
1558# selects everything in the widget.
1559#------------------------------------------------------------------------------
1560proc tablelist::selectAll win {
1561    upvar ::tablelist::ns${win}::data data
1562    switch $data(-selecttype) {
1563	row {
1564	    if {[string compare $data(-selectmode) "single"] == 0 ||
1565		[string compare $data(-selectmode) "browse"] == 0} {
1566		::$win selection clear 0 end
1567		::$win selection set active
1568	    } else {
1569		::$win selection set 0 end
1570	    }
1571	}
1572
1573	cell {
1574	    if {[string compare $data(-selectmode) "single"] == 0 ||
1575		[string compare $data(-selectmode) "browse"] == 0} {
1576		::$win cellselection clear 0,0 end
1577		::$win cellselection set active
1578	    } else {
1579		::$win cellselection set 0,0 end
1580	    }
1581	}
1582    }
1583
1584    event generate $win <<TablelistSelect>>
1585}
1586
1587#------------------------------------------------------------------------------
1588# tablelist::firstVisibleRow
1589#
1590# Returns the index of the first non-hidden row of the tablelist widget win.
1591#------------------------------------------------------------------------------
1592proc tablelist::firstVisibleRow win {
1593    upvar ::tablelist::ns${win}::data data
1594    for {set row 0} {$row < $data(itemCount)} {incr row} {
1595	if {![doRowCget $row $win -hide]} {
1596	    return $row
1597	}
1598    }
1599
1600    return -1
1601}
1602
1603#------------------------------------------------------------------------------
1604# tablelist::lastVisibleRow
1605#
1606# Returns the index of the last non-hidden row of the tablelist widget win.
1607#------------------------------------------------------------------------------
1608proc tablelist::lastVisibleRow win {
1609    upvar ::tablelist::ns${win}::data data
1610    for {set row $data(lastRow)} {$row >= 0} {incr row -1} {
1611	if {![doRowCget $row $win -hide]} {
1612	    return $row
1613	}
1614    }
1615
1616    return -1
1617}
1618
1619#------------------------------------------------------------------------------
1620# tablelist::firstVisibleCol
1621#
1622# Returns the index of the first non-hidden column of the tablelist widget win.
1623#------------------------------------------------------------------------------
1624proc tablelist::firstVisibleCol win {
1625    upvar ::tablelist::ns${win}::data data
1626    for {set col 0} {$col < $data(colCount)} {incr col} {
1627	if {!$data($col-hide)} {
1628	    return $col
1629	}
1630    }
1631
1632    return -1
1633}
1634
1635#------------------------------------------------------------------------------
1636# tablelist::lastVisibleCol
1637#
1638# Returns the index of the last non-hidden column of the tablelist widget win.
1639#------------------------------------------------------------------------------
1640proc tablelist::lastVisibleCol win {
1641    upvar ::tablelist::ns${win}::data data
1642    for {set col $data(lastCol)} {$col >= 0} {incr col -1} {
1643	if {!$data($col-hide)} {
1644	    return $col
1645	}
1646    }
1647
1648    return -1
1649}
1650
1651#------------------------------------------------------------------------------
1652# tablelist::condChangeSelection
1653#
1654# Activates the given item or element, and selects it exclusively if we are in
1655# browse or extended selection mode.
1656#------------------------------------------------------------------------------
1657proc tablelist::condChangeSelection {win row col} {
1658    upvar ::tablelist::ns${win}::data data
1659    switch $data(-selecttype) {
1660	row {
1661	    ::$win activate $row
1662	    ::$win see active
1663
1664	    switch -- $data(-selectmode) {
1665		browse {
1666		    ::$win selection clear 0 end
1667		    ::$win selection set active
1668		    event generate $win <<TablelistSelect>>
1669		}
1670		extended {
1671		    ::$win selection clear 0 end
1672		    ::$win selection set active
1673		    ::$win selection anchor active
1674		    variable priv
1675		    set priv(selection) {}
1676		    set priv(prevRow) $data(activeRow)
1677		    event generate $win <<TablelistSelect>>
1678		}
1679	    }
1680	}
1681
1682	cell {
1683	    ::$win activatecell $row,$col
1684	    ::$win seecell active
1685
1686	    switch -- $data(-selectmode) {
1687		browse {
1688		    ::$win cellselection clear 0,0 end
1689		    ::$win cellselection set active
1690		    event generate $win <<TablelistSelect>>
1691		}
1692		extended {
1693		    ::$win cellselection clear 0,0 end
1694		    ::$win cellselection set active
1695		    ::$win cellselection anchor active
1696		    variable priv
1697		    set priv(selection) {}
1698		    set priv(prevRow) $data(activeRow)
1699		    set priv(prevCol) $data(activeCol)
1700		    event generate $win <<TablelistSelect>>
1701		}
1702	    }
1703	}
1704    }
1705}
1706
1707#------------------------------------------------------------------------------
1708# tablelist::changeSelection
1709#
1710# Activates the given item or element and selects it exclusively.
1711#------------------------------------------------------------------------------
1712proc tablelist::changeSelection {win row col} {
1713    upvar ::tablelist::ns${win}::data data
1714    switch $data(-selecttype) {
1715	row {
1716	    ::$win activate $row
1717	    ::$win see active
1718
1719	    ::$win selection clear 0 end
1720	    ::$win selection set active
1721	}
1722
1723	cell {
1724	    ::$win activatecell $row,$col
1725	    ::$win seecell active
1726
1727	    ::$win cellselection clear 0,0 end
1728	    ::$win cellselection set active
1729	}
1730    }
1731
1732    event generate $win <<TablelistSelect>>
1733}
1734
1735#
1736# Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow
1737# ==================================================================
1738#
1739
1740#------------------------------------------------------------------------------
1741# tablelist::defineTablelistSubLabel
1742#
1743# Defines the binding tag TablelistSubLabel (for sublabels of tablelist labels)
1744# to have the same events as TablelistLabel and the binding scripts obtained
1745# from those of TablelistLabel by replacing the widget %W with the containing
1746# label as well as the %x and %y fields with the corresponding coordinates
1747# relative to that label.
1748#------------------------------------------------------------------------------
1749proc tablelist::defineTablelistSubLabel {} {
1750    foreach event [bind TablelistLabel] {
1751	set script [strMap {
1752	    "%W" "$tablelist::W"  "%x" "$tablelist::x"  "%y" "$tablelist::y"
1753	} [bind TablelistLabel $event]]
1754
1755	bind TablelistSubLabel $event [format {
1756	    set tablelist::W \
1757		[string range %%W 0 [expr {[string length %%W] - 4}]]
1758	    set tablelist::x \
1759		[expr {%%x + [winfo x %%W] - [winfo x $tablelist::W]}]
1760	    set tablelist::y \
1761		[expr {%%y + [winfo y %%W] - [winfo y $tablelist::W]}]
1762	    %s
1763	} $script]
1764    }
1765}
1766
1767#------------------------------------------------------------------------------
1768# tablelist::defineTablelistArrow
1769#
1770# Defines the binding tag TablelistArrow (for sort arrows) to have the same
1771# events as TablelistLabel and the binding scripts obtained from those of
1772# TablelistLabel by replacing the widget %W with the containing label as well
1773# as the %x and %y fields with the corresponding coordinates relative to that
1774# label.
1775#------------------------------------------------------------------------------
1776proc tablelist::defineTablelistArrow {} {
1777    foreach event [bind TablelistLabel] {
1778	set script [strMap {
1779	    "%W" "$tablelist::W"  "%x" "$tablelist::x"  "%y" "$tablelist::y"
1780	} [bind TablelistLabel $event]]
1781
1782	bind TablelistArrow $event [format {
1783	    set tablelist::W \
1784		[winfo parent %%W].l[string range [winfo name %%W] 1 end]
1785	    set tablelist::x \
1786		[expr {%%x + [winfo x %%W] - [winfo x $tablelist::W]}]
1787	    set tablelist::y \
1788		[expr {%%y + [winfo y %%W] - [winfo y $tablelist::W]}]
1789	    %s
1790	} $script]
1791    }
1792}
1793
1794#------------------------------------------------------------------------------
1795# tablelist::labelEnter
1796#
1797# This procedure is invoked when the mouse pointer enters the header label w of
1798# a tablelist widget, or is moving within that label.  It updates the cursor,
1799# displays the tooltip, and activates or deactivates the label, depending on
1800# whether the pointer is on its right border or not.
1801#------------------------------------------------------------------------------
1802proc tablelist::labelEnter {w X Y x} {
1803    parseLabelPath $w win col
1804    upvar ::tablelist::ns${win}::data data
1805    configLabel $w -cursor $data(-cursor)
1806
1807    if {[string compare $data(-tooltipaddcommand) ""] != 0 &&
1808	[string compare $data(-tooltipdelcommand) ""] != 0 &&
1809	$col != $data(prevCol)} {
1810	#
1811	# Display the tooltip corresponding to this label
1812	#
1813	set data(prevCol) $col
1814	set focus [focus -displayof $win]
1815	if {[string compare $focus ""] == 0 ||
1816	    [string first $win $focus] != 0 ||
1817	    [string compare [winfo toplevel $focus] \
1818	     [winfo toplevel $win]] == 0} {
1819	    uplevel #0 $data(-tooltipaddcommand) [list $win -1 $col]
1820	    event generate $win <Enter> -rootx $X -rooty $Y
1821	}
1822    }
1823
1824    if {$data(isDisabled)} {
1825	return ""
1826    }
1827
1828    if {$x >= [winfo width $w] - 5} {
1829	set inResizeArea 1
1830	set col2 $col
1831    } elseif {$x < 5} {
1832	set X [expr {[winfo rootx $w] - 3}]
1833	set contW [winfo containing -displayof $w $X [winfo rooty $w]]
1834	set inResizeArea [parseLabelPath $contW dummy col2]
1835    } else {
1836	set inResizeArea 0
1837    }
1838
1839    if {$inResizeArea && $data(-resizablecolumns) && $data($col2-resizable)} {
1840	configLabel $w -cursor $data(-resizecursor)
1841	configLabel $w -active 0
1842    } else {
1843	configLabel $w -active 1
1844    }
1845}
1846
1847#------------------------------------------------------------------------------
1848# tablelist::labelLeave
1849#
1850# This procedure is invoked when the mouse pointer leaves the header label w of
1851# a tablelist widget.  It removes the tooltip and deactivates the label.
1852#------------------------------------------------------------------------------
1853proc tablelist::labelLeave {w X x y} {
1854    parseLabelPath $w win col
1855    upvar ::tablelist::ns${win}::data data
1856
1857    #
1858    # The following code is needed because the event
1859    # can also occur in a widget placed into the label
1860    #
1861    set hdrX [winfo rootx $data(hdr)]
1862    if {$X >= $hdrX && $X < $hdrX + [winfo width $data(hdr)] &&
1863	$x >= 1 && $x < [winfo width $w] - 1 &&
1864	$y >= 0 && $y < [winfo height $w]} {
1865	return ""
1866    }
1867
1868    if {[string compare $data(-tooltipaddcommand) ""] != 0 &&
1869	[string compare $data(-tooltipdelcommand) ""] != 0} {
1870	#
1871	# Remove the tooltip, if any
1872	#
1873	event generate $win <Leave>
1874	catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
1875	set data(prevCol) -1
1876    }
1877
1878    if {$data(isDisabled)} {
1879	return ""
1880    }
1881
1882    configLabel $w -active 0
1883}
1884
1885#------------------------------------------------------------------------------
1886# tablelist::labelB1Down
1887#
1888# This procedure is invoked when mouse button 1 is pressed in the header label
1889# w of a tablelist widget.  If the pointer is on the right border of the label
1890# then the procedure records its x-coordinate relative to the label, the width
1891# of the column, and some other data needed later.  Otherwise it saves the
1892# label's relief so it can be restored later, and changes the relief to sunken.
1893#------------------------------------------------------------------------------
1894proc tablelist::labelB1Down {w x shiftPressed} {
1895    parseLabelPath $w win col
1896    upvar ::tablelist::ns${win}::data data
1897    if {$data(isDisabled) ||
1898	[info exists data(colBeingResized)]} {	;# resize operation in progress
1899	return ""
1900    }
1901
1902    set data(labelClicked) 1
1903    set data(X) [expr {[winfo rootx $w] + $x}]
1904    set data(shiftPressed) $shiftPressed
1905
1906    if {$x >= [winfo width $w] - 5} {
1907	set inResizeArea 1
1908	set col2 $col
1909    } elseif {$x < 5} {
1910	set X [expr {[winfo rootx $w] - 3}]
1911	set contW [winfo containing -displayof $w $X [winfo rooty $w]]
1912	set inResizeArea [parseLabelPath $contW dummy col2]
1913    } else {
1914	set inResizeArea 0
1915    }
1916
1917    if {$inResizeArea && $data(-resizablecolumns) && $data($col2-resizable)} {
1918	set data(colBeingResized) $col2
1919
1920	set w $data(body)
1921	set topTextIdx [$w index @0,0]
1922	set btmTextIdx [$w index @0,[expr {[winfo height $w] - 1}]]
1923	$w tag add visibleLines "$topTextIdx linestart" "$btmTextIdx lineend"
1924	set data(topRow) [expr {int($topTextIdx) - 1}]
1925	set data(btmRow) [expr {int($btmTextIdx) - 1}]
1926
1927	set w $data(hdrTxtFrLbl)$col2
1928	set labelWidth [winfo width $w]
1929	set data(oldStretchedColWidth) [expr {$labelWidth - 2*$data(charWidth)}]
1930	set data(oldColDelta) $data($col2-delta)
1931	set data(configColWidth) [lindex $data(-columns) [expr {3*$col2}]]
1932
1933	if {[lsearch -exact $data(arrowColList) $col2] >= 0} {
1934	    set canvasWidth $data(arrowWidth)
1935	    if {[llength $data(arrowColList)] > 1} {
1936		incr canvasWidth 6
1937	    }
1938	    set data(minColWidth) $canvasWidth
1939	} elseif {$data($col2-wrap)} {
1940	    set data(minColWidth) $data(charWidth)
1941	} else {
1942	    set data(minColWidth) 0
1943	}
1944	incr data(minColWidth)
1945
1946	set data(focus) [focus -displayof $win]
1947	set topWin [winfo toplevel $win]
1948	focus $topWin
1949	set data(topEscBinding) [bind $topWin <Escape>]
1950	bind $topWin <Escape> \
1951	     [list tablelist::escape [strMap {"%" "%%"} $win] $col2]
1952    } else {
1953	set data(inClickedLabel) 1
1954	set data(relief) [$w cget -relief]
1955
1956	if {[info exists data($col-labelcommand)] ||
1957	    [string compare $data(-labelcommand) ""] != 0} {
1958	    set data(changeRelief) 1
1959	    configLabel $w -relief sunken -pressed 1
1960	} else {
1961	    set data(changeRelief) 0
1962	}
1963
1964	if {$data(-movablecolumns)} {
1965	    set data(focus) [focus -displayof $win]
1966	    set topWin [winfo toplevel $win]
1967	    focus $topWin
1968	    set data(topEscBinding) [bind $topWin <Escape>]
1969	    bind $topWin <Escape> \
1970		 [list tablelist::escape [strMap {"%" "%%"} $win] $col]
1971	}
1972    }
1973}
1974
1975#------------------------------------------------------------------------------
1976# tablelist::labelB1Motion
1977#
1978# This procedure is invoked to process mouse motion events in the header label
1979# w of a tablelist widget while button 1 is down.  If this event occured during
1980# a column resize operation then the procedure computes the difference between
1981# the pointer's new x-coordinate relative to that label and the one recorded by
1982# the last invocation of labelB1Down, and adjusts the width of the
1983# corresponding column accordingly.  Otherwise a horizontal scrolling is
1984# performed if needed, and the would-be target position of the clicked label is
1985# visualized if the columns are movable.
1986#------------------------------------------------------------------------------
1987proc tablelist::labelB1Motion {w X x y} {
1988    parseLabelPath $w win col
1989    upvar ::tablelist::ns${win}::data data
1990    if {!$data(labelClicked)} {
1991	return ""
1992    }
1993
1994    if {[info exists data(colBeingResized)]} {	;# resize operation in progress
1995	set width [expr {$data(oldStretchedColWidth) + $X - $data(X)}]
1996	if {$width >= $data(minColWidth)} {
1997	    set col $data(colBeingResized)
1998	    set idx [expr {3*$col}]
1999	    set data(-columns) [lreplace $data(-columns) $idx $idx -$width]
2000	    set idx [expr {2*$col}]
2001	    set data(colList) [lreplace $data(colList) $idx $idx $width]
2002	    set data($col-lastStaticWidth) $width
2003	    set data($col-delta) 0
2004	    redisplayCol $win $col $data(topRow) $data(btmRow)
2005
2006	    #
2007	    # Handle the case that the bottom row has become
2008	    # greater (due to the redisplayCol invocation)
2009	    #
2010	    set b $data(body)
2011	    set btmY [expr {[winfo height $b] - 1}]
2012	    set btmTextIdx [$b index @0,$btmY]
2013	    set btmRow [expr {int($btmTextIdx) - 1}]
2014	    while {$btmRow > $data(btmRow)} {
2015		$b tag add visibleLines [expr {double($data(btmRow) + 2)}] \
2016					"$btmTextIdx lineend"
2017		incr data(btmRow)
2018		redisplayCol $win $col $data(btmRow) $btmRow
2019		set data(btmRow) $btmRow
2020
2021		set btmTextIdx [$b index @0,$btmY]
2022		set btmRow [expr {int($btmTextIdx) - 1}]
2023	    }
2024
2025	    #
2026	    # Handle the case that the top row has become
2027	    # less (due to the redisplayCol invocation)
2028	    #
2029	    set topTextIdx [$b index @0,0]
2030	    set topRow [expr {int($topTextIdx) - 1}]
2031	    while {$topRow < $data(topRow)} {
2032		$b tag add visibleLines "$topTextIdx linestart" \
2033					"[expr {double($data(topRow))}] lineend"
2034		incr data(topRow) -1
2035		redisplayCol $win $col $topRow $data(topRow)
2036		set data(topRow) $topRow
2037
2038		set topTextIdx [$b index @0,0]
2039		set topRow [expr {int($topTextIdx) - 1}]
2040	    }
2041
2042	    adjustColumns $win {} 0
2043	    adjustElidedText $win
2044	    updateVScrlbarWhenIdle $win
2045	}
2046    } else {
2047	#
2048	# Scroll the window horizontally if needed
2049	#
2050	set hdrX [winfo rootx $data(hdr)]
2051	if {$data(-titlecolumns) == 0 || ![winfo viewable $data(sep)]} {
2052	    set leftX $hdrX
2053	} else {
2054	    set leftX [expr {[winfo rootx $data(sep)] + 1}]
2055	}
2056	set rightX [expr {$hdrX + [winfo width $data(hdr)]}]
2057	set scroll 0
2058	if {($X >= $rightX && $data(X) < $rightX) ||
2059	    ($X < $leftX && $data(X) >= $leftX)} {
2060	    set scroll 1
2061	} elseif {($X < $rightX && $data(X) >= $rightX) ||
2062		  ($X >= $leftX && $data(X) < $leftX)} {
2063	    after cancel $data(afterId)
2064	    set data(afterId) ""
2065	}
2066	set data(X) $X
2067	if {$scroll} {
2068	    horizAutoScan $win
2069	}
2070
2071	if {$x >= 1 && $x < [winfo width $w] - 1 &&
2072	    $y >= 0 && $y < [winfo height $w]} {
2073	    #
2074	    # The following code is needed because the event
2075	    # can also occur in a widget placed into the label
2076	    #
2077	    set data(inClickedLabel) 1
2078	    configLabel $w -cursor $data(-cursor)
2079	    $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor)
2080	    if {$data(changeRelief)} {
2081		configLabel $w -relief sunken -pressed 1
2082	    }
2083
2084	    place forget $data(colGap)
2085	} else {
2086	    #
2087	    # The following code is needed because the event
2088	    # can also occur in a widget placed into the label
2089	    #
2090	    set data(inClickedLabel) 0
2091	    configLabel $w -relief $data(relief) -pressed 0
2092
2093	    if {$data(-movablecolumns)} {
2094		#
2095		# Get the target column index
2096		#
2097		set contW [winfo containing -displayof $w $X [winfo rooty $w]]
2098		if {[parseLabelPath $contW dummy targetCol]} {
2099		    set master $contW
2100		    if {$X < [winfo rootx $contW] + [winfo width $contW]/2} {
2101			set relx 0.0
2102		    } else {
2103			incr targetCol
2104			set relx 1.0
2105		    }
2106		} elseif {[string compare $contW $data(colGap)] == 0} {
2107		    set targetCol $data(targetCol)
2108		    set master $data(master)
2109		    set relx $data(relx)
2110		} elseif {$X >= $rightX || $X >= [winfo rootx $w]} {
2111		    for {set targetCol $data(lastCol)} {$targetCol >= 0} \
2112			{incr targetCol -1} {
2113			if {!$data($targetCol-hide)} {
2114			    break
2115			}
2116		    }
2117		    incr targetCol
2118		    set master $data(hdrTxtFr)
2119		    set relx 1.0
2120		} else {
2121		    for {set targetCol 0} {$targetCol < $data(colCount)} \
2122			{incr targetCol} {
2123			if {!$data($targetCol-hide)} {
2124			    break
2125			}
2126		    }
2127		    set master $data(hdrTxtFr)
2128		    set relx 0.0
2129		}
2130
2131		#
2132		# Visualize the would-be target position
2133		# of the clicked label if appropriate
2134		#
2135		if {$data(-protecttitlecolumns) &&
2136		    (($col >= $data(-titlecolumns) &&
2137		      $targetCol < $data(-titlecolumns)) ||
2138		     ($col < $data(-titlecolumns) &&
2139		      $targetCol > $data(-titlecolumns)))} {
2140		    set data(targetCol) -1
2141		    configLabel $w -cursor $data(-cursor)
2142		    $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor)
2143		    place forget $data(colGap)
2144		} else {
2145		    set data(targetCol) $targetCol
2146		    set data(master) $master
2147		    set data(relx) $relx
2148		    configLabel $w -cursor $data(-movecolumncursor)
2149		    $data(hdrTxtFrCanv)$col configure -cursor \
2150					    $data(-movecolumncursor)
2151		    place $data(colGap) -in $master -anchor n \
2152					-bordermode outside \
2153					-relheight 1.0 -relx $relx
2154		}
2155	    }
2156	}
2157    }
2158}
2159
2160#------------------------------------------------------------------------------
2161# tablelist::labelB1Enter
2162#
2163# This procedure is invoked when the mouse pointer enters the header label w of
2164# a tablelist widget while mouse button 1 is down.  If the label was not
2165# previously clicked then nothing happens.  Otherwise, if this event occured
2166# during a column resize operation then the procedure updates the mouse cursor
2167# accordingly.  Otherwise it changes the label's relief to sunken.
2168#------------------------------------------------------------------------------
2169proc tablelist::labelB1Enter w {
2170    parseLabelPath $w win col
2171    upvar ::tablelist::ns${win}::data data
2172    if {!$data(labelClicked)} {
2173	return ""
2174    }
2175
2176    configLabel $w -cursor $data(-cursor)
2177
2178    if {[info exists data(colBeingResized)]} {	;# resize operation in progress
2179	configLabel $w -cursor $data(-resizecursor)
2180    } else {
2181	set data(inClickedLabel) 1
2182	if {$data(changeRelief)} {
2183	    configLabel $w -relief sunken -pressed 1
2184	}
2185    }
2186}
2187
2188#------------------------------------------------------------------------------
2189# tablelist::labelB1Leave
2190#
2191# This procedure is invoked when the mouse pointer leaves the header label w of
2192# a tablelist widget while mouse button 1 is down.  If the label was not
2193# previously clicked then nothing happens.  Otherwise, if no column resize
2194# operation is in progress then the procedure restores the label's relief, and,
2195# if the columns are movable, then it changes the mouse cursor, too.
2196#------------------------------------------------------------------------------
2197proc tablelist::labelB1Leave {w x y} {
2198    parseLabelPath $w win col
2199    upvar ::tablelist::ns${win}::data data
2200    if {!$data(labelClicked) ||
2201	[info exists data(colBeingResized)]} {	;# resize operation in progress
2202	return ""
2203    }
2204
2205    #
2206    # The following code is needed because the event
2207    # can also occur in a widget placed into the label
2208    #
2209    if {$x >= 1 && $x < [winfo width $w] - 1 &&
2210	$y >= 0 && $y < [winfo height $w]} {
2211	return ""
2212    }
2213
2214    set data(inClickedLabel) 0
2215    configLabel $w -relief $data(relief) -pressed 0
2216}
2217
2218#------------------------------------------------------------------------------
2219# tablelist::labelB1Up
2220#
2221# This procedure is invoked when mouse button 1 is released, if it was
2222# previously clicked in a label of the tablelist widget win.  If this event
2223# occured during a column resize operation then the procedure redisplays the
2224# column and stretches the stretchable columns.  Otherwise, if the mouse button
2225# was released in the previously clicked label then the procedure restores the
2226# label's relief and invokes the command specified by the -labelcommand or
2227# -labelcommand2 configuration option, passing to it the widget name and the
2228# column number as arguments.  Otherwise the column of the previously clicked
2229# label is moved before the column containing the mouse cursor or to its right,
2230# if the columns are movable.
2231#------------------------------------------------------------------------------
2232proc tablelist::labelB1Up {w X} {
2233    parseLabelPath $w win col
2234    upvar ::tablelist::ns${win}::data data
2235    if {!$data(labelClicked)} {
2236	return ""
2237    }
2238
2239    if {[info exists data(colBeingResized)]} {	;# resize operation in progress
2240	configLabel $w -cursor $data(-cursor)
2241	if {[winfo exists $data(focus)]} {
2242	    focus $data(focus)
2243	}
2244	bind [winfo toplevel $win] <Escape> $data(topEscBinding)
2245	set col $data(colBeingResized)
2246	if {$data(-width) <= 0} {
2247	    $data(hdr) configure -width $data(hdrPixels)
2248	    $data(lb) configure -width \
2249		      [expr {$data(hdrPixels) / $data(charWidth)}]
2250	} elseif {[info exists data(stretchableCols)] &&
2251		  [lsearch -exact $data(stretchableCols) $col] >= 0} {
2252	    set oldColWidth \
2253		[expr {$data(oldStretchedColWidth) - $data(oldColDelta)}]
2254	    set stretchedColWidth \
2255		[expr {$data(oldStretchedColWidth) + $X - $data(X)}]
2256	    if {$oldColWidth < $data(stretchablePixels) &&
2257		$stretchedColWidth >= $data(minColWidth) &&
2258		$stretchedColWidth < $oldColWidth + $data(delta)} {
2259		#
2260		# Compute the new column width, using the following equations:
2261		#
2262		# $colWidth = $stretchedColWidth - $colDelta
2263		# $colDelta / $colWidth =
2264		#    ($data(delta) - $colWidth + $oldColWidth) /
2265		#    ($data(stretchablePixels) + $colWidth - $oldColWidth)
2266		#
2267		set colWidth [expr {
2268		    $stretchedColWidth *
2269		    ($data(stretchablePixels) - $oldColWidth) /
2270		    ($data(stretchablePixels) + $data(delta) -
2271		     $stretchedColWidth)
2272		}]
2273		if {$colWidth < 1} {
2274		    set colWidth 1
2275		}
2276		set idx [expr {3*$col}]
2277		set data(-columns) \
2278		    [lreplace $data(-columns) $idx $idx -$colWidth]
2279		set idx [expr {2*$col}]
2280		set data(colList) [lreplace $data(colList) $idx $idx $colWidth]
2281		set data($col-delta) [expr {$stretchedColWidth - $colWidth}]
2282	    }
2283	}
2284	unset data(colBeingResized)
2285	$data(body) tag delete visibleLines 1.0 end
2286	redisplayCol $win $col 0 end
2287	adjustColumns $win {} 0
2288	stretchColumns $win $col
2289	event generate $win <<TablelistColumnResized>>
2290    } else {
2291	if {[info exists data(X)]} {
2292	    unset data(X)
2293	    after cancel $data(afterId)
2294	    set data(afterId) ""
2295	}
2296    	if {$data(-movablecolumns)} {
2297	    if {[winfo exists $data(focus)]} {
2298		focus $data(focus)
2299	    }
2300	    bind [winfo toplevel $win] <Escape> $data(topEscBinding)
2301	    place forget $data(colGap)
2302	}
2303
2304	if {$data(inClickedLabel)} {
2305	    configLabel $w -relief $data(relief) -pressed 0
2306	    if {$data(shiftPressed)} {
2307		if {[info exists data($col-labelcommand2)]} {
2308		    uplevel #0 $data($col-labelcommand2) [list $win $col]
2309		} elseif {[string compare $data(-labelcommand2) ""] != 0} {
2310		    uplevel #0 $data(-labelcommand2) [list $win $col]
2311		}
2312	    } else {
2313		if {[info exists data($col-labelcommand)]} {
2314		    uplevel #0 $data($col-labelcommand) [list $win $col]
2315		} elseif {[string compare $data(-labelcommand) ""] != 0} {
2316		    uplevel #0 $data(-labelcommand) [list $win $col]
2317		}
2318	    }
2319	} elseif {$data(-movablecolumns)} {
2320	    $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor)
2321	    if {[info exists data(targetCol)] && $data(targetCol) != -1 &&
2322		$data(targetCol) != $col && $data(targetCol) != $col + 1} {
2323		moveCol $win $col $data(targetCol)
2324		event generate $win <<TablelistColumnMoved>>
2325	    }
2326	}
2327    }
2328
2329    set data(labelClicked) 0
2330}
2331
2332#------------------------------------------------------------------------------
2333# tablelist::labelB3Down
2334#
2335# This procedure is invoked when mouse button 3 is pressed in the header label
2336# w of a tablelist widget.  If the Shift key was down when this event occured
2337# then the procedure restores the last static width of the given column;
2338# otherwise it configures the width of the given column to be just large enough
2339# to hold all the elements (including the label).
2340#------------------------------------------------------------------------------
2341proc tablelist::labelB3Down {w shiftPressed} {
2342    parseLabelPath $w win col
2343    upvar ::tablelist::ns${win}::data data
2344    if {!$data(isDisabled) &&
2345	$data(-resizablecolumns) && $data($col-resizable)} {
2346	if {$shiftPressed} {
2347	    doColConfig $col $win -width -$data($col-lastStaticWidth)
2348	} else {
2349	    doColConfig $col $win -width 0
2350	}
2351	event generate $win <<TablelistColumnResized>>
2352    }
2353}
2354
2355#------------------------------------------------------------------------------
2356# tablelist::escape
2357#
2358# This procedure is invoked to process <Escape> events in the top-level window
2359# containing the tablelist widget win during a column resize or move operation.
2360# The procedure cancels the action in progress and, in case of column resizing,
2361# it restores the initial width of the respective column.
2362#------------------------------------------------------------------------------
2363proc tablelist::escape {win col} {
2364    upvar ::tablelist::ns${win}::data data
2365    set w $data(hdrTxtFrLbl)$col
2366    if {[info exists data(colBeingResized)]} {	;# resize operation in progress
2367	configLabel $w -cursor $data(-cursor)
2368	update idletasks
2369	if {[winfo exists $data(focus)]} {
2370	    focus $data(focus)
2371	}
2372	bind [winfo toplevel $win] <Escape> $data(topEscBinding)
2373	set data(labelClicked) 0
2374	set col $data(colBeingResized)
2375	set idx [expr {3*$col}]
2376	setupColumns $win [lreplace $data(-columns) $idx $idx \
2377				    $data(configColWidth)] 0
2378	redisplayCol $win $col $data(topRow) $data(btmRow)
2379	unset data(colBeingResized)
2380	$data(body) tag delete visibleLines 1.0 end
2381	adjustColumns $win {} 1
2382    } elseif {!$data(inClickedLabel)} {
2383	configLabel $w -cursor $data(-cursor)
2384	$data(hdrTxtFrCanv)$col configure -cursor $data(-cursor)
2385	if {[winfo exists $data(focus)]} {
2386	    focus $data(focus)
2387	}
2388	bind [winfo toplevel $win] <Escape> $data(topEscBinding)
2389	place forget $data(colGap)
2390	if {[info exists data(X)]} {
2391	    unset data(X)
2392	    after cancel $data(afterId)
2393	    set data(afterId) ""
2394	}
2395	set data(labelClicked) 0
2396    }
2397}
2398
2399#------------------------------------------------------------------------------
2400# tablelist::horizAutoScan
2401#
2402# This procedure is invoked when the mouse leaves the scrollable part of a
2403# tablelist widget's header frame.  It scrolls the header and reschedules
2404# itself as an after command so that the header continues to scroll until the
2405# mouse moves back into the window or the mouse button is released.
2406#------------------------------------------------------------------------------
2407proc tablelist::horizAutoScan win {
2408    if {![winfo exists $win]} {
2409	return ""
2410    }
2411
2412    upvar ::tablelist::ns${win}::data data
2413    if {![info exists data(X)]} {
2414	return ""
2415    }
2416
2417    set X $data(X)
2418    set hdrX [winfo rootx $data(hdr)]
2419    if {$data(-titlecolumns) == 0 || ![winfo viewable $data(sep)]} {
2420	set leftX $hdrX
2421    } else {
2422	set leftX [expr {[winfo rootx $data(sep)] + 1}]
2423    }
2424    set rightX [expr {$hdrX + [winfo width $data(hdr)]}]
2425    if {$data(-titlecolumns) == 0} {
2426	set units 2
2427	set ms 50
2428    } else {
2429	set units 1
2430	set ms 250
2431    }
2432
2433    if {$X >= $rightX} {
2434	::$win xview scroll $units units
2435    } elseif {$X < $leftX} {
2436	::$win xview scroll -$units units
2437    } else {
2438	return ""
2439    }
2440
2441    set data(afterId) [after $ms [list tablelist::horizAutoScan $win]]
2442}
2443