Unnamed Fossil Project

Check-in [9156f55936]
Login

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

Overview
Comment:fixes for treeview insert and draw
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:9156f559362ce0051b3987d7cb41287107dec0e5
User & Date: arnulf 2013-09-20 19:45:43
Context
2013-09-21
17:08
a lot of changes including additional paramter recordPtr for all *Element.tcl methods for makeing first treeview example running. check-in: b0ea45cca7 user: arnulf tags: trunk
2013-09-20
19:45
fixes for treeview insert and draw check-in: 9156f55936 user: arnulf tags: trunk
2013-09-18
19:40
fixes and new code for treeview insert check-in: 422deb7b94 user: arnulf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/ntkLayout.tcl.

689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
# RebindSublayout --
#     Bind sublayout to new data source.
#=========================================================================

::itcl::body layout::RebindSubLayout {layoutVar recordPtr} {
    upvar $layoutVar layout

    dict set layout recordPtr $recordPtr
}

#================================ NodeSize ============================
#    Compute requested size of a layout.
#=========================================================================

::itcl::body layout::NodeSize {layout node state widthVar heightVar paddingVar} {







|







689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
# RebindSublayout --
#     Bind sublayout to new data source.
#=========================================================================

::itcl::body layout::RebindSubLayout {layoutVar recordPtr} {
    upvar $layoutVar layout

    dict set layout -recordPtr $recordPtr
}

#================================ NodeSize ============================
#    Compute requested size of a layout.
#=========================================================================

::itcl::body layout::NodeSize {layout node state widthVar heightVar paddingVar} {

Changes to library/ntkTTreeview.tcl.

542
543
544
545
546
547
548

549
550
551

552
553
554
555
556
557
558
...
824
825
826
827
828
829
830
831
832
833


834
835
836
837
838
839
840
...
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
...
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
...
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
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012

1013



1014
1015
1016
1017
1018
1019
1020
1021
....
1022
1023
1024
1025
1026
1027
1028
1029
1030

1031
1032
1033
1034
1035
1036
1037
1038
1039
....
1041
1042
1043
1044
1045
1046
1047
1048






1049
1050
1051
1052
1053
1054
1055
1056
....
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194

1195


1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222



1223


1224

1225
1226
1227
1228
1229
1230
1231
1232


1233
1234
1235
1236
1237
1238
1239
1240

1241
1242
1243
1244
1245
1246
1247
....
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314




1315

1316
1317
1318


1319
1320
1321
1322
1323
1324
1325
1326
1327
....
1362
1363
1364
1365
1366
1367
1368

1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
....
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
....
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445

1446


1447
1448
1449
1450
1451
1452
1453
        return 0
    }
    dict set tree headingLayout $headingLayout
    set rowLayout [dict get $tree rowLayout]
    if {[GetSublayout $theme $treeLayout ".Row" $tagOptionTable rowLayout] eq ""} {
        return 0
    }

    dict set tree rowLayout $rowLayout
    # Compute heading height.
    ::ntk::classes::layout::RebindSubLayout headingLayout [dict get $tree column0]

    dict set tree headingLayout $headingLayout
    ::ntk::classes::layout::LayoutSize $headingLayout 0 unused [dict get $tree headingHeight]

    # Get item height, indent from style:
    # @@@ TODO: sanity-check.

    dict set tree rowHeight 20
................................................................................
# DisplayLayout --
#     Rebind, place, and draw a layout + object combination.
#=========================================================================

::itcl::body treeview::DisplayLayout {layoutVar recordPtr state box} {
    upvar $layoutVar layout

#puts stderr "DisplayLayout!$box!"
    ::ntk::classes::layout::RebindSubLayout layout $recordPtr
    ::ntk::classes::layout::PlaceLayout layout $state $box


    ::ntk::classes::layout::DrawLayout $layout $state
}

#================================ DrawHeadings ============================
# DrawHeadings --
#     Draw tree headings.
#=========================================================================
................................................................................
#================================ PrepareItem ============================
# PrepareItem --
#=========================================================================

::itcl::body treeview::PrepareItem {item displayItemVar} {
    upvar $displayItemVar displayItem

puts stderr "PrepareItem!"
    set style [::ntk::classes::layout::LayoutStyle [dict get $core layout]]
    set state [ItemState $item]



    TagSetValues [dict get $tree tagTable] [dict get $item tagset] $displayItem
    TagSetApplyStyle [dict get $tree tagTable] $style $state $displayItem
}

#================================ ItemState ============================
# ItemState --
#     Returns the state of the specified item, based
#     on widget state, item state, and other information.
#=========================================================================

::itcl::body treeview::ItemState {item} {
puts stderr "ItemState!"
    set state [dict get $core state]

    lappend state [dict get $item state]
    if {[dict get $item children] ne ""} {
        lappend state stateLea
    }
    if {$item ne [dict get $tree focus]} {
        set idx [lsearch $state stateFocus]
        if {$idx >= 0} {
            set state [lreplace $state $idx $idx]
        }
    }
................................................................................
# DrawCells --
#    Draw data cells for specified item.
#=========================================================================

::itcl::body treeview::DrawCells {item displayItemVar x y} {
    upvar $displayItemVar displayItem

puts stderr "DrawCells!"
    set layout [dict get $tree cellLayout]
    set state [ItemState $item]
    set cellPadding [list 4 0 4 0]
    set rowHeight [dict get $tree rowHeight]
    set nValues 0
    set values ""



    if {[dict get $item valuesObj] eq ""} {
        return
    }

    set values [dict get $item valuesObj]
    set nValues [llength $values]
    set i 0
    while {$i <  [dict get $tree nColumns]} {
        set columns [dict get $tree columns]
        set coli [lindex $comlumns $i]
        if {$i < $nValues} {
            dict set coli data [lindex $values $i]
................................................................................
    while {$i < [dict get $tree nDisplayColumns]} {
        set column [lindex [dict get $tree displayColumns] $i]
        set parcel [::ntk::classes::layout::PadBox [list $x $y [dict get $column width] $rowHeight] $cellPadding]

        dict set displayItem textObj [dict get $column data]
        dict set displayItem anchorObj [dict get $column anchorObj] ; # <<NOTE-ANCHOR>> 

        DisplayLayout $layout $displayItem $state $parcel

        set x [rexpr {$x + [dict get $column width]}]
        incr i
    }
}

#================================ DrawItem ============================
# DrawItem --
#     Draw an item (row background, tree label, and cells).
#=========================================================================

::itcl::body treeview::DrawItem {item depth row} {
puts stderr "DrawItem!"
    set state [ItemState $item]
    set rowHeight [dict get $ree rowHeight]
    set x [expr {[dict get $tree treeArea x] - [dict get $tree xscroll first]}]

    set y = [expr {[dict get $tree treeArea y] + $rowHeight * ($row - [dict get $tree yscroll first])}]

    if {$row % 2} {
        lappend state stateAlternate
    }


    PrepareItem $item displayItem

    # Draw row background:

    set rowBox [lst $x $y [TreeWidth] $rowHeight]
    DisplayLayout [dict get $tree rowLayout] displayItem $state $rowBox




    # Draw tree label:


    if {[lsearch [dict get $tree showFlags] tree] >= 0} {
        set indent [expr {$depth * [dict get $tree indent]}]
        set colwidth [dict get $tree column0 width]
        set parcel [list [expr {$x+$indent}] $y [expr {$colwidth-$indent}] $rowHeight]


        if {[dict get $item textObj] ne ""} {
            dict set displayItem textObj [dict get $item textObj]
        }
        if {[dict get $item imageObj] ne ""} {
            dict set displayItem imageObj [dict get $item imageObj]
        }







        # ??? displayItem.anchorObj = 0; <<NOTE-ANCHOR>>
        DisplayLayout [dict get $tree itemLayout] displayItem $state $parcel


        set x i[expr {$x + $colwidth}]
    }

    # Draw data cells:

 
    DrawCells $item displayItem $x $y
}

#================================ DrawSubtree ============================
# DrawSubtree --
#     Draw an item and all of its (viewable) descendants.
#
# Returns:
#     Row number of the last item drawn.
#=========================================================================

::itcl::body treeview::DrawSubtree {item depth row} {
puts stderr "DrawSubtree!"
    if {$row >= [dict get $tree yscroll first]} {
        DrawItem $item $depth $row
    }


    if {[lsearch [dict get $item state] stateOpen] >= 0} {



        return [DrawForest [dict get $item children] [expr {$depth + 1}] [expr {$row + 1}]]
    } else {
        return [expr {$row + 1}]
    }
}

#================================ DrawForest ============================
# DrawForest --
................................................................................
#     Draw a sequence of items and their visible descendants.

# Returns:
#     Row number of the last item drawn.
#=========================================================================

::itcl::body treeview::DrawForest {item depth row} {
puts stderr "DrawForest!$item!$depth!$row!"
    while {$item ne "" && $row <= [dict get $tree yscroll last]} {

        set row [DrawSubtree $item $depth $row]
        set item [dict get $item next]
    }
    return $row;
}

#================================ TreeviewDisplay ============================
# TreeviewDisplay --
#     Display() widget hook.  Draw the widget contents.
................................................................................

::itcl::body treeview::TreeviewDisplay {} {
#puts stderr "TreeviewDisplay!"
    ::ntk::classes::layout::DrawLayout [dict get $core layout] [dict get $core state]
    if {[lsearch [dict get $tree showFlags] headings] >= 0 } {
        DrawHeadings
    }
::ntk::classes::layout::printDict [dict get $tree items ""]






    DrawForest [dict get $tree root children] 0 0
}

#================================ TreeviewBBoxCommand ============================
#     
#=========================================================================

::itcl::body treeview::TreeviewBBoxCommand {args} {
................................................................................
#       Insert an item into the tree after the specified item.
#
# Preconditions:
#      item is currently detached
#      prev != NULL ==> prev->parent == parent.
#=========================================================================

::itcl::body treeview::InsertItem {parentVar prevVar itemVar} {
    upvar $parentVar parent
    upvar $prevVar prev
    upvar $itemVar item

#puts stderr "InsertItem!parent!$parent!\nprev!$prev!\nitem!$item!"
    if {$parent ne "" && [dict exists $parent entryPtr]} {
        dict set item parent [dict get $parent entryPtr]

    } else {


        dict set item parent ""
    }
    if {$prev ne ""} {
        if {$prev ne "" [dict exists $prev entryPtr]} {
            dict set item prev [dict get $prev entryPtr]
        } else {
            dict set item prev ""
        }
    } else {
        dict set item prev $prev
    }
    if {$prev ne ""} {
        if {[dict exists $prev next entryPtr]} {
            dict set item next [dict get $prev next entryPtr]
        } else {
            dict set item next ""
        }
        dict set prev next [dict get $item entryPtr]
    } else {
        if {[dict exists $parent children entryPtr]} {
            dict set item next [dict get $parent children entryPtr]
        } else {
            dict set item next ""
        }
        dict set parent children [dict get $item entryPtr]
    }
    if {[dict get $item next] ne ""} {



        dict set item next prev [dict get $item entryPtr]


    }

}

#================================ ConfigureItem ============================
# ConfigureItem --
#     Set item options.
#=========================================================================

::itcl::body treeview::ConfigureItem {item args} {


#puts stderr "ConfigureItem!$item!\n$args!"
    set newImageSpec ""
    set newTagSet ""
    set mask ""

    set savedOptions [dict create]
    SetOptions item $args savedOptions mask


    # Make sure that -values is a valid list:
 
    if {[dict get $item valuesObj] ne ""} {
#        if (Tcl_ListObjLength(interp, item->valuesObj, &unused) != TCL_OK)
#            goto error;
    }

................................................................................
#     Returns a pointer to the item just before the specified index,
#     or 0 if the item is to be inserted at the beginning.
#=========================================================================

::itcl::body treeview::InsertPosition {parent index} {
#puts stderr "InsertPosition!$parent!$index!"
    set prev ""
    if {$parent ne "" && [dict exists $parent children entryPtr]} {
        set next [dict get $parent children entryPtr]
    } else {
        set next ""




    }


    while {$next ne "" && $index > 0} {
        incr index -1


        set prev [dict get $next entryPtr]
        set next [dict get $prev next entryPtr]
    }

    return $prev
}

#================================ EndPosition ============================
# EndPosition --
................................................................................
                break
            }
            set endPtr [dict get $endPtr next entryPtr]
        }
        dict set tree endPtr $endPtr
    }


    return $endPtr
}

#================================ FindItem ============================
#     
#=========================================================================

::itcl::body treeview::FindItem {itemName} {
#puts stderr "FindItem!$itemName!"
    if {$itemName eq ""} {
        return [dict get $tree items $itemName]
    }
    if {![dict exists $tree items $itemName]} {
        return -code error "Item $itemName not found"
    }
    return [dict get $tree items $itemName]
}

#================================ TreeviewInsertCommand ============================
................................................................................
#     
#=========================================================================

::itcl::body treeview::TreeviewInsertCommand {args} {
puts stderr "TreeviewInsertCommand!$args!"
    # Get parent node:

    set parent [FindItem [lindex $args 0]]

    # Locate previous sibling based on $index:
    if {[lindex $args 1] eq "end"} {
        set sibling [EndPosition $parent]
    } else {
        set index [lindex $args 1]
        if {![string is integer $index]} {
            return -code error "index is not integer"
        }
        set sibling [InsertPosition $parent $index]
    }

#puts stderr "sibling!$sibling!"
    # Get node name:
    #     If -id supplied and does not already exist, use that;
    #     Otherwise autogenerate new one.
    set args [lrange $args 2 end]
    if {[llength $args] >= 2 && [lindex $args 0] eq "-id"} {
        set itemName [lindex $args 1]

        if {[dict exists $tree items $itemName]} {
            return -code error "Item $itemName already exists"
        }
        dict set tree items $itemName [dict create]
        set args [lrange $args 2 end]
    } else {
        while {1} {
            dict set tree serial [expr {[dict get $tree serial] + 1}]
            set idbuf [format "I%03X" [dict get $tree serial]]
            if {![dict exists $tree items $idbuf]} {
                dict set tree items $idbuf [dict create]
................................................................................
#puts stderr "itemName!$itemName!"

    # Create and configure new item:
 
    set newItem [NewItem]
#    Tk_InitOptions(newItem, tv->tree.itemOptionTable, tv->core.tkwin);
#    dict set newItem tagset [GetTagSetFromObj [dict get $tree tagTable]]
    ConfigureItem $newItem $args

    # Store in hash table, link into tree:
 
    dict set tree items $itemName $newItem
    dict set newItem entryPtr $itemName
    InsertItem parent sibling newItem

    dict set tree items $itemName $newItem


    RedisplayWidget ""

    return [ItemName $newItem]
}

#================================ TreeviewItemCommand ============================
#     







>


|
>







 







|
|

>
>







 







<


>

>
|
|









|

>
|
|
|







 







|







>
>
|



|







 







|
>











|

|
|
>
|





>




|
|
>
>
>


>





>
>
|
|

|
|

>
>
>
>
>
>
>

|
>
>
|



>













|
|



>
|
>
>
>
|







 







|
|
>

|







 







|
>
>
>
>
>
>
|







 







|
|
|


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

<
|
<
<
<
|


>
>
>
|
>
>

>







|
>
>








>







 







<
<
<
|
>
>
>
>

>



>
>
|
|







 







>









<
<
<







 







|



|





|













<







 







|





|
>

>
>







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
...
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
...
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
...
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
...
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
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
....
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
....
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
....
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237

1238

1239
1240
1241
1242



1243

1244



1245
1246

1247



1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
....
1341
1342
1343
1344
1345
1346
1347



1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
....
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419



1420
1421
1422
1423
1424
1425
1426
....
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457

1458
1459
1460
1461
1462
1463
1464
....
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
        return 0
    }
    dict set tree headingLayout $headingLayout
    set rowLayout [dict get $tree rowLayout]
    if {[GetSublayout $theme $treeLayout ".Row" $tagOptionTable rowLayout] eq ""} {
        return 0
    }
puts stderr "rowLayout"
    dict set tree rowLayout $rowLayout
    # Compute heading height.
#    ::ntk::classes::layout::RebindSubLayout headingLayout [dict get $tree column0]
    ::ntk::classes::layout::RebindSubLayout headingLayout $core
    dict set tree headingLayout $headingLayout
    ::ntk::classes::layout::LayoutSize $headingLayout 0 unused [dict get $tree headingHeight]

    # Get item height, indent from style:
    # @@@ TODO: sanity-check.

    dict set tree rowHeight 20
................................................................................
# DisplayLayout --
#     Rebind, place, and draw a layout + object combination.
#=========================================================================

::itcl::body treeview::DisplayLayout {layoutVar recordPtr state box} {
    upvar $layoutVar layout

puts stderr "DisplayLayout!$box!"
    ::ntk::classes::layout::RebindSubLayout layout $core
    ::ntk::classes::layout::PlaceLayout layout $state $box
#puts stderr "layout!$layout!"
#::ntk::classes::layout::printDict $layout
    ::ntk::classes::layout::DrawLayout $layout $state
}

#================================ DrawHeadings ============================
# DrawHeadings --
#     Draw tree headings.
#=========================================================================
................................................................................
#================================ PrepareItem ============================
# PrepareItem --
#=========================================================================

::itcl::body treeview::PrepareItem {item displayItemVar} {
    upvar $displayItemVar displayItem


    set style [::ntk::classes::layout::LayoutStyle [dict get $core layout]]
    set state [ItemState $item]
puts stderr "PrepareItem!$item![dict get $style styleName]!$state!"

    set itemInfo [dict get $tree items $item]
    TagSetValues [dict get $tree tagTable] [dict get $itemInfo tagset] displayItem
    TagSetApplyStyle [dict get $tree tagTable] $style $state displayItem
}

#================================ ItemState ============================
# ItemState --
#     Returns the state of the specified item, based
#     on widget state, item state, and other information.
#=========================================================================

::itcl::body treeview::ItemState {item} {
#puts stderr "ItemState!$item!"
    set state [dict get $core state]
    set itemInfo [dict get $tree items $item]
    lappend state [dict get $itemInfo state]
    if {[dict get $itemInfo children] ne ""} {
        lappend state stateLeaf
    }
    if {$item ne [dict get $tree focus]} {
        set idx [lsearch $state stateFocus]
        if {$idx >= 0} {
            set state [lreplace $state $idx $idx]
        }
    }
................................................................................
# DrawCells --
#    Draw data cells for specified item.
#=========================================================================

::itcl::body treeview::DrawCells {item displayItemVar x y} {
    upvar $displayItemVar displayItem

puts stderr "DrawCells!$item!$x!$y!"
    set layout [dict get $tree cellLayout]
    set state [ItemState $item]
    set cellPadding [list 4 0 4 0]
    set rowHeight [dict get $tree rowHeight]
    set nValues 0
    set values ""

    set itemInfo [dict get $tree items $item]
puts stderr "VAL![dict get $itemInfo valuesObj]!"
    if {[dict get $itemInfo valuesObj] eq ""} {
        return
    }

    set values [dict get $itemInfo valuesObj]
    set nValues [llength $values]
    set i 0
    while {$i <  [dict get $tree nColumns]} {
        set columns [dict get $tree columns]
        set coli [lindex $comlumns $i]
        if {$i < $nValues} {
            dict set coli data [lindex $values $i]
................................................................................
    while {$i < [dict get $tree nDisplayColumns]} {
        set column [lindex [dict get $tree displayColumns] $i]
        set parcel [::ntk::classes::layout::PadBox [list $x $y [dict get $column width] $rowHeight] $cellPadding]

        dict set displayItem textObj [dict get $column data]
        dict set displayItem anchorObj [dict get $column anchorObj] ; # <<NOTE-ANCHOR>> 

#        DisplayLayout layout $displayItem $state $parcel
        DisplayLayout layout $core $state $parcel
        set x [rexpr {$x + [dict get $column width]}]
        incr i
    }
}

#================================ DrawItem ============================
# DrawItem --
#     Draw an item (row background, tree label, and cells).
#=========================================================================

::itcl::body treeview::DrawItem {item depth row} {
puts stderr "DrawItem!$item!"
    set state [ItemState $item]
    set rowHeight [dict get $tree rowHeight]
    set x [expr {[dict get $tree treeArea x] - [dict get $tree xscrollHandle xscroll first]}]
puts stderr "X!$x![dict get $tree treeArea x]![dict get $tree xscrollHandle xscroll first]!"
    set y [expr {[dict get $tree treeArea y] + $rowHeight * ($row - [dict get $tree yscrollHandle yscroll first])}]

    if {$row % 2} {
        lappend state stateAlternate
    }

    set displayItem ""
    PrepareItem $item displayItem

    # Draw row background:

    set rowBox [list $x $y [TreeWidth] $rowHeight]
    set rowLayout [dict get $tree rowLayout]
#puts stderr "displayItem!$displayItem!"
puts stderr "rowBox!$rowBox!$state!"
    DisplayLayout rowLayout displayItem $state $rowBox

    # Draw tree label:
puts stderr "Draw tree label![dict get $tree showFlags]!"

    if {[lsearch [dict get $tree showFlags] tree] >= 0} {
        set indent [expr {$depth * [dict get $tree indent]}]
        set colwidth [dict get $tree column0 width]
        set parcel [list [expr {$x+$indent}] $y [expr {$colwidth-$indent}] $rowHeight]
puts stderr "parcel!$parcel!$item!"
	set itemInfo [dict get $tree items $item]
        if {[dict get $itemInfo textObj] ne ""} {
            dict set displayItem textObj [dict get $itemInfo textObj]
        }
        if {[dict get $itemInfo imageObj] ne ""} {
            dict set displayItem imageObj [dict get $itemInfo imageObj]
        }
set optionsTable [dict get $itemInfo optionsTable]
if {[dict exists $optionsTable -text]} {
dict set displayItem -text [dict get $optionsTable -text]
}
if {[dict exists $optionsTable -image]} {
dict set displayItem -image [dict get $optionsTable -image]
}
        # ??? displayItem.anchorObj = 0; <<NOTE-ANCHOR>>
	set itemLayout [dict get $tree itemLayout]
puts stderr "displayItem!$displayItem!"
        DisplayLayout itemLayout displayItem $state $parcel
        set x [expr {$x + $colwidth}]
    }

    # Draw data cells:
puts stderr "Draw data cells!$x!$y!$colwidth!"
 
    DrawCells $item displayItem $x $y
}

#================================ DrawSubtree ============================
# DrawSubtree --
#     Draw an item and all of its (viewable) descendants.
#
# Returns:
#     Row number of the last item drawn.
#=========================================================================

::itcl::body treeview::DrawSubtree {item depth row} {
puts stderr "DrawSubtree!$item!$depth!$row![dict get $tree yscrollHandle yscroll first]!"
    if {$row >= [dict get $tree yscrollHandle yscroll first]} {
        DrawItem $item $depth $row
    }

    set itemInfo [dict get $tree items $item]
    set isOpen [lsearch [dict get $itemInfo state] stateOpen]
# FIXME!!! temporary
set isOpen 1
    if {$isOpen} {
        return [DrawForest [dict get $itemInfo children] [expr {$depth + 1}] [expr {$row + 1}]]
    } else {
        return [expr {$row + 1}]
    }
}

#================================ DrawForest ============================
# DrawForest --
................................................................................
#     Draw a sequence of items and their visible descendants.

# Returns:
#     Row number of the last item drawn.
#=========================================================================

::itcl::body treeview::DrawForest {item depth row} {
puts stderr "DrawForest!$item!$depth!$row![dict get $tree yscrollHandle yscroll last]!"
    while {$item ne "" && $row <= [dict get $tree yscrollHandle yscroll last]} {
	set itemInfo [dict get $tree items $item]
        set row [DrawSubtree $item $depth $row]
        set item [dict get $itemInfo next]
    }
    return $row;
}

#================================ TreeviewDisplay ============================
# TreeviewDisplay --
#     Display() widget hook.  Draw the widget contents.
................................................................................

::itcl::body treeview::TreeviewDisplay {} {
#puts stderr "TreeviewDisplay!"
    ::ntk::classes::layout::DrawLayout [dict get $core layout] [dict get $core state]
    if {[lsearch [dict get $tree showFlags] headings] >= 0 } {
        DrawHeadings
    }
#::ntk::classes::layout::printDict [dict get $tree items ""]
foreach key [dict keys [dict get $tree items]] {
#puts stderr "KEY!$key![dict get $tree items $key]!"
#::ntk::classes::layout::printDict [dict get $tree items $key]
}
    set start [dict get $tree root entryPtr]
    set top [dict get $tree items $start]
    DrawForest [dict get $top children] 0 0
}

#================================ TreeviewBBoxCommand ============================
#     
#=========================================================================

::itcl::body treeview::TreeviewBBoxCommand {args} {
................................................................................
#       Insert an item into the tree after the specified item.
#
# Preconditions:
#      item is currently detached
#      prev != NULL ==> prev->parent == parent.
#=========================================================================

::itcl::body treeview::InsertItem {parentItemVar prevItemVar itemVar} {
    upvar $parentItemVar parentItem
    upvar $prevItemVar prevItem
    upvar $itemVar item

#puts stderr "InsertItem!item![dict get $item entryPtr]!"
#puts stderr "parent![dict get $parentItem entryPtr]!"
#if {$prevItem eq ""} {
#puts stderr "prev!$prevItem!"
#} else {
#puts stderr "prev![dict get $prevItem entryPtr]!"
#}
    dict set item parent [dict get $parentItem entryPtr]

    if {$prevItem ne ""} {

        dict set item prev [dict get $prevItem entryPtr]
    } else {
        dict set item prev ""
    }



    if {$prevItem ne ""} {

        dict set item next [dict get $prevItem next]



	dict set prevItem next [dict get $item entryPtr]
    } else {

        dict set item next [dict get $parentItem children]



        dict set parentItem children [dict get $item entryPtr]
    }
    if {[dict get $item next] ne ""} {
#puts stderr "ITEM!$item!"
        set nextItemName [dict get $item next]
        set nextItem [dict get $tree items $nextItemName]
	dict set nextItem prev [dict get $item entryPtr]
	dict set tree items $nextItemName $nextItem
#puts stderr "NEXTITEM!$nextItem!"
    }
#puts stderr "PARENTITEM!$parentItem!"
}

#================================ ConfigureItem ============================
# ConfigureItem --
#     Set item options.
#=========================================================================

::itcl::body treeview::ConfigureItem {itemVar args} {
    upvar $itemVar item

#puts stderr "ConfigureItem!$item!\n$args!"
    set newImageSpec ""
    set newTagSet ""
    set mask ""

    set savedOptions [dict create]
    SetOptions item $args savedOptions mask

puts stderr "OPTTAB![dict get $item optionsTable]!"
    # Make sure that -values is a valid list:
 
    if {[dict get $item valuesObj] ne ""} {
#        if (Tcl_ListObjLength(interp, item->valuesObj, &unused) != TCL_OK)
#            goto error;
    }

................................................................................
#     Returns a pointer to the item just before the specified index,
#     or 0 if the item is to be inserted at the beginning.
#=========================================================================

::itcl::body treeview::InsertPosition {parent index} {
#puts stderr "InsertPosition!$parent!$index!"
    set prev ""



    set next ""
    set children [dict get $$parent children]
    if {$children ne ""} {
#puts stderr "CH1!$children!"
        set next [dict get $tree items $children entryPtr]
    }
#puts stderr "CH2!$next!"

    while {$next ne "" && $index > 0} {
        incr index -1
        set prevItem [dict get $prev]
	set prev [dict get $tree items $prevItem entryPtr]
        set nextItem [dict get $next]
        set next [dict get $tree items $nextItem entryPtr]
    }

    return $prev
}

#================================ EndPosition ============================
# EndPosition --
................................................................................
                break
            }
            set endPtr [dict get $endPtr next entryPtr]
        }
        dict set tree endPtr $endPtr
    }

#puts stderr "endPtr2!$endPtr!"
    return $endPtr
}

#================================ FindItem ============================
#     
#=========================================================================

::itcl::body treeview::FindItem {itemName} {
#puts stderr "FindItem!$itemName!"



    if {![dict exists $tree items $itemName]} {
        return -code error "Item $itemName not found"
    }
    return [dict get $tree items $itemName]
}

#================================ TreeviewInsertCommand ============================
................................................................................
#     
#=========================================================================

::itcl::body treeview::TreeviewInsertCommand {args} {
puts stderr "TreeviewInsertCommand!$args!"
    # Get parent node:

    set parentItem [FindItem [lindex $args 0]]

    # Locate previous sibling based on $index:
    if {[lindex $args 1] eq "end"} {
        set sibling [EndPosition $parentItem]
    } else {
        set index [lindex $args 1]
        if {![string is integer $index]} {
            return -code error "index is not integer"
        }
        set sibling [InsertPosition $parentItem $index]
    }

#puts stderr "sibling!$sibling!"
    # Get node name:
    #     If -id supplied and does not already exist, use that;
    #     Otherwise autogenerate new one.
    set args [lrange $args 2 end]
    if {[llength $args] >= 2 && [lindex $args 0] eq "-id"} {
        set itemName [lindex $args 1]

        if {[dict exists $tree items $itemName]} {
            return -code error "Item $itemName already exists"
        }

        set args [lrange $args 2 end]
    } else {
        while {1} {
            dict set tree serial [expr {[dict get $tree serial] + 1}]
            set idbuf [format "I%03X" [dict get $tree serial]]
            if {![dict exists $tree items $idbuf]} {
                dict set tree items $idbuf [dict create]
................................................................................
#puts stderr "itemName!$itemName!"

    # Create and configure new item:
 
    set newItem [NewItem]
#    Tk_InitOptions(newItem, tv->tree.itemOptionTable, tv->core.tkwin);
#    dict set newItem tagset [GetTagSetFromObj [dict get $tree tagTable]]
    ConfigureItem newItem $args

    # Store in hash table, link into tree:
 
    dict set tree items $itemName $newItem
    dict set newItem entryPtr $itemName
    InsertItem parentItem sibling newItem
#puts stderr "sibling!$sibling!"
    dict set tree items $itemName $newItem
    set entryPtr [dict get $parentItem entryPtr]
    dict set tree items $entryPtr $parentItem
    RedisplayWidget ""

    return [ItemName $newItem]
}

#================================ TreeviewItemCommand ============================
#     

Changes to library/ntkTagSet.tcl.

22
23
24
25
26
27
28
29
30
31
32


33
34
35
36
37
38
39
..
50
51
52
53
54
55
56
57


58
59
60
61
62
63
64
}

#================================ TagSetValues ============================
# Tag values
#=========================================================================

::itcl::body tagset::TagSetValues {tagTableVar tagSet record} {
    upvar $tagsetVar tagsetable
puts stderr "tagset::TagSetValues!"
    set LOWEST_PRIORITY 0x7FFFFFFF



    set i 0
    while {[dict get [lindex [dict get $tagTable optionSpecs] $i] type] ne "optionEnd"} {
        set optionSpec [lindex [dict get $tagTable optionSpecs] $i]
        set offset [dict get $optionSpec objOffset]
        set prio $LOWEST_PRIORITY

        set j 0
................................................................................
}

#================================ TagSetApplyStyle ============================
# TagSetApplyStyle --
#=========================================================================

::itcl::body tagset::TagSetApplyStyle {tagTable style state record} {
puts stderr "tagset::TagSetApplyStyle!"


   set optionSpec [lindex [dict get $tagTable optionSpecs] 0]

    set i 1
    while {[dict get $optionSpec type] ne "optionEnd"} {
        set offset [dict get $optionSpec objOffset]
        set optionName [dict get $optionSpec optionName]
        set val [::ntk::classes::theme::StyleMap $style $optionName $state]







|
|


>
>







 







|
>
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
}

#================================ TagSetValues ============================
# Tag values
#=========================================================================

::itcl::body tagset::TagSetValues {tagTableVar tagSet record} {
    upvar $tagTableVar tagTable
#puts stderr "tagset::TagSetValues!"
    set LOWEST_PRIORITY 0x7FFFFFFF

# FIXME !!! temporary
return 
    set i 0
    while {[dict get [lindex [dict get $tagTable optionSpecs] $i] type] ne "optionEnd"} {
        set optionSpec [lindex [dict get $tagTable optionSpecs] $i]
        set offset [dict get $optionSpec objOffset]
        set prio $LOWEST_PRIORITY

        set j 0
................................................................................
}

#================================ TagSetApplyStyle ============================
# TagSetApplyStyle --
#=========================================================================

::itcl::body tagset::TagSetApplyStyle {tagTable style state record} {
#puts stderr "tagset::TagSetApplyStyle!"
# FIXME !!! temporary
return 
   set optionSpec [lindex [dict get $tagTable optionSpecs] 0]

    set i 1
    while {[dict get $optionSpec type] ne "optionEnd"} {
        set offset [dict get $optionSpec objOffset]
        set optionName [dict get $optionSpec optionName]
        set val [::ntk::classes::theme::StyleMap $style $optionName $state]

Changes to library/ntkTreeareaElement.tcl.

53
54
55
56
57
58
59
60
61
62
63
}

#================================ ElementDraw ============================
#     
#=========================================================================

::itcl::body TreeareaElement::ElementDraw {box state} {
#puts stderr "TreeareaElement::ElementDraw!$box!"
}

} ; # end namepsace ::ntk::classes







|



53
54
55
56
57
58
59
60
61
62
63
}

#================================ ElementDraw ============================
#     
#=========================================================================

::itcl::body TreeareaElement::ElementDraw {box state} {
puts stderr "TreeareaElement::ElementDraw!$box!"
}

} ; # end namepsace ::ntk::classes

Changes to library/ntkTreeitemIndicatorElement.tcl.

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
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113




















114
115
116
117
#
# @(#) $Id: ntkTreeitemIndicatorElement.tcl
#--------------------------------------------------------------------------

namespace eval ::ntk::classes {

::itcl::extendedclass TreeitemIndicatorElement {
    inherit baseElement utils

    private variable defaultWidth 13
    private variable defaultHeight 13

    protected option [list -background Background Background] \
            -default #d9d9d9
    protected option [list -indicatorrelief indicatorRelief TreeitemIndicatorRelief] \
            -default raised
    protected option [list -indicatorwidth indicatorDiameter TreeitemIndicatorDiameter] \
            -default "4.0m"
    protected option [list -indicatorheight indicatorDiameter TreeitemIndicatorDiameter] \
            -default "1.7m"
    protected option [list -indicatormargin indicatorMargin TreeitemIndicatorMargin] \
            -default [list 5 0]
    protected option [list -borderwidth borderWidth BorderWidth] \
            -default 2



    public method InitializeOptionValues {styleName tkwin state}
    public method indicatorElementConfigure {option value}
    public method ElementSize {widthVar heightVar paddingVar}
    public method ElementDraw {box state}
}











#================================ InitializeOptionValues ============================
#     
#=========================================================================

::itcl::body TreeitemIndicatorElement::InitializeOptionValues {styleName tkwin state} {
    InitializeOptionValuesBase $styleName $tkwin $state
................................................................................
#=========================================================================

::itcl::body TreeitemIndicatorElement::ElementSize {widthVar heightVar paddingVar} {
    upvar $widthVar width
    upvar $heightVar height
    upvar $paddingVar padding

    set padding [cget -indicatormargin]
    ::ntk::classes::layout::InitPadding $padding padding
    lassign $padding l t r b
    set w [cget -indicatorwidth]
    set h [cget -indicatorheight]
    set w [::ntk::classes::utils::Value2Pixel $w]
    set h [::ntk::classes::utils::Value2Pixel $h]
    if {$w == 0} {
        set w 1
    }
    if {$h == 0} {
        set h 1
    }
    set width [expr {$w + $l + $r}]
    set height [expr {$h + $t + $b}]
    set padding [list $l $t $r $b]

}

#================================ ElementDraw ===================
#     
#=========================================================================

::itcl::body TreeitemIndicatorElement::ElementDraw {box state} {
#puts stderr "INDICATOR MENU elementDraw!$box!"
    set background [cget -background]
    set indicatorcolor $background
    set borderWidth [cget -borderwidth]
    set relief [cget -indicatorrelief]
    set padding [cget -indicatormargin]
    ::ntk::classes::layout::InitPadding $padding padding
    set b [::ntk::classes::layout::PadBox $box $padding]
    lassign $b x y width height
#puts stderr "B!$b!r!$relief!"
    # TEMPORARY!!!
    set color [ColorValue2RGBA $indicatorcolor]
    lassign [GetElementPositions $b] pos1 pos2 pos3 pos4
#puts stderr "POS border!$pos1!$pos2!$pos3!$pos4!"
    ::gles2::builtin::fillrectangle [list $pos1 $color] [list $pos2 $color] [list $pos3 $color] [list $pos4 $color]
    if {$relief ne "flat"} {
        set shadows [::ntk::classes::border::GetShadows $color]
        lassign $shadows darkColor lightColor
	set depth 0
	set z 0
	set b [list $x $y $z $width $height $depth]
        ::ntk::classes::border::DrawRectangleBorder $b $borderWidth $relief $shadows




















    }
}

} ; # end namespace ::ntk::classes







|




|
<
<
|
|
|
<
<
|
|


>
>







>
>
>
>
>
>
>
>
>







 







|


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

>







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




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
..
69
70
71
72
73
74
75
76
77
78
79









80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
#
# @(#) $Id: ntkTreeitemIndicatorElement.tcl
#--------------------------------------------------------------------------

namespace eval ::ntk::classes {

::itcl::extendedclass TreeitemIndicatorElement {
    inherit ArrowElement

    private variable defaultWidth 13
    private variable defaultHeight 13

    protected option [list -foreground Foreground Foreground] \


            -default black
    protected option [list -indicatorsize indicatorSize IndicatorSize] \
            -default 12


    protected option [list -indicatormargins indicatorMargins IndicatorMargins] \
            -default [list 2 2 4 2]
    protected option [list -borderwidth borderWidth BorderWidth] \
            -default 2

    constructor {args} {}

    public method InitializeOptionValues {styleName tkwin state}
    public method indicatorElementConfigure {option value}
    public method ElementSize {widthVar heightVar paddingVar}
    public method ElementDraw {box state}
}


#================================ constructor ============================
#     
#=========================================================================

::itcl::body UparrowElement::constructor {args} {
#puts stderr "++++ UparrowElement::constructor!$args!"
    set direction arrowRight
}

#================================ InitializeOptionValues ============================
#     
#=========================================================================

::itcl::body TreeitemIndicatorElement::InitializeOptionValues {styleName tkwin state} {
    InitializeOptionValuesBase $styleName $tkwin $state
................................................................................
#=========================================================================

::itcl::body TreeitemIndicatorElement::ElementSize {widthVar heightVar paddingVar} {
    upvar $widthVar width
    upvar $heightVar height
    upvar $paddingVar padding

    set padding [cget -indicatormargins]
    ::ntk::classes::layout::InitPadding $padding padding
    lassign $padding l t r b
    set size [cget -indicatorsize]









    set width [expr {$size + $l + $r}]
    set height [expr {$size + $t + $b}]
    set padding [list $l $t $r $b]
puts stderr "TreeitemIndicatorElement::ElementSize!$width!$height!$padding!"
}

#================================ ElementDraw ===================
#     
#=========================================================================

::itcl::body TreeitemIndicatorElement::ElementDraw {box state} {
puts stderr "INDICATOR Treeitem elementDraw!$box!$state!"
    if {[lsearch $state stateOpen] >= 0} {
        set direction arrowDown
    } else {
        set direction arrowRight
    }
    set arrowMargins [cget -indicatormargins]
    set foreground [cget -foreground]
    set depth [cget -depth]
    set borderWidth [cget -borderwidth]
    set relief [cget -relief]
    set backgroundValue [cget -background]
set backgroundValue white
    set backgroundColor [ColorValue2RGBA $backgroundValue]
    set arrowValue [cget -arrowcolor]
set arrowValue black
    set arrowColor [ColorValue2RGBA $arrowValue]
    lassign [GetElementPositions $box] pos1 pos2 pos3 pos4
    set backgroundColor [ColorValue2RGBA $backgroundValue]
    set shadows [::ntk::classes::border::GetShadows $backgroundColor]
    lassign $shadows darkColor lightColor
    if {$borderWidth > 0 && $relief ne "flat"} {
	lassign $box x y width height
	set z 0
	set mybox [list $x $y $z $width $height $depth]
	::ntk::classes::border::DrawRectangleBorder $mybox $borderWidth $relief $shadows
        ::gles2::swapbuffers

	set x [expr {$x + $borderWidth}]
	set y [expr {$y + $borderWidth}]
	set width [expr {$width - 2 *$borderWidth}]
	set height [expr {$height - 2 *$borderWidth}]
	set backbox [list $x $y $width $height]
        lassign [GetElementPositions $backbox] pos1 pos2 pos3 pos4
#puts stderr "BACKGROUND2!$pos1!$pos2!$pos3!$pos4!"
        ::gles2::builtin::fillrectangle [list $pos1 $backgroundColor] [list $pos2 $backgroundColor] [list $pos3 $backgroundColor] [list $pos4 $backgroundColor]
	set z 0
	set arrowbox [::ntk::classes::layout::PadBox $box $arrowMargins]
	lassign $arrowbox x y width height
	set arrowbox [list $x $y $z $width $height $depth]
        FillArrow $arrowColor $arrowbox $direction
        ::gles2::swapbuffers
    }
}

} ; # end namespace ::ntk::classes

Changes to library/ntkTreerowElement.tcl.

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
}

#================================ ElementDraw ============================
#     
#=========================================================================

::itcl::body TreerowElement::ElementDraw {box state} {
#puts stderr "TreerowElement::ElementDraw!$box!"
    set backgroundVal [cget -background]
set backgroundVal #d9d9d9
    set backgroundColor [ColorValue2RGBA $backgroundVal]
#puts stderr "backgroundColor!$backgroundColor!"
    lassign [GetElementPositions $box] pos1 pos2 pos3 pos4
    ::gles2::builtin::fillrectangle [list $pos1 $backgroundColor] [list $pos2 $backgroundColor] [list $pos3 $backgroundColor] [list $pos4 $backgroundColor]
    ::gles2::swapbuffers
}

} ; # end namepsace ::ntk::classes







|










57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
}

#================================ ElementDraw ============================
#     
#=========================================================================

::itcl::body TreerowElement::ElementDraw {box state} {
puts stderr "TreerowElement::ElementDraw!$box!"
    set backgroundVal [cget -background]
set backgroundVal #d9d9d9
    set backgroundColor [ColorValue2RGBA $backgroundVal]
#puts stderr "backgroundColor!$backgroundColor!"
    lassign [GetElementPositions $box] pos1 pos2 pos3 pos4
    ::gles2::builtin::fillrectangle [list $pos1 $backgroundColor] [list $pos2 $backgroundColor] [list $pos3 $backgroundColor] [list $pos4 $backgroundColor]
    ::gles2::swapbuffers
}

} ; # end namepsace ::ntk::classes