proc notebook {w args} {
frame $w
pack [frame $w.top] -side top -fill x -anchor w
rename $w _$w
proc $w {cmd args} { #-- overloaded frame command
set w [lindex [info level 0] 0]
switch -- $cmd {
add {notebook'add $w $args}
raise {notebook'raise $w $args}
default {eval [linsert $args 0 _$w $cmd]}
}
}
return $w
}
proc notebook'add {w title} {
set btn [button $w.top.b$title -text $title -command [list $w raise $title]]
pack $btn -side left -ipadx 5
set f [frame $w.f$title -relief raised -borderwidth 2]
pack $f -fill both -expand 1
$btn invoke
bind $btn <3> "destroy {$btn}; destroy {$f}" ;# (1)
return $f
}
proc notebook'raise {w title} {
foreach i [winfo children $w.top] {$i config -borderwidth 0}
$w.top.b$title config -borderwidth 1
set frame $w.f$title
foreach i [winfo children $w] {
if {![string match *top $i] && $i ne $frame} {pack forget $i}
}
pack $frame -fill both -expand 1
}
#----------------------------------------- test and demo code
package require Tk
pack [notebook .n] -fill both -expand 1
set p1 [.n add Text]
pack [text $p1.t -wrap word] -fill both -expand 1
set p2 [.n add Canvas]
pack [canvas $p2.c -bg yellow] -fill both -expand 1
set p3 [.n add Options]
pack [button $p3.1 -text Console -command {console show}]
.n raise Text
wm geometry . 400x300(1): Adding this line adds the capability of deleting a page by just right-clicking on its tab.
