ListNBk.tcl 3.5 KB
Newer Older
xuebingbing's avatar
xuebingbing committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 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 153
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
#	$Id: ListNBk.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# ListNBk.tcl --
#
#	"List NoteBook" widget. Acts similarly to the notebook but uses a
#	HList widget to represent the pages.
#
# Copyright (c) 1993-1999 Ioi Kim Lam.
# Copyright (c) 2000-2001 Tix Project Group.
# Copyright (c) 2004 ActiveState
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

tixWidgetClass tixListNoteBook {
    -classname TixListNoteBook
    -superclass tixVStack
    -method {
    }
    -flag {
	-height -width
    }
    -configspec {
	{-width width Width 0}
	{-height height Height 0}
    }
    -forcecall {
	-dynamicgeometry -width -height
    }
    -default {
	{*Orientation		horizontal}
    }
}

proc tixListNoteBook:ConstructWidget {w} {
    upvar #0 $w data

    tixChainMethod $w ConstructWidget
    set data(w_pane) [tixPanedWindow $w.pane -panerelief flat]
    set p1 [$data(w_pane) add p1 -expand 0]
    set p2 [$data(w_pane) add p2 -expand 1]
    set data(w_p2) $p2
    set data(w:shlist) [tixScrolledHList $p1.shlist]
    set data(w:hlist) [$data(w:shlist) subwidget hlist]

    if {[$data(w_pane) cget -orientation] eq "vertical"} {
	pack $data(w:shlist) -expand yes -fill both -padx 2 -pady 3
    } else {
	pack $data(w:shlist) -expand yes -fill both -padx 3 -pady 2
    }

    $data(w:hlist) config \
	-command   [list tixListNoteBook:Choose $w] \
	-browsecmd [list tixListNoteBook:Choose $w] \
	-selectmode single

    pack $data(w_pane) -expand yes -fill both
}

proc tixListNoteBook:add {w child args} {
    upvar #0 $w data

    if {[string match *.* $child]} {
	error "the name of the page cannot contain the \".\" character"
    }
    return [eval tixChainMethod $w add $child $args]
}

#----------------------------------------------------------------------
# Virtual Methods
#----------------------------------------------------------------------
proc tixListNoteBook:InitGeometryManager {w} {
    tixWidgetDoWhenIdle tixListNoteBook:InitialRaise $w
}

proc tixListNoteBook:InitialRaise {w} {
    upvar #0 $w data

    if {$data(topchild) eq ""} {
	set top [lindex $data(windows) 0]
    } else {
	set top $data(topchild)
    }

    if {$top ne ""} {
	tixCallMethod $w raise $top
    }
}

proc tixListNoteBook:CreateChildFrame {w child} {
    upvar #0 $w data
    return [frame $data(w_p2).$child]
}

proc tixListNoteBook:RaiseChildFrame {w child} {
    upvar #0 $w data

    if {$data(topchild) ne $child} {
	if {$data(topchild) ne ""} {
	    pack forget $data(w:$data(topchild))
	}
	pack $data(w:$child) -expand yes -fill both
    }
}

#
#----------------------------------------------------------------------
#

proc tixListNoteBook:config-dynamicgeometry {w value} {
    upvar #0 $w data

    $data(w_pane) config -dynamicgeometry $value
}

proc tixListNoteBook:config-width {w value} {
    upvar #0 $w data

    if {$value != 0} {
	$data(w_pane) config -width $value
    }
}

proc tixListNoteBook:config-height {w value} {
    upvar #0 $w data

    if {$value != 0} {
	$data(w_pane) config -height $value
    }
}

proc tixListNoteBook:raise {w child} {
    upvar #0 $w data

    $data(w:hlist) selection clear
    $data(w:hlist) selection set $child
    $data(w:hlist) anchor set $child

    tixChainMethod $w raise $child
}

proc tixListNoteBook:Choose {w args} {
    upvar #0 $w data

    set entry [tixEvent flag V]

    if {[lsearch $data(windows) $entry] != -1} {
	tixCallMethod $w raise $entry
    }
}