#
# hierbox.tcl
# ----------------------------------------------------------------------
# Bindings for the BLT hierbox widget
# ----------------------------------------------------------------------
# AUTHOR: George Howlett
# Bell Labs Innovations for Lucent Technologies
# gah@lucent.com
# http://www.tcltk.com/blt
#
# RCS: $Id: hierbox.tcl,v 1.1.1.1 2009/05/09 16:27:21 pcmacdon Exp $
#
# ----------------------------------------------------------------------
# Copyright (c) 1998 Lucent Technologies, Inc.
# ======================================================================
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of Lucent Technologies
# any of their entities not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# Lucent Technologies disclaims all warranties with regard to this
# software, including all implied warranties of merchantability and
# fitness. In no event shall Lucent be liable for any special, indirect
# or consequential damages or any damages whatsoever resulting from loss
# of use, data or profits, whether in an action of contract, negligence
# or other tortuous action, arising out of or in connection with the use
# or performance of this software.
#
# ======================================================================
array set bltHierbox {
afterId ""
scroll 0
space off
x 0
y 0
}
catch {
namespace eval blt::Hierbox {}
}
#
# ButtonPress assignments
#
# B1-Enter start auto-scrolling
# B1-Leave stop auto-scrolling
# ButtonPress-2 start scan
# B2-Motion adjust scan
# ButtonRelease-2 stop scan
#
bind Hierbox <ButtonPress-2> {
set bltHierbox(cursor) [%W cget -cursor]
%W configure -cursor hand1
%W scan mark %x %y
}
bind Hierbox <B2-Motion> {
%W scan dragto %x %y
}
bind Hierbox <ButtonRelease-2> {
%W configure -cursor $bltHierbox(cursor)
}
bind Hierbox <B1-Leave> {
if { $bltHierbox(scroll) } {
blt::Hierbox::AutoScroll %W
}
}
bind Hierbox <B1-Enter> {
after cancel $bltHierbox(afterId)
}
#
# KeyPress assignments
#
# Up
# Down
# Shift-Up
# Shift-Down
# Prior (PageUp)
# Next (PageDn)
# Left
# Right
# space Start selection toggle of entry currently with focus.
# Return Start selection toggle of entry currently with focus.
# Home
# End
# F1
# F2
# ASCII char Go to next open entry starting with character.
#
# KeyRelease
#
# space Stop selection toggle of entry currently with focus.
# Return Stop selection toggle of entry currently with focus.
bind Hierbox <KeyPress-Up> {
blt::Hierbox::MoveFocus %W up
if { $bltHierbox(space) } {
%W selection toggle focus
}
}
bind Hierbox <KeyPress-Down> {
blt::Hierbox::MoveFocus %W down
if { $bltHierbox(space) } {
%W selection toggle focus
}
}
bind Hierbox <Shift-KeyPress-Up> {
blt::Hierbox::MoveFocus %W prevsibling
}
bind Hierbox <Shift-KeyPress-Down> {
blt::Hierbox::MoveFocus %W nextsibling
}
bind Hierbox <KeyPress-Prior> {
blt::Hierbox::MovePage %W top
}
bind Hierbox <KeyPress-Next> {
blt::Hierbox::MovePage %W bottom
}
bind Hierbox <KeyPress-Left> {
%W close focus
}
bind Hierbox <KeyPress-Right> {
%W open focus
%W see focus -anchor w
}
bind Hierbox <KeyPress-space> {
blt::HierboxToggle %W focus
set bltHierbox(space) on
}
bind Hierbox <KeyRelease-space> {
set bltHierbox(space) off
}
bind Hierbox <KeyPress-Return> {
blt::HierboxToggle %W focus
set bltHierbox(space) on
}
bind Hierbox <KeyRelease-Return> {
set bltHierbox(space) off
}
bind Hierbox <KeyPress> {
blt::Hierbox::NextMatchingEntry %W %A
}
bind Hierbox <KeyPress-Home> {
blt::Hierbox::MoveFocus %W root
}
bind Hierbox <KeyPress-End> {
blt::Hierbox::MoveFocus %W end
}
bind Hierbox <KeyPress-F1> {
%W open -r root
}
bind Hierbox <KeyPress-F2> {
eval %W close -r [%W entry children root 0 end]
}
# ----------------------------------------------------------------------
# USAGE: blt::HierboxToggle <hierbox> <index>
# Arguments: hierbox hierarchy widget
#
# Invoked when the user presses the space bar. Toggles the selection
# for the entry at <index>.
# ----------------------------------------------------------------------
proc blt::HierboxToggle { widget index } {
switch -- [$widget cget -selectmode] {
single {
if { [$widget selection includes $index] } {
$widget selection clearall
} else {
$widget selection set $index
}
}
multiple {
$widget selection toggle $index
}
}
}
# ----------------------------------------------------------------------
# USAGE: blt::Hierbox::MovePage <hierbox> <where>
# Arguments: hierbox hierarchy widget
#
# Invoked by KeyPress bindings. Pages the current view up or down.
# The <where> argument should be either "top" or "bottom".
# ----------------------------------------------------------------------
proc blt::Hierbox::MovePage { widget where } {
# If the focus is already at the top/bottom of the window, we want
# to scroll a page. It's really one page minus an entry because we
# want to see the last entry on the next/last page.
if { [$widget index focus] == [$widget index view.$where] } {
if {$where == "top"} {
$widget yview scroll -1 pages
$widget yview scroll 1 units
} else {
$widget yview scroll 1 pages
$widget yview scroll -1 units
}
}
update
# Adjust the entry focus and the view. Also activate the entry.
# just in case the mouse point is not in the widget.
$widget entry highlight view.$where
$widget focus view.$where
$widget see view.$where
if { [$widget cget -selectmode] == "single" } {
$widget selection clearall
$widget selection set focus
}
}
#
# Edit mode assignments
#
# ButtonPress-3 Enables/disables edit mode on entry. Sets focus to
# entry.
#
# KeyPress
#
# Left Move insertion position to previous.
# Right Move insertion position to next.
# Up Move insertion position up one line.
# Down Move insertion position down one line.
# Return End edit mode.
# Shift-Return Line feed.
# Home Move to first position.
# End Move to last position.
# ASCII char Insert character left of insertion point.
# Del Delete character right of insertion point.
# Delete Delete character left of insertion point.
# Ctrl-X Cut
# Ctrl-V Copy
# Ctrl-P Paste
#
# KeyRelease
#
# ButtonPress-1 Start selection if in entry, otherwise clear selection.
# B1-Motion Extend/reduce selection.
# ButtonRelease-1 End selection if in entry, otherwise use last selection.
# B1-Enter Disabled.
# B1-Leave Disabled.
# ButtonPress-2 Same as above.
# B2-Motion Same as above.
# ButtonRelease-2 Same as above.
#
# All bindings in editting mode will "break" to override other bindings.
#
#
bind Hierbox <ButtonPress-3> {
set node [%W nearest %x %y]
%W entry insert $node @%x,%y ""
# %W entry insert $node 2 ""
}
proc blt::Hierbox::Init { widget } {
#
# Active entry bindings
#
$widget bind Entry <Enter> {
%W entry highlight current
}
$widget bind Entry <Leave> {
%W entry highlight ""
}
#
# Button bindings
#
$widget button bind all <ButtonRelease-1> {
%W see current
%W toggle current
}
$widget button bind all <Enter> {
%W button highlight current
}
$widget button bind all <Leave> {
%W button highlight ""
}
#
# ButtonPress-1
#
# Performs the following operations:
#
# 1. Clears the previous selection.
# 2. Selects the current entry.
# 3. Sets the focus to this entry.
# 4. Scrolls the entry into view.
# 5. Sets the selection anchor to this entry, just in case
# this is "multiple" mode.
#
$widget bind Entry <ButtonPress-1> {
blt::Hierbox::SetSelectionAnchor %W current
set bltHierbox(scroll) 1
}
$widget bin Entry <Double-ButtonPress-1> {
%W toggle current
}
#
# B1-Motion
#
# For "multiple" mode only. Saves the current location of the
# pointer for auto-scrolling.
#
$widget bind Entry <B1-Motion> {
set bltHierbox(x) %x
set bltHierbox(y) %y
set index [%W nearest %x %y]
if { [%W cget -selectmode] == "multiple" } {
%W selection mark $index
} else {
blt::Hierbox::SetSelectionAnchor %W $index
}
}
#
# ButtonRelease-1
#
# For "multiple" mode only.
#
$widget bind Entry <ButtonRelease-1> {
if { [%W cget -selectmode] == "multiple" } {
%W selection anchor current
}
after cancel $bltHierbox(afterId)
set bltHierbox(scroll) 0
}
#
# Shift-ButtonPress-1
#
# For "multiple" mode only.
#
$widget bind Entry <Shift-ButtonPress-1> {
if { [%W cget -selectmode] == "multiple" && [%W selection present] } {
if { [%W index anchor] == "" } {
%W selection anchor current
}
set index [%W index anchor]
%W selection clearall
%W selection set $index current
} else {
blt::Hierbox::SetSelectionAnchor %W current
}
}
$widget bind Entry <Shift-B1-Motion> {
# do nothing
}
$widget bind Entry <Shift-ButtonRelease-1> {
after cancel $bltHierbox(afterId)
set bltHierbox(scroll) 0
}
#
# Control-ButtonPress-1
#
# For "multiple" mode only.
#
$widget bind Entry <Control-ButtonPress-1> {
if { [%W cget -selectmode] == "multiple" } {
set index [%W index current]
%W selection toggle $index
%W selection anchor $index
} else {
blt::Hierbox::SetSelectionAnchor %W current
}
}
$widget bind Entry <Control-B1-Motion> {
# do nothing
}
$widget bind Entry <Control-ButtonRelease-1> {
after cancel $bltHierbox(afterId)
set bltHierbox(scroll) 0
}
#
# Control-Shift-ButtonPress-1
#
# For "multiple" mode only.
#
$widget bind Entry <Control-Shift-ButtonPress-1> {
if { [%W cget -selectmode] == "multiple" && [%W selection present] } {
if { [%W index anchor] == "" } {
%W selection anchor current
}
if { [%W selection includes anchor] } {
%W selection set anchor current
} else {
%W selection clear anchor current
%W selection set current
}
} else {
blt::Hierbox::SetSelectionAnchor %W current
}
}
$widget bind Entry <Control-Shift-B1-Motion> {
# do nothing
}
}
# ----------------------------------------------------------------------
# USAGE: blt::Hierbox::AutoScroll <hierbox>
#
# Invoked when the user is selecting elements in a hierbox widget
# and drags the mouse pointer outside of the widget. Scrolls the
# view in the direction of the pointer.
#
# Arguments: hierbox hierarchy widget
#
# ----------------------------------------------------------------------
proc blt::Hierbox::AutoScroll { widget } {
global bltHierbox
if { ![winfo exists $widget] } {
return
}
set x $bltHierbox(x)
set y $bltHierbox(y)
set index [$widget nearest $x $y]
if { $y >= [winfo height $widget] } {
$widget yview scroll 1 units
set neighbor down
} elseif { $y < 0 } {
$widget yview scroll -1 units
set neighbor up
} else {
set neighbor $index
}
if { [$widget cget -selectmode] == "single" } {
blt::Hierbox::SetSelectionAnchor $widget $neighbor
} else {
$widget selection mark $index
}
set bltHierbox(afterId) [after 10 blt::Hierbox::AutoScroll $widget]
}
proc blt::Hierbox::SetSelectionAnchor { widget index } {
set index [$widget index $index]
$widget selection clearall
$widget see $index
$widget focus $index
$widget selection set $index
$widget selection anchor $index
}
# ----------------------------------------------------------------------
# USAGE: blt::Hierbox::NextMatchingEntry <hierbox> <char>
# Arguments: hierbox hierarchy widget
#
# Invoked by KeyPress bindings. Searches for an entry that starts
# with the letter <char> and makes that entry active.
# ----------------------------------------------------------------------
proc blt::Hierbox::NextMatchingEntry { widget key } {
if {[string match {[ -~]} $key]} {
set last [$widget index focus]
set next [$widget index next]
while { $next != $last } {
set label [$widget entry cget $next -label]
if { [string index $label 0] == $key } {
break
}
set next [$widget index -at $next next]
}
$widget focus $next
if {[$widget cget -selectmode] == "single"} {
$widget selection clearall
$widget selection set focus
}
$widget see focus
}
}
# ----------------------------------------------------------------------
# USAGE: blt::Hierbox::MoveFocus <hierbox> <where>
#
# Invoked by KeyPress bindings. Moves the active selection to the
# entry <where>, which is an index such as "up", "down", "prevsibling",
# "nextsibling", etc.
# ----------------------------------------------------------------------
proc blt::Hierbox::MoveFocus { widget where } {
catch {$widget focus $where}
if { [$widget cget -selectmode] == "single" } {
$widget selection clearall
$widget selection set focus
}
$widget see focus
}
Mini Shell