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