Bwidget Source Code
Check-in [c82174bca6]
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 support for keyboard-based scrolling.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c82174bca6698c150e79356f125478139b4a596d
User & Date: ericm 1999-10-22 18:16:08
Context
1999-10-25
21:54
* font.tcl: Added support for two new flags: -families and -styles; -families allows you to specify one of all, fixed, or variable, to limit the choice of fonts to those fonts; -styles allows you to specify a list of styles that can be set with the widget (ie, bold, italic, etc).
check-in: 0044eccdb1 user: ericm tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3
4

5
6
7
8
9
10
11
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



>







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.
	Added support for keyboard-based scrolling.

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

Changes to tree.tcl.

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

132
133
134
135
136








137
138
139
140
141
142
143
....
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
....
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
....
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
# ------------------------------------------------------------------------------
#  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
................................................................................
                  -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-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
    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd 1
................................................................................
	    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 ""] } {
................................................................................
	    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
		}
	    }
................................................................................
		    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
	    }


|







 







>





>
>
>
>
>
>
>
>







 







>







>







>







 







>







 







>







1
2
3
4
5
6
7
8
9
10
11
...
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
....
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
....
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
....
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
# ------------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.4 1999/10/22 18:16:08 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Tree::create
#     - Tree::configure
#     - Tree::cget
#     - Tree::insert
#     - Tree::itemconfigure
................................................................................
                  -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]
    # These allow keyboard traversal of the tree
    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"

    # These allow keyboard control of the scrolling
    bind $path <Control-KeyPress-Up>    "$path yview scroll -1 units"
    bind $path <Control-KeyPress-Down>  "$path yview scroll  1 units"
    bind $path <Control-KeyPress-Left>  "$path xview scroll -1 units"
    bind $path <Control-KeyPress-Right> "$path xview scroll  1 units"

    bind $path
    # [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
................................................................................
	    if { [string equal $node ""] } {
		return
	    }
	    set index [lsearch $nodes $node]
	    incr index -1
	    if { $index >= 0 } {
		$win selection set [lindex $nodes $index]
		$win see [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]
		$win see [lindex $nodes 0]
		return
	    }

	    set index [lsearch $nodes $node]
	    incr index
	    if { $index < [llength $nodes] } {
		$win selection set [lindex $nodes $index]
		$win see [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 ""] } {
................................................................................
	    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]
			$win see [lindex $nodes $index]
			return
		    }
		} else {
		    $win itemconfigure $node -open 1
		    return
		}
	    }
................................................................................
		    set parent [$win parent $parent]
		    if { [string equal $parent "root"] } {
			set parent $node
			break
		    }
		}
		$win selection set $parent
		$win see $parent
		return
	    }
	}
	"space" {
	    if { [string equal $node ""] } {
		return
	    }