Bwidget Source Code
Check-in [3f7df86982]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:* tree.tcl: Added a -selectable option to tree nodes, which controls whether or not a given node is selectable (duh). This works with the new -selectcommand option for the tree, and with keyboard traversal (also new). Now, whenever the tree gets a "selection set", it calls the given -selectcommand with the name of the tree and the list of selected nodes, which makes it easier to just drop in place and use.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 3f7df86982648883ff25f43610f3c5d2b8dbc7e8
User & Date: ericm 1999-10-22 00:09:04
Context
1999-10-22
17:49
* tree.tcl: Fixed some problems with keyboard traversal. Added support for left/right arrows a la MS Explorer. check-in: d9ce65d137 user: ericm tags: trunk
00:09
* tree.tcl: Added a -selectable option to tree nodes, which controls whether or not a given node is selectable (duh). This works with the new -selectcommand option for the tree, and with keyboard traversal (also new). Now, whenever the tree gets a "selection set", it calls the given -selectcommand with the name of the tree and the list of selected nodes, which makes it easier to just drop in place and use. check-in: 3f7df86982 user: ericm tags: trunk
1999-10-21
17:41
Added support for keyboard traversal. The widget will now tab in even when it is not editible. Also the entry widget content will be selected when the user tabs in. The key bindings now allow a traversal of the list (<Down> brings up the list). The arrow button no longer switches to an up button, but instead changes relief. The button is now more Windows NT like (for Windows NT). check-in: 347d417b33 user: sven tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.
















1
2
3
4
5
6
7














1999-10-15  Eric Melski  <[email protected]>

	* dialog.tcl: Added an overrideredirect option to Dialog::draw, which
	allows the user to control the overrideredirect state of the dialog.

1999-09-19  Eric Melski  <[email protected]>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
1999-10-21  Eric Melski  <[email protected]>

	* tree.tcl: Added a -selectable option to tree nodes, which
	controls whether or not a given node is selectable (duh).  This
	works with the new -selectcommand option for the tree, and with
	keyboard traversal (also new).  Now, whenever the tree gets a
	"selection set", it calls the given -selectcommand with the name
	of the tree and the list of selected nodes, which makes it easier
	to just drop in place and use.

1999-10-15  Eric Melski  <[email protected]>

	* panedw.tcl: Added a -class PanedWindow option to the main frame 
	(the megawidget) of the paned window.

1999-10-15  Eric Melski  <[email protected]>

	* dialog.tcl: Added an overrideredirect option to Dialog::draw, which
	allows the user to control the overrideredirect state of the dialog.

1999-09-19  Eric Melski  <[email protected]>

Changes to tree.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
53
54
55
56
57
58
59

60
61
62
63
64
65
66
..
71
72
73
74
75
76
77

78
79
80
81
82
83
84
...
121
122
123
124
125
126
127







128
129
130
131
132
133
134
135






136
137
138
139
140
141
142
...
410
411
412
413
414
415
416

417
418
419
420
421










422
423
424
425
426
427
428
....
1383
1384
1385
1386
1387
1388
1389















































































































# ------------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.1.1.1 1999/08/03 20:20:23 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................
            {-text       String     ""      0}
            {-font       TkResource ""      0 listbox}
            {-image      TkResource ""      0 label}
            {-window     String     ""      0}
            {-fill       TkResource black   0 {listbox -foreground}}
            {-data       String     ""      0}
            {-open       Boolean    0       0}

            {-drawcross  Enum       auto    0 {auto allways never}}
        }
    }

    Widget::tkinclude Tree canvas :cmd \
        remove     {-insertwidth -insertbackground -insertborderwidth -insertofftime \
                        -insertontime -selectborderwidth -closeenough -confine -scrollregion \
................................................................................
    Widget::declare Tree {
        {-deltax           Int 10 0 {=0 ""}}
        {-deltay           Int 15 0 {=0 ""}}
        {-padx             Int 20 0 {=0 ""}}
        {-background       TkResource "" 0 listbox}
        {-selectbackground TkResource "" 0 listbox}
        {-selectforeground TkResource "" 0 listbox}

        {-width            TkResource "" 0 listbox}
        {-height           TkResource "" 0 listbox}
        {-showlines        Boolean 1  0}
        {-linesfill        TkResource black  0 {frame -background}}
        {-linestipple      TkResource ""     0 {label -bitmap}}
        {-redraw           Boolean 1  0}
        {-opencmd          String  "" 0}
................................................................................

    set path [eval canvas $path [Widget::subcget $path :cmd] \
                  -width  [expr {[Widget::getoption $path -width]*8}] \
                  -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
                  -xscrollincrement 8]

    $path bind cross <ButtonPress-1> {Tree::_cross_event %W}







    bind $path <Configure> "Tree::_update_scrollregion $path"
    bind $path <Destroy>   "Tree::_destroy $path"

    DragSite::setdrag $path $path Tree::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd 1

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval Tree::\$cmd $path \$args\]"







    return $path
}


# ------------------------------------------------------------------------------
#  Command Tree::configure
................................................................................
    upvar 0  $path data

    switch -- $cmd {
        set {
            set data(selnodes) {}
            foreach node $args {
                if { [info exists data($node)] } {

                    if { [lsearch $data(selnodes) $node] == -1 } {
                        lappend data(selnodes) $node
                    }
                }
            }










        }
        add {
            foreach node $args {
                if { [info exists data($node)] } {
                    if { [lsearch $data(selnodes) $node] == -1 } {
                        lappend data(selnodes) $node
                    }
................................................................................
        $path:cmd $cmd scroll $dir units
        set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir]
    } else {
        set data(dnd,afterid) ""
        DropSite::setcursor dot
    }
}

















































































































|







 







>







 







>







 







>
>
>
>
>
>
>








>
>
>
>
>
>







 







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







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
..
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
...
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
....
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
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
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
# ------------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.2 1999/10/22 00:09:04 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................
            {-text       String     ""      0}
            {-font       TkResource ""      0 listbox}
            {-image      TkResource ""      0 label}
            {-window     String     ""      0}
            {-fill       TkResource black   0 {listbox -foreground}}
            {-data       String     ""      0}
            {-open       Boolean    0       0}
	    {-selectable Boolean    1       0}
            {-drawcross  Enum       auto    0 {auto allways never}}
        }
    }

    Widget::tkinclude Tree canvas :cmd \
        remove     {-insertwidth -insertbackground -insertborderwidth -insertofftime \
                        -insertontime -selectborderwidth -closeenough -confine -scrollregion \
................................................................................
    Widget::declare Tree {
        {-deltax           Int 10 0 {=0 ""}}
        {-deltay           Int 15 0 {=0 ""}}
        {-padx             Int 20 0 {=0 ""}}
        {-background       TkResource "" 0 listbox}
        {-selectbackground TkResource "" 0 listbox}
        {-selectforeground TkResource "" 0 listbox}
	{-selectcommand    String     "" 0}
        {-width            TkResource "" 0 listbox}
        {-height           TkResource "" 0 listbox}
        {-showlines        Boolean 1  0}
        {-linesfill        TkResource black  0 {frame -background}}
        {-linestipple      TkResource ""     0 {label -bitmap}}
        {-redraw           Boolean 1  0}
        {-opencmd          String  "" 0}
................................................................................

    set path [eval canvas $path [Widget::subcget $path :cmd] \
                  -width  [expr {[Widget::getoption $path -width]*8}] \
                  -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
                  -xscrollincrement 8]

    $path bind cross <ButtonPress-1> {Tree::_cross_event %W}

    # Added by [email protected]
    bind $path <KeyPress-Up>    "Tree::_keynav up %W"
    bind $path <KeyPress-Down>  "Tree::_keynav down %W"
    bind $path <KeyPress-space> "Tree::_keynav space %W"
    # [email protected]

    bind $path <Configure> "Tree::_update_scrollregion $path"
    bind $path <Destroy>   "Tree::_destroy $path"

    DragSite::setdrag $path $path Tree::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd 1

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval Tree::\$cmd $path \$args\]"

    # ericm
    # Bind <Button-1> to select the clicked node -- no reason not to, right?
    Tree::bindText  $path <Button-1> "$path selection set"
    Tree::bindImage $path <Button-1> "$path selection set"
    # ericm

    return $path
}


# ------------------------------------------------------------------------------
#  Command Tree::configure
................................................................................
    upvar 0  $path data

    switch -- $cmd {
        set {
            set data(selnodes) {}
            foreach node $args {
                if { [info exists data($node)] } {
		    if { [Widget::getoption $path.$node -selectable] } {
			if { [lsearch $data(selnodes) $node] == -1 } {
			    lappend data(selnodes) $node
			}
		    }
                }
            }

	    if { ![string equal $data(selnodes) ""] } {
		set selectcmd [Widget::getoption $path -selectcommand]
		if { ![string equal $selectcmd ""] } {
		    lappend selectcmd $path
		    lappend selectcmd $data(selnodes)
		    uplevel \#0 $selectcmd
		}
	    }
        }
        add {
            foreach node $args {
                if { [info exists data($node)] } {
                    if { [lsearch $data(selnodes) $node] == -1 } {
                        lappend data(selnodes) $node
                    }
................................................................................
        $path:cmd $cmd scroll $dir units
        set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir]
    } else {
        set data(dnd,afterid) ""
        DropSite::setcursor dot
    }
}

# Tree::_keynav --
#
#	Handle navigational keypresses on the tree.
#
# Arguments:
#	which      one of up, down or space.
#       win        name of the tree widget
#
# Results:
#	None.

proc Tree::_keynav {which win} {
    set node     [$win selection get]
    switch -exact -- $which {
	"up" {
	    # If nothing is selected, do nothing??
	    if { [string equal $node ""] } {
		return
	    }

	    # If this node has a previous sibling, go to it
	    set parent   [$win parent $node]
	    set siblings [$win nodes $parent]
	    set index    [lsearch $siblings $node]
	    set newIndex [expr {$index - 1}]
	    if { $newIndex >= 0 } {
		set node [lindex $siblings $newIndex]
		# If the previous sibling is open and has children, go to its
		# last child
		if { [$win itemcget $node -open] } {
		    if { [llength [$win nodes $node]] } {
			set node [lindex [$win nodes $node] end]
		    }
		}
		$win selection clear
		$win selection set $node
		$win see $node
		return
	    }

	    # Otherwise, go to this node's parent, unless that is "root"
	    if { ![string equal $parent "root"] } {
		$win selection clear
		$win selection set $parent
		$win see $parent
		return
	    }

	}
	"down" {
	    # If nothing is selected, select the first node
	    if { [string equal $node ""] } {
		set node [lindex [$win nodes root] 0]
		if { ![string equal $node ""] } {
		    $win selection set $node
		    $win see $node
		}
		return
	    }

	    set open [$win itemcget $node -open]
	    # If this node is open, select its first child (if it has any)
	    # Otherwise, fallthrough to the "closed node" state
	    if { $open } {
		set children [$win nodes $node]
		if { [llength $children] } {
		    set node [lindex $children 0]
		    $win selection clear
		    $win selection set $node
		    $win see $node
		    return
		}
	    }

	    # If the node is not open, go to its next sibling, if it has one
	    set parent   [$win parent $node]
	    set siblings [$win nodes $parent]
	    set index    [lsearch $siblings $node]
	    set newIndex [expr {$index + 1 }]
	    # If the node was the last of the children, go to the next sibling
	    # of the parent
	    while { $newIndex >= [llength $siblings] } {
		set node $parent
		if { [string equal $node "root"] } {
		    return
		}
		set parent [$win parent $node]
		set siblings [$win nodes $parent]
		set index [lsearch $siblings $node]
		set newIndex [expr {$index + 1}]
	    }

	    set newNode  [lindex $siblings $newIndex]
	    $win selection clear
	    $win selection set $newNode
	    $win see $newNode
	}
	"space" {
	    if { [string equal $node ""] } {
		return
	    }
	    set open [$win itemcget $node -open]
	    if { [llength [$win nodes $node]] } {
		$win itemconfigure $node -open [expr {$open?0:1}]
	    }
	}
    }
    return
}