package require BWidget

  set nb [NoteBook .nb -side top]
  $nb insert 0 foo -text "foo"
  $nb insert 1 bar -text "bar"

  set pane [$nb getframe foo]
  label $pane.hello -text "hello world"
  pack $pane.hello -fill both -expand 1

  set pane [$nb getframe bar]
  button $pane.fizz -text testing
  pack $pane.fizz -fill both -expand true

  pack $nb -fill both -expand 1
  $nb raise foo

 package require BWidget

 ## create a notebook with 2 text panes
 NoteBook .n
 .n insert 0 text1 -text Text1
 .n insert 1 text2 -text Text2
 foreach panel {text1 text2} {
        set pane [.n getframe $panel]
        text $pane.t
        pack $pane.t -fill both -expand 1
 }
 pack .n
 .n raise text1

 ## make a popup menu for the tabs (just add commands)
 menu .popup -tearoff 0 -activeborderwidth 0
 .popup add command -label "mess 1" -command [list puts "in mess 1"]
 .popup add command -label "mess 2" -command [list puts "in mess 2"]
 .popup add separator
 .popup add command -label "mess n" -command [list puts "in mess n"] 

 ## bind right mouse button to the popup menus
 .n bindtabs <Button-3> [list popup .popup %X %Y]

 proc popup {win X Y pane} {
        # check to see if current click is on the top tab
        if {[string equal [.n raise] $pane]} {
                tk_popup $win $X $Y
        }
 }

pack [::ttk::notebook .n] -fill both -expand true
foreach tabs {Edit Check Close} {
    ::ttk::entry .n.[string tolower $tabs]
    .n add .n.[string tolower $tabs] -text $tabs
}
# bind after tabs are created to avoid calls in creation
bind .n <<NotebookTabChanged>> tabChanged
proc tabChanged {} {
    if {[.n select] eq ".n.edit"} {
        # If edit page raised, always clear the entry widget
        .n.edit delete 0 end
        .n.edit selection clear
    }
}

set image [image create photo -format gif -data {R0lGODlhBwAHAIABAP8AAP///
        yH5BAEKAAEALAAAAAAHAAcAAAIMBIKmsWrIXnLxuDMLADs=}]
ttk::style element create close_button image $image -height 14 -width 14 -sticky e

ttk::style layout TNotebook.Tab {Notebook.tab -sticky nswe -children {
        Notebook.padding -expand 1 -sticky nswe -children {Notebook.label
        -expand 1 -sticky nesw -side left close_button -side right}}}

ttk::notebook .test
ttk::frame .test.frame_a
ttk::frame .test.frame_b
.test add .test.frame_a -text "Frame A"
.test add .test.frame_b -text "Frame B"
pack .test

set script {
        if {[%W identify %x %y] == "close_button"} {
                puts "Hurrah! Close tab [%W index @%x,%y] plz."
                break
        }
}

bind TNotebook <Button-1> "$script\;[bind TNotebook <Button-1>]"

package require Tk
package require BWidget 1.9.13 ;# for right side images in tabs
wm geom . 877x161+92+213
catch {console show ; console eval {wm geom . 69x24+15+6}}

#normal and active, must be same size right side images

#here's with an alpha channel
set close1 [image create photo -data {
    
    R0lGODlhFQAVAKUhAAICAg4ODhMTExcXFxwcHCAgIDIyMjMzMzU1NTo6OkpKSktLS0xMTE1NTYaG
    hoiIiIuLi5CQkJSUlJmZmaKioqenp6ysrLCwsLW1tcPDw8fHx8zMzNXV1dra2t7e3t/f3+Pj4///
    ////////////////////////////////////////////////////////////////////////////
    /////////////////////////////////////////////yH+EUNyZWF0ZWQgd2l0aCBHSU1QACH5
    BAEKAD8ALAAAAAAVABUAAAZiwJ9wSCwaj8ikchm4LD0HYyZgURoSR02ggiwokhoBlwhlLDUDCvG6
    FG4E6p+3PXw/EA06EQNA6NcKAhN/cgs/HAMSdGVDHAQRbWxEHY9Kc0aUEEeMSB8EDkaSSSAEhKan
    f0EAOw==
    
}]

set close2 [image create photo -data {
    
    R0lGODlhFQAVAKUiAAICAg4ODhMTExcXFxwcHCAgIDIyMjMzMzU1NTo6OkpKSktLS0xMTE1NTYKC
    goaGhoiIiIuLi5CQkJSUlJmZmaKioqenp6ysrLCwsLW1tcPDw8fHx8zMzNXV1dra2t7e3t/f3+Pj
    4///////////////////////////////////////////////////////////////////////////
    /////////////////////////////////////////////yH+EUNyZWF0ZWQgd2l0aCBHSU1QACH5
    BAEKAD8ALAAAAAAVABUAAAaJQIBwSCwaAb+kcslcCpvQ5vMXwESVn0Nyqglcrj9DYotMbgKWaEGh
    nJoF6WWW4SwrN4PKUsx0KzkCej9rUnZLgBAIDVB+SxkACFGNSgYKAhSMhkoFCz8dAxOFTHNKHQQS
    fZp8Sx6ndUuETa0RbWWkUSAED2RJq1chBA4/T7FgPyEFw5rGtUfORUEAOw==
    
}]

proc main {} {
    global nb close1 close2
    set ::Widget::_theme 1 ;# undocumented feature ??, will use ttk::frame for tab container frame
    
    set nb [NoteBook .nb1 -side top -bd 1  -font {{consolas bold italic} 17} -homogeneous 0 -arcradius 8 -bg grey45]
    bindings $nb 1  ;# create context menu and mousewheel bindings
    
    foreach tab {notebook tiletable dragdrop2 ver extra1 extra2 notebook2} { ;# generate 7 tabs, a text and 5 buttons + nested notebook
        $nb insert end $tab -text "   $tab.tcl  " -rimage $close1 -ractiveimage $close2 \
                -rimagecmd [list closetab $nb] -activeforeground red -createcmd [list created $tab] -raisecmd [list raised $nb $tab]
    }
    
    set pane [$nb getframe notebook] ;# this one gets a text widget in the frame
    text $pane.hello  -font {{comic sans MS} 20}
    $pane.hello insert end  "hello notebook\nhere is some text"
    pack $pane.hello  -fill both -side top -expand 1
    
    foreach {tab fill} {tiletable both   dragdrop2 y   ver x   extra1 none   extra2 both} { ;# rest are just some buttons
        pack [ttk::button [$nb getframe $tab].foo -text "$tab-button" \
                -command [list puts "$tab button pushed"]]  -fill $fill -expand true
    }
    $nb raise notebook 
    
# add a nested NoteBook inisde notebook2 
    
    set pane [$nb getframe notebook2]
    set nb2 [NoteBook $pane.nb -side top -bd 1  -font {{consolas bold italic} 12} -homogeneous 0 -arcradius 8 -bg grey45]
    bindings $nb2 2
    
    foreach tab {a b c d e f g h i j} { ;# generate some tabs
        $nb2 insert end $tab -text "   $tab.tcl  " -rimage $close1 -ractiveimage $close2 \
                -rimagecmd [list closetab $nb2] -activeforeground red -createcmd [list created $tab] -raisecmd [list raised $nb2 $tab]
        pack [label [$nb2 getframe $tab].label -text "this is tab $tab"] -fill both -expand true
    }
    $nb2 raise a

    return
}

proc bindings {nb n} {
    catch {bind ${nb}.c <MouseWheel> [list wheel $nb %D]
        bind    ${nb}.c <Button-4>         [list wheel $nb 1]  ;# on linux, mousewheel maps to but 4 and 5
        bind    ${nb}.c <Button-5>         [list wheel $nb -1]
    } ;# if this fails, well no mouse wheel support bind to .c canvas with tabs
    pack $nb -fill both -expand 1
    
    #       make a popup menu for the tabs
     menu .popup$n -tearoff 0 -activeborderwidth 0
    .popup$n add command -label "close tab"           -command [list closetab $nb]
    .popup$n add separator
    .popup$n add command -label "move tab to front"   -command [list moveit $nb 0]
    .popup$n add command -label "move tab to end"     -command [list moveit $nb end]
    #       bind right mouse button to the popup menus
    $nb bindtabs <Button-3> [list popup $nb .popup$n %X %Y]
}

proc wheel {args} {
    lassign $args nb dir
    set cur [$nb raise]
    set index [$nb index $cur]
    if { $dir >= 0 } {
        if { [incr index -1] >= 0 } {
            $nb raise [$nb pages $index]
            $nb see [$nb  raise]
        }
    } else {
        if { [incr index] < [llength [$nb pages]] } {
            $nb raise [$nb pages $index]
            $nb see [$nb  raise]
        }
    }
}
proc created {args} {
#   puts "created args= |$args| " ;# first time (only) it's raised
}
proc raised {pathname args} {
    if [catch {
        foreach page [$pathname pages] {
            if { [$pathname raise] eq $page } {
                $pathname itemconfigure $page -background white
            } else {
                $pathname itemconfigure $page -background grey85
            }
        }
    } err_code] {
        puts $err_code
    }
}


proc popup {pathname win X Y pane} {
#   also raise on right click
    $pathname raise $pane
    tk_popup $win $X $Y
}
proc closetab {pathname args} {
    set pane [$pathname raise] ;# current pane
    set index [$pathname index $pane]
    $pathname delete $pane
    if { [incr index -1]  < 0} {
        set index 0
    }
    if [catch {
        $pathname raise [$pathname pages $index] ;# activate and see first one to left or first one
        $pathname see [$pathname pages $index  ] ;# This will fail if < 0
    } err_code] {
        puts "$err_code $index"
    }
    
}
proc moveit {pathname where args} {
    set pane [$pathname raise] ;# current pane
    $pathname move $pane $where
    $pathname see $pane
    
}

main