Notebook widget with close buttons supporting non-closing tab.

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

package require Tk

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 {
            # No XP element engine - use images...
            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 user3} ::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.focus -side top -sticky nswe -children {
                    ButtonNotebook.padding -side right -sticky nswe -children {
                        ButtonNotebook.close -side right -sticky {}
                    }
                    ButtonNotebook.label -side left -sticky {}
                }
            }
        }
        #if {$::tcl_platform(platform) eq "windows"} {} ??
        ttk::style configure ButtonNotebook.Tab -width -8
        ttk::style configure ButtonNotebook.Tab -padding {8 0 0 0}
    }

    bind TNotebook <ButtonPress-1> {+::ButtonNotebook::Press %W %x %y}
    bind TNotebook <Motion> {+::ButtonNotebook::Drag %W %x %y %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]} {
        set index [$w index @$x,$y]
        set tw [lindex [$w tabs] $index]
        if {[winfo class $tw] ne "Noclose"} {
            $w state pressed
        }
    } else {
        upvar #0 [namespace current]::$w state
        if {![info exists state]} {
            # FIX ME: dragging tabs isnt working so well at the moment
            #set state(drag) 1
            #set state(drag_index) [$w index @$x,$y]
            #set state(drag_under)  $state(drag_index)
            #set state(drag_from_x) $x
            #set state(draw_from_y) $y
            #set state(drag_indic) [ttk::label $w._indic -text v]
        }
    }
}

proc ::ButtonNotebook::Drag {w x y rootX rootY} {
    upvar #0 [namespace current]::$w state

    # Use user3 to prevent activation of a non-closing close element
    set contained [lindex [$w tabs] [$w index @$x,$y]]
    if {[winfo class $contained] eq "Noclose"} {
        $w state user3
    } else { $w state !user3 }

    if {[info exists state]} {
        if {[winfo containing $rootX $rootY] eq $w} {
            set index [$w index @$x,$y]
            if {$index != $state(drag_under)} {
                place $state(drag_indic) -anchor nw -x $x -y 0
                set state(drag_under) $index
            }
        }
    }
}

# 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]} {
        set tw [lindex [$w tabs] $index]
        if {[winfo class $tw] ne "Noclose"} {
            $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]} {
            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
            }
            destroy $state(drag_indic)
            unset state
        }
    }
}

# 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]]
    bind $tab <Configure> \
        [namespace code [list Debug $notebook "Configure %wx%h %x,%y"]]
    bind $tab <Expose> [namespace code [list Debug $notebook "Expose"]]
    bind $tab <Activate> [namespace code [list Debug $notebook "Activate"]]
    bind $tab <Deactivate> [namespace code [list Debug $notebook "Deactivate"]]
    bind $tab <ButtonPress> [namespace code [list Debug $notebook "Button"]]
    bind $tab <Visibility> \
        [namespace code [list Debug $notebook "Visibility %s"]]
    
    event generate $tab <<DetachedTab>>
}
proc ::ButtonNotebook::Debug {notebook msg} {
    if {[winfo exists $notebook.page0.text]} {
        $notebook.page0.text insert end $msg\n {}
        $notebook.page0.text see end
    }
}

# 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 -class Noclose
    frame $nb.page3 -background tomato -width 100 -height 100
    $nb add $nb.page0 -text One
    $nb add $nb.page1 -text Two
    $nb add $nb.page2 -text Three
    $nb add $nb.page3 -text "Some really long label."

    set txt [text $nb.page0.text -height 10 -width 10]
    set vs [scrollbar $nb.page0.vs -command [list $txt yview]]
    $txt configure -yscrollcommand [list $vs set]
    grid $txt $vs -sticky news
    grid rowconfigure $nb.page0 0 -weight 1
    grid columnconfigure $nb.page0 0 -weight 1

    grid $dlg.nb -sticky news
    grid rowconfigure $dlg 0 -weight 1
    grid columnconfigure $dlg 0 -weight 1
    
    bind TNotebook <Motion> [string map [list %txt $txt] {
        %txt insert end [%W identify %x %y] {} "\n" {}
        %txt see end
    }]
    bind $dlg <Control-F2> {console show}
    wm withdraw .
    wm protocol $dlg WM_DELETE_WINDOW {exit}
    wm geometry $dlg 320x240
    wm deiconify $dlg
}

::ButtonNotebook::Init 1

# The following line causes the Test procedure to be run if this file
# is run standalone.
puts [winfo class .]
if {[string match "Tab*" [winfo class .]]} {
    ::ButtonNotebook::Test
    tkwait window .
}