Posted to tcl by patthoyts at Mon Apr 28 10:41:54 GMT 2008view raw
- # 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 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.detach -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}
- 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
- }
- }
- # On release, do the button action if any.
- proc ::ButtonNotebook::Release {w x y} {
- $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]} {
- set tab [lindex [$w tabs] $index]
- set title [$w tab $index -text]
- $w forget $index
- wm manage $tab
- wm title $tab $title
- wm protocol $tab WM_DELETE_WINDOW \
- [namespace code [list Attach $w $tab $index]]
- event generate $tab <<DetachedTab>>
- }
- }
- 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
- $nb add $nb.page0 -text One
- $nb add $nb.page1 -text Two
- 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}
- wm deiconify $dlg
- }
- ::ButtonNotebook::Init 1
- #::ButtonNotebook::Test; tkwait window .