tree.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

	    $tree config -selectmode $selectmode
	}
    }
    public exportselection {0} {
	if {[winfo exists $tree]} {
	    $tree config -exportselection $exportselection
	}
    }
    public selectforeground "" {
	if {$selectforeground != "" && [winfo exists $tree]} {
	    $tree config -selectforeground $selectforeground
	}
    }
    public selectbackground "" {
	if {$selectbackground != "" && [winfo exists $tree]} {
	    $tree config -selectbackground $selectbackground
	}
    }
    public fillselection {1} {
	if {[winfo exists $tree]} {
	    $tree config -fillselection $fillselection
	}
    }
    public sortedinsertion {0} {
	if {[winfo exists $tree]} {
	    $tree config -sortedinsertion $sortedinsertion
	}
    }
    public nocase 1 {
	if {[winfo exists $tree]} {
	    $tree config -sortnocase $sortnocase
	}
    }
    public sortnocase {0} {
	if {[winfo exists $tree]} {
	    $tree config -sortnocase $sortnocase
	}
    }
    public sortcolumn {0} {
	if {[winfo exists $tree]} {
	    $tree config -sortcolumn $sortcolumn
	}
    }
    public info_label {""} {
    }

    public truncate 1 {
	if {[winfo exists $tree]} {
	    eval $tree config -truncate $truncate
	}
    }

    public splitlines 1 {
	if {[winfo exists $tree]} {
	    eval $tree config -splitlines $splitlines
	}
    }
    public tabfreespace 8 {
	if {[winfo exists $tree]} {
	    eval $tree config -tabfreespace $tabfreespace
	}
    }

    public hiddencolumns "" {
    }

    #darkgray = "#aaaaaa"
    public lineforeground "#aaaaaa" {
	if {$lineforeground != "" && [winfo exists $tree]} {
	    $tree config -lineforeground $lineforeground
	}
    }

    public splitlineforeground gray {
	if {[winfo exists $tree]} {
	    $tree config -splitlineforeground $splitlineforeground
	}
    }
	
    public autofit 0 {
	if {[winfo exists $tree]} {
	    $tree config -autofit $autofit
	}
    }

    public bestfit 0 {
	if {[winfo exists $tree]} {
	    $tree config -bestfit $bestfit
	}
    }

    public indentwidth 15 {
	if {$indentwidth != -1 && [winfo exists $tree]} {
	    $tree config -indentwidth $indentwidth
	}
    }
    public borderwidth 1 {
	if {$borderwidth != -1 && [winfo exists $tree]} {
	    $tree config -borderwidth $borderwidth
	}
    }
    public highlightwidth 0 {
	if {$highlightwidth > -1 && [winfo exists $tree]} {
	    $tree config -highlightthickness $highlightwidth
	}
    }
    public highlightthickness 1 {
	if {$highlightthickness > -1 && [winfo exists $tree]} {
	    $tree config -highlightthickness $highlightthickness
	}
    }
    public relief "" {
	if {$relief != "" && [winfo exists $tree]} {
	    $tree config -relief $relief
	}
    }
    public takefocus "" {
	if {$takefocus != "" && [winfo exists $tree]} {
	    $tree config -takefocus $takefocus
	}
    }
    public bitmapspace 7 {
	if {$bitmapspace != -1 && [winfo exists $tree]} {
	    $tree config -bitmapspace $bitmapspace
	}
    }

    public bitmap "" {
	if {$bitmap != "" && [winfo exists $tree]} {
	    set size [$tree size]
	    for {set i 0} {$i < $size} {incr i} {
		$tree itemconfig $i -bitmap $bitmap
	    }
	}
    }

    public selectborderwidth 1 {
	if {$selectborderwidth != "" && [winfo exists $tree]} {
	    $tree config -selectborderwidth $selectborderwidth
	}
    }

    public hiddenbitmap "" {
	if {$hiddenbitmap != "" && [winfo exists $tree]} {
	    $tree config -hiddenbitmap $hiddenbitmap
	}
    }

    public hiddenimage "" {
	if {$hiddenimage != "" && [winfo exists $tree]} {
	    $tree config -hiddenimage $hiddenimage
	}
    }

    public plusimage "" {
	if {$plusimage != "" && [winfo exists $tree]} {
	    $tree config -plusimage $plusimage
	}
    }

    public minusimage "" {
	if {$minusimage != "" && [winfo exists $tree]} {
	    $tree config -minusimage $minusimage
	}
    }

    public unknownimage "" {
	if {$unknownimage != "" && [winfo exists $tree]} {
	    $tree config -unknownimage $unknownimage
	}
    }

    public width 45 {
	if {$width == ""} {
	    set width 45
	}
	if {[winfo exists $tree]} {
	    $tree config -width $width
	}
    }

    public height 12 {
	if {$height == ""} {
	    set height 12
	}
	if {[winfo exists $tree]} {
	    $tree config -height $height
	}
    }

    public font "" {
	if {$font != "" && [winfo exists $tree]} {
	    $tree config -font $font
	}
    }

    public propagate 0 {
	if {[winfo exists $tree]} {
	    grid propagate $tree $propagate
	}
    }
    public accelerator 0 {
	if {[winfo exists $tree]} {
	    $tree config -accelerator $accelerator
	}
    }

    #it's not very important to enable choosing how to truncate
    #columns (auto, prefix, suffix). "auto" seems to do the job
    public enable_truncating_methode_submenu 0
    public truncatemethode auto {
	if {[winfo exists $tree]} {
	    $tree config -truncatemethode $truncatemethode
	}
    }
    public contents {} {
	contents
    }

    public fillcommand "" {
    }

    public sort "-increasing"
    public advised {}
    public filter_window 1

    public uniq {0} {
    }

    public filter {*} {
	if {[winfo exists $entry]} {
	    global $thisTail-filter
	    set $thisTail-filter $filter
	    $entry icursor 0
	    if {$contents != ""} {
		$this fill
	    }
	}
    }

    public have_filter 1 {
	if {!$have_filter} {
	    set filter ""
	}
    }

    public bind_config 1
    public editable 0
    public header {}

    #can be set external to be executed when option menu
    #is launched.
    public when_post_menu ""
}
#############################################################################
##  END CLASS for TreeWidget with tab stop support                         ##
#############################################################################

##########################################################################
## bindings for the treetable widget                                ##
##########################################################################

#default key bindings
proc treetable_bindings {t} {
    #the keybindings to the treetable are compatible to
    #those of listbox.
    bind $t <1> {
	if [winfo exists %W] {
	    focus %W
	    tkListboxBeginSelect %W [%W index @%x,%y]
	}
    }

    bind TreeTable <Double-1> {
    }

    bind $t <B1-Motion> {
	set tkPriv(x) %x
	set tkPriv(y) %y
	catch {tkListboxMotion %W [%W index @%x,%y]}
    }
    bind $t <ButtonRelease-1> {
	tkCancelRepeat
	%W activate @%x,%y
    }
    bind $t <Shift-1> {
	tkListboxBeginExtend %W [%W index @%x,%y]
    }
    bind $t <Control-1> {
	tkListboxBeginToggle %W [%W index @%x,%y]
    }
    bind $t <B1-Leave> {
	set tkPriv(x) %x
	set tkPriv(y) %y
	tkListboxAutoScan %W
    }
    bind $t <B1-Enter> {
	tkCancelRepeat
    }

    bind $t <Up> {
	tkTreeTableUpDown %W -1
    }
    bind $t <Shift-Up> {
	tkListboxExtendUpDown %W -1
    }
    bind $t <Down> {
	tkTreeTableUpDown %W 1
    }
    bind $t <Shift-Down> {
	tkListboxExtendUpDown %W 1
    }
    bind $t <Left> {
	%W xview scroll -1 units
    }
    bind $t <Control-Left> {
	%W xview scroll -1 pages
    }
    bind $t <Right> {
	%W xview scroll 1 units
    }
    bind $t <Control-Right> {
	%W xview scroll 1 pages
    }
    bind $t <Prior> {
	%W yview scroll -1 pages
	%W activate @0,0
    }
    bind $t <Next> {
	%W yview scroll 1 pages
	%W activate @0,0
    }
    bind $t <Control-Prior> {
	%W xview scroll -1 pages
    }
    bind $t <Control-Next> {
	%W xview scroll 1 pages
    }
    bind $t <Home> {
	%W xview moveto 0
    }
    bind $t <End> {
	%W xview moveto 1
    }
    bind $t <Control-Home> {
	%W activate 0
	%W see 0
	%W selection clear 0 end
	%W selection set 0
    }
    bind $t <Shift-Control-Home> {
	tkListboxDataExtend %W 0
    }
    bind $t <Control-End> {
	%W activate end
	%W see end
	%W selection clear 0 end
	%W selection set end
    }
    bind $t <Shift-Control-End> {
	tkListboxDataExtend %W end
    }
    bind $t <F16> {
	if {[selection own -displayof %W] == "%W"} {
	    clipboard clear -displayof %W
	    clipboard append -displayof %W [selection get -displayof %W]
    	}
    }
    bind $t <space> {
	tkListboxBeginSelect %W [%W index active]
    }
    bind $t <Select> {
	tkListboxBeginSelect %W [%W index active]
    }
    bind $t <Control-Shift-space> {
	tkListboxBeginExtend %W [%W index active]
    }
    bind $t <Shift-Select> {
	tkListboxBeginExtend %W [%W index active]
    }
    bind $t <Escape> {
        if {$tkPriv(listboxPrev) != ""} {
	    tkListboxCancel %W
        }
    }
    bind $t <Control-slash> {
	tkListboxSelectAll %W
    }
    bind $t <Control-backslash> {
	if {[%W cget -selectmode] != "browse"} {
	    %W selection clear 0 end
	}
    }

    bind $t <2> {
	%W scan mark %x %y
    }
    bind $t <B2-Motion> {
	%W scan dragto %x %y
    }

    #other bindings added to default listbox bindings
    bind $t <Key> {treetable_search_region %W %A %s}
    bind $t <3> {sn_listbox_post_menu %W %X %Y}
    bind $t <Control-3> {sn_listbox_post_menu %W %X %Y}
    # Sun Home
    bind $t <Any-F27> 	[bind $t <Home>]
    # Sun End
    bind $t <Any-R13> 	[bind $t <End>]
    # Sun Next
    bind $t <Any-R15> 	[bind $t <Next>]
    # Sun Prior
    bind $t <Any-R9> 	[bind $t <Prior>]

    bind $t <Tab> {focus [tk_focusNext %W]}
    bind $t <Shift-Tab> {focus [tk_focusPrev %W]}
}

proc tkTreeTableUpDown {w amount} {
    global tkPriv
    $w activate [expr [$w index active] + $amount] $amount
    $w see active
    switch [$w cget -selectmode] {
    browse {
	    $w selection clear 0 end
	}
    extended {
	    $w selection clear 0 end
	    if {[string compare [$w index active] ""] != 0} {
		$w selection anchor active
		set tkPriv(listboxPrev) [$w index active]
	    }
	    set tkPriv(listboxSelection) {}
	}
    }
}

proc treetable_search_in_widget {w a beg {end end}} {
    if {[$w size] > 20000} {
	$w config -cursor watch
	update idletasks
    }
    set res [$w search -nocase -begins -- $a $beg $end]
    $w config -cursor {}
    if {$res == ""} {
	return -1
    }
    $w activate $res
    return $res
}

proc treetable_search_region {w a state} {

    #accept only ascii-characters
    if {[string compare $a ""] == 0 || [string length $a] > 1} {
	return -1
    }
    #returns if alt-key is pressed (reserved for menu)
    if {[expr {$state & 8}] == 8} {
	return -1
    }

    upvar #0 $w-pat pat

    append pat $a
    set srch $pat
    set off [$w index active]
    if {[string compare $off ""] == 0} {
	set sel 0
    } else {
	set sel [expr $off + 1]
    }
    # Search from the selection!
    set off [treetable_search_in_widget $w $srch $sel]

    if {$off == -1 && $sel != 0} {
	#     Search until the selection!
	set off [treetable_search_in_widget $w $srch 0 $sel]
    }
    if {$off == -1} {
	if {[string length $pat] > 1} {
	    set pat $a
	    set srch $pat

	    # Search from the selection!
	    set off [treetable_search_in_widget $w $srch $sel]
	    if {$off == -1} {
		#     Search until the selection!
		set off [treetable_search_in_widget $w $srch 0 $sel]
	    }
	}
	if {$off == -1} {
	    set pat ""
	    bell -displayof $w
	    $w selection clear 0 end
	    return 1
	}
    }
    $w activate $off
    $w activate $off
    $w yview see $off

    return 0
}

#immediatly define the treetabe default bindings
treetable_bindings TreeTable