Bwidget Source Code
Check-in [d9ce65d137]
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: Fixed some problems with keyboard traversal. Added support for left/right arrows a la MS Explorer.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d9ce65d1373d733a64405bda7da5eead594bc058
User & Date: ericm 1999-10-22 17:49:56
Context
1999-10-22
18:16
* tree.tcl: Added support for keyboard-based scrolling. check-in: c82174bca6 user: ericm tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7




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
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
1999-10-22  Eric Melski  <[email protected]>

	* tree.tcl: Fixed some problems with keyboard traversal.  Added
	support for left/right arrows a la MS Explorer.

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

Changes to tree.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
127
128
129
130
131
132
133


134
135
136
137
138
139
140
....
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
# ------------------------------------------------------------------------------
#  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
................................................................................
                  -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
................................................................................
}

# 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]] } {


|







 







>
>







 







|
>
>
>
>
>






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



>
>
>
>
>
|
>
|
<
>
>

<
<
<
<
<


<

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



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

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







1
2
3
4
5
6
7
8
9
10
11
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
....
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
1527
1528
1529
1530
1531
# ------------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.3 1999/10/22 17:49:56 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................
                  -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-Right> "Tree::_keynav right %W"
    bind $path <KeyPress-Left>  "Tree::_keynav left %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
................................................................................
}

# Tree::_keynav --
#
#	Handle navigational keypresses on the tree.
#
# Arguments:
#	which      tag indicating the direction of motion:
#                  up         move to the node graphically above current
#                  down       move to the node graphically below current
#                  left       close current if open, else move to parent
#                  right      open current if closed, else move to child
#                  open       open current if closed, close current if open
#       win        name of the tree widget
#
# Results:
#	None.

proc Tree::_keynav {which win} {
    # Keyboard navigation is riddled with special cases.  In order to avoid
    # the complex logic, we will instead make a list of all the visible,
    # selectable nodes, then do a simple next or previous operation.

    # One easy way to get all of the visible nodes is to query the canvas
    # object for all the items with the "node" tag; since the tree is always
    # completely redrawn, this list will be in vertical order.
    set nodes {}
    foreach nodeItem [$win:cmd find withtag node] {
	set node [string range [lindex [$win:cmd gettags $nodeItem] 1] 2 end]
	if { [Widget::getoption $win.$node -selectable] } {
	    lappend nodes $node
	}
    }
	
    # Keyboard navigation is all relative to the current node
    set node      [$win selection get]

    switch -exact -- $which {
	"up" {
	    # Up goes to the node that is vertically above the current node
	    # (NOT necessarily the current node's parent)
	    if { [string equal $node ""] } {
		return
	    }
	    set index [lsearch $nodes $node]
	    incr index -1
	    if { $index >= 0 } {
		$win selection set [lindex $nodes $index]
		return
	    }
	}
	"down" {
	    # Down goes to the node that is vertically below the current node
	    if { [string equal $node ""] } {
		$win selection set [lindex $nodes 0]
		return
	    }

	    set index [lsearch $nodes $node]
	    incr index
	    if { $index < [llength $nodes] } {
		$win selection set [lindex $nodes $index]
		return
	    }
	}
	"right" {

	    # On a right arrow, if the current node is closed, open it.
	    # If the current node is open, go to its first child
	    if { [string equal $node ""] } {





		return
	    }

	    set open [$win itemcget $node -open]

	    if { [llength [$win nodes $node]] } {
		if { $open } {
		    set index [lsearch $nodes $node]
		    incr index
		    if { $index < [llength $nodes] } {
			$win selection set [lindex $nodes $index]
			return

		    }
		} else {
		    $win itemconfigure $node -open 1
		    return
		}
	    }
	}


	"left" {
	    # On a left arrow, if the current node is open, close it.
	    # If the current node is closed, go to its parent.




	    if { [string equal $node ""] } {
		return
	    }
	    set open [$win itemcget $node -open]
	    if { $open } {
		$win itemconfigure $node -open 0
		return
	    } else {
		set parent [$win parent $node]

		while { ![$win itemcget $parent -selectable] } {
		    set parent [$win parent $parent]
		    if { [string equal $parent "root"] } {
			set parent $node
			break
		    }
		}


		$win selection set $parent

		return
	    }
	}
	"space" {
	    if { [string equal $node ""] } {
		return
	    }
	    set open [$win itemcget $node -open]
	    if { [llength [$win nodes $node]] } {