Tk Library Source Code

Check-in [20637f9fa8]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment: * scripts/*.tcl: Added the "-xmousewheelwindow" and "-ymousewheelwindow" configuration options; optimized the deletion of a list of items; improved the performance of the vertical scrolling; eliminated a potential endless loop triggered by key navigation with the "aqua" theme and selection type "cell"; fixed two regressions introduced in Tablelist 6.3, related to (1) the handling of the "-listvariable" option when using Itcl 3.x and (2) clearing the multiple or extended selection; further improvements and minor bug fixes; updated the copyright information.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:20637f9fa82ce72899d6c3e8e4cf824e584e7f00b44c6f9d3f39a7d0f6586c9e
User & Date: csaba 2019-01-07 19:20:55
Context
2019-01-07
19:21
* scripts/tclIndex: Newly generated. check-in: daf5383477 user: csaba tags: trunk
19:20
* scripts/*.tcl: Added the "-xmousewheelwindow" and "-ymousewheelwindow" configuration options; optimized the deletion of a list of items; improved the performance of the vertical scrolling; eliminated a potential endless loop triggered by key navigation with the "aqua" theme and selection type "cell"; fixed two regressions introduced in Tablelist 6.3, related to (1) the handling of the "-listvariable" option when using Itcl 3.x and (2) clearing the multiple or extended selection; further improvements and minor bug fixes; updated the copyright information. check-in: 20637f9fa8 user: csaba tags: trunk
19:19
* CHANGES.txt: Updated to reflect the changes. * doc/*.html: check-in: 142a3c721a user: csaba tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/tablelist/scripts/mwutil.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22




23

24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
..
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
...
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
...
507
508
509
510
511
512
513
































#==============================================================================
# Contains utility procedures for mega-widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedures
#
# Copyright (c) 2000-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8

#
# Namespace initialization
# ========================
#

namespace eval mwutil {
    #
    # Public variables:
    #
    variable version	2.10




    variable library	[file dirname [info script]]


    #
    # Public procedures:
    #
    namespace export	wrongNumArgs getAncestorByClass convEventFields \
			defineKeyNav processTraversal focusNext focusPrev \
			configureWidget fullConfigOpt fullOpt enumOpts \
			configureSubCmd attribSubCmd hasattribSubCmd \
			unsetattribSubCmd getScrollInfo


    #
    # Make modified versions of the procedures tk_focusNext and
    # tk_focusPrev, to be invoked in the processTraversal command
    #
    proc makeFocusProcs {} {
	#
................................................................................
	# Enforce the evaluation of the Tk library file "focus.tcl"
	#
	tk_focusNext .

	#
	# Build the procedures focusNext and focusPrev
	#
	foreach direction {Next Prev} {
	    set procBody [info body tk_focus$direction]
	    regsub -all {winfo children} $procBody {getChildren $class} procBody
	    proc focus$direction {w class} $procBody
	}
    }
    makeFocusProcs 

    #
    # Invoked in the procedures focusNext and focusPrev defined above:
    #
................................................................................
}

#------------------------------------------------------------------------------
# mwutil::processTraversal
#
# Processes the given traversal event for the mega-widget of the specified
# class containing the widget w if that mega-widget is not the only widget
# receiving the focus during keyboard traversal within its top-level widget.
#------------------------------------------------------------------------------
proc mwutil::processTraversal {w class event} {
    set win [getAncestorByClass $w $class]

    if {[string compare $event "<Tab>"] == 0} {
	set target [focusNext $win $class]
    } else {
	set target [focusPrev $win $class]
    }

    if {[string compare $target $win] != 0} {
	set focus [focus]
	if {[string length $focus] != 0} {
	    event generate $focus <<TraverseOut>>
	}

	focus $target
	event generate $target <<TraverseIn>>
    }

    return -code break ""
................................................................................
	} else {
	    return -code error "bad argument \"$what\": must be units or pages"
	}
    } else {
	return -code error "unknown option \"$opt\": must be moveto or scroll"
    }
}







































|













|
>
>
>
>
|
>








|
>







 







|
|

|







 







|











|
|
|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
..
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
...
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
#==============================================================================
# Contains utility procedures for mega-widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedures
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8

#
# Namespace initialization
# ========================
#

namespace eval mwutil {
    #
    # Public variables:
    #
    variable version	2.11
    variable library
    if {$::tcl_version >= 8.4} {
	set library	[file dirname [file normalize [info script]]]
    } else {
	set library	[file dirname [info script]] ;# no "file normalize" yet
    }

    #
    # Public procedures:
    #
    namespace export	wrongNumArgs getAncestorByClass convEventFields \
			defineKeyNav processTraversal focusNext focusPrev \
			configureWidget fullConfigOpt fullOpt enumOpts \
			configureSubCmd attribSubCmd hasattribSubCmd \
			unsetattribSubCmd getScrollInfo hasFocus \
			genMouseWheelEvent

    #
    # Make modified versions of the procedures tk_focusNext and
    # tk_focusPrev, to be invoked in the processTraversal command
    #
    proc makeFocusProcs {} {
	#
................................................................................
	# Enforce the evaluation of the Tk library file "focus.tcl"
	#
	tk_focusNext .

	#
	# Build the procedures focusNext and focusPrev
	#
	foreach dir {Next Prev} {
	    set procBody [info body tk_focus$dir]
	    regsub -all {winfo children} $procBody {getChildren $class} procBody
	    proc focus$dir {w class} $procBody
	}
    }
    makeFocusProcs 

    #
    # Invoked in the procedures focusNext and focusPrev defined above:
    #
................................................................................
}

#------------------------------------------------------------------------------
# mwutil::processTraversal
#
# Processes the given traversal event for the mega-widget of the specified
# class containing the widget w if that mega-widget is not the only widget
# receiving the focus during keyboard traversal within its toplevel widget.
#------------------------------------------------------------------------------
proc mwutil::processTraversal {w class event} {
    set win [getAncestorByClass $w $class]

    if {[string compare $event "<Tab>"] == 0} {
	set target [focusNext $win $class]
    } else {
	set target [focusPrev $win $class]
    }

    if {[string compare $target $win] != 0} {
	set focusWin [focus -displayof $win]
	if {[string length $focusWin] != 0} {
	    event generate $focusWin <<TraverseOut>>
	}

	focus $target
	event generate $target <<TraverseIn>>
    }

    return -code break ""
................................................................................
	} else {
	    return -code error "bad argument \"$what\": must be units or pages"
	}
    } else {
	return -code error "unknown option \"$opt\": must be moveto or scroll"
    }
}

#------------------------------------------------------------------------------
# mwutil::hasFocus
#
# Returns a boolean value indicating whether the focus window is (a descendant
# of) the widget w.
#------------------------------------------------------------------------------
proc mwutil::hasFocus w {
    return [expr {[string first $w. [focus -displayof $w].] == 0}]
}

#------------------------------------------------------------------------------
# mwutil::genMouseWheelEvent
#
# Generates a mouse wheel event with the given root coordinates and delta on
# the widget w.
#------------------------------------------------------------------------------
proc mwutil::genMouseWheelEvent {w event rootX rootY delta} {
    set needsFocus [expr {[package vcompare $::tk_patchLevel "8.6b2"] < 0 &&
	[string compare $::tcl_platform(platform) "windows"] == 0}]

    if {$needsFocus} {
	set focusWin [focus -displayof $w]
	focus $w
    }

    event generate $w $event -rootx $rootX -rooty $rootY -delta $delta

    if {$needsFocus} {
	focus $focusWin
    }
}

Changes to modules/tablelist/scripts/repair.tcl.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# "tablelistSort.tcl", and "tablelistUtil.tcl" by defining the procedure
# "arrElemExists" and replacing all invocations of "[info exists
# <array>(<name>)]" with "[arrElemExists <array> <name>]".  This works around a
# bug in Tcl versions 8.2, 8.3.0 - 8.3.2, and 8.4a1 (fixed in Tcl 8.3.3 and
# 8.4a2), which causes excessive memory use when calling "info exists" on
# non-existent array elements.
#
# Copyright (c) 2001-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

set procDef {
    #
    # The following procedure returns 1 if arrName($name) exists and
    # 0 otherwise.  It is a (partial) replacement for [info exists
    # arrName($name)], which -- due to a bug in Tcl versions 8.2,







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# "tablelistSort.tcl", and "tablelistUtil.tcl" by defining the procedure
# "arrElemExists" and replacing all invocations of "[info exists
# <array>(<name>)]" with "[arrElemExists <array> <name>]".  This works around a
# bug in Tcl versions 8.2, 8.3.0 - 8.3.2, and 8.4a1 (fixed in Tcl 8.3.3 and
# 8.4a2), which causes excessive memory use when calling "info exists" on
# non-existent array elements.
#
# Copyright (c) 2001-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

set procDef {
    #
    # The following procedure returns 1 if arrName($name) exists and
    # 0 otherwise.  It is a (partial) replacement for [info exists
    # arrName($name)], which -- due to a bug in Tcl versions 8.2,

Changes to modules/tablelist/scripts/tablelistBind.tcl.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287
...
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
...
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
...
809
810
811
812
813
814
815




816




817


818

819
820








821


822

823
824
825








826


827

828
829



830




831


832

833
834
835



836




837


838

839
840



841




842



843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867








868



869
870
871
872
873








874



875
876
877
878
879








880



881
882
883
884
885








886



887
888
889
890
891
892
893
....
1025
1026
1027
1028
1029
1030
1031
1032
1033

1034
1035
1036
1037
1038
1039
1040
1041
....
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
....
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
....
2932
2933
2934
2935
2936
2937
2938
2939
2940

2941
2942
2943
2944
2945
2946
2947
2948
....
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
....
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
....
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
#   - Public helper procedures
#   - Binding tag Tablelist
#   - Binding tag TablelistWindow
#   - Binding tag TablelistBody
#   - Binding tag TablelistHeader
#   - Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow
#
# Copyright (c) 2000-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Public helper procedures
# ========================
#

................................................................................
	after cancel $data($name)
    }

    #
    # If there is a list variable associated with the
    # widget then remove the trace set on this variable
    #
    if {$data(hasListVar) && [info exists ::$data(-listvariable)]} {

	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
    }

    #
    # Destroy any existing bindings for the tags data(bodyTag),
    # data(headerTag), data(labelTag), and data(editwinTag)
................................................................................
    }
    bind TablelistBody <Shift-Control-End> {
	tablelist::extendToFirstLast [tablelist::getTablelistPath %W] last
    }
    foreach event {<space> <Select>} {
	bind TablelistBody $event {
	    set tablelist::W [tablelist::getTablelistPath %W]

	    tablelist::beginSelect $tablelist::W \
		[$tablelist::W index active] [$tablelist::W columnindex active]
	}
    }
    foreach event {<Shift-Control-space> <Shift-Select>} {
	bind TablelistBody $event {
	    set tablelist::W [tablelist::getTablelistPath %W]

	    tablelist::beginExtend $tablelist::W \
		[$tablelist::W index active] [$tablelist::W columnindex active]
	}
    }
    foreach event {<Control-space> <Control-Select>} {
	bind TablelistBody $event {
	    if {!$tablelist::strictTk} {
		set tablelist::W [tablelist::getTablelistPath %W]

		tablelist::beginToggle $tablelist::W \
		    [$tablelist::W index active] \
		    [$tablelist::W columnindex active]
	    }
	}
    }
    bind TablelistBody <Escape> {
................................................................................
	tablelist::cancelSelection [tablelist::getTablelistPath %W]
    }
    bind TablelistBody $eventArr(SelectAll) {
	tablelist::selectAll [tablelist::getTablelistPath %W]
    }
    bind TablelistBody $eventArr(SelectNone) {
	set tablelist::W [tablelist::getTablelistPath %W]

	if {[string compare [$tablelist::W cget -selectmode] "browse"] != 0} {
	    $tablelist::W selection clear 0 end
	    event generate $tablelist::W <<TablelistSelect>>
	}
    }
    foreach pattern {Tab Shift-Tab ISO_Left_Tab hpBackTab} {
	catch {
................................................................................
    }

    variable winSys
    catch {
	if {[string compare $winSys "classic"] == 0 ||
	    [string compare $winSys "aqua"] == 0} {
	    bind TablelistBody <MouseWheel> {




		[tablelist::getTablelistPath %W] yview scroll [expr {-%D}] units




		break


	    }

	    bind TablelistBody <Shift-MouseWheel> {
		[tablelist::getTablelistPath %W] xview scroll [expr {-%D}] units








		break


	    }

	    bind TablelistBody <Option-MouseWheel> {
		[tablelist::getTablelistPath %W] yview scroll \
		    [expr {-10 * %D}] units








		break


	    }

	    bind TablelistBody <Shift-Option-MouseWheel> {
		[tablelist::getTablelistPath %W] xview scroll \



		    [expr {-10 * %D}] units




		break


	    }

	} else {
	    bind TablelistBody <MouseWheel> {
		[tablelist::getTablelistPath %W] yview scroll \



		    [expr {-(%D / 120) * 4}] units




		break


	    }

	    bind TablelistBody <Shift-MouseWheel> {
		[tablelist::getTablelistPath %W] xview scroll \



		    [expr {-(%D / 120) * 4}] units




		break



	    }

	    foreach event {<Control-Key-a> <Control-Lock-Key-A>} {
		bind TablelistBody $event {
		    tablelist::selectAll [tablelist::getTablelistPath %W]
		}
	    }
	    foreach event {<Shift-Control-Key-A> <Shift-Control-Lock-Key-a>} {
		bind TablelistBody $event {
		    set tablelist::W [tablelist::getTablelistPath %W]

		    if {[string compare [$tablelist::W cget -selectmode] \
			 "browse"] != 0} {
			$tablelist::W selection clear 0 end
			event generate $tablelist::W <<TablelistSelect>>
		    }
		}
	    }
	}
    }

    if {[string compare $winSys "x11"] == 0} {
	bind TablelistBody <Button-4> {
	    if {!$tk_strictMotif} {
		[tablelist::getTablelistPath %W] yview scroll -5 units








		break



	    }
	}
	bind TablelistBody <Button-5> {
	    if {!$tk_strictMotif} {
		[tablelist::getTablelistPath %W] yview scroll 5 units








		break



	    }
	}
	bind TablelistBody <Shift-Button-4> {
	    if {!$tk_strictMotif} {
		[tablelist::getTablelistPath %W] xview scroll -5 units








		break



	    }
	}
	bind TablelistBody <Shift-Button-5> {
	    if {!$tk_strictMotif} {
		[tablelist::getTablelistPath %W] xview scroll 5 units








		break



	    }
	}
    }

    foreach event {<Control-Left> <<PrevWord>> <Control-Right> <<NextWord>>
		   <Control-Prior> <Control-Next> <<Copy>>
		   <Button-2> <B2-Motion>} {
................................................................................
    event generate $win <Leave>
    catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
    if {[destroyed $win]} {
	return ""
    }
    set data(prevCell) $row,$col
    if {$row >= 0 && $col >= 0} {
	set focus [focus -displayof $win]
	if {[string length $focus] == 0 || [string first $win $focus] != 0 ||

	    [string compare [winfo toplevel $focus] \
	     [winfo toplevel $win]] == 0} {
	    uplevel #0 $data(-tooltipaddcommand) [list $win $row $col]
	    if {[destroyed $win]} {
		return ""
	    }
	    event generate $win <Enter> -rootx $X -rooty $Y
	}
................................................................................
	doFinishEditing $win
    }
}

#------------------------------------------------------------------------------
# tablelist::cancelMove
#
# This procedure is invoked to process <Escape> events in the top-level window
# containing the tablelist widget win during a row move operation.  It cancels
# the action in progress.
#------------------------------------------------------------------------------
proc tablelist::cancelMove win {
    upvar ::tablelist::ns${win}::data data
    if {![info exists data(sourceRow)]} {
	return ""
................................................................................

    event generate $win <<TablelistSelect>>
}

#------------------------------------------------------------------------------
# tablelist::isDragSrc
#
# Checks whether the body component of the tablelist widget win is a BWidget or
# TkDND drag source for mouse button 1.
#------------------------------------------------------------------------------
proc tablelist::isDragSrc win {
    upvar ::tablelist::ns${win}::data data
    set bindTags [bindtags $data(body)]
    return [expr {[info exists data(sourceRow)] || $data(-customdragsource) ||
		  [lsearch -exact $bindTags "BwDrag1"] >= 0 ||
		  [lsearch -exact $bindTags "TkDND_Drag1"] >= 0
................................................................................
    event generate $win <Leave>
    catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
    if {[destroyed $win]} {
	return ""
    }
    set data(hdr_prevCell) $row,$col
    if {$row >= 0 && $col >= 0} {
	set focus [focus -displayof $win]
	if {[string length $focus] == 0 || [string first $win $focus] != 0 ||

	    [string compare [winfo toplevel $focus] \
	     [winfo toplevel $win]] == 0} {
	    uplevel #0 $data(-tooltipaddcommand) [list $win h$row $col]
	    if {[destroyed $win]} {
		return ""
	    }
	    event generate $win <Enter> -rootx $X -rooty $Y
	}
................................................................................
	#
	event generate $win <Leave>
	catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
	if {[destroyed $win]} {
	    return ""
	}
	set data(prevCol) $col
	set focus [focus -displayof $win]
	if {[string length $focus] == 0 ||
	    [string first $win $focus] != 0 ||
	    [string compare [winfo toplevel $focus] \
	     [winfo toplevel $win]] == 0} {
	    uplevel #0 $data(-tooltipaddcommand) [list $win -1 $col]
	    if {[destroyed $win]} {
		return ""
	    }
	    event generate $win <Enter> -rootx $X -rooty $Y
	}
................................................................................
	genVirtualEvent $win <<TablelistColumnResized>> $col
    }
}

#------------------------------------------------------------------------------
# tablelist::escape
#
# This procedure is invoked to process <Escape> events in the top-level window
# containing the tablelist widget win during a column resize or move operation.
# The procedure cancels the action in progress and, in case of column resizing,
# it restores the initial width of the respective column.
#------------------------------------------------------------------------------
proc tablelist::escape {win col} {
    upvar ::tablelist::ns${win}::data data
    set w $data(hdrTxtFrmLbl)$col
................................................................................
# tablelist widget is in the resize area of that label or of the one to its
# left.
#------------------------------------------------------------------------------
proc tablelist::inResizeArea {w x colName} {
    if {![parseLabelPath $w dummy _col]} {
	return 0
    }


    upvar $colName col
    if {$x >= [winfo width $w] - 5} {
	set col $_col
	return 1
    } elseif {$x < 5} {
	set X [expr {[winfo rootx $w] - 3}]
	set contW [winfo containing -displayof $w $X [winfo rooty $w]]
	return [parseLabelPath $contW dummy col]
    } else {
	return 0
    }
}







|







 







|
>







 







<







<








<







 







<







 







>
>
>
>
|
>
>
>
>
|
>
>
|
>
|
|
>
>
>
>
>
>
>
>
|
>
>
|
>
|
|
<
>
>
>
>
>
>
>
>
|
>
>
|
>

|
>
>
>
|
>
>
>
>
|
>
>
|
>


|
>
>
>
|
>
>
>
>
|
>
>
|
>

|
>
>
>
|
>
>
>
>
|
>
>
>










<













|
>
>
>
>
>
>
>
>
|
>
>
>




|
>
>
>
>
>
>
>
>
|
>
>
>




|
>
>
>
>
>
>
>
>
|
>
>
>




|
>
>
>
>
>
>
>
>
|
>
>
>







 







|
|
>
|







 







|







 







|
|







 







|
|
>
|







 







|
|
|
|







 







|







 







<













5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
757
758
759
760
761
762
763

764
765
766
767
768
769
770

771
772
773
774
775
776
777
778

779
780
781
782
783
784
785
...
786
787
788
789
790
791
792

793
794
795
796
797
798
799
...
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843

844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
....
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
....
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
....
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
....
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
....
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
....
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
....
3913
3914
3915
3916
3917
3918
3919

3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
#   - Public helper procedures
#   - Binding tag Tablelist
#   - Binding tag TablelistWindow
#   - Binding tag TablelistBody
#   - Binding tag TablelistHeader
#   - Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Public helper procedures
# ========================
#

................................................................................
	after cancel $data($name)
    }

    #
    # If there is a list variable associated with the
    # widget then remove the trace set on this variable
    #
    if {$data(hasListVar) &&
	[uplevel #0 [list info exists $data(-listvariable)]]} {
	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
    }

    #
    # Destroy any existing bindings for the tags data(bodyTag),
    # data(headerTag), data(labelTag), and data(editwinTag)
................................................................................
    }
    bind TablelistBody <Shift-Control-End> {
	tablelist::extendToFirstLast [tablelist::getTablelistPath %W] last
    }
    foreach event {<space> <Select>} {
	bind TablelistBody $event {
	    set tablelist::W [tablelist::getTablelistPath %W]

	    tablelist::beginSelect $tablelist::W \
		[$tablelist::W index active] [$tablelist::W columnindex active]
	}
    }
    foreach event {<Shift-Control-space> <Shift-Select>} {
	bind TablelistBody $event {
	    set tablelist::W [tablelist::getTablelistPath %W]

	    tablelist::beginExtend $tablelist::W \
		[$tablelist::W index active] [$tablelist::W columnindex active]
	}
    }
    foreach event {<Control-space> <Control-Select>} {
	bind TablelistBody $event {
	    if {!$tablelist::strictTk} {
		set tablelist::W [tablelist::getTablelistPath %W]

		tablelist::beginToggle $tablelist::W \
		    [$tablelist::W index active] \
		    [$tablelist::W columnindex active]
	    }
	}
    }
    bind TablelistBody <Escape> {
................................................................................
	tablelist::cancelSelection [tablelist::getTablelistPath %W]
    }
    bind TablelistBody $eventArr(SelectAll) {
	tablelist::selectAll [tablelist::getTablelistPath %W]
    }
    bind TablelistBody $eventArr(SelectNone) {
	set tablelist::W [tablelist::getTablelistPath %W]

	if {[string compare [$tablelist::W cget -selectmode] "browse"] != 0} {
	    $tablelist::W selection clear 0 end
	    event generate $tablelist::W <<TablelistSelect>>
	}
    }
    foreach pattern {Tab Shift-Tab ISO_Left_Tab hpBackTab} {
	catch {
................................................................................
    }

    variable winSys
    catch {
	if {[string compare $winSys "classic"] == 0 ||
	    [string compare $winSys "aqua"] == 0} {
	    bind TablelistBody <MouseWheel> {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W yview scroll [expr {-%D}] units
		    } else {
			mwutil::genMouseWheelEvent $tablelist::w \
			    <MouseWheel> %X %Y %D
		    }
		    break
		} else {
		    $tablelist::W yview scroll [expr {-%D}] units
		}
	    }
	    bind TablelistBody <Option-MouseWheel> {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W yview scroll [expr {-10 * %D}] units
		    } else {
			mwutil::genMouseWheelEvent $tablelist::w \
			    <Option-MouseWheel> %X %Y %D
		    }
		    break
		} else {
		    $tablelist::W yview scroll [expr {-10 * %D}] units
		}
	    }
	    bind TablelistBody <Shift-MouseWheel> {
		set tablelist::W [tablelist::getTablelistPath %W]

		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W xview scroll [expr {-%D}] units
		    } else {
			mwutil::genMouseWheelEvent $tablelist::w \
			    <Shift-MouseWheel> %X %Y %D
		    }
		    break
		} else {
		    $tablelist::W xview scroll [expr {-%D}] units
		}
	    }
	    bind TablelistBody <Shift-Option-MouseWheel> {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W xview scroll [expr {-10 * %D}] units
		    } else {
			mwutil::genMouseWheelEvent $tablelist::w \
			    <Shift-Option-MouseWheel> %X %Y %D
		    }
		    break
		} else {
		    $tablelist::W xview scroll [expr {-10 * %D}] units
		}
	    }
	} else {
	    bind TablelistBody <MouseWheel> {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W yview scroll [expr {-(%D/120) * 4}] units
		    } else {
			mwutil::genMouseWheelEvent $tablelist::w \
			    <MouseWheel> %X %Y %D
		    }
		    break
		} else {
		    $tablelist::W yview scroll [expr {-(%D/120) * 4}] units
		}
	    }
	    bind TablelistBody <Shift-MouseWheel> {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W xview scroll [expr {-(%D/120) * 4}] units
		    } else {
			mwutil::genMouseWheelEvent $tablelist::w \
			    <Shift-MouseWheel> %X %Y %D
		    }
		    break
		} else {
		    $tablelist::W xview scroll [expr {-(%D/120) * 4}] units
		}
	    }

	    foreach event {<Control-Key-a> <Control-Lock-Key-A>} {
		bind TablelistBody $event {
		    tablelist::selectAll [tablelist::getTablelistPath %W]
		}
	    }
	    foreach event {<Shift-Control-Key-A> <Shift-Control-Lock-Key-a>} {
		bind TablelistBody $event {
		    set tablelist::W [tablelist::getTablelistPath %W]

		    if {[string compare [$tablelist::W cget -selectmode] \
			 "browse"] != 0} {
			$tablelist::W selection clear 0 end
			event generate $tablelist::W <<TablelistSelect>>
		    }
		}
	    }
	}
    }

    if {[string compare $winSys "x11"] == 0} {
	bind TablelistBody <Button-4> {
	    if {!$tk_strictMotif} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W yview scroll -5 units
		    } else {
			event generate $tablelist::w \
			    <Button-4> -rootx %X -rooty %Y
		    }
		    break
		} else {
		    $tablelist::W yview scroll -5 units
		}
	    }
	}
	bind TablelistBody <Button-5> {
	    if {!$tk_strictMotif} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W yview scroll 5 units
		    } else {
			event generate $tablelist::w \
			    <Button-5> -rootx %X -rooty %Y
		    }
		    break
		} else {
		    $tablelist::W yview scroll 5 units
		}
	    }
	}
	bind TablelistBody <Shift-Button-4> {
	    if {!$tk_strictMotif} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W xview scroll -5 units
		    } else {
			event generate $tablelist::w <Shift-Button-4> \
			    -rootx %X -rooty %Y
		    }
		    break
		} else {
		    $tablelist::W xview scroll -5 units
		}
	    }
	}
	bind TablelistBody <Shift-Button-5> {
	    if {!$tk_strictMotif} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w]} {
		    if {[mwutil::hasFocus $tablelist::W]} {
			$tablelist::W xview scroll 5 units
		    } else {
			event generate $tablelist::w <Shift-Button-5> \
			    -rootx %X -rooty %Y
		    }
		    break
		} else {
		    $tablelist::W xview scroll 5 units
		}
	    }
	}
    }

    foreach event {<Control-Left> <<PrevWord>> <Control-Right> <<NextWord>>
		   <Control-Prior> <Control-Next> <<Copy>>
		   <Button-2> <B2-Motion>} {
................................................................................
    event generate $win <Leave>
    catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
    if {[destroyed $win]} {
	return ""
    }
    set data(prevCell) $row,$col
    if {$row >= 0 && $col >= 0} {
	set focusWin [focus -displayof $win]
	if {[string length $focusWin] == 0 ||
	    [string first $win. $focusWin] != 0 ||
	    [string compare [winfo toplevel $focusWin] \
	     [winfo toplevel $win]] == 0} {
	    uplevel #0 $data(-tooltipaddcommand) [list $win $row $col]
	    if {[destroyed $win]} {
		return ""
	    }
	    event generate $win <Enter> -rootx $X -rooty $Y
	}
................................................................................
	doFinishEditing $win
    }
}

#------------------------------------------------------------------------------
# tablelist::cancelMove
#
# This procedure is invoked to process <Escape> events in the toplevel window
# containing the tablelist widget win during a row move operation.  It cancels
# the action in progress.
#------------------------------------------------------------------------------
proc tablelist::cancelMove win {
    upvar ::tablelist::ns${win}::data data
    if {![info exists data(sourceRow)]} {
	return ""
................................................................................

    event generate $win <<TablelistSelect>>
}

#------------------------------------------------------------------------------
# tablelist::isDragSrc
#
# Checks whether the body component of the tablelist widget win is a drag
# source for mouse button 1.
#------------------------------------------------------------------------------
proc tablelist::isDragSrc win {
    upvar ::tablelist::ns${win}::data data
    set bindTags [bindtags $data(body)]
    return [expr {[info exists data(sourceRow)] || $data(-customdragsource) ||
		  [lsearch -exact $bindTags "BwDrag1"] >= 0 ||
		  [lsearch -exact $bindTags "TkDND_Drag1"] >= 0
................................................................................
    event generate $win <Leave>
    catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
    if {[destroyed $win]} {
	return ""
    }
    set data(hdr_prevCell) $row,$col
    if {$row >= 0 && $col >= 0} {
	set focusWin [focus -displayof $win]
	if {[string length $focusWin] == 0 ||
	    [string first $win. $focusWin] != 0 ||
	    [string compare [winfo toplevel $focusWin] \
	     [winfo toplevel $win]] == 0} {
	    uplevel #0 $data(-tooltipaddcommand) [list $win h$row $col]
	    if {[destroyed $win]} {
		return ""
	    }
	    event generate $win <Enter> -rootx $X -rooty $Y
	}
................................................................................
	#
	event generate $win <Leave>
	catch {uplevel #0 $data(-tooltipdelcommand) [list $win]}
	if {[destroyed $win]} {
	    return ""
	}
	set data(prevCol) $col
	set focusWin [focus -displayof $win]
	if {[string length $focusWin] == 0 ||
	    [string first $win. $focusWin] != 0 ||
	    [string compare [winfo toplevel $focusWin] \
	     [winfo toplevel $win]] == 0} {
	    uplevel #0 $data(-tooltipaddcommand) [list $win -1 $col]
	    if {[destroyed $win]} {
		return ""
	    }
	    event generate $win <Enter> -rootx $X -rooty $Y
	}
................................................................................
	genVirtualEvent $win <<TablelistColumnResized>> $col
    }
}

#------------------------------------------------------------------------------
# tablelist::escape
#
# This procedure is invoked to process <Escape> events in the toplevel window
# containing the tablelist widget win during a column resize or move operation.
# The procedure cancels the action in progress and, in case of column resizing,
# it restores the initial width of the respective column.
#------------------------------------------------------------------------------
proc tablelist::escape {win col} {
    upvar ::tablelist::ns${win}::data data
    set w $data(hdrTxtFrmLbl)$col
................................................................................
# tablelist widget is in the resize area of that label or of the one to its
# left.
#------------------------------------------------------------------------------
proc tablelist::inResizeArea {w x colName} {
    if {![parseLabelPath $w dummy _col]} {
	return 0
    }


    upvar $colName col
    if {$x >= [winfo width $w] - 5} {
	set col $_col
	return 1
    } elseif {$x < 5} {
	set X [expr {[winfo rootx $w] - 3}]
	set contW [winfo containing -displayof $w $X [winfo rooty $w]]
	return [parseLabelPath $contW dummy col]
    } else {
	return 0
    }
}

Changes to modules/tablelist/scripts/tablelistConfig.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
63
64
65
66
67
68
69


70
71
72
73
74
75
76
....
1280
1281
1282
1283
1284
1285
1286








1287
1288
1289
1290
1291
1292
1293
....
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
....
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
....
3984
3985
3986
3987
3988
3989
3990
3991

3992
3993
3994
3995
3996
3997
3998
3999
4000
4001

4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026

4027
4028
4029
4030
4031
4032
4033
#==============================================================================
# Contains private configuration procedures for tablelist widgets.
#
# Copyright (c) 2000-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# tablelist::extendConfigSpecs
#
# Extends the elements of the array configSpecs.
#------------------------------------------------------------------------------
................................................................................
    lappend configSpecs(-stripeheight)		1
    lappend configSpecs(-targetcolor)		black
    lappend configSpecs(-tight)			0
    lappend configSpecs(-titlecolumns)		0
    lappend configSpecs(-tooltipaddcommand)	{}
    lappend configSpecs(-tooltipdelcommand)	{}
    lappend configSpecs(-treecolumn)		0



    #
    # Append the default values of the configuration options
    # of a temporary, invisible listbox widget to the values
    # of the corresponding elements of the array configSpecs
    #
    set helpListbox .__helpListbox
................................................................................
				  [expr {$data(hdrWidth) / $data(charWidth)}]
		    } else {
			$data(hdr) configure $opt 0
			$data(lb) configure $opt $val
		    }
		    set data($opt) $val
		    updateListboxSetgridOpt $win








		}
		-xscrollcommand {
		    #
		    # Save val in data($opt), and apply it to the header text
		    # widget if (and only if) no title columns are being used
		    #
		    set data($opt) $val
................................................................................
		incr col
	    }

	    #
	    # Replace the row's content in the list variable if present
	    #
	    if {$inBody && $data(hasListVar) &&
		[info exists ::$data(-listvariable)]} {
		upvar #0 $data(-listvariable) var
		trace vdelete var wu $data(listVarTraceCmd)
		set var [lreplace $var $row $row $newItem]
		trace variable var wu $data(listVarTraceCmd)
	    }

	    #
................................................................................
	    set data(${p}itemList) \
		[lreplace $data(${p}itemList) $row $row $newItem]

	    #
	    # Replace the cell's content in the list variable if present
	    #
	    if {$inBody && $data(hasListVar) &&
		[info exists ::$data(-listvariable)]} {
		upvar #0 $data(-listvariable) var
		trace vdelete var wu $data(listVarTraceCmd)
		set var [lreplace $var $row $row \
			 [lrange $newItem 0 $data(lastCol)]]
		trace variable var wu $data(listVarTraceCmd)
	    }

................................................................................
proc tablelist::makeListVar {win varName} {
    upvar ::tablelist::ns${win}::data data
    if {[string length $varName] == 0} {
	#
	# If there is an old list variable associated with the
	# widget then remove the trace set on this variable
	#
	if {$data(hasListVar) && [info exists ::$data(-listvariable)]} {

	    synchronize $win
	    upvar #0 $data(-listvariable) oldVar
	    trace vdelete oldVar wu $data(listVarTraceCmd)
	}
	return ""
    }

    #
    # The list variable may be an array element but must not be an array
    #

    if {![regexp {^(.*)\((.*)\)$} $varName dummy name1 name2]} {
	if {[array exists ::$varName]} {
	    return -code error "variable \"$varName\" is array"
	}

	set name1 $varName
	set name2 ""
    }

    #
    # The value of the list variable (if any) must be a list of lists
    #
    upvar #0 $varName var
    if {[info exists var]} {
	if {[catch {foreach item $var {llength $item}}] != 0} {
	    return -code error "value of variable \"$varName\" is not a list\
				of lists"
	}
    }

    #
    # If there is an old list variable associated with the
    # widget then remove the trace set on this variable
    #
    if {$data(hasListVar) && [info exists ::$data(-listvariable)]} {

	synchronize $win
	upvar #0 $data(-listvariable) oldVar
	trace vdelete oldVar wu $data(listVarTraceCmd)
    }

    if {[info exists var]} {
	#



|







 







>
>







 







>
>
>
>
>
>
>
>







 







|







 







|







 







|
>










>

|










<

|

|







|
>







1
2
3
4
5
6
7
8
9
10
11
..
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
....
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
....
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
....
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
....
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025

4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
#==============================================================================
# Contains private configuration procedures for tablelist widgets.
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# tablelist::extendConfigSpecs
#
# Extends the elements of the array configSpecs.
#------------------------------------------------------------------------------
................................................................................
    lappend configSpecs(-stripeheight)		1
    lappend configSpecs(-targetcolor)		black
    lappend configSpecs(-tight)			0
    lappend configSpecs(-titlecolumns)		0
    lappend configSpecs(-tooltipaddcommand)	{}
    lappend configSpecs(-tooltipdelcommand)	{}
    lappend configSpecs(-treecolumn)		0
    lappend configSpecs(-xmousewheelwindow)	{}
    lappend configSpecs(-ymousewheelwindow)	{}

    #
    # Append the default values of the configuration options
    # of a temporary, invisible listbox widget to the values
    # of the corresponding elements of the array configSpecs
    #
    set helpListbox .__helpListbox
................................................................................
				  [expr {$data(hdrWidth) / $data(charWidth)}]
		    } else {
			$data(hdr) configure $opt 0
			$data(lb) configure $opt $val
		    }
		    set data($opt) $val
		    updateListboxSetgridOpt $win
		}
		-xmousewheelwindow -
		-ymousewheelwindow {
		    if {[string length $val] == 0 || [winfo exists $val]} {
			set data($opt) $val
		    } else {
			return -code error "bad window path name \"$val\""
		    }
		}
		-xscrollcommand {
		    #
		    # Save val in data($opt), and apply it to the header text
		    # widget if (and only if) no title columns are being used
		    #
		    set data($opt) $val
................................................................................
		incr col
	    }

	    #
	    # Replace the row's content in the list variable if present
	    #
	    if {$inBody && $data(hasListVar) &&
		[uplevel #0 [list info exists $data(-listvariable)]]} {
		upvar #0 $data(-listvariable) var
		trace vdelete var wu $data(listVarTraceCmd)
		set var [lreplace $var $row $row $newItem]
		trace variable var wu $data(listVarTraceCmd)
	    }

	    #
................................................................................
	    set data(${p}itemList) \
		[lreplace $data(${p}itemList) $row $row $newItem]

	    #
	    # Replace the cell's content in the list variable if present
	    #
	    if {$inBody && $data(hasListVar) &&
		[uplevel #0 [list info exists $data(-listvariable)]]} {
		upvar #0 $data(-listvariable) var
		trace vdelete var wu $data(listVarTraceCmd)
		set var [lreplace $var $row $row \
			 [lrange $newItem 0 $data(lastCol)]]
		trace variable var wu $data(listVarTraceCmd)
	    }

................................................................................
proc tablelist::makeListVar {win varName} {
    upvar ::tablelist::ns${win}::data data
    if {[string length $varName] == 0} {
	#
	# If there is an old list variable associated with the
	# widget then remove the trace set on this variable
	#
	if {$data(hasListVar) &&
	    [uplevel #0 [list info exists $data(-listvariable)]]} {
	    synchronize $win
	    upvar #0 $data(-listvariable) oldVar
	    trace vdelete oldVar wu $data(listVarTraceCmd)
	}
	return ""
    }

    #
    # The list variable may be an array element but must not be an array
    #
    upvar #0 $varName var
    if {![regexp {^(.*)\((.*)\)$} $varName dummy name1 name2]} {
	if {[array exists var]} {
	    return -code error "variable \"$varName\" is array"
	}

	set name1 $varName
	set name2 ""
    }

    #
    # The value of the list variable (if any) must be a list of lists
    #

    if {[info exists var]} {
	if {[catch {foreach item $var {llength $item}} err] != 0} {
	    return -code error "value of variable \"$varName\" is not a list\
				of lists ($err)"
	}
    }

    #
    # If there is an old list variable associated with the
    # widget then remove the trace set on this variable
    #
    if {$data(hasListVar) &&
	[uplevel #0 [list info exists $data(-listvariable)]]} {
	synchronize $win
	upvar #0 $data(-listvariable) oldVar
	trace vdelete oldVar wu $data(listVarTraceCmd)
    }

    if {[info exists var]} {
	#

Changes to modules/tablelist/scripts/tablelistEdit.tcl.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
....
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
....
1402
1403
1404
1405
1406
1407
1408
1409

1410
1411
1412
1413
1414
1415
1416
....
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598




1599
1600
1601
1602
1603
1604
1605
....
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
....
2599
2600
2601
2602
2603
2604
2605
2606

2607
2608
2609
2610








2611













2612




2613


2614
2615



2616
2617








2618













2619




2620


2621
2622

2623

2624
2625
2626








2627













2628




2629


2630
2631


2632
2633
2634
2635
2636
2637
2638
....
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
....
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950



2951
2952
2953
2954
2955
2956
2957
2958
2959

2960
2961
2962
2963
2964
2965
2966
#
# Structure of the module:
#   - Namespace initialization
#   - Public procedures related to interactive cell editing
#   - Private procedures implementing the interactive cell editing
#   - Private procedures used in bindings related to interactive cell editing
#
# Copyright (c) 2003-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
proc tablelist::createTileSpinbox {w args} {
    if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} {
	package require tile 0.8.3
    }
    createTileAliases 

    #
    # The style of the tile entry widget should have -borderwidth
    # 2 and -padding 1.  For those themes that don't honor the
    # -borderwidth 2 setting, set the padding to another value.
    #
    set win [getTablelistPath $w]
    switch -- [getCurrentTheme] {
	aqua {
	    set padding {0 0 0 -1}
................................................................................
#------------------------------------------------------------------------------
# tablelist::createIncrCombobox
#
# Creates an [incr Widgets] combobox of the given path name for interactive
# cell editing in a tablelist widget.
#------------------------------------------------------------------------------
proc tablelist::createIncrCombobox {w args} {
    eval [list iwidgets::combobox $w -dropdown 1 -editable 1 -width 0] $args


    foreach event {<Map> <Unmap>} {
	bind [$w component list] $event {+
	    tablelist::invokeMotionHandler [tablelist::getTablelistPath %W]
	}
    }

................................................................................
	    $b delete $editIdx $tabIdx2
	}
    }
    $b window create $editIdx -padx -3 -pady -3 -window $f
    $b mark set editMark $editIdx

    #
    # Insert the binding tags $data(editwinTag) and TablelistEdit
    # into the list of binding tags of some components
    # of w, just before the respective path names

    #
    if {$isMentry} {
	set compList [$w entries]
    } else {
	set comp [subst [strMap {"%W" "$w"} $editWin($name-focusWin)]]
	set compList [list $comp]
	set data(editFocus) $comp
    }
    foreach comp $compList {
	set bindTags [bindtags $comp]
	set idx [lsearch -exact $bindTags $comp]
	bindtags $comp [linsert $bindTags $idx $data(editwinTag) TablelistEdit]




    }

    #
    # Restore or initialize some of the edit window's data
    #
    if {$restore} {
	restoreEditData $win
................................................................................
	bind TablelistEdit <$modifier-Home> {
	    tablelist::goToNextPrevCell %W 1 0 -1
	}
	bind TablelistEdit <$modifier-End> {
	    tablelist::goToNextPrevCell %W -1 0 0
	}
    }
    foreach direction {Left Right} amount {-1 1} {
	bind TablelistEdit <$direction> [format {
	    if {![tablelist::isKeyReserved %%W %%K]} {
		tablelist::goLeftRight %%W %d
	    }
	} $amount]
    }
    foreach direction {Up Down} amount {-1 1} {
	bind TablelistEdit <$direction> [format {
	    if {![tablelist::isKeyReserved %%W %%K]} {
		tablelist::goUpDown %%W %d
	    }
	} $amount]
    }
    foreach page {Prior Next} amount {-1 1} {
	bind TablelistEdit <$page> [format {
................................................................................
	    ![tablelist::isKeyReserved %W Meta-greater]} {
	    tablelist::goToNextPrevCell %W -1 0 0
	}
    }

    #
    # Define some bindings for the binding tag TablelistEdit that
    # propagate the mousewheel events to the tablelist's body

    #
    catch {
	bind TablelistEdit <MouseWheel> {
	    if {![tablelist::hasMouseWheelBindings %W] &&








		![tablelist::isComboTopMapped %W]} {













		tablelist::genMouseWheelEvent \




		    [[tablelist::getTablelistPath %W] bodypath] %D


	    }
	}



	bind TablelistEdit <Option-MouseWheel> {
	    if {![tablelist::hasMouseWheelBindings %W] &&








		![tablelist::isComboTopMapped %W]} {













		tablelist::genOptionMouseWheelEvent \




		    [[tablelist::getTablelistPath %W] bodypath] %D


	    }
	}

    }

    foreach detail {4 5} {
	bind TablelistEdit <Button-$detail> [format {
	    if {![tablelist::hasMouseWheelBindings %%W] &&








		![tablelist::isComboTopMapped %%W]} {













		event generate \




		    [[tablelist::getTablelistPath %%W] bodypath] <Button-%s>


	    }
	} $detail]


    }
}

#------------------------------------------------------------------------------
# tablelist::insertChar
#
# Inserts the string str ("\t" or "\n") into the entry-like widget w at the
................................................................................
	    goToPrevNextLine $w -1 $data(itemCount) $col changeSelection
	}
    }

    return -code break ""
}

#------------------------------------------------------------------------------
# tablelist::genMouseWheelEvent
#
# Generates a <MouseWheel> event with the given delta on the widget w.
#------------------------------------------------------------------------------
proc tablelist::genMouseWheelEvent {w delta} {
    set focus [focus -displayof $w]
    focus $w
    event generate $w <MouseWheel> -delta $delta
    focus $focus
}

#------------------------------------------------------------------------------
# tablelist::genOptionMouseWheelEvent
#
# Generates an <Option-MouseWheel> event with the given delta on the widget w.
#------------------------------------------------------------------------------
proc tablelist::genOptionMouseWheelEvent {w delta} {
    set focus [focus -displayof $w]
    focus $w
    event generate $w <Option-MouseWheel> -delta $delta
    focus $focus
}

#------------------------------------------------------------------------------
# tablelist::isKeyReserved
#
# Checks whether the given keysym is used in the standard binding scripts
# associated with the widget w, which is assumed to be the edit window or one
# of its descendants.
#------------------------------------------------------------------------------
................................................................................
    return [expr {[lsearch -exact $editWin($name-reservedKeys) $keySym] >= 0}]
}

#------------------------------------------------------------------------------
# tablelist::hasMouseWheelBindings
#
# Checks whether the given widget, which is assumed to be the edit window or
# one of its descendants, has mouse wheel bindings.
#------------------------------------------------------------------------------
proc tablelist::hasMouseWheelBindings w {



    if {[regexp {^(Text|Ctext|TCombobox|TSpinbox)$} [winfo class $w]]} {
	return 1
    } else {
	set bindTags [bindtags $w]
	return [expr {([lsearch -exact $bindTags "MentryDateTime"] >= 0 ||
		       [lsearch -exact $bindTags "MentryMeridian"] >= 0 ||
		       [lsearch -exact $bindTags "MentryIPAddr"] >= 0 ||
		       [lsearch -exact $bindTags "MentryIPv6Addr"] >= 0) &&
		      ($mentry::version >= 3.2)}]

    }
}

#------------------------------------------------------------------------------
# tablelist::isComboTopMapped
#
# Checks whether the given widget is a component of an Oakley combobox having







|







 







|







 







|
>







 







|
|
|
>












>
>
>
>







 







|
|





|
|







 







|
>



|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
>
>


>
>
>
|
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
>
>


>

>
|
|
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
>
>
|
|
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|

|
>
>
>
|
|
|
|
|
|
|
|
|
>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
....
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
....
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
....
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
....
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
....
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
....
2992
2993
2994
2995
2996
2997
2998
























2999
3000
3001
3002
3003
3004
3005
....
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
#
# Structure of the module:
#   - Namespace initialization
#   - Public procedures related to interactive cell editing
#   - Private procedures implementing the interactive cell editing
#   - Private procedures used in bindings related to interactive cell editing
#
# Copyright (c) 2003-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
proc tablelist::createTileSpinbox {w args} {
    if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} {
	package require tile 0.8.3
    }
    createTileAliases 

    #
    # The style of the tile spinbox widget should have -borderwidth
    # 2 and -padding 1.  For those themes that don't honor the
    # -borderwidth 2 setting, set the padding to another value.
    #
    set win [getTablelistPath $w]
    switch -- [getCurrentTheme] {
	aqua {
	    set padding {0 0 0 -1}
................................................................................
#------------------------------------------------------------------------------
# tablelist::createIncrCombobox
#
# Creates an [incr Widgets] combobox of the given path name for interactive
# cell editing in a tablelist widget.
#------------------------------------------------------------------------------
proc tablelist::createIncrCombobox {w args} {
    eval [list iwidgets::combobox $w -dropdown 1 -editable 1 -grab global \
	  -width 0] $args

    foreach event {<Map> <Unmap>} {
	bind [$w component list] $event {+
	    tablelist::invokeMotionHandler [tablelist::getTablelistPath %W]
	}
    }

................................................................................
	    $b delete $editIdx $tabIdx2
	}
    }
    $b window create $editIdx -padx -3 -pady -3 -window $f
    $b mark set editMark $editIdx

    #
    # Insert the binding tags $data(editwinTag) and TablelistEdit into the list
    # of binding tags of some components of w, just before the respective path
    # names.  In addition, insert the binding tag TablelistEditBreak into the
    # same lists of binding tags, just after the respective widget class names
    #
    if {$isMentry} {
	set compList [$w entries]
    } else {
	set comp [subst [strMap {"%W" "$w"} $editWin($name-focusWin)]]
	set compList [list $comp]
	set data(editFocus) $comp
    }
    foreach comp $compList {
	set bindTags [bindtags $comp]
	set idx [lsearch -exact $bindTags $comp]
	bindtags $comp [linsert $bindTags $idx $data(editwinTag) TablelistEdit]

	set bindTags [bindtags $comp]
	set idx [lsearch -exact $bindTags [winfo class $comp]]
	bindtags $comp [linsert $bindTags [incr idx] TablelistEditBreak]
    }

    #
    # Restore or initialize some of the edit window's data
    #
    if {$restore} {
	restoreEditData $win
................................................................................
	bind TablelistEdit <$modifier-Home> {
	    tablelist::goToNextPrevCell %W 1 0 -1
	}
	bind TablelistEdit <$modifier-End> {
	    tablelist::goToNextPrevCell %W -1 0 0
	}
    }
    foreach dir {Left Right} amount {-1 1} {
	bind TablelistEdit <$dir> [format {
	    if {![tablelist::isKeyReserved %%W %%K]} {
		tablelist::goLeftRight %%W %d
	    }
	} $amount]
    }
    foreach dir {Up Down} amount {-1 1} {
	bind TablelistEdit <$dir> [format {
	    if {![tablelist::isKeyReserved %%W %%K]} {
		tablelist::goUpDown %%W %d
	    }
	} $amount]
    }
    foreach page {Prior Next} amount {-1 1} {
	bind TablelistEdit <$page> [format {
................................................................................
	    ![tablelist::isKeyReserved %W Meta-greater]} {
	    tablelist::goToNextPrevCell %W -1 0 0
	}
    }

    #
    # Define some bindings for the binding tag TablelistEdit that
    # redirect the mouse wheel events to the containing scrollable
    # frame (if any) or propagate them to the tablelist's body
    #
    catch {
	bind TablelistEdit <MouseWheel> {
	    if {[tablelist::hasMouseWheelBindings %W y]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w] &&
		    ![mwutil::hasFocus $tablelist::W]} {
		    mwutil::genMouseWheelEvent $tablelist::w \
			<MouseWheel> %X %Y %D
		    break
		}
	    } elseif {![tablelist::isComboTopMapped %%W]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		mwutil::genMouseWheelEvent [$tablelist::W bodypath] \
		    <MouseWheel> %X %Y %D
	    }
	}
	bind TablelistEditBreak <MouseWheel> { break }

	bind TablelistEdit <Option-MouseWheel> {
	    if {[tablelist::hasMouseWheelBindings %W y]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		if {[winfo exists $tablelist::w] &&
		    ![mwutil::hasFocus $tablelist::W]} {
		    mwutil::genMouseWheelEvent $tablelist::w \
			<Option-MouseWheel> %X %Y %D
		    break
		}
	    } elseif {![tablelist::isComboTopMapped %%W]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		mwutil::genMouseWheelEvent [$tablelist::W bodypath] \
		    <Option-MouseWheel> %X %Y %D
	    }
	}
	bind TablelistEditBreak <Option-MouseWheel> { break }
    }
    catch {
	bind TablelistEdit <Shift-MouseWheel> {
	    if {[tablelist::hasMouseWheelBindings %W x]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w] &&
		    ![mwutil::hasFocus $tablelist::W]} {
		    mwutil::genMouseWheelEvent $tablelist::w \
			<Shift-MouseWheel> %X %Y %D
		    break
		}
	    } elseif {![tablelist::isComboTopMapped %%W]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		mwutil::genMouseWheelEvent [$tablelist::W bodypath] \
		    <Shift-MouseWheel> %X %Y %D
	    }
	}
	bind TablelistEditBreak <Shift-MouseWheel> { break }

	bind TablelistEdit <Shift-Option-MouseWheel> {
	    if {[tablelist::hasMouseWheelBindings %W x]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		if {[winfo exists $tablelist::w] &&
		    ![mwutil::hasFocus $tablelist::W]} {
		    mwutil::genMouseWheelEvent $tablelist::w \
			<Shift-Option-MouseWheel> %X %Y %D
		    break
		}
	    } elseif {![tablelist::isComboTopMapped %%W]} {
		set tablelist::W [tablelist::getTablelistPath %W]
		mwutil::genMouseWheelEvent [$tablelist::W bodypath] \
		    <Shift-Option-MouseWheel> %X %Y %D
	    }
	}
	bind TablelistEditBreak <Shift-Option-MouseWheel> { break }
    }
    if {[string compare $winSys "x11"] == 0} {
	foreach detail {4 5} {
	    bind TablelistEdit <Button-$detail> [format {
		if {[tablelist::hasMouseWheelBindings %%W y]} {
		    set tablelist::W [tablelist::getTablelistPath %%W]
		    set tablelist::w [$tablelist::W cget -ymousewheelwindow]
		    if {[winfo exists $tablelist::w] &&
			![mwutil::hasFocus $tablelist::W]} {
			event generate $tablelist::w <Button-%s> \
			    -rootx %%X -rooty %%Y
			break
		    }
		} elseif {![tablelist::isComboTopMapped %%W]} {
		    set tablelist::W [tablelist::getTablelistPath %%W]
		    event generate [$tablelist::W bodypath] <Button-%s> \
			-rootx %%X -rooty %%Y
		}
	    } $detail $detail]
	    bind TablelistEditBreak <Button-$detail> { break }

	    bind TablelistEdit <Shift-Button-$detail> [format {
		if {[tablelist::hasMouseWheelBindings %%W x]} {
		    set tablelist::W [tablelist::getTablelistPath %%W]
		    set tablelist::w [$tablelist::W cget -xmousewheelwindow]
		    if {[winfo exists $tablelist::w] &&
			![mwutil::hasFocus $tablelist::W]} {
			event generate $tablelist::w <Shift-Button-%s> \
			    -rootx %%X -rooty %%Y
			break
		    }
		} elseif {![tablelist::isComboTopMapped %%W]} {
		    set tablelist::W [tablelist::getTablelistPath %%W]
		    event generate [$tablelist::W bodypath] <Shift-Button-%s> \
			-rootx %%X -rooty %%Y
		}
	    } $detail $detail]
	    bind TablelistEditBreak <Shift-Button-$detail> { break }
	}
    }
}

#------------------------------------------------------------------------------
# tablelist::insertChar
#
# Inserts the string str ("\t" or "\n") into the entry-like widget w at the
................................................................................
	    goToPrevNextLine $w -1 $data(itemCount) $col changeSelection
	}
    }

    return -code break ""
}

























#------------------------------------------------------------------------------
# tablelist::isKeyReserved
#
# Checks whether the given keysym is used in the standard binding scripts
# associated with the widget w, which is assumed to be the edit window or one
# of its descendants.
#------------------------------------------------------------------------------
................................................................................
    return [expr {[lsearch -exact $editWin($name-reservedKeys) $keySym] >= 0}]
}

#------------------------------------------------------------------------------
# tablelist::hasMouseWheelBindings
#
# Checks whether the given widget, which is assumed to be the edit window or
# one of its descendants, has mouse wheel bindings for the given axis (x or y).
#------------------------------------------------------------------------------
proc tablelist::hasMouseWheelBindings {w axis} {
    if {[string compare $axis "x"] == 0} {
	return [regexp {^(Text|Ctext)$} [winfo class $w]]
    } else {
	if {[regexp {^(Text|Ctext|TCombobox|TSpinbox)$} [winfo class $w]]} {
	    return 1
	} else {
	    set bindTags [bindtags $w]
	    return [expr {([lsearch -exact $bindTags "MentryDateTime"] >= 0 ||
			   [lsearch -exact $bindTags "MentryMeridian"] >= 0 ||
			   [lsearch -exact $bindTags "MentryIPAddr"] >= 0 ||
			   [lsearch -exact $bindTags "MentryIPv6Addr"] >= 0) &&
			  ($mentry::version >= 3.2)}]
	}
    }
}

#------------------------------------------------------------------------------
# tablelist::isComboTopMapped
#
# Checks whether the given widget is a component of an Oakley combobox having

Changes to modules/tablelist/scripts/tablelistImages.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
#==============================================================================
# Contains procedures that create various bitmap and photo images.  The
# argument w specifies a canvas displaying a sort arrow, while the argument win
# stands for a tablelist widget.
#
# Copyright (c) 2006-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# tablelist::flat5x3Arrows
#------------------------------------------------------------------------------
proc tablelist::flat5x3Arrows w {
    image create bitmap triangleUp$w -data "





|







1
2
3
4
5
6
7
8
9
10
11
12
13
#==============================================================================
# Contains procedures that create various bitmap and photo images.  The
# argument w specifies a canvas displaying a sort arrow, while the argument win
# stands for a tablelist widget.
#
# Copyright (c) 2006-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# tablelist::flat5x3Arrows
#------------------------------------------------------------------------------
proc tablelist::flat5x3Arrows w {
    image create bitmap triangleUp$w -data "

Changes to modules/tablelist/scripts/tablelistMove.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
...
288
289
290
291
292
293
294
295

296
297
298
299
300
301
302
...
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
#==============================================================================
# Contains the implementation of the tablelist move and movecolumn subcommands.
#
# Copyright (c) 2003-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# tablelist::moveRow
#
# Processes the 1st form of the tablelist move subcommand.
#------------------------------------------------------------------------------
................................................................................
	set targetKey [lindex $data(keyList) $target]
	if {[string compare $data($targetKey-parent) $parentKey] != 0} {
	    return -code error \
		   "cannot move item with index \"$source\" outside its parent"
	}

	set targetChildIdx \
	    [lsearch -exact $data($parentKey-children) $targetKey]
    }

    return [moveNode $win $source $parentKey $targetChildIdx]
}

#------------------------------------------------------------------------------
# tablelist::moveNode
................................................................................
	doRowConfig $target1 $win -elide 1
    }

    if {$withDescendants} {
	#
	# Update the tree information
	#
	set targetBuddyCount [llength $data($targetParentKey-children)]
	set sourceChildIdx \
	    [lsearch -exact $data($sourceParentKey-children) $sourceKey]
	set data($sourceParentKey-children) \
	    [lreplace $data($sourceParentKey-children) \
	     $sourceChildIdx $sourceChildIdx]
	if {[string first $targetChildIdx "end"] == 0} {
	    set targetChildIdx $targetBuddyCount
	}
	if {$targetChildIdx >= $targetBuddyCount} {
	    lappend data($targetParentKey-children) $sourceKey
	} else {
	    if {[string compare $sourceParentKey $targetParentKey] == 0 &&
		$sourceChildIdx < $targetChildIdx} {
		incr targetChildIdx -1
	    }
	    set data($targetParentKey-children) \
		[linsert $data($targetParentKey-children) \
		 $targetChildIdx $sourceKey]
	}
	set data($sourceKey-parent) $targetParentKey

	#
	# If the list of children of the source's parent has become empty
	# then set the parent's indentation image to the indented one
	#
	if {[llength $data($sourceParentKey-children)] == 0 &&
	    [info exists data($sourceParentKey,$treeCol-indent)]} {
	    collapseSubCmd $win [list $sourceParentKey -partly]
	    set data($sourceParentKey,$treeCol-indent) [strMap \
		{"collapsed" "indented" "expanded" "indented"
		 "Act" "" "Sel" ""} $data($sourceParentKey,$treeCol-indent)]
	    if {[winfo exists $w.ind_$sourceParentKey,$treeCol]} {
		$w.ind_$sourceParentKey,$treeCol configure -image \
................................................................................
	    doCellConfig $target1 $treeCol $win -indent $base$depth
	}
    }

    #
    # Update the list variable if present
    #
    if {$data(hasListVar) && [info exists ::$data(-listvariable)]} {

	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
	set var [lreplace $var $source $source]
	set pureSourceItem [lrange $sourceItem 0 $data(lastCol)]
	if {$target == $data(itemCount)} {
	    lappend var $pureSourceItem		;# this works much faster
	} else {
................................................................................
	}
    }

    if {$withDescendants} {
	#
	# Save the source node's list of children and temporarily empty it
	#
	set sourceChildList $data($sourceKey-children)
	set data($sourceKey-children) {}

	#
	# Move the source item's descendants
	#
	if {$source < $target} {
	    set lastDescRow [expr {$source + $sourceDescCount - 1}]
	    set increment -1
................................................................................

	    moveNode $win $descRow $sourceKey end 0
	}

	#
	# Restore the source node's list of children
	#
	set data($sourceKey-children) $sourceChildList

	#
	# Adjust the columns, restore the stripes in the body text widget,
	# redisplay the line numbers (if any), and update the view
	#
	adjustColumns $win $treeCol 1
	adjustElidedText $win



|







 







|







 







|

|
|
|





|





|
|








|







 







|
>







 







|
|







 







|







1
2
3
4
5
6
7
8
9
10
11
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
...
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
#==============================================================================
# Contains the implementation of the tablelist move and movecolumn subcommands.
#
# Copyright (c) 2003-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# tablelist::moveRow
#
# Processes the 1st form of the tablelist move subcommand.
#------------------------------------------------------------------------------
................................................................................
	set targetKey [lindex $data(keyList) $target]
	if {[string compare $data($targetKey-parent) $parentKey] != 0} {
	    return -code error \
		   "cannot move item with index \"$source\" outside its parent"
	}

	set targetChildIdx \
	    [lsearch -exact $data($parentKey-childList) $targetKey]
    }

    return [moveNode $win $source $parentKey $targetChildIdx]
}

#------------------------------------------------------------------------------
# tablelist::moveNode
................................................................................
	doRowConfig $target1 $win -elide 1
    }

    if {$withDescendants} {
	#
	# Update the tree information
	#
	set targetBuddyCount [llength $data($targetParentKey-childList)]
	set sourceChildIdx \
	    [lsearch -exact $data($sourceParentKey-childList) $sourceKey]
	set data($sourceParentKey-childList) \
	    [lreplace $data($sourceParentKey-childList) \
	     $sourceChildIdx $sourceChildIdx]
	if {[string first $targetChildIdx "end"] == 0} {
	    set targetChildIdx $targetBuddyCount
	}
	if {$targetChildIdx >= $targetBuddyCount} {
	    lappend data($targetParentKey-childList) $sourceKey
	} else {
	    if {[string compare $sourceParentKey $targetParentKey] == 0 &&
		$sourceChildIdx < $targetChildIdx} {
		incr targetChildIdx -1
	    }
	    set data($targetParentKey-childList) \
		[linsert $data($targetParentKey-childList) \
		 $targetChildIdx $sourceKey]
	}
	set data($sourceKey-parent) $targetParentKey

	#
	# If the list of children of the source's parent has become empty
	# then set the parent's indentation image to the indented one
	#
	if {[llength $data($sourceParentKey-childList)] == 0 &&
	    [info exists data($sourceParentKey,$treeCol-indent)]} {
	    collapseSubCmd $win [list $sourceParentKey -partly]
	    set data($sourceParentKey,$treeCol-indent) [strMap \
		{"collapsed" "indented" "expanded" "indented"
		 "Act" "" "Sel" ""} $data($sourceParentKey,$treeCol-indent)]
	    if {[winfo exists $w.ind_$sourceParentKey,$treeCol]} {
		$w.ind_$sourceParentKey,$treeCol configure -image \
................................................................................
	    doCellConfig $target1 $treeCol $win -indent $base$depth
	}
    }

    #
    # Update the list variable if present
    #
    if {$data(hasListVar) &&
	[uplevel #0 [list info exists $data(-listvariable)]]} {
	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
	set var [lreplace $var $source $source]
	set pureSourceItem [lrange $sourceItem 0 $data(lastCol)]
	if {$target == $data(itemCount)} {
	    lappend var $pureSourceItem		;# this works much faster
	} else {
................................................................................
	}
    }

    if {$withDescendants} {
	#
	# Save the source node's list of children and temporarily empty it
	#
	set sourceChildList $data($sourceKey-childList)
	set data($sourceKey-childList) {}

	#
	# Move the source item's descendants
	#
	if {$source < $target} {
	    set lastDescRow [expr {$source + $sourceDescCount - 1}]
	    set increment -1
................................................................................

	    moveNode $win $descRow $sourceKey end 0
	}

	#
	# Restore the source node's list of children
	#
	set data($sourceKey-childList) $sourceChildList

	#
	# Adjust the columns, restore the stripes in the body text widget,
	# redisplay the line numbers (if any), and update the view
	#
	adjustColumns $win $treeCol 1
	adjustElidedText $win

Changes to modules/tablelist/scripts/tablelistSort.tcl.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
...
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
# tablelist::addToSortColumns commands, as well as of the tablelist sort,
# sortbycolumn, and sortbycolumnlist subcommands.
#
# Structure of the module:
#   - Public procedures related to sorting
#   - Private procedures implementing the sorting
#
# Copyright (c) 2000-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Public procedures related to sorting
# ====================================
#

................................................................................
#
# Sorts the children of a given parent within the tablelist widget win,
# recursively.
#------------------------------------------------------------------------------
proc tablelist::sortChildren {win parentKey sortCmd itemListName} {
    upvar $itemListName itemList ::tablelist::ns${win}::data data

    set childKeyList $data($parentKey-children)
    if {[llength $childKeyList] == 0} {
	return ""
    }

    #
    # Build and sort the list of child items
    #
................................................................................
	lappend childItemList [lindex $data(itemList) [keyToRow $win $childKey]]
    }
    set childItemList [eval $sortCmd [list $childItemList]]

    #
    # Update the lists and invoke the procedure recursively for the children
    #
    set data($parentKey-children) {}
    foreach item $childItemList {
	lappend itemList $item
	set childKey [lindex $item end]
	lappend data($parentKey-children) $childKey

	sortChildren $win $childKey $sortCmd itemList
    }
}

#------------------------------------------------------------------------------
# tablelist::sortList







|







 







|







 







|



|







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
...
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
# tablelist::addToSortColumns commands, as well as of the tablelist sort,
# sortbycolumn, and sortbycolumnlist subcommands.
#
# Structure of the module:
#   - Public procedures related to sorting
#   - Private procedures implementing the sorting
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Public procedures related to sorting
# ====================================
#

................................................................................
#
# Sorts the children of a given parent within the tablelist widget win,
# recursively.
#------------------------------------------------------------------------------
proc tablelist::sortChildren {win parentKey sortCmd itemListName} {
    upvar $itemListName itemList ::tablelist::ns${win}::data data

    set childKeyList $data($parentKey-childList)
    if {[llength $childKeyList] == 0} {
	return ""
    }

    #
    # Build and sort the list of child items
    #
................................................................................
	lappend childItemList [lindex $data(itemList) [keyToRow $win $childKey]]
    }
    set childItemList [eval $sortCmd [list $childItemList]]

    #
    # Update the lists and invoke the procedure recursively for the children
    #
    set data($parentKey-childList) {}
    foreach item $childItemList {
	lappend itemList $item
	set childKey [lindex $item end]
	lappend data($parentKey-childList) $childKey

	sortChildren $win $childKey $sortCmd itemList
    }
}

#------------------------------------------------------------------------------
# tablelist::sortList

Changes to modules/tablelist/scripts/tablelistThemes.tcl.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#
# Structure of the module:
#   - Public procedures related to tile themes
#   - Private procedures related to tile themes
#   - Private procedures performing RGB <-> HSV conversions
#   - Private procedures related to global KDE configuration options
#
# Copyright (c) 2005-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Public procedures related to tile themes
# ========================================
#








|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#
# Structure of the module:
#   - Public procedures related to tile themes
#   - Private procedures related to tile themes
#   - Private procedures performing RGB <-> HSV conversions
#   - Private procedures related to global KDE configuration options
#
# Copyright (c) 2005-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Public procedures related to tile themes
# ========================================
#

Changes to modules/tablelist/scripts/tablelistUtil.tcl.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
....
1002
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016
....
2638
2639
2640
2641
2642
2643
2644

2645




2646
2647
2648
2649
2650
2651
2652
....
2692
2693
2694
2695
2696
2697
2698



2699
2700
2701
2702
2703
2704
2705
....
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
....
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
....
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
....
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
....
3149
3150
3151
3152
3153
3154
3155

3156
3157
3158
3159
3160
3161
3162
....
3457
3458
3459
3460
3461
3462
3463

3464
3465
3466


3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
....
3711
3712
3713
3714
3715
3716
3717






3718
3719
3720
3721
3722
3723
3724
....
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754

3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
....
4019
4020
4021
4022
4023
4024
4025







4026
4027
4028
4029
4030
4031
4032
....
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
....
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
# Contains private utility procedures for tablelist widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedure
#   - Private utility procedures
#
# Copyright (c) 2000-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
#------------------------------------------------------------------------------
proc tablelist::descCount {win key} {
    upvar ::tablelist::ns${win}::data data

    if {[string compare $key "root"] == 0} {
	return $data(itemCount)
    } else {
	set count [llength $data($key-children)]
	foreach child $data($key-children) {
	    incr count [descCount $win $child]
	}
	return $count
    }
}

#------------------------------------------------------------------------------
................................................................................
# Returns the row of the child item identified by childIdx of the node given by
# parentKey within the tablelist widget win.
#------------------------------------------------------------------------------
proc tablelist::nodeRow {win parentKey childIdx} {
    upvar ::tablelist::ns${win}::data data

    if {[isInteger $childIdx]} {
	if {$childIdx < [llength $data($parentKey-children)]} {
	    set childKey [lindex $data($parentKey-children) $childIdx]
	    return [keyToRow $win $childKey]
	} else {
	    return [expr {[keyToRow $win $parentKey] +
			  [descCount $win $parentKey] + 1}]
	}
    } elseif {[string first $childIdx "end"] == 0} {
	return [expr {[keyToRow $win $parentKey] +
		      [descCount $win $parentKey] + 1}]
    } elseif {[string first $childIdx "last"] == 0} {
	set childKey [lindex $data($parentKey-children) end]
	return [keyToRow $win $childKey]
    } else {
	return -code error \
	       "bad child index \"$childIdx\": must be end, last, or a number"
    }
}

................................................................................
#------------------------------------------------------------------------------
# tablelist::condUpdateListVar
#
# Updates the list variable of the tablelist widget win if present.
#------------------------------------------------------------------------------
proc tablelist::condUpdateListVar win {
    upvar ::tablelist::ns${win}::data data
    if {$data(hasListVar) && [info exists ::$data(-listvariable)]} {

	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
	set var {}
	foreach item $data(itemList) {
	    lappend var [lrange $item 0 $data(lastCol)]
	}
	trace variable var wu $data(listVarTraceCmd)
................................................................................
    set w $data(vsep)
    if {$col < 0 || $mainSepHeight == 0} {
	if {[winfo exists $w]} {
	    place forget $w
	}
    } else {
	if {!$data(-showlabels)} {

	    incr mainSepHeight




	}
	place $w -in $data(hdrTxtFrmLbl)$col -anchor ne -bordermode outside \
		 -height $mainSepHeight -relx 1.0 -x $sepX -y 1
	raise $w
    }

    #
................................................................................
	    incr sepHeight 3
	}
    }
    incr sepHeight [expr {[winfo reqheight $data(hdr)] -
			  [winfo reqheight $data(hdrTxtFrm)]}]
    if {!$data(-showlabels)} {
	incr sepHeight -1



    }
    foreach w [winfo children $win] {
	if {[regexp {^vsep[0-9]+$} [winfo name $w]]} {
	    place configure $w -height $sepHeight -rely $relY -y $y
	}
    }
}
................................................................................
# tablelist::getSepX
#
# Returns the value of the -x option to be used when placing a separator
# relative to the corresponding header label, with -anchor ne.
#------------------------------------------------------------------------------
proc tablelist::getSepX {} {
    set x 1
    variable usingTile
    if {$usingTile} {
	set currentTheme [getCurrentTheme]
	variable xpStyle
	if {([string compare $currentTheme "aqua"] == 0) ||
	    ([string compare $currentTheme "xpnative"] == 0 && $xpStyle)} {
	    set x 0
	} elseif {[string compare $currentTheme "tileqt"] == 0} {
	    switch -- [string tolower [tileqt_currentThemeName]] {
		cleanlooks -
		gtk+ -
		oxygen	{ set x 0 }
		qtcurve	{ set x 2 }
	    }
	}
    }

    return $x
}

#------------------------------------------------------------------------------
................................................................................
# widths are to be computed when performing these operations.  The stretchCols
# argument specifies whether to stretch the stretchable columns.
#------------------------------------------------------------------------------
proc tablelist::adjustColumns {win whichWidths stretchCols} {
    set compAllColWidths [expr {[string compare $whichWidths "allCols"] == 0}]
    set compAllLabelWidths \
	[expr {[string compare $whichWidths "allLabels"] == 0}]

    variable usingTile
    set usingAquaTheme \
	[expr {$usingTile && [string compare [getCurrentTheme] "aqua"] == 0}]

    #
    # Configure the labels and compute the positions
    # of the tab stops to be set in both text widgets
    #
    upvar ::tablelist::ns${win}::data data
    set data(hdrWidth) 0
................................................................................
# tablelist::adjustLabel
#
# Applies some configuration options to the col'th label of the tablelist
# widget win as well as to the label's sublabels (if any), and places the
# sublabels.
#------------------------------------------------------------------------------
proc tablelist::adjustLabel {win col pixels alignment} {
    variable usingTile
    set usingAquaTheme \
	[expr {$usingTile && [string compare [getCurrentTheme] "aqua"] == 0}]

    #
    # Apply some configuration options to the label and its sublabels (if any)
    #
    upvar ::tablelist::ns${win}::data data
    set w $data(hdrTxtFrmLbl)$col
    variable anchors
    set anchor $anchors($alignment)
................................................................................
    if {$padX < 0} {
	set padX 0
    }
    set padL $padX
    set padR $padX
    set marginL $data(charWidth)
    set marginR $data(charWidth)
    if {$usingAquaTheme} {
	incr padL
	incr marginL
	if {$col == 0} {
	    incr padL
	    incr marginL
	}
	set padding [$w cget -padding]
................................................................................
	    place forget $w-tl
	}
    } else {
	if {[string length $text] == 0} {
	    place forget $w-tl
	}


	if {$usingTile} {
	    set padding [$w cget -padding]
	    set padT [lindex $padding 1]
	    set padB [lindex $padding 3]
	} else {
	    set padT [$w cget -pady]
	    set padB $padT
................................................................................
	place configure $data(hdrTxt) -y 0
	place configure $data(hdrFrm) -y 0
	place configure $data(cornerLbl) -height $maxLabelHeight -y 0
    } else {
	$data(hdrTxtFrm) configure -height 1
	if {$data(hdr_itemCount) == 0} {
	    set hdrHeight 1

	} else {
	    set hdrHeight [$data(hdrTxt) count -update -ypixels 1.0 end]
	    incr hdrHeight 2


	}
	$data(hdr) configure -height $hdrHeight
	$data(hdrFrm) configure -height 1

	place configure $data(hdrTxt) -y -1
	place configure $data(hdrFrm) -y -1
	place configure $data(cornerLbl) -height 1 -y -1
    }

    set cornerFrmHeight $hdrHeight
    if {$data(hdr_itemCount) != 0} {
	variable usingTile
	if {$usingTile && [string compare [getCurrentTheme] "aqua"] == 0} {
	    incr cornerFrmHeight -1
	} else {
	    incr cornerFrmHeight -2
	}
    }
    $data(cornerFrm-ne) configure -height $cornerFrmHeight

................................................................................
    if {$updateAll} {
	set topTextIdx [$w index @0,0]
	set btmTextIdx [$w index @0,$data(btmY)]
	set fromTextIdx "$topTextIdx linestart"
	set toTextIdx   "$btmTextIdx lineend"

	$w tag remove select $fromTextIdx $toTextIdx







	if {$data(isDisabled)} {
	    $w tag add disabled $fromTextIdx $toTextIdx
	}

	if {[string length $data(-colorizecommand)] == 0} {
	    set hasColorizeCmd 0
................................................................................

	    #
	    # Handle the -stripebackground and -stripeforeground
	    # column configuration options, as well as the
	    # -(select)background and -(select)foreground column,
	    # row, and cell configuration options in this row
	    #
	    findTabs $win $w $line $leftCol $leftCol tabIdx1 tabIdx2
	    set lineTagNames [$w tag names $tabIdx1]
	    set inStripe [expr {[lsearch -exact $lineTagNames stripe] >= 0}]

	    for {set col $leftCol} {$col <= $rightCol} {incr col} {
		if {$data($col-hide) && !$canElide} {
		    continue
		}

		set textIdx2 [$w index $tabIdx2+1$pu]

		set cellTagNames [$w tag names $tabIdx2]
		foreach tag $cellTagNames {
		    if {[string match "*-*ground-*" $tag]} {
			$w tag remove $tag $tabIdx1 $textIdx2
		    }
		}

		if {$inStripe} {
		    foreach opt {-stripebackground -stripeforeground} {
			set name $col$opt
			if {[info exists data($name)]} {
			    $w tag add col$opt-$data($name) $tabIdx1 $textIdx2
			}
		    }
................................................................................

    set leftCol [colIndex $win @0,0 0 0]
    if {$leftCol < 0} {
	return ""
    }

    set w $data(hdrTxt)







    if {$data(isDisabled)} {
	$w tag add disabled 2.0 end
    }

    if {[string length $data(-colorizecommand)] == 0} {
	set hasColorizeCmd 0
    } else {
................................................................................
	for {set col $leftCol} {$col <= $rightCol} {incr col} {
	    if {$data($col-hide) && !$canElide} {
		continue
	    }

	    set textIdx2 [$w index $tabIdx2+1$pu]

	    set cellTagNames [$w tag names $tabIdx2]
	    foreach tag $cellTagNames {
		if {[string match "*-*ground-*" $tag]} {
		    $w tag remove $tag $tabIdx1 $textIdx2
		}
	    }

	    foreach opt {-background -foreground} {
		foreach level [list col row cell] \
			name  [list $col$opt $key$opt $key,$col$opt] {
		    if {[info exists data($name)]} {
			$w tag add $level$opt-$data($name) $tabIdx1 $textIdx2
		    }
		}
................................................................................
    # directly, before the idle time occured; in this case we should
    # cancel the execution of the previously scheduled idle callback.
    #
    after cancel $data(syncId)	;# no harm if data(syncId) is no longer valid
    unset data(syncId)

    upvar #0 $data(-listvariable) var
    if {[catch {foreach item $var {llength $item}}] != 0} {
	condUpdateListVar $win
	return -code error "value of variable \"$data(-listvariable)\" is not\
			    a list of lists"
    }

    set newCount [llength $var]
    if {$newCount < $data(itemCount)} {
	#
	# Delete the items with indices >= newCount from the widget
	#







|







 







|
|







 







|
|









|







 







|
>







 







>
|
>
>
>
>







 







>
>
>







 







<
<
|
|
|
|
|
|
|
|
|
|
|
<







 







<
<
<
|







 







<
<
<
<







 







|







 







>







 







>

|

>
>




|






<
|







 







>
>
>
>
>
>







 







<
|

>







<
<
<
<
<
<
<







 







>
>
>
>
>
>
>







 







<
<
<
<
<
<
<







 







|


|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
....
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
....
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
....
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
....
2717
2718
2719
2720
2721
2722
2723


2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739
2740
2741
....
2748
2749
2750
2751
2752
2753
2754



2755
2756
2757
2758
2759
2760
2761
2762
....
2944
2945
2946
2947
2948
2949
2950




2951
2952
2953
2954
2955
2956
2957
....
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
....
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
....
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480

3481
3482
3483
3484
3485
3486
3487
3488
....
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
....
3753
3754
3755
3756
3757
3758
3759

3760
3761
3762
3763
3764
3765
3766
3767
3768
3769







3770
3771
3772
3773
3774
3775
3776
....
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
....
4054
4055
4056
4057
4058
4059
4060







4061
4062
4063
4064
4065
4066
4067
....
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
# Contains private utility procedures for tablelist widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedure
#   - Private utility procedures
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
#------------------------------------------------------------------------------
proc tablelist::descCount {win key} {
    upvar ::tablelist::ns${win}::data data

    if {[string compare $key "root"] == 0} {
	return $data(itemCount)
    } else {
	set count [llength $data($key-childList)]
	foreach child $data($key-childList) {
	    incr count [descCount $win $child]
	}
	return $count
    }
}

#------------------------------------------------------------------------------
................................................................................
# Returns the row of the child item identified by childIdx of the node given by
# parentKey within the tablelist widget win.
#------------------------------------------------------------------------------
proc tablelist::nodeRow {win parentKey childIdx} {
    upvar ::tablelist::ns${win}::data data

    if {[isInteger $childIdx]} {
	if {$childIdx < [llength $data($parentKey-childList)]} {
	    set childKey [lindex $data($parentKey-childList) $childIdx]
	    return [keyToRow $win $childKey]
	} else {
	    return [expr {[keyToRow $win $parentKey] +
			  [descCount $win $parentKey] + 1}]
	}
    } elseif {[string first $childIdx "end"] == 0} {
	return [expr {[keyToRow $win $parentKey] +
		      [descCount $win $parentKey] + 1}]
    } elseif {[string first $childIdx "last"] == 0} {
	set childKey [lindex $data($parentKey-childList) end]
	return [keyToRow $win $childKey]
    } else {
	return -code error \
	       "bad child index \"$childIdx\": must be end, last, or a number"
    }
}

................................................................................
#------------------------------------------------------------------------------
# tablelist::condUpdateListVar
#
# Updates the list variable of the tablelist widget win if present.
#------------------------------------------------------------------------------
proc tablelist::condUpdateListVar win {
    upvar ::tablelist::ns${win}::data data
    if {$data(hasListVar) &&
	[uplevel #0 [list info exists $data(-listvariable)]]} {
	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
	set var {}
	foreach item $data(itemList) {
	    lappend var [lrange $item 0 $data(lastCol)]
	}
	trace variable var wu $data(listVarTraceCmd)
................................................................................
    set w $data(vsep)
    if {$col < 0 || $mainSepHeight == 0} {
	if {[winfo exists $w]} {
	    place forget $w
	}
    } else {
	if {!$data(-showlabels)} {
	    if {$data(hdr_itemCount) == 0} {
		incr mainSepHeight
	    } else {
		incr mainSepHeight \
		     [$data(hdrTxt) count -update -ypixels 1.0 2.0]
	    }
	}
	place $w -in $data(hdrTxtFrmLbl)$col -anchor ne -bordermode outside \
		 -height $mainSepHeight -relx 1.0 -x $sepX -y 1
	raise $w
    }

    #
................................................................................
	    incr sepHeight 3
	}
    }
    incr sepHeight [expr {[winfo reqheight $data(hdr)] -
			  [winfo reqheight $data(hdrTxtFrm)]}]
    if {!$data(-showlabels)} {
	incr sepHeight -1
	if {$data(hdr_itemCount) != 0} {
	    incr sepHeight [$data(hdrTxt) count -update -ypixels 1.0 2.0]
	}
    }
    foreach w [winfo children $win] {
	if {[regexp {^vsep[0-9]+$} [winfo name $w]]} {
	    place configure $w -height $sepHeight -rely $relY -y $y
	}
    }
}
................................................................................
# tablelist::getSepX
#
# Returns the value of the -x option to be used when placing a separator
# relative to the corresponding header label, with -anchor ne.
#------------------------------------------------------------------------------
proc tablelist::getSepX {} {
    set x 1


    set currentTheme [getCurrentTheme]
    variable xpStyle
    if {([string compare $currentTheme "aqua"] == 0) ||
	([string compare $currentTheme "xpnative"] == 0 && $xpStyle)} {
	set x 0
    } elseif {[string compare $currentTheme "tileqt"] == 0} {
	switch -- [string tolower [tileqt_currentThemeName]] {
	    cleanlooks -
	    gtk+ -
	    oxygen	{ set x 0 }
	    qtcurve	{ set x 2 }

	}
    }

    return $x
}

#------------------------------------------------------------------------------
................................................................................
# widths are to be computed when performing these operations.  The stretchCols
# argument specifies whether to stretch the stretchable columns.
#------------------------------------------------------------------------------
proc tablelist::adjustColumns {win whichWidths stretchCols} {
    set compAllColWidths [expr {[string compare $whichWidths "allCols"] == 0}]
    set compAllLabelWidths \
	[expr {[string compare $whichWidths "allLabels"] == 0}]



    set usingAquaTheme [expr {[string compare [getCurrentTheme] "aqua"] == 0}]

    #
    # Configure the labels and compute the positions
    # of the tab stops to be set in both text widgets
    #
    upvar ::tablelist::ns${win}::data data
    set data(hdrWidth) 0
................................................................................
# tablelist::adjustLabel
#
# Applies some configuration options to the col'th label of the tablelist
# widget win as well as to the label's sublabels (if any), and places the
# sublabels.
#------------------------------------------------------------------------------
proc tablelist::adjustLabel {win col pixels alignment} {




    #
    # Apply some configuration options to the label and its sublabels (if any)
    #
    upvar ::tablelist::ns${win}::data data
    set w $data(hdrTxtFrmLbl)$col
    variable anchors
    set anchor $anchors($alignment)
................................................................................
    if {$padX < 0} {
	set padX 0
    }
    set padL $padX
    set padR $padX
    set marginL $data(charWidth)
    set marginR $data(charWidth)
    if {[string compare [getCurrentTheme] "aqua"] == 0} {
	incr padL
	incr marginL
	if {$col == 0} {
	    incr padL
	    incr marginL
	}
	set padding [$w cget -padding]
................................................................................
	    place forget $w-tl
	}
    } else {
	if {[string length $text] == 0} {
	    place forget $w-tl
	}

	variable usingTile
	if {$usingTile} {
	    set padding [$w cget -padding]
	    set padT [lindex $padding 1]
	    set padB [lindex $padding 3]
	} else {
	    set padT [$w cget -pady]
	    set padB $padT
................................................................................
	place configure $data(hdrTxt) -y 0
	place configure $data(hdrFrm) -y 0
	place configure $data(cornerLbl) -height $maxLabelHeight -y 0
    } else {
	$data(hdrTxtFrm) configure -height 1
	if {$data(hdr_itemCount) == 0} {
	    set hdrHeight 1
	    set y -1
	} else {
	    set hdrHeight [$data(hdrTxt) count -update -ypixels 2.0 end]
	    incr hdrHeight 2
	    set y -2
	    $data(hdrTxt) yview 1
	}
	$data(hdr) configure -height $hdrHeight
	$data(hdrFrm) configure -height 1

	place configure $data(hdrTxt) -y $y
	place configure $data(hdrFrm) -y -1
	place configure $data(cornerLbl) -height 1 -y -1
    }

    set cornerFrmHeight $hdrHeight
    if {$data(hdr_itemCount) != 0} {

	if {[string compare [getCurrentTheme] "aqua"] == 0} {
	    incr cornerFrmHeight -1
	} else {
	    incr cornerFrmHeight -2
	}
    }
    $data(cornerFrm-ne) configure -height $cornerFrmHeight

................................................................................
    if {$updateAll} {
	set topTextIdx [$w index @0,0]
	set btmTextIdx [$w index @0,$data(btmY)]
	set fromTextIdx "$topTextIdx linestart"
	set toTextIdx   "$btmTextIdx lineend"

	$w tag remove select $fromTextIdx $toTextIdx

	foreach tag [$w tag names] {
	    if {[string match "*-*ground-*" $tag]} {
		$w tag remove $tag $fromTextIdx $toTextIdx
	    }
	}

	if {$data(isDisabled)} {
	    $w tag add disabled $fromTextIdx $toTextIdx
	}

	if {[string length $data(-colorizecommand)] == 0} {
	    set hasColorizeCmd 0
................................................................................

	    #
	    # Handle the -stripebackground and -stripeforeground
	    # column configuration options, as well as the
	    # -(select)background and -(select)foreground column,
	    # row, and cell configuration options in this row
	    #

	    set lineTagNames [$w tag names $line.0]
	    set inStripe [expr {[lsearch -exact $lineTagNames stripe] >= 0}]
	    findTabs $win $w $line $leftCol $leftCol tabIdx1 tabIdx2
	    for {set col $leftCol} {$col <= $rightCol} {incr col} {
		if {$data($col-hide) && !$canElide} {
		    continue
		}

		set textIdx2 [$w index $tabIdx2+1$pu]








		if {$inStripe} {
		    foreach opt {-stripebackground -stripeforeground} {
			set name $col$opt
			if {[info exists data($name)]} {
			    $w tag add col$opt-$data($name) $tabIdx1 $textIdx2
			}
		    }
................................................................................

    set leftCol [colIndex $win @0,0 0 0]
    if {$leftCol < 0} {
	return ""
    }

    set w $data(hdrTxt)

    foreach tag [$w tag names] {
	if {[string match "*-*ground-*" $tag]} {
	    $w tag remove $tag 2.0 end
	}
    }

    if {$data(isDisabled)} {
	$w tag add disabled 2.0 end
    }

    if {[string length $data(-colorizecommand)] == 0} {
	set hasColorizeCmd 0
    } else {
................................................................................
	for {set col $leftCol} {$col <= $rightCol} {incr col} {
	    if {$data($col-hide) && !$canElide} {
		continue
	    }

	    set textIdx2 [$w index $tabIdx2+1$pu]








	    foreach opt {-background -foreground} {
		foreach level [list col row cell] \
			name  [list $col$opt $key$opt $key,$col$opt] {
		    if {[info exists data($name)]} {
			$w tag add $level$opt-$data($name) $tabIdx1 $textIdx2
		    }
		}
................................................................................
    # directly, before the idle time occured; in this case we should
    # cancel the execution of the previously scheduled idle callback.
    #
    after cancel $data(syncId)	;# no harm if data(syncId) is no longer valid
    unset data(syncId)

    upvar #0 $data(-listvariable) var
    if {[catch {foreach item $var {llength $item}} err] != 0} {
	condUpdateListVar $win
	return -code error "value of variable \"$data(-listvariable)\" is not\
			    a list of lists ($err)"
    }

    set newCount [llength $var]
    if {$newCount < $data(itemCount)} {
	#
	# Delete the items with indices >= newCount from the widget
	#

Changes to modules/tablelist/scripts/tablelistWidget.tcl.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
182
183
184
185
186
187
188

189

190
191
192
193
194
195
196
...
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
....
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
....
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
....
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
....
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
....
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
....
2043
2044
2045
2046
2047
2048
2049




2050
2051
2052
2053

2054
2055
2056
2057




2058
2059
2060

2061
2062
2063
2064
2065
2066
2067
....
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
....
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
....
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
....
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
....
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
....
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
....
3465
3466
3467
3468
3469
3470
3471




3472
3473
3474
3475

3476
3477
3478

3479


3480
3481
3482

3483
3484
3485
3486
3487
3488
3489
....
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
....
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
....
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
....
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
....
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
....
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
....
6875
6876
6877
6878
6879
6880
6881
6882


6883

6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896
6897

6898
6899
6900
6901
6902
6903
6904
....
7078
7079
7080
7081
7082
7083
7084
7085

7086
7087
7088
7089
7090
7091
7092
....
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219


7220
7221
7222
7223
7224
7225
7226
7227
....
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
....
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
8031
....
8177
8178
8179
8180
8181
8182
8183






8184
8185
8186
8187
8188
8189
8190
....
8352
8353
8354
8355
8356
8357
8358
8359

8360
8361
8362
8363
8364
8365
8366
8367
8368

8369
8370
8371
8372
8373
8374
8375
8376
....
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
8413
8414
....
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744
8745
8746
8747

8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new tablelist widget
#   - Private procedures implementing the tablelist widget command
#   - Private callback procedures
#
# Copyright (c) 2000-2018  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
	-tight			 {tight			  Tight		      w}
	-titlecolumns		 {titleColumns	  	  TitleColumns	      w}
	-tooltipaddcommand	 {tooltipAddCommand	  TooltipAddCommand   w}
	-tooltipdelcommand	 {tooltipDelCommand	  TooltipDelCommand   w}
	-treecolumn		 {treeColumn		  TreeColumn	      w}
	-treestyle		 {treeStyle		  TreeStyle	      w}
	-width			 {width			  Width		      w}

	-xscrollcommand		 {xScrollCommand	  ScrollCommand	      w}

	-yscrollcommand		 {yScrollCommand	  ScrollCommand	      w}
    }

    #
    # Extend the elements of the array configSpecs
    #
    extendConfigSpecs 
................................................................................
	    cellsToReconfig	 {}
	    hdr_cellsToReconfig	 {}
	    nonViewableRowCount	 0
	    viewableRowList	 {-1}
	    hiddenColCount	 0
	    root-row		-1
	    root-parent		 ""
	    root-children	 {}
	    keyToRowMapValid	 1
	    searchStartIdx	 0
	    keyBeingExpanded	 ""
	    justEntered		 0
	    inEditWin		 0
	}

................................................................................
    if {[llength $argList] != 1} {
	mwutil::wrongNumArgs "$win childcount nodeIndex"
    }

    synchronize $win
    set key [nodeIndexToKey $win [lindex $argList 0]]
    upvar ::tablelist::ns${win}::data data
    return [llength $data($key-children)]
}

#------------------------------------------------------------------------------
# tablelist::childindexSubCmd
#------------------------------------------------------------------------------
proc tablelist::childindexSubCmd {win argList} {
    if {[llength $argList] != 1} {
................................................................................
    }

    synchronize $win
    set row [rowIndex $win [lindex $argList 0] 0 1]
    upvar ::tablelist::ns${win}::data data
    set key [lindex $data(keyList) $row]
    set parentKey $data($key-parent)
    return [lsearch -exact $data($parentKey-children) $key]
}

#------------------------------------------------------------------------------
# tablelist::childkeysSubCmd
#------------------------------------------------------------------------------
proc tablelist::childkeysSubCmd {win argList} {
    if {[llength $argList] != 1} {
	mwutil::wrongNumArgs "$win childkeys nodeIndex"
    }

    synchronize $win
    set key [nodeIndexToKey $win [lindex $argList 0]]
    upvar ::tablelist::ns${win}::data data
    return $data($key-children)
}

#------------------------------------------------------------------------------
# tablelist::collapseSubCmd
#------------------------------------------------------------------------------
proc tablelist::collapseSubCmd {win argList} {
    set argCount [llength $argList]
................................................................................
	set data($key,$col-indent) [strMap \
	    {"indented" "collapsed" "expanded" "collapsed"} \
	    $data($key,$col-indent)]
	if {[winfo exists $w.ind_$key,$col]} {
	    $w.ind_$key,$col configure -image $data($key,$col-indent)
	}

	if {[llength $data($key-children)] == 0} {
	    continue
	}

	#
	# Elide the descendants of this item
	#
	set fromRow [expr {$index + 1}]
	set toRow [nodeRow $win $key end]
	for {set row $fromRow} {$row < $toRow} {incr row} {
	    doRowConfig $row $win -elide 1

	    if {$fullCollapsion} {
		set descKey [lindex $data(keyList) $row]
		if {[llength $data($descKey-children)] != 0} {
		    if {$callCollapseCmd} {
			uplevel #0 $data(-collapsecommand) [list $win $row]
		    }

		    #
		    # Change the descendant's indentation image
		    # from the expanded to the collapsed one
................................................................................
    displayItems $win

    upvar ::tablelist::ns${win}::data data
    set callCollapseCmd [expr {[string length $data(-collapsecommand)] != 0}]
    set col $data(treeCol)
    set w $data(body)

    foreach key $data(root-children) {
	if {![info exists data($key,$col-indent)]} {
	    continue
	}

	set index [keyToRow $win $key]
	if {$callCollapseCmd} {
	    uplevel #0 $data(-collapsecommand) [list $win $index]
................................................................................
	set data($key,$col-indent) [strMap \
	    {"indented" "collapsed" "expanded" "collapsed"} \
	    $data($key,$col-indent)]
	if {[winfo exists $w.ind_$key,$col]} {
	    $w.ind_$key,$col configure -image $data($key,$col-indent)
	}

	if {[llength $data($key-children)] == 0} {
	    continue
	}

	#
	# Elide the descendants of this item
	#
	set fromRow [expr {$index + 1}]
	set toRow [nodeRow $win $key end]
	for {set row $fromRow} {$row < $toRow} {incr row} {
	    doRowConfig $row $win -elide 1

	    if {$fullCollapsion} {
		set descKey [lindex $data(keyList) $row]
		if {[llength $data($descKey-children)] != 0} {
		    if {$callCollapseCmd} {
			uplevel #0 $data(-collapsecommand) [list $win $row]
		    }

		    #
		    # Change the descendant's indentation image
		    # from the expanded to the collapsed one
................................................................................
		    set index 0
		} elseif {$index > $data(lastRow)} {
		    set index $data(lastRow)
		}
		lappend indexList $index
	    }
	    set indexList [lsort -integer -decreasing $indexList]





	    #
	    # Traverse the sorted index list and ignore any duplicates
	    #

	    set prevIndex -1
	    foreach index $indexList {
		if {$index != $prevIndex} {
		    deleteRows $win $index $index $data(hasListVar)




		    set prevIndex $index
		}
	    }

	    return ""
	}
    } else {
	set first [rowIndex $win $first 0]
	set last [rowIndex $win [lindex $argList 1] 0]
	return [deleteRows $win $first $last $data(hasListVar)]
    }
................................................................................
	    uplevel #0 $data(-expandcommand) [list $win $index]
	    set data(keyBeingExpanded) ""
	}

	#
	# Set the indentation image to the indented or expanded one
	#
	set childCount [llength $data($key-children)]
	set state [expr {($childCount == 0) ? "indented" : "expanded"}]
	set data($key,$col-indent) [strMap \
	    [list "collapsed" $state "expanded" $state] $data($key,$col-indent)]
	if {[string compare $state "indented"] == 0} {
	    set data($key,$col-indent) [strMap \
		{"Act" "" "Sel" ""} $data($key,$col-indent)]
	}
................................................................................

	#
	# Unelide the children if appropriate and
	# invoke this procedure recursively on them
	#
	set isViewable [expr {![info exists data($key-elide)] &&
			      ![info exists data($key-hide)]}]
	foreach childKey $data($key-children) {
	    set childRow [keyToRow $win $childKey]
	    if {$isViewable} {
		doRowConfig $childRow $win -elide 0
	    }
	    if {$fullExpansion} {
		expandSubCmd $win [list $childRow -fully]
	    } elseif {[string match "*expanded*" \
................................................................................
    displayItems $win

    upvar ::tablelist::ns${win}::data data
    set callExpandCmd [expr {[string length $data(-expandcommand)] != 0}]
    set col $data(treeCol)
    set w $data(body)

    foreach key $data(root-children) {
	if {![info exists data($key,$col-indent)] ||
	    [string match "*indented*" $data($key,$col-indent)]} {
	    continue
	}

	if {$callExpandCmd} {
	    set data(keyBeingExpanded) $key
................................................................................
	    uplevel #0 $data(-expandcommand) [list $win [keyToRow $win $key]]
	    set data(keyBeingExpanded) ""
	}

	#
	# Set the indentation image to the indented or expanded one
	#
	set childCount [llength $data($key-children)]
	set state [expr {($childCount == 0) ? "indented" : "expanded"}]
	set data($key,$col-indent) [strMap \
	    [list "collapsed" $state "expanded" $state] $data($key,$col-indent)]
	if {[string compare $state "indented"] == 0} {
	    set data($key,$col-indent) [strMap \
		{"Act" "" "Sel" ""} $data($key,$col-indent)]
	}
................................................................................
	    $w.ind_$key,$col configure -image $data($key,$col-indent)
	}

	#
	# Unelide the children if appropriate and invoke expandSubCmd on them
	#
	set isViewable [expr {![info exists data($key-hide)]}]
	foreach childKey $data($key-children) {
	    set childRow [keyToRow $win $childKey]
	    if {$isViewable} {
		doRowConfig $childRow $win -elide 0
	    }
	    if {$fullExpansion} {
		expandSubCmd $win [list $childRow -fully]
	    } elseif {[string match "*expanded*" \
................................................................................
		incr n
		set parentKey [nodeIndexToKey $win [lindex $argList $n]]
	    }
	}
    }

    upvar ::tablelist::ns${win}::data data
    set childCount [llength $data($parentKey-children)]
    if {$childCount == 0} {
	return -1
    }

    if {$descend} {
	set fromChildKey [lindex $data($parentKey-children) 0]
	set fromRow [keyToRow $win $fromChildKey]
	set toRow [nodeRow $win $parentKey end]
	for {set row $fromRow} {$row < $toRow} {incr row} {
	    set key [lindex $data(keyList) $row]
	    set hasName [info exists data($key-name)]
	    if {($hasName && [string compare $name $data($key-name)] == 0) ||
		(!$hasName && $nameIsEmpty)} {
		return $row
	    }
	}
    } else {
	for {set childIdx 0} {$childIdx < $childCount} {incr childIdx} {
	    set key [lindex $data($parentKey-children) $childIdx]
	    set hasName [info exists data($key-name)]
	    if {($hasName && [string compare $name $data($key-name)] == 0) ||
		(!$hasName && $nameIsEmpty)} {
		return [keyToRow $win $key]
	    }
	}
    }
................................................................................
		    set index 0
		} elseif {$index > $data(hdr_lastRow)} {
		    set index $data(hdr_lastRow)
		}
		lappend indexList $index
	    }
	    set indexList [lsort -integer -decreasing $indexList]





	    #
	    # Traverse the sorted index list and ignore any duplicates
	    #

	    set prevIndex -1
	    foreach index $indexList {
		if {$index != $prevIndex} {

		    hdr_deleteRows $win $index $index


		    set prevIndex $index
		}
	    }

	    return ""
	}
    } else {
	set first [hdr_rowIndex $win $first 0]
	set last [hdr_rowIndex $win [lindex $argList 1] 0]
	return [hdr_deleteRows $win $first $last]
    }
................................................................................
    }

    #
    # Build the list of row indices of the matching elements
    #
    set rowList {}
    set useFormatCmd [expr {$formatted && [lindex $data(fmtCmdFlagList) $col]}]
    set childCount [llength $data($parentKey-children)]
    if {$childCount != 0} {
	if {$backwards} {
	    set childIdx [expr {$childCount - 1}]
	    if {$descend} {
		set childKey [lindex $data($parentKey-children) $childIdx]
		set maxRow [expr {[nodeRow $win $childKey end] - 1}]
		if {$gotStartRow && $maxRow > $startRow} {
		    set maxRow $startRow
		}
		set minRow [nodeRow $win $parentKey 0]
		for {set row $maxRow} {$row >= $minRow} {incr row -1} {
		    set item [lindex $data(itemList) $row]
................................................................................
			if {!$allMatches} {
			    break
			}
		    }
		}
	    } else {
		for {} {$childIdx >= 0} {incr childIdx -1} {
		    set key [lindex $data($parentKey-children) $childIdx]
		    set row [keyToRow $win $key]
		    if {$gotStartRow && $row > $startRow} {
			continue
		    }
		    set elem [lindex [lindex $data(itemList) $row] $col]
		    if {$useFormatCmd} {
			set elem [formatElem $win $key $row $col $elem]
................................................................................
			}
		    }
		}
	    }
	} else {
	    set childIdx 0
	    if {$descend} {
		set childKey [lindex $data($parentKey-children) $childIdx]
		set fromRow [keyToRow $win $childKey]
		if {$gotStartRow && $fromRow < $startRow} {
		    set fromRow $startRow
		}
		set toRow [nodeRow $win $parentKey end]
		for {set row $fromRow} {$row < $toRow} {incr row} {
		    set item [lindex $data(itemList) $row]
................................................................................
			if {!$allMatches} {
			    break
			}
		    }
		}
	    } else {
		for {} {$childIdx < $childCount} {incr childIdx} {
		    set key [lindex $data($parentKey-children) $childIdx]
		    set row [keyToRow $win $key]
		    if {$gotStartRow && $row < $startRow} {
			continue
		    }
		    set elem [lindex [lindex $data(itemList) $row] $col]
		    if {$useFormatCmd} {
			set elem [formatElem $win $key $row $col $elem]
................................................................................
    # Unset the elements of data, attribs, and
    # selStates corresponding to the deleted items
    #
    if {$count == $data(itemCount)} {
	arrayUnset data {k[0-9]*}
	array set data {rowTagRefCount 0  nonViewableRowCount 0
	    cellTagRefCount 0  imgCount 0  winCount 0  indentCount 0
	    root-children {}}

	arrayUnset attribs {k[0-9]*}
	arrayUnset selStates *
    } else {
	for {set row $first} {$row <= $last} {incr row} {
	    set item [lindex $data(itemList) $row]
	    set key [lindex $item end]
................................................................................
		incr data(nonViewableRowCount) -1
	    }

	    #
	    # Remove the key from the list of children of its parent
	    #
	    set parentKey $data($key-parent)
	    if {[info exists data($parentKey-children)]} {
		set childIdx [lsearch -exact $data($parentKey-children) $key]
		set data($parentKey-children) \
		    [lreplace $data($parentKey-children) $childIdx $childIdx]

		#
		# If the parent's list of children has become empty
		# then set its indentation image to the indented one
		#
		set col $data(treeCol)
		if {[llength $data($parentKey-children)] == 0 &&
		    [info exists data($parentKey,$col-indent)]} {
		    collapseSubCmd $win [list $parentKey -partly]
		    set data($parentKey,$col-indent) [strMap \
			{"collapsed" "indented" "expanded" "indented"
			 "Act" "" "Sel" ""} $data($parentKey,$col-indent)]
		    if {[winfo exists $data(body).ind_$parentKey,$col]} {
			$data(body).ind_$parentKey,$col configure -image \
			    $data($parentKey,$col-indent)
		    }
		}
	    }

	    foreach prop {-row -parent -children} {
		unset data($key$prop)
	    }

	    for {set col 0} {$col < $data(colCount)} {incr col} {
		foreach opt {-background -foreground -editable -editwindow
			     -imagebackground -selectbackground
			     -selectforeground -valign -windowdestroy
................................................................................

		if {[info exists data($key,$col-indent)]} {
		    unset data($key,$col-indent)
		    incr data(indentCount) -1
		}
	    }

	    arrayUnset attribs $key*


	    arrayUnset selStates $key*

	}
    }

    #
    # Delete the given items from the internal list
    #
    set data(itemList) [lreplace $data(itemList) $first $last]
    set data(keyList) [lreplace $data(keyList) $first $last]
    incr data(itemCount) -$count

    #
    # Delete the given items from the list variable if needed
    #
    if {$updateListVar && [info exists ::$data(-listvariable)]} {

	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
	set var [lreplace $var $first $last]
	trace variable var wu $data(listVarTraceCmd)
    }

    #
................................................................................
	    if {[info exists data($key,$col-window)]} {
		unset data($key,$col-window)
		unset data($key,$col-reqWidth)
		unset data($key,$col-reqHeight)
	    }
	}

	arrayUnset attribs $key*

    }

    #
    # Delete the given items from the internal list
    #
    set data(hdr_itemList) [lreplace $data(hdr_itemList) $first $last]
    set data(hdr_keyList) [lreplace $data(hdr_keyList) $first $last]
................................................................................
    upvar ::tablelist::ns${win}::data data
    if {$index < 0} {
	set index 0
    } elseif {$index > $data(itemCount)} {
	set index $data(itemCount)
    }

    set childCount [llength $data($parentKey-children)]
    if {$childIdx < 0} {
	set childIdx 0
    } elseif {$childIdx > $childCount} {	;# e.g., if $childIdx is "end"
	set childIdx $childCount
    }



    if {$updateListVar && [info exists ::$data(-listvariable)]} {
	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
    }

    #
    # Insert the items into the internal list
    #
................................................................................
	    lappend data(keyList) $key		;# this works much faster
	} else {
	    set data(itemList) [linsert $data(itemList) $row $item]
	    set data(keyList) [linsert $data(keyList) $row $key]
	}

	array set data \
	    [list $key-row $row  $key-parent $parentKey  $key-children {}]

	#
	# Insert the key into the parent's list of children
	#
	if {$appendingChildren} {
	    lappend data($parentKey-children) $key    ;# this works much faster
	} else {
	    set data($parentKey-children) \
		[linsert $data($parentKey-children) $childIdx $key]
	}

	lappend result $key

	incr row
	incr childIdx
    }
................................................................................
    set key [lindex $data(keyList) $index]
    set col $data(treeCol)
    if {![info exists data($key,$col-indent)] ||
	[string match "*indented*" $data($key,$col-indent)]} {
	return ""
    }

    if {[llength $data($key-children)] == 0} {
	uplevel #0 $data(-populatecommand) [list $win $index]
    }

    if {$fully} {
	#
	# Invoke this procedure recursively on the children
	#
	foreach childKey $data($key-children) {
	    populate $win [keyToRow $win $childKey] 1
	}
    }
}

#------------------------------------------------------------------------------
# tablelist::doesMatch
................................................................................
    if {$data(-titlecolumns) == 0} {
	findTabs $win $b [expr {$row + 1}] $col $col tabIdx1 tabIdx2
	variable pu
	set nextIdx [$b index $tabIdx2+1$pu]
	set alignment [lindex $data(colList) [expr {2*$col + 1}]]
	set lX [winfo x $data(hdrTxtFrmLbl)$col]
	set rX [expr {$lX + [winfo width $data(hdrTxtFrmLbl)$col] - 1}]







	switch $alignment {
	    left {
		#
		# Bring the cell's left edge into view
		#
		if {![seeTextIdx $win $tabIdx1]} {
................................................................................
	    }

	    if {$first == 0 && $last == $data(lastRow)} {
		arrayUnset selStates *		;# this works much faster
	    } else {
		for {set row $first} {$row <= $last} {incr row} {
		    set key [lindex $data(keyList) $row]
		    arrayUnset selStates $key*

		}
	    }

	    updateColorsWhenIdle $win
	    return ""
	}

	includes {
	    set key [lindex $data(keyList) $first]

	    return [expr {[llength [array names selStates $key*]] != 0 &&
			  $data(colCount) != 0}]
	}

	set {
	    #
	    # Swap the indices if necessary and adjust
	    # the range to fit within the existing items
................................................................................

	    #
	    # If the selection is exported and there are any selected
	    # cells in the widget then make win the new owner of the
	    # PRIMARY selection and register a callback to be invoked
	    # when it loses ownership of the PRIMARY selection
	    #
	    if {$data(-exportselection) && $data(colCount) != 0 &&
		[array size selStates] != 0} {
		selection own -command \
		    [list ::tablelist::lostSelection $win] $win
	    }

	    updateColorsWhenIdle $win
	    return ""
	}
................................................................................
		#
		set data(syncId) [after idle [list tablelist::synchronize $win]]
	    }
	}

	u {
	    #
	    # Recreate the variable ::$varName by setting it according to
	    # the value of data(itemList), and set the trace on it again
	    #
	    if {[string length $arrIndex] != 0} {
		set varName ${varName}($arrIndex)
	    }
	    set ::$varName {}

	    foreach item $data(itemList) {
		lappend ::$varName [lrange $item 0 $data(lastCol)]
	    }
	    trace variable ::$varName wu $data(listVarTraceCmd)
	}
    }
}

#------------------------------------------------------------------------------
# tablelist::checkStatesTrace
#







|







 







>

>







 







|







 







|







 







|













|







 







|













|







 







|







 







|













|







 







>
>
>
>




>
|


<
>
>
>
>



>







 







|







 







|







 







|







 







|







 







|







 







|





|












|







 







>
>
>
>




>
|


>
|
>
>



>







 







|




|







 







|







 







|







 







|







 







|







 







|
|
|
|






|












|







 







|
>
>
|
>













|
>







 







|
>







 







|






>
>
|







 







|





|

|
|







 







|







|







 







>
>
>
>
>
>







 







|
>









>
|







 







|
|







 







|





|
>

|

|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
...
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
....
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
....
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
....
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
....
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
....
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
....
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
....
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
....
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
....
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
....
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
....
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
....
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
....
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
....
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
....
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
....
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
....
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
....
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
....
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
....
6895
6896
6897
6898
6899
6900
6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
....
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
....
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
7254
....
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
....
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
....
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216
8217
8218
8219
8220
8221
8222
8223
....
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
....
8434
8435
8436
8437
8438
8439
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
....
8769
8770
8771
8772
8773
8774
8775
8776
8777
8778
8779
8780
8781
8782
8783
8784
8785
8786
8787
8788
8789
8790
8791
8792
8793
8794
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new tablelist widget
#   - Private procedures implementing the tablelist widget command
#   - Private callback procedures
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
	-tight			 {tight			  Tight		      w}
	-titlecolumns		 {titleColumns	  	  TitleColumns	      w}
	-tooltipaddcommand	 {tooltipAddCommand	  TooltipAddCommand   w}
	-tooltipdelcommand	 {tooltipDelCommand	  TooltipDelCommand   w}
	-treecolumn		 {treeColumn		  TreeColumn	      w}
	-treestyle		 {treeStyle		  TreeStyle	      w}
	-width			 {width			  Width		      w}
	-xmousewheelwindow	 {xMouseWheelWindow	  MouseWheelWindow    w}
	-xscrollcommand		 {xScrollCommand	  ScrollCommand	      w}
	-ymousewheelwindow	 {yMouseWheelWindow	  MouseWheelWindow    w}
	-yscrollcommand		 {yScrollCommand	  ScrollCommand	      w}
    }

    #
    # Extend the elements of the array configSpecs
    #
    extendConfigSpecs 
................................................................................
	    cellsToReconfig	 {}
	    hdr_cellsToReconfig	 {}
	    nonViewableRowCount	 0
	    viewableRowList	 {-1}
	    hiddenColCount	 0
	    root-row		-1
	    root-parent		 ""
	    root-childList	 {}
	    keyToRowMapValid	 1
	    searchStartIdx	 0
	    keyBeingExpanded	 ""
	    justEntered		 0
	    inEditWin		 0
	}

................................................................................
    if {[llength $argList] != 1} {
	mwutil::wrongNumArgs "$win childcount nodeIndex"
    }

    synchronize $win
    set key [nodeIndexToKey $win [lindex $argList 0]]
    upvar ::tablelist::ns${win}::data data
    return [llength $data($key-childList)]
}

#------------------------------------------------------------------------------
# tablelist::childindexSubCmd
#------------------------------------------------------------------------------
proc tablelist::childindexSubCmd {win argList} {
    if {[llength $argList] != 1} {
................................................................................
    }

    synchronize $win
    set row [rowIndex $win [lindex $argList 0] 0 1]
    upvar ::tablelist::ns${win}::data data
    set key [lindex $data(keyList) $row]
    set parentKey $data($key-parent)
    return [lsearch -exact $data($parentKey-childList) $key]
}

#------------------------------------------------------------------------------
# tablelist::childkeysSubCmd
#------------------------------------------------------------------------------
proc tablelist::childkeysSubCmd {win argList} {
    if {[llength $argList] != 1} {
	mwutil::wrongNumArgs "$win childkeys nodeIndex"
    }

    synchronize $win
    set key [nodeIndexToKey $win [lindex $argList 0]]
    upvar ::tablelist::ns${win}::data data
    return $data($key-childList)
}

#------------------------------------------------------------------------------
# tablelist::collapseSubCmd
#------------------------------------------------------------------------------
proc tablelist::collapseSubCmd {win argList} {
    set argCount [llength $argList]
................................................................................
	set data($key,$col-indent) [strMap \
	    {"indented" "collapsed" "expanded" "collapsed"} \
	    $data($key,$col-indent)]
	if {[winfo exists $w.ind_$key,$col]} {
	    $w.ind_$key,$col configure -image $data($key,$col-indent)
	}

	if {[llength $data($key-childList)] == 0} {
	    continue
	}

	#
	# Elide the descendants of this item
	#
	set fromRow [expr {$index + 1}]
	set toRow [nodeRow $win $key end]
	for {set row $fromRow} {$row < $toRow} {incr row} {
	    doRowConfig $row $win -elide 1

	    if {$fullCollapsion} {
		set descKey [lindex $data(keyList) $row]
		if {[llength $data($descKey-childList)] != 0} {
		    if {$callCollapseCmd} {
			uplevel #0 $data(-collapsecommand) [list $win $row]
		    }

		    #
		    # Change the descendant's indentation image
		    # from the expanded to the collapsed one
................................................................................
    displayItems $win

    upvar ::tablelist::ns${win}::data data
    set callCollapseCmd [expr {[string length $data(-collapsecommand)] != 0}]
    set col $data(treeCol)
    set w $data(body)

    foreach key $data(root-childList) {
	if {![info exists data($key,$col-indent)]} {
	    continue
	}

	set index [keyToRow $win $key]
	if {$callCollapseCmd} {
	    uplevel #0 $data(-collapsecommand) [list $win $index]
................................................................................
	set data($key,$col-indent) [strMap \
	    {"indented" "collapsed" "expanded" "collapsed"} \
	    $data($key,$col-indent)]
	if {[winfo exists $w.ind_$key,$col]} {
	    $w.ind_$key,$col configure -image $data($key,$col-indent)
	}

	if {[llength $data($key-childList)] == 0} {
	    continue
	}

	#
	# Elide the descendants of this item
	#
	set fromRow [expr {$index + 1}]
	set toRow [nodeRow $win $key end]
	for {set row $fromRow} {$row < $toRow} {incr row} {
	    doRowConfig $row $win -elide 1

	    if {$fullCollapsion} {
		set descKey [lindex $data(keyList) $row]
		if {[llength $data($descKey-childList)] != 0} {
		    if {$callCollapseCmd} {
			uplevel #0 $data(-collapsecommand) [list $win $row]
		    }

		    #
		    # Change the descendant's indentation image
		    # from the expanded to the collapsed one
................................................................................
		    set index 0
		} elseif {$index > $data(lastRow)} {
		    set index $data(lastRow)
		}
		lappend indexList $index
	    }
	    set indexList [lsort -integer -decreasing $indexList]
	    set indexCount [llength $indexList]
	    if {$indexCount == 0} {
		return ""
	    }

	    #
	    # Traverse the sorted index list and ignore any duplicates
	    #
	    set maxIndex [lindex $indexList 0]
	    set prevIndex [expr {$maxIndex + 1}]
	    foreach index $indexList {
		if {$index != $prevIndex} {

		    if {$index != $prevIndex - 1} {
			deleteRows $win $prevIndex $maxIndex $data(hasListVar)
			set maxIndex $index
		    }
		    set prevIndex $index
		}
	    }
	    deleteRows $win $index $maxIndex $data(hasListVar)
	    return ""
	}
    } else {
	set first [rowIndex $win $first 0]
	set last [rowIndex $win [lindex $argList 1] 0]
	return [deleteRows $win $first $last $data(hasListVar)]
    }
................................................................................
	    uplevel #0 $data(-expandcommand) [list $win $index]
	    set data(keyBeingExpanded) ""
	}

	#
	# Set the indentation image to the indented or expanded one
	#
	set childCount [llength $data($key-childList)]
	set state [expr {($childCount == 0) ? "indented" : "expanded"}]
	set data($key,$col-indent) [strMap \
	    [list "collapsed" $state "expanded" $state] $data($key,$col-indent)]
	if {[string compare $state "indented"] == 0} {
	    set data($key,$col-indent) [strMap \
		{"Act" "" "Sel" ""} $data($key,$col-indent)]
	}
................................................................................

	#
	# Unelide the children if appropriate and
	# invoke this procedure recursively on them
	#
	set isViewable [expr {![info exists data($key-elide)] &&
			      ![info exists data($key-hide)]}]
	foreach childKey $data($key-childList) {
	    set childRow [keyToRow $win $childKey]
	    if {$isViewable} {
		doRowConfig $childRow $win -elide 0
	    }
	    if {$fullExpansion} {
		expandSubCmd $win [list $childRow -fully]
	    } elseif {[string match "*expanded*" \
................................................................................
    displayItems $win

    upvar ::tablelist::ns${win}::data data
    set callExpandCmd [expr {[string length $data(-expandcommand)] != 0}]
    set col $data(treeCol)
    set w $data(body)

    foreach key $data(root-childList) {
	if {![info exists data($key,$col-indent)] ||
	    [string match "*indented*" $data($key,$col-indent)]} {
	    continue
	}

	if {$callExpandCmd} {
	    set data(keyBeingExpanded) $key
................................................................................
	    uplevel #0 $data(-expandcommand) [list $win [keyToRow $win $key]]
	    set data(keyBeingExpanded) ""
	}

	#
	# Set the indentation image to the indented or expanded one
	#
	set childCount [llength $data($key-childList)]
	set state [expr {($childCount == 0) ? "indented" : "expanded"}]
	set data($key,$col-indent) [strMap \
	    [list "collapsed" $state "expanded" $state] $data($key,$col-indent)]
	if {[string compare $state "indented"] == 0} {
	    set data($key,$col-indent) [strMap \
		{"Act" "" "Sel" ""} $data($key,$col-indent)]
	}
................................................................................
	    $w.ind_$key,$col configure -image $data($key,$col-indent)
	}

	#
	# Unelide the children if appropriate and invoke expandSubCmd on them
	#
	set isViewable [expr {![info exists data($key-hide)]}]
	foreach childKey $data($key-childList) {
	    set childRow [keyToRow $win $childKey]
	    if {$isViewable} {
		doRowConfig $childRow $win -elide 0
	    }
	    if {$fullExpansion} {
		expandSubCmd $win [list $childRow -fully]
	    } elseif {[string match "*expanded*" \
................................................................................
		incr n
		set parentKey [nodeIndexToKey $win [lindex $argList $n]]
	    }
	}
    }

    upvar ::tablelist::ns${win}::data data
    set childCount [llength $data($parentKey-childList)]
    if {$childCount == 0} {
	return -1
    }

    if {$descend} {
	set fromChildKey [lindex $data($parentKey-childList) 0]
	set fromRow [keyToRow $win $fromChildKey]
	set toRow [nodeRow $win $parentKey end]
	for {set row $fromRow} {$row < $toRow} {incr row} {
	    set key [lindex $data(keyList) $row]
	    set hasName [info exists data($key-name)]
	    if {($hasName && [string compare $name $data($key-name)] == 0) ||
		(!$hasName && $nameIsEmpty)} {
		return $row
	    }
	}
    } else {
	for {set childIdx 0} {$childIdx < $childCount} {incr childIdx} {
	    set key [lindex $data($parentKey-childList) $childIdx]
	    set hasName [info exists data($key-name)]
	    if {($hasName && [string compare $name $data($key-name)] == 0) ||
		(!$hasName && $nameIsEmpty)} {
		return [keyToRow $win $key]
	    }
	}
    }
................................................................................
		    set index 0
		} elseif {$index > $data(hdr_lastRow)} {
		    set index $data(hdr_lastRow)
		}
		lappend indexList $index
	    }
	    set indexList [lsort -integer -decreasing $indexList]
	    set indexCount [llength $indexList]
	    if {$indexCount == 0} {
		return ""
	    }

	    #
	    # Traverse the sorted index list and ignore any duplicates
	    #
	    set maxIndex [lindex $indexList 0]
	    set prevIndex [expr {$maxIndex + 1}]
	    foreach index $indexList {
		if {$index != $prevIndex} {
		    if {$index != $prevIndex - 1} {
			hdr_deleteRows $win $prevIndex $maxIndex
			set maxIndex $index
		    }
		    set prevIndex $index
		}
	    }
	    hdr_deleteRows $win $index $maxIndex
	    return ""
	}
    } else {
	set first [hdr_rowIndex $win $first 0]
	set last [hdr_rowIndex $win [lindex $argList 1] 0]
	return [hdr_deleteRows $win $first $last]
    }
................................................................................
    }

    #
    # Build the list of row indices of the matching elements
    #
    set rowList {}
    set useFormatCmd [expr {$formatted && [lindex $data(fmtCmdFlagList) $col]}]
    set childCount [llength $data($parentKey-childList)]
    if {$childCount != 0} {
	if {$backwards} {
	    set childIdx [expr {$childCount - 1}]
	    if {$descend} {
		set childKey [lindex $data($parentKey-childList) $childIdx]
		set maxRow [expr {[nodeRow $win $childKey end] - 1}]
		if {$gotStartRow && $maxRow > $startRow} {
		    set maxRow $startRow
		}
		set minRow [nodeRow $win $parentKey 0]
		for {set row $maxRow} {$row >= $minRow} {incr row -1} {
		    set item [lindex $data(itemList) $row]
................................................................................
			if {!$allMatches} {
			    break
			}
		    }
		}
	    } else {
		for {} {$childIdx >= 0} {incr childIdx -1} {
		    set key [lindex $data($parentKey-childList) $childIdx]
		    set row [keyToRow $win $key]
		    if {$gotStartRow && $row > $startRow} {
			continue
		    }
		    set elem [lindex [lindex $data(itemList) $row] $col]
		    if {$useFormatCmd} {
			set elem [formatElem $win $key $row $col $elem]
................................................................................
			}
		    }
		}
	    }
	} else {
	    set childIdx 0
	    if {$descend} {
		set childKey [lindex $data($parentKey-childList) $childIdx]
		set fromRow [keyToRow $win $childKey]
		if {$gotStartRow && $fromRow < $startRow} {
		    set fromRow $startRow
		}
		set toRow [nodeRow $win $parentKey end]
		for {set row $fromRow} {$row < $toRow} {incr row} {
		    set item [lindex $data(itemList) $row]
................................................................................
			if {!$allMatches} {
			    break
			}
		    }
		}
	    } else {
		for {} {$childIdx < $childCount} {incr childIdx} {
		    set key [lindex $data($parentKey-childList) $childIdx]
		    set row [keyToRow $win $key]
		    if {$gotStartRow && $row < $startRow} {
			continue
		    }
		    set elem [lindex [lindex $data(itemList) $row] $col]
		    if {$useFormatCmd} {
			set elem [formatElem $win $key $row $col $elem]
................................................................................
    # Unset the elements of data, attribs, and
    # selStates corresponding to the deleted items
    #
    if {$count == $data(itemCount)} {
	arrayUnset data {k[0-9]*}
	array set data {rowTagRefCount 0  nonViewableRowCount 0
	    cellTagRefCount 0  imgCount 0  winCount 0  indentCount 0
	    root-childList {}}

	arrayUnset attribs {k[0-9]*}
	arrayUnset selStates *
    } else {
	for {set row $first} {$row <= $last} {incr row} {
	    set item [lindex $data(itemList) $row]
	    set key [lindex $item end]
................................................................................
		incr data(nonViewableRowCount) -1
	    }

	    #
	    # Remove the key from the list of children of its parent
	    #
	    set parentKey $data($key-parent)
	    if {[info exists data($parentKey-childList)]} {
		set childIdx [lsearch -exact $data($parentKey-childList) $key]
		set data($parentKey-childList) \
		    [lreplace $data($parentKey-childList) $childIdx $childIdx]

		#
		# If the parent's list of children has become empty
		# then set its indentation image to the indented one
		#
		set col $data(treeCol)
		if {[llength $data($parentKey-childList)] == 0 &&
		    [info exists data($parentKey,$col-indent)]} {
		    collapseSubCmd $win [list $parentKey -partly]
		    set data($parentKey,$col-indent) [strMap \
			{"collapsed" "indented" "expanded" "indented"
			 "Act" "" "Sel" ""} $data($parentKey,$col-indent)]
		    if {[winfo exists $data(body).ind_$parentKey,$col]} {
			$data(body).ind_$parentKey,$col configure -image \
			    $data($parentKey,$col-indent)
		    }
		}
	    }

	    foreach prop {-row -parent -childList} {
		unset data($key$prop)
	    }

	    for {set col 0} {$col < $data(colCount)} {incr col} {
		foreach opt {-background -foreground -editable -editwindow
			     -imagebackground -selectbackground
			     -selectforeground -valign -windowdestroy
................................................................................

		if {[info exists data($key,$col-indent)]} {
		    unset data($key,$col-indent)
		    incr data(indentCount) -1
		}
	    }

	    arrayUnset attribs $key-*
	    arrayUnset attribs $key,*-*

	    arrayUnset selStates $key
	    arrayUnset selStates $key,*
	}
    }

    #
    # Delete the given items from the internal list
    #
    set data(itemList) [lreplace $data(itemList) $first $last]
    set data(keyList) [lreplace $data(keyList) $first $last]
    incr data(itemCount) -$count

    #
    # Delete the given items from the list variable if needed
    #
    if {$updateListVar &&
	[uplevel #0 [list info exists $data(-listvariable)]]} {
	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
	set var [lreplace $var $first $last]
	trace variable var wu $data(listVarTraceCmd)
    }

    #
................................................................................
	    if {[info exists data($key,$col-window)]} {
		unset data($key,$col-window)
		unset data($key,$col-reqWidth)
		unset data($key,$col-reqHeight)
	    }
	}

	arrayUnset attribs $key-*
	arrayUnset attribs $key,*-*
    }

    #
    # Delete the given items from the internal list
    #
    set data(hdr_itemList) [lreplace $data(hdr_itemList) $first $last]
    set data(hdr_keyList) [lreplace $data(hdr_keyList) $first $last]
................................................................................
    upvar ::tablelist::ns${win}::data data
    if {$index < 0} {
	set index 0
    } elseif {$index > $data(itemCount)} {
	set index $data(itemCount)
    }

    set childCount [llength $data($parentKey-childList)]
    if {$childIdx < 0} {
	set childIdx 0
    } elseif {$childIdx > $childCount} {	;# e.g., if $childIdx is "end"
	set childIdx $childCount
    }

    set updateListVar [expr {$updateListVar &&
	[uplevel #0 [list info exists $data(-listvariable)]]}]
    if {$updateListVar} {
	upvar #0 $data(-listvariable) var
	trace vdelete var wu $data(listVarTraceCmd)
    }

    #
    # Insert the items into the internal list
    #
................................................................................
	    lappend data(keyList) $key		;# this works much faster
	} else {
	    set data(itemList) [linsert $data(itemList) $row $item]
	    set data(keyList) [linsert $data(keyList) $row $key]
	}

	array set data \
	    [list $key-row $row  $key-parent $parentKey  $key-childList {}]

	#
	# Insert the key into the parent's list of children
	#
	if {$appendingChildren} {
	    lappend data($parentKey-childList) $key   ;# this works much faster
	} else {
	    set data($parentKey-childList) \
		[linsert $data($parentKey-childList) $childIdx $key]
	}

	lappend result $key

	incr row
	incr childIdx
    }
................................................................................
    set key [lindex $data(keyList) $index]
    set col $data(treeCol)
    if {![info exists data($key,$col-indent)] ||
	[string match "*indented*" $data($key,$col-indent)]} {
	return ""
    }

    if {[llength $data($key-childList)] == 0} {
	uplevel #0 $data(-populatecommand) [list $win $index]
    }

    if {$fully} {
	#
	# Invoke this procedure recursively on the children
	#
	foreach childKey $data($key-childList) {
	    populate $win [keyToRow $win $childKey] 1
	}
    }
}

#------------------------------------------------------------------------------
# tablelist::doesMatch
................................................................................
    if {$data(-titlecolumns) == 0} {
	findTabs $win $b [expr {$row + 1}] $col $col tabIdx1 tabIdx2
	variable pu
	set nextIdx [$b index $tabIdx2+1$pu]
	set alignment [lindex $data(colList) [expr {2*$col + 1}]]
	set lX [winfo x $data(hdrTxtFrmLbl)$col]
	set rX [expr {$lX + [winfo width $data(hdrTxtFrmLbl)$col] - 1}]
	if {[string compare [getCurrentTheme] "aqua"] == 0} {
	    incr lX
	    if {$col == 0} {
		incr lX
	    }
	}

	switch $alignment {
	    left {
		#
		# Bring the cell's left edge into view
		#
		if {![seeTextIdx $win $tabIdx1]} {
................................................................................
	    }

	    if {$first == 0 && $last == $data(lastRow)} {
		arrayUnset selStates *		;# this works much faster
	    } else {
		for {set row $first} {$row <= $last} {incr row} {
		    set key [lindex $data(keyList) $row]
		    arrayUnset selStates $key
		    arrayUnset selStates $key,*
		}
	    }

	    updateColorsWhenIdle $win
	    return ""
	}

	includes {
	    set key [lindex $data(keyList) $first]
	    return [expr {([info exists selStates($key)] ||
			   [llength [array names selStates $key,*]] != 0) &&
			  $data(colCount) != 0}]
	}

	set {
	    #
	    # Swap the indices if necessary and adjust
	    # the range to fit within the existing items
................................................................................

	    #
	    # If the selection is exported and there are any selected
	    # cells in the widget then make win the new owner of the
	    # PRIMARY selection and register a callback to be invoked
	    # when it loses ownership of the PRIMARY selection
	    #
	    if {$data(-exportselection) && [array size selStates] != 0 &&
		$data(colCount) != 0} {
		selection own -command \
		    [list ::tablelist::lostSelection $win] $win
	    }

	    updateColorsWhenIdle $win
	    return ""
	}
................................................................................
		#
		set data(syncId) [after idle [list tablelist::synchronize $win]]
	    }
	}

	u {
	    #
	    # Recreate the variable $varName by setting it according to
	    # the value of data(itemList), and set the trace on it again
	    #
	    if {[string length $arrIndex] != 0} {
		set varName ${varName}($arrIndex)
	    }
	    upvar #0 $varName var
	    set var {}
	    foreach item $data(itemList) {
		lappend var [lrange $item 0 $data(lastCol)]
	    }
	    trace variable var wu $data(listVarTraceCmd)
	}
    }
}

#------------------------------------------------------------------------------
# tablelist::checkStatesTrace
#