tk8.6-blt2.5 2.5.3+dfsg-3 / usr / lib / blt2.5 / hierbox.tcl

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