Posted to tcl by patthoyts at Mon Apr 28 14:31:12 GMT 2008view pretty
# Replace the standard notebook tab with one that includes a close # button. # In future versions of ttk this will be supported more directly when # the identify command will be able to identify parts of the tab. namespace eval ::ButtonNotebook { } # Tk 8.6 has the Visual Styles element engine on windows. If this is # available we use it to get proper windows close buttons. # proc ::ButtonNotebook::CreateElements {} { if {[lsearch -exact [ttk::style element names] close] == -1} { if {[catch { # WINDOW WP_SMALLCLOSEBUTTON (19) # WINDOW WP_MDICLOSEBUTTON (20) # WINDOW WP_MDIRESTOREBUTTON (22) #ttk::style element create close vsapi \ # WINDOW 20 {disabled 4 {active pressed} 3 active 2 {} 1} ttk::style element create close vsapi \ EXPLORERBAR 2 {disabled 4 {active pressed} 3 active 2 {} 1} ttk::style element create detach vsapi \ WINDOW 22 {disabled 4 {active pressed} 3 active 2 {} 1} }]} then { CreateImageElements } } } proc ::ButtonNotebook::CreateImageElements {} { # Create two image based elements to provide buttons to close the # tabs or to detach a tab and turn it into a toplevel. namespace eval ::img {} set imgdir [file join [file dirname [info script]] images] image create photo ::img::close -file [file join $imgdir xhn.gif] image create photo ::img::closepressed -file [file join $imgdir xhd.gif] image create photo ::img::closeactive -file [file join $imgdir xhu.gif] image create photo ::img::detach -file [file join $imgdir dhn.gif] image create photo ::img::detachup -file [file join $imgdir dhu.gif] image create photo ::img::detachdown -file [file join $imgdir dhd.gif] if {[lsearch -exact [ttk::style element names] close] == -1} { if {[catch { ttk::style element create close image \ [list ::img::close \ {active pressed !disabled} ::img::closepressed \ {active !disabled} ::img::closeactive] \ -border 3 -sticky {} ttk::style element create detach image \ [list ::img::detach \ {active pressed !disabled} ::img::detachdown \ {active !disabled} ::img::detachup] \ -border 3 -sticky {} } err]} { puts stderr $err } } } proc ::ButtonNotebook::Init {{pertab 0}} { CreateElements # This places the buttons on the right end of the tab area -- but in # Tk 8.5 we cannot identify these elements. if {!$pertab} { ttk::style layout ButtonNotebook { ButtonNotebook.client -sticky nswe ButtonNotebook.close -side right -sticky ne ButtonNotebook.detach -side right -sticky ne } } # This places the button elements on each tab which uses quite a # lot of space but we can identify the elements. Changes to the # widget state affect all the button elements though. if {$pertab} { ttk::style layout ButtonNotebook { ButtonNotebook.client -sticky nswe } ttk::style layout ButtonNotebook.Tab { ButtonNotebook.tab -sticky nswe -children { ButtonNotebook.padding -side top -sticky nswe -children { ButtonNotebook.focus -side top -sticky nswe -children { ButtonNotebook.label -side left -sticky {} ButtonNotebook.close -side left -sticky {} } } } } } if {$::ttk::currentTheme eq "xpnative"} { ttk::style configure ButtonNotebook.Tab -width -8 } bind TNotebook <ButtonPress-1> {+::ButtonNotebook::Press %W %x %y} bind TNotebook <ButtonRelease-1> {+::ButtonNotebook::Release %W %x %y %X %Y} bind TNotebook <<ThemeChanged>> [namespace code [list Init $pertab]] } # Hook in some event extras: # set the state to pressed if button down over a button element. proc ::ButtonNotebook::Press {w x y} { set e [$w identify $x $y] if {[string match "*close" $e] || [string match "*detach" $e]} { $w state pressed } else { upvar #0 [namespace current]::$w state set state(drag) 1 set state(drag_index) [$w index @$x,$y] set state(drag_from_x) $x set state(draw_from_y) $y } } # On release, do the button action if any. proc ::ButtonNotebook::Release {w x y rootX rootY} { $w state !pressed set e [$w identify $x $y] set index [$w index @$x,$y] if {[string match "*close" $e]} { $w forget $index event generate $w <<NotebookClosedTab>> } elseif {[string match "*detach" $e]} { Detach $w $index } else { upvar #0 [namespace current]::$w state if {[info exists state(drag)] && $state(drag)} { set dropwin [winfo containing $rootX $rootY] if {$dropwin eq {}} { Detach $w $state(drag_index) } elseif {$dropwin eq $w && $index != $state(drag_index)} { Move $w $state(drag_index) $index } unset state } } unset -nocomplain [namespace current]::$w } # Move a tab from old index to new index position. proc ::ButtonNotebook::Move {notebook old_index new_index} { set tab [lindex [$notebook tabs] $old_index] set title [$notebook tab $old_index -text] $notebook forget $old_index if {[string is integer -strict $new_index]} { incr new_index -1 if {$new_index < 0} {set new_index 0} if {$new_index > [llength [$notebook tabs]]} { set new_index end } } else { set new_index end } $notebook insert $new_index $tab -text $title } # Turn a tab into a toplevel (must be a tk::frame) proc ::ButtonNotebook::Detach {notebook index} { set tab [lindex [$notebook tabs] $index] set title [$notebook tab $index -text] $notebook forget $index wm manage $tab wm title $tab $title wm protocol $tab WM_DELETE_WINDOW \ [namespace code [list Attach $notebook $tab $index]] event generate $tab <<DetachedTab>> } # Attach a toplevel to the notebook proc ::ButtonNotebook::Attach {notebook tab {index end}} { set title [wm title $tab] wm forget $tab if {[catch { if {[catch {$notebook insert $index $tab -text $title} err]} { $notebook add $tab -text $title } $notebook select $tab } err]} { puts stderr "AttachWindow: $err" wm manage $w wm title $w $title } } proc ::ButtonNotebook::Test {} { variable tabtest set dlg [toplevel .test[incr tabtest]] wm title $dlg "Notebook test" wm withdraw $dlg set nb [ttk::notebook $dlg.nb -style ButtonNotebook] frame $nb.page0 -background red -width 100 -height 100 frame $nb.page1 -background blue -width 100 -height 100 frame $nb.page2 -background green -width 100 -height 100 $nb add $nb.page0 -text One $nb add $nb.page1 -text Two $nb add $nb.page2 -text Three grid $dlg.nb -sticky news grid rowconfigure $dlg 0 -weight 1 grid columnconfigure $dlg 0 -weight 1 bind TNotebook <Motion> {puts stderr [%W identify %x %y]} bind $dlg <Control-F2> {console show} console show wm geometry $dlg 320x240 wm deiconify $dlg focus $dlg } ::ButtonNotebook::Init 1 ::ButtonNotebook::Test; tkwait window .