Adding close/detach buttons to ttk::notebook tabs

# 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 .