# -------------------------------------------------------------------------
# dynnotebook.tcl ---
#   A megawidget based on  BWidget's Notebook
#   Copyright(c) 2009,  Johann Oberdorfer
#                       mail-to: [email protected]
# -------------------------------------------------------------------------
# This source file is distributed under the BSD license.
#
#   NAME
#      dynnotebook - Implements a dynamic notebook widget.
#                    It is derived from BW's Notebook and "knows" all
#                    commands and options from this widget.
#
#   TO-DO:
#   If tile is available, carry over ttk color settings for
#   foreground/background to integrate BW's Notebook widget with ttk.
#
#   SYNOPSIS
#      dynnotebook pathName ?options?
#
#   OPTIONS
#      -dummy              [no=default|0|yes|1]
#      -pagecreatecommand  [""=default] a command to be executed
#                                       when a new notebook page is created
#      -showtoolbar        [no=default|0|yes|1]
#                             shows additional toolbar for tab-manipulation
#                             remember: a right mouse pull-down menu is
#                             available all the time providing
#                             the same functionality
#      -expandtoolbar      [no=default|0|yes|1]
#                             takes precedence only in case -showtoolbar is
#                             set to yes, toggles the visability
#
#   WIDGET COMMANDS
#      pathName cget option
#      pathName configure ?option? ?value option value ...?
#      pathName dummycmd
#      pathName addpage
#      pathName getactivepageindex
#      pathName getcurrentpageframe
#      pathName gettoolbarframe
#
# -------------------------------------------------------------------------
# Change history:
#   July 2009: Johann Oberdorfer, V0.1, first release
# -------------------------------------------------------------------------

package provide dynnotebook 0.1
package require BWidget


# -------------------------------------------------------------------------
# -------------------------------------------------------------------------
namespace eval ::dynnotebook::ttkutil:: {
  variable defaults

  namespace export \
    LoadImages GetTtkOptionValue Wrap

  # where to find image library file (optional) / image files (required):
  set thisDir [file dirname [info script]]

  array set defaults [list \
    pattern "*.gif" \
    imageDir [file join $thisDir "images"] \
    imageLib [file join $thisDir "ImageLib.tcl"] \
    imageArrayName "images" \
  ]
}

# support function to created default images
# take only those images, which are specified by requiredImages argument list

proc ::dynnotebook::ttkutil::LoadImages {requiredImages} {
  variable defaults

  # try to load image library file...
  if { [file exists $defaults(imageLib)] } {

     source $defaults(imageLib)
     return [array get images]
  }

  # load each image from image directory...
  foreach pattern $defaults(pattern) {
    foreach file [glob -directory $defaults(imageDir) $pattern] {
      set img [file tail [file rootname $file]]

      if { ![info exists images($img)] } {
        if {[lsearch $requiredImages [file tail $file]] != -1} {
           set images($img) [image create photo -file $file]
        } else {
           # create a blank image, so that the code won't break
           set images($img) [image create photo]
        }
      }
    }
  }

  return [array get images]
}

proc ::dynnotebook::ttkutil::GetTtkOptionValue { copt }  {

  if { [catch {package require tile}] != 0 } {

    # a fallback solution:
    # retrieve option from the standard tk option database

    foreach opt [. configure] {

      if {[llength $opt] == 5} {
        set option [lindex $opt 1]
        set value  [lindex $opt 4]

        if {$option == $copt} {
          return $value
        }
      }
    }
    return ""
  }

  if {[info commands ::ttk::style] ne ""} {
           set styleCmd ttk::style
  } else { set styleCmd style }

  foreach {option value} [$styleCmd configure .] {
    if {$option == $copt} {
      return $value
    }
  }
  
  return ""
}

proc ::dynnotebook::ttkutil::GetArg {args keystr arg} {
  upvar $arg cvalue
  
  set cvalue ""
  while {[set i [lsearch -exact $args $keystr]] >= 0} {
     set j [expr $i + 1]
     set cvalue [lindex $args $j]
     set args [lreplace $args $i $j]
  }
  return $args
}

# a helper function to distinguish between tk and ttk
proc ::dynnotebook::ttkutil::Wrap {wtype wpath args} {
  variable vars

  if { ![info exists vars(tile_present)] } {
    set vars(tile_status) [catch {package present tile 0.8}]
  }

  if { $vars(tile_status) == 0 } {

    # filter out (ttk-)unsupported (tk-)options:
    set args [GetArg $args "-fg"     tmp]
    set args [GetArg $args "-bg"     tmp]
    set args [GetArg $args "-relief" tmp]
    set args [GetArg $args "-highlightthickness" tmp]
    set args [GetArg $args "-padx"   tmp]
    set args [GetArg $args "-pady"   tmp]
    set args [GetArg $args "-font"   tmp]
    set args [GetArg $args "-bd"     tmp]

    set w [eval ttk::$wtype $wpath $args]

  } else {

      set args [GetArg $args "-style" tmp]
      set w [eval $wtype $wpath $args]
  }

  return $w
}


# -------------------------------------------------------------------------
# -------------------------------------------------------------------------


namespace eval ::dynnotebook:: {
  variable widgetOptions
  variable widgetGlobals
  
  # the public interface
  namespace export dynnotebook

  # list all allowed options with their database and class names
  # note: lower case is requ. here, but
  #         - the option database needs to be upper case:
  #           *DynNotebook.optname and
  #         - the -class definition in turn looks like e.g.:
  #           "DynNotebook"...

  array set widgetOptions {
    -dummy              { dummy              Dummy } \
    -pagecreatecommand  { pagecreatecommand  PagecreateCommand } \
    -showtoolbar        { showtoolbar        ShowToolbar       } \
    -expandtoolbar      { expandtoolbar      ExpandToolbar     } \
  }

  # default options for this widget:
  option add *DynNotebook.dummy              ""  widgetDefault
  option add *DynNotebook.pagecreatecommand  ""  widgetDefault
  option add *DynNotebook.showtoolbar         1  widgetDefault
  option add *DynNotebook.expandtoolbar       0  widgetDefault

  # globals - same for all instances of this widget
  array set widgetGlobals {
    debug 0
    initialized 0
  }

  # "tree-plus.gif"
  # "tree-minus.gif"

  set widgetGlobals(requiredImages) {
        "edit-rename.gif"
        "go-next.gif"
        "go-previous.gif"
        "tab-close.gif"
        "tab-new-background.gif"
        "view-pim-journal.gif"
        "img-leftarrow1.gif"
        "img-downarrow1.gif"
    }
}


# contains initializations needed for the dynnotebook widget - it's
# only necessary to invoke it for the first instance of a widget since
# all stuff defined here are common for all widgets of this type

proc ::dynnotebook::Initialize {}  {
  variable widgetGlobals

  if {$widgetGlobals(debug) != 0}  {
    puts "[namespace current]::Initialize"
  }

  array set widgetGlobals \
       [ttkutil::LoadImages $widgetGlobals(requiredImages)]

  # this allows us to clean up some things when we go away
  bind dynnotebook <Destroy> "[namespace current]::DestroyHandler %W"

  # carry over options from ttk:
  set widgetGlobals(fg) [ttkutil::GetTtkOptionValue -foreground]
  set widgetGlobals(bg) [ttkutil::GetTtkOptionValue -background]

  option add *DynNotebook*foreground $widgetGlobals(fg) userDefault ;# widgetDefault
  option add *DynNotebook*background $widgetGlobals(bg) userDefault ;# widgetDefault
  # -test- option add *DynNotebook*background DarkGrey

  # works:
  # option add *Frame*background $widgetGlobals(bg) userDefault

  set widgetGlobals(initialized) 1
}



# this implements the methods cget and configure,
# as well as all the widget related commands...
# args: list of key value pairs for the widget options.

proc ::dynnotebook::WidgetProc { w command args } {

  variable widgetGlobals
  variable widgetOptions

  upvar [namespace current]::${w}::wlocals wlocals
  upvar [namespace current]::${w}::options options

  if {$widgetGlobals(debug) != 0} {
    puts "[namespace current]::WidgetProc w=$w, command=$command, args=$args"
  }
  
  set result {}
  
  # which command?
  switch -- $command {
    cget {
      if {[llength $args] != 1}  {
        return -code error \
            "wrong # args: should be $w cget option"
      }

      # pass cget request over to one of the orig. widget

      if {[catch {set result $options($args)}]} {
        set result [eval $viewer cget $args]
      }

    }
    configure {
      set result [eval WidgetConfigure $w $args]
    }
    dummy {
      set result {}
    }
    addpage {
      set result [eval AddPageCmd $w $args]
    }
    getactivepageindex {
      set idx 0
      set activePage [$wlocals(notebook) raise]

      foreach p [$wlocals(notebook) pages] {
          if {$p == $activePage} {
             break
          }
          incr idx
      }

      set result $idx
    }
    getcurrentpageframe {
      set result [GetCurrentPageframe $w]
    }
    gettoolbarframe {
      set result $wlocals(wtoolbarframe)
    }
    default {

      # if the command wasn't one of our special one's,
      # just pass control over one of our real widget commands as-is.

      if {[catch "$wlocals(notebook) $command $args" result]} {
        return -code error $result
      }
    }
  }

  return $result
}


# implements the "configure" widget command (method)
# args: list of key value pairs for the widget options.

proc ::dynnotebook::WidgetConfigure { w args }  {
  variable widgetGlobals
  variable widgetOptions

  upvar [namespace current]::${w}::options options
  upvar [namespace current]::${w}::wlocals wlocals
  
  if {$widgetGlobals(debug) != 0}  {
    puts "[namespace current]::WidgetConfigure w=$w, args=$args"
  }
  
  # error checking - doesn' make sense here as we delegate
  #                  options to original widget
  # foreach {name value} $args  {
  #   if {![info exists widgetOptions($name)]}  {
  #     return -code error \
  #         "unknown option for the [namespace current]: $name"
  #   }
  # }

  if {[llength $args] == 0}  {
    
    # return all options
    foreach opt [lsort [array names widgetOptions]] {
      set optName  [lindex $widgetOptions($opt) 0]
      set optClass [lindex $widgetOptions($opt) 1]
      set def [option get $w $optName $optClass]
      lappend results [list $opt $optName $optClass $def $options($opt)]
    }
    return $results

  } elseif {[llength $args] == 1}  {
    
    # return configuration value for this option
    set opt $args
    set optName  [lindex $widgetOptions($opt) 0]
    set optClass [lindex $widgetOptions($opt) 1]
    set def [option get $w $optName $optClass]
    return [list $opt $optName $optClass $def $options($opt)]
  }
  
  # error checking
  if {[expr {[llength $args]%2}] == 1}  {
    return -code error "value for \"[lindex $args end]\" missing"
  }
  
  # process the new configuration options...
  array set opts $args
  # parray opts

  foreach opt [array names opts] {
    set newValue $opts($opt)

    if {[info exists options($opt)]}  {
             set oldValue $options($opt)
    } else { set oldValue {} }

    set options($opt) $newValue
    
    if {$widgetGlobals(debug) != 0}  {
      puts "[namespace current]::WidgetConfigure opt=$opt, n=$newValue, o=$oldValue"
    }

    # nothing to do ?
    # if { ![winfo exists $wlocals(simpleFileView)] } { return {} }
    # if {$newValue == $oldValue} { return {} }
    # puts "--> $oldValue : $newValue"

    # some options need action from the widgets side
    switch -- $opt {
      -dummy {}
      -pagecreatecommand {}
      -showtoolbar {}
      -expandtoolbar {
         if { [regexp -nocase {(true|yes|1)} $options(-expandtoolbar)] } {

               $wlocals(pageman) configure -height $wlocals(pmheight_big) \
                                           -width  $wlocals(pmwidth_big)
               $wlocals(pageman) raise "full_option_view"
         } else {
               $wlocals(pageman) configure -height $wlocals(pmheight) \
                                           -width  $wlocals(pmwidth)
               $wlocals(pageman) raise "minimized_option_view"
         }
      }
      default {

        # if the configure option wasn't one of our special one's,
        # pass control over to the original widget!
        
        if {[catch {$wlocals(notebook) configure $opt $newValue} result]} {
          return -code error $result
        }
      }
    }
  }

  return {}
}


proc ::dynnotebook::DestroyHandler {w} {
  # remove the namespace with the widget
  namespace delete [namespace current]::${w}
}


# parses options, creates widget command, and calls the "Configure"
# procedure to do the rest, result is the widget path or an error

proc ::dynnotebook::BuildWidget { w args }  {
  variable widgetGlobals
  variable widgetOptions
  
  if {$widgetGlobals(debug) != 0}  {
    puts "[namespace current]::BuildWidget w=$w, args=$args"
  }
  
  # instance specific namespace
  namespace eval ::dynnotebook::${w} {
    variable options
    variable wlocals
  }
  
  # set simpler variable names:
  upvar [namespace current]::${w}::options options
  upvar [namespace current]::${w}::wlocals wlocals

  set wlocals(pageIndex) 0

  # we use a frame for this specific widget class
  set wlocals(this)  [ttkutil::Wrap frame $w -class DynNotebook]
  set wlocals(frame) [namespace current]::${w}::${w}

  # parse options, first get widget defaults
  foreach name [array names widgetOptions] {
    set optName  [lindex $widgetOptions($name) 0]
    set optClass [lindex $widgetOptions($name) 1]
    set options($name) [option get $w $optName $optClass]
  }
  
  # apply the options supplied in the widget command,
  # overwrite defaults when option set in command!

  if {[llength $args] > 0}  {
     array set options $args
  }

  # pack everything together into a container frame:
  set fmain [ttkutil::Wrap frame $w.f]
    pack $fmain -side top -fill both -expand true

    set ftoolbar_main [ttkutil::Wrap frame $fmain.f]
      pack $ftoolbar_main -side top -fill x

      set ftoolbar_left [ttkutil::Wrap frame $ftoolbar_main.ftoolbar_left]
        pack $ftoolbar_left -side left

      set ftoolbar_right [ttkutil::Wrap frame $ftoolbar_main.ftoolbar_right]
        pack $ftoolbar_right -side right -fill both

        # additional container where one might want to
        # place an additional user defined toolbar:
        # (pack'ing is done in the client code)
        set ftoolbar [ttkutil::Wrap frame $ftoolbar_right.ftoolbar]
          set wlocals(wtoolbarframe) $ftoolbar

      set pageman [PagesManager $ftoolbar_main.pageman]
        pack $pageman -side left
        set wlocals(pageman) $pageman

        set f_container [$pageman add "full_option_view"]
          pack $f_container -side top -fill both 

          set fopt_min [$pageman add "minimized_option_view"]
            # pack $fopt_min -side left -fill y -padx 5

            if { [regexp -nocase {(true|yes|1)} $options(-showtoolbar)] } {

               Button $fopt_min.img \
                  -image $widgetGlobals(img-leftarrow1) \
                  -helptext "Show Toolbar" \
                  -command "[namespace current]::Minimize_optionPage $w" \
                  -relief flat
                 pack $fopt_min.img -side left
            }

        $pageman compute_size
        set wlocals(pmheight) [$pageman cget -height]
        set wlocals(pmwidth)  [$pageman cget -width]


    set fbttn [ttkutil::Wrap frame $f_container.fbttn]
      pack $fbttn -side top -fill x

      CreateLocalToolBar $w $fbttn

    set f [ttkutil::Wrap frame $fmain.notebook]
      pack $f -side top -fill both -expand true

      # ---------------------------------------
      set wlocals(notebook) [NoteBook $f.nbook]
      # ---------------------------------------
        pack $f.nbook -side top -fill both -expand true

        # additional binding:
        $f.nbook bindtabs <ButtonPress-3> \
              "[namespace current]::TabPopup $w"
     
        # potential problem, in case there are more than one
        # megawidget at the same time (!) ...

        bind all <Control-KeyPress-n> \
              "[namespace current]::AddPageCmd $w"

        bind all <Control-KeyPress-x> \
              "[namespace current]::DeletePageCmd $w"

       # pathName bindtabs  event  script 
       # add our own additional raise command:
      $wlocals(notebook) bindtabs <ButtonRelease> \
         "[namespace current]::MainteinToolBarState $w"
 
  # necessary to remove the original frame procedure
  # from the global namespace into our own:
  rename ::$w $wlocals(frame)
  

  # create the actual widget procedure...
  proc ::${w} { command args }   \
      "eval [namespace current]::WidgetProc {$w} \$command \$args"
  
  # the actual widget creation takes place within 'WidgetConfigure'
  eval WidgetConfigure $wlocals(this) [array get options]

  return $w
}


# the constructor of this class; it creates an instance named 'w',
# returns the widget path or an error

proc ::dynnotebook::dynnotebook { w {args {}} }  {
  variable widgetGlobals
  variable widgetOptions
  
  if {$widgetGlobals(debug) != 0}  {
     puts "[namespace current] w=$w, args=$args"
  }
  
  # we need to initialize the widget at least once
  if { !$widgetGlobals(initialized) }  {
     Initialize
  }

  # error checking...
  # foreach {name value} $args  {
  #  if {![info exists widgetOptions($name)]}  {
  #    return -code error \
  #        "unknown option for the [namespace current]: $name"
  #  }
  # }
  
  # continues in the 'Build' procedure...
  return [eval BuildWidget $w $args]
}


#--------------------------------------------------------------------------
# megawidget implementation starts here:
#--------------------------------------------------------------------------

proc ::dynnotebook::Minimize_optionPage {w {mode ""}} {

  upvar [namespace current]::${w}::options options
  upvar [namespace current]::${w}::wlocals wlocals

  # toggle value!
  if {$mode == ""} {
      if { [regexp -nocase {(true|yes|1)} $options(-expandtoolbar)] } {
              set options(-expandtoolbar) 0
      } else {set options(-expandtoolbar) 1}
  } else {
      # overcome problem when dialog is initialized
      # and app(pm_expanded) == 0
      $wlocals(pageman) configure -height $wlocals(pmheight_big) \
                                  -width  $wlocals(pmwidth_big)
      $wlocals(pageman) raise "full_option_view"
  }

  if { [regexp -nocase {(true|yes|1)} $options(-expandtoolbar)] } {

        $wlocals(pageman) configure -height $wlocals(pmheight_big) \
                                    -width  $wlocals(pmwidth_big)
        $wlocals(pageman) raise "full_option_view"
  } else {
        $wlocals(pageman) configure -height $wlocals(pmheight) \
                                    -width  $wlocals(pmwidth)
        $wlocals(pageman) raise "minimized_option_view"
  }
}


proc ::dynnotebook::MainteinToolBarState {w args} {

  upvar [namespace current]::${w}::wlocals wlocals

  # some page metrics...
  set cur_page [$wlocals(notebook) raise]
  set end_idx  [llength [$wlocals(notebook) pages]]
  set cur_idx  [$wlocals(notebook) index $cur_page]

  if { $cur_idx > 0 && $end_idx > 1 } {
           set state normal
  } else { set state disabled }
  $wlocals(bttn:closeTab) configure -state $state

  if { $cur_idx > 1} {
           set state normal
  } else { set state disabled }
  $wlocals(bttn:moveLeft) configure -state $state
  $wlocals(bttn:Rename) configure -state $state

  if { $cur_idx < [expr $end_idx -1] } {
           set state normal
  } else { set state disabled }
  $wlocals(bttn:moveRight) configure -state $state

  if { $cur_idx == 0 } {
    $wlocals(bttn:Rename) configure -state disabled
    $wlocals(bttn:moveLeft) configure -state disabled
    $wlocals(bttn:moveRight) configure -state disabled
  }
}


proc ::dynnotebook::CreateLocalToolBar {w wparent} {
  variable widgetGlobals

  upvar [namespace current]::${w}::wlocals wlocals

  Button $wparent.img \
      -image $widgetGlobals(img-downarrow1) \
      -helptext "Hide Toolbar" \
      -command "[namespace current]::Minimize_optionPage $w" \
      -relief flat
    pack $wparent.img -side left -anchor ne

  set bbox [ButtonBox $wparent.bbox -spacing 5]
    pack $bbox -side left -anchor e -padx 20

    set wlocals(bttn:addTab) \
      [$bbox add \
        -helptext "Create a new Tab" \
        -image $widgetGlobals(tab-new-background) \
        -command "[namespace current]::AddPageCmd $w" \
        -relief flat]

    set wlocals(bttn:closeTab) \
      [$bbox add \
        -helptext "Close Tab currently active" \
        -image $widgetGlobals(tab-close) \
        -command "[namespace current]::DeletePageCmd $w" \
        -relief flat]

    set wlocals(bttn:Rename) \
      [$bbox add \
        -helptext "Rename Tab" \
        -image $widgetGlobals(edit-rename) \
        -command "[namespace current]::RenameCmd $w" \
        -relief flat]

    set wlocals(bttn:moveLeft) \
      [$bbox add \
        -helptext "Move Left" \
        -image $widgetGlobals(go-previous) \
        -command "[namespace current]::MovePageCmd $w left" \
        -relief flat]

    set wlocals(bttn:moveRight) \
      [$bbox add \
        -helptext "Move Right" \
        -image $widgetGlobals(go-next) \
        -command "[namespace current]::MovePageCmd $w right" \
        -relief flat]

  $wlocals(pageman) compute_size
  set wlocals(pmheight_big) [$wlocals(pageman) cget -height]
  set wlocals(pmwidth_big)  [$wlocals(pageman) cget -width]

  Minimize_optionPage $w "initialize"
}


proc ::dynnotebook::AddPageCmd {w args} {
  variable widgetGlobals
  upvar [namespace current]::${w}::options options
  upvar [namespace current]::${w}::wlocals wlocals

  # if { $wlocals(pageIndex) == 0 } {
  #    $wlocals(notebook) itemconfigure [$wlocals(notebook) pages 0] \
  #      -image $widgetGlobals(view-pim-journal)
  # }

  # the widget's unique identifier:
  set new_page $wlocals(pageIndex)

  # calculate text, based on available tab's:
  set tabText [expr {[llength [$wlocals(notebook) pages 0 end]] +1}]

  $wlocals(notebook) insert end $new_page \
     -text " $tabText" \
     -image $widgetGlobals(view-pim-journal)

  if { [llength $args] } {
    eval $wlocals(notebook) itemconfigure $new_page $args
  }

  set f [$wlocals(notebook) getframe $new_page]
  $wlocals(notebook) raise $new_page
  $wlocals(notebook) see $new_page

  incr wlocals(pageIndex)

  if {[info exists options(-pagecreatecommand)] &&
      [string length $options(-pagecreatecommand)] } {

    # evaluate command in parent namespace:
    uplevel $options(-pagecreatecommand) $f $new_page
  }

  MainteinToolBarState $w
  return $f
}


proc ::dynnotebook::MovePageCmd {w direction} {
  variable widgetGlobals
  upvar [namespace current]::${w}::options options
  upvar [namespace current]::${w}::wlocals wlocals

  # some page metrics...
  set cur_page [$wlocals(notebook) raise]
  set end_idx  [llength [$wlocals(notebook) pages]]
  set cur_idx  [$wlocals(notebook) index $cur_page]


  switch -- $direction {
    "left" {
        # move left
        if { $cur_idx > 1} {
          set new_idx $cur_idx
          incr new_idx -1
          $wlocals(notebook) move $cur_page $new_idx
        }
     }
     "right" {
        # move to the right

        if { $cur_idx < [expr $end_idx -1] } {
          set new_idx $cur_idx
          incr new_idx 1
          $wlocals(notebook) move $cur_page $new_idx
        }
     }
  }

  $wlocals(notebook) see $cur_page

  MainteinToolBarState $w
}


# -unused-
proc ::dynnotebook::GetAllPages {w} {
  upvar [namespace current]::${w}::wlocals wlocals

  set rlst [list]
  foreach page [$wlocals(notebook) pages] {
    lappend rlst [$wlocals(notebook) itemcget $page -text]
  }
  return $rlst
}


proc ::dynnotebook::GetCurrentPageframe {w} {
  upvar [namespace current]::${w}::wlocals wlocals

  set currentPage [$wlocals(notebook) raise]
  return [$wlocals(notebook) getframe $currentPage]
}


proc ::dynnotebook::DeletePageCmd {w args} {
  upvar [namespace current]::${w}::wlocals wlocals

  set allPages [$wlocals(notebook) pages]
  
  # deletion of the 1st page is not allowed!
  if { [llength $allPages] == 1 } {
     return
  }
  
  # currenlty active page is:
  set cpage [$wlocals(notebook) raise]

  # retrieve the parent page:
  set parent_page ""
  foreach page $allPages {
    if {$page == $cpage} {
        break
    } else {
        set parent_page $page
    }
  }

  $wlocals(notebook) delete $cpage

  if {$parent_page != ""} {
      $wlocals(notebook) raise  $parent_page
  } else {
      # raise the 1st page
      $wlocals(notebook) raise [lindex [$wlocals(notebook) pages] 0]
  }

  MainteinToolBarState $w
}


proc ::dynnotebook::RenameOK_Cmd {w t} {
  upvar [namespace current]::${w}::wlocals wlocals

  set cpage [$wlocals(notebook) raise]
  $wlocals(notebook) itemconfigure $cpage -text $wlocals(pageName)
  destroy $t
}


proc ::dynnotebook::RenameCmd {w} {
  upvar [namespace current]::${w}::wlocals wlocals

  set x [winfo pointerx .]
  set y [winfo pointery .]

  catch {destroy .rename_entry_dlg}
  set t [toplevel .rename_entry_dlg]

  wm title $t "Rename: "
  wm geometry $t +$x+$y
  wm protocol $t WM_DELETE_WINDOW "destroy $t"
  wm transient $t $w

  bind $t <Escape> "destroy $t"
  bind $t <Return> "[namespace current]::RenameOK_Cmd $w $t"

  set wlocals(pageName) [$wlocals(notebook) itemcget [$wlocals(notebook) raise] -text]

  set f [ttkutil::Wrap frame $t.f -bd 10]
    pack $f -fill both -expand true
  
  ttkutil::Wrap entry $f.entry \
        -textvariable "[namespace current]::${w}::wlocals(pageName)"

  ttkutil::Wrap button $f.ok \
         -text OK -width 10 \
         -command "[namespace current]::RenameOK_Cmd $w $t"

  ttkutil::Wrap button $f.cancel \
         -text Cancel -width 10 \
         -command "destroy $t"

  pack $f.entry -side left -padx 5 -pady 5
  pack $f.ok -side left -padx 5 -pady 5
  pack $f.cancel -side left -padx 5 -pady 5
}


proc ::dynnotebook::TabPopup {w args} {
  variable widgetGlobals
  upvar [namespace current]::${w}::wlocals wlocals

  if {[winfo exists .popup_menu]} {
     destroy .popup_menu
  }

  set m [menu .popup_menu -tearoff 0]
  $m add command \
           -label " New Tab   <CTRL-N>" \
           -command "[namespace current]::AddPageCmd $w" \
           -image $widgetGlobals(tab-new-background) -compound left \
           -font TkFixedFont

  # some page metrics...
  set cur_page [$wlocals(notebook) raise]
  set end_idx  [llength [$wlocals(notebook) pages]]
  set cur_idx  [$wlocals(notebook) index $cur_page]

  if { $cur_idx > 0 && $end_idx > 1} {
    set idx $cur_idx
    incr idx -1
    set rpage [$wlocals(notebook) pages $idx]

    $m add command \
         -label " Close Tab <CTRL-X>" \
         -command "[namespace current]::DeletePageCmd $w" \
         -image $widgetGlobals(tab-close) -compound left \
         -font TkFixedFont
  }

  if { $cur_idx > 1} {
    set new_idx $cur_idx
    incr new_idx -1
    $m add command \
         -label " Move Left" \
         -command "[namespace current]::MovePageCmd $w left" \
         -image $widgetGlobals(go-previous) -compound left \
         -font TkFixedFont
  }

  if { $cur_idx > 0 && $cur_idx < [expr $end_idx -1] } {
    set new_idx $cur_idx
    incr new_idx 1
    $m add command \
         -label " Move Right" \
         -command "[namespace current]::MovePageCmd $w right" \
         -image $widgetGlobals(go-next) -compound left \
         -font TkFixedFont
  }

  if { $cur_idx > 0 } {
    $m add separator
    $m add command \
       -label " Rename" \
       -command "[namespace current]::RenameCmd $w" \
       -image $widgetGlobals(edit-rename) -compound left \
       -font TkFixedFont
  }

  set x [winfo pointerx .]
  set y [winfo pointery .]
  
  tk_popup $m $x $y
}

# ImageLib.tcl ---
# Automatically created by: CreateImageLib.tcl

set images(edit-rename) [image create photo -data {
R0lGODlhFgAWAPMKAIiJhoiIiIqMiamqqKytq8PDw8rKyc/Qzt3d3fb29v//
/wAAAAAAAAAAAAAAAAAAACH5BAEAAAsALAAAAAAWABYAAARVcMlJq7046827
t0EojiS5BAWirmy7FiGSKHRt30qCxAoBCAOccBdA0AwH4ZCnQCpxRGMz+bRF
j9Qq7TrV1q4+oFcRnY1pulDKxWbBTqV46UOv2++UCAA7
}]
set images(go-next) [image create photo -data {
R0lGODlhFgAWAOcAAPr8/rHP7rXN6d/s97PP66C83PX8/vL6/cve8Zy/5Zqy
z/H5/e/4/N7s96bG6ZKnwuz2++r1++Xx+bjU76DF7NHd66C72ZOw05GszI+m
w42hu4yftejz+uby+cvf85210+fw9+Pv9+Tw+OTw+ePw+eHu+eHu+ODt997s
9tTl9KrL7dro89no9dvq9uDu+d/t+Nbm89bl8qzK6p/E65OsydLi8NXl89vr
997t+dzq9r3S6anC35+415y6253B6JStx7bM5cPX7svf8tHj9dPl9tTm98/i
9cvf9MHY8L7V7rjP6rHJ5aW+26/H5LvS7MPc8cvg9c7j9tHk99Dk987i9sbc
87HJ5Ji43a/F17jR6czj9tLn+Nfp+tjq+tXo+dLl98nf9MPa8cHZ77LL5Zaz
1au90YqfuYmbs4iYrYeUppOksdrr+tXn+czh9afB3JOot97u/Nzs+9To+cXd
8JeuypOsveHw/Nju+7TM4ZSyw+Hz/dPs+Z2yx4iZsLTX463I2oucspeww///
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
/////////////////////yH5BAEAAP8ALAAAAAAWABYAAAj3AP8JHEiwoMGD
CBMeBBBAoUIBAwg4RFjAwAEECSYWVLCAAYMGDjQOfAAhgkkJEyggrGDhAoYM
GjZw4NChgwQJHlQa/AAihAgJI4KOIFHCxAkUKVQYxLCCRYsGLlyUKOHiRYMW
LGDEkDGDII0aNljcuIGj7NgcKRDo2MGjh4+BP4AEETKESBEiRIwcQZJEyZId
THpkFPijiZMnUKJIkTKFCpQqSJwIsNLjCkEsWZ5o2cKli5ctX6iACSNmDBmD
ZcyYOYMmjZo1XNh8aQPGDQaNb+DE4SJnDh2R/+rYgXMHjxng//Lo2cOnD/J/
fv4Aei4wEBrq2LEHBAA7
}]
set images(go-previous) [image create photo -data {
R0lGODlhFgAWAOcAAL/X8ezz+q/M6+Dr98TX7ZzA58fa8PT5/fb6/paz1aTG
6tzo9vP4/ZOsy6DF7LXR7+fw+e/1/I6kwcfb8ujw+evy+uzz+4ycs4yguY6p
ypOv0aC62dHd66fI7NPi8+Ts9+Xu+Obv+Ojw+ury+uPs9uDq9Z2105/E69Xh
8Nvm897o9eDq9uLs9+Pt+OTu+eTv+eDs+Nnk8p3B6bXM58za69He7tXi8djk
89vn9d/r+ODs+eHt+d3q99Tj9K3F4Yymxpu+5K7F4rjL4sHS6MfZ7c7e8NLi
89Xk9dfn99jo99bn99Pl983h9cfd88HZ8LjQ6q/H5Iykwpi43pq32qfA3rHJ
5b/W78Xb8snf9M/j9s/j99Hk983h9sbc877V7rPL54qgvqjC4LrS7MHY8NTm
+NXo+cvg9cHX8JOowZGszKK72dfp+trq+oSOnIWRooaUqYiasYibtpisw5er
wpaty7/U7Nvr+93t+4SRobHF3eHv/IWTpZyuxdXl9uPx/YWUqL/Z6JqvwZSo
u4yhtv//////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
/////////////////////yH5BAEAAP8ALAAAAAAWABYAAAj1AP8JHEiwoMGD
CBMqFAggwEKEAgYQeFiwgIEDCBJQHKhgAYOPDTY6eAAhgskIEig6mEChQgUL
MC9gkJBBwwYOBjt4+AAiBAQRIkZAgBACBIkSJgieEIAihYoVLFq4eEHVxQcY
KmJkGChjBo0aNm7gWJBDx46zOnj0IODjx0AgQYQMIVLEyBEkSZIoWcKkiZMn
UKIQlDKFSpUnVq5gyaJFy5YsXLp4+QLGYIIwYsY04bKFTJkyZLSYOfMFzcE0
asZg0UJmDZs2bt7AiSNnTkI6dbSssXMHz0aBGPLs1rPnt0A4fPr4+WN84AVA
gZoPFDRIuvWNAQEAOw==
}]
set images(tab-close) [image create photo -data {
R0lGODlhFgAWAPYAAEUFBlgbGHUGBWAiH1wuI3AkIXUlI4MCAocTE6QPCLgA
ALkDAr0QDIYoIKAvJak1Lq48LrQ8Jbc+JbA5Kqo1MqE7NaI8OcsAAMgWD9AW
DtIdEuAAAPIAAOEYE+IeFs8wJ8Q0LMo+Ptc3M+EyLu42MrRBN8RGPsxMOuxC
O5ZSVa9OQrJHQLRMRL5LRLlMRL1QSL9cSspLS8xJSc5KSsdVTMpVStJZSs9a
VtNcVuVNSOhbVs5gUNdhUddmWt1oWt5kZNFrY953bcl2d893d+BwbOBwbueG
fsB9gLyDhcCChdKBgPOGhPSIhsGiptGipNSrrNa0tN6ys9/f3+fNzeza2+Dg
4OLi4uPj4+Tk5Obm5unl5u/n6Ojo6Orq6uvr6+zs7O7u7u/v7/Dk5fLl5fPu
7/Tv8PDw8Pbx8ff09fry8vj39/r4+Pr6+vv7+/z6+vz8/P39/f7+/v///wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAHMA
LAAAAAAWABYAAAfsgHOCg4SFhoeIiYqLi2Zyj5CPYIxyUpaXlnKUUm2dnlKa
i5Wen6GRp49VpJ1VplWvsLFXb7RyrKZYj22Ru7a0nrmCZ01ktm5tW2dubrS1
u8FzQjRHZG1qT0BDnc1vnXLBBzxMNUhbTjJMRUZt3b+2XZoJPj9FKiklQT9K
K7vOj/CCXtiYgYMGjho+XIjRZashmFBpWJwIESPGjhJUdmls2OahIDlQIjBQ
oKAEEi1kwKhcuTLUFAgaLmC4kGHCEzeoIgly4GHDBwIgNnR4AGBRAxQcRgyY
E0AEBxIWGFXIUWCQAR0UGAkSUAiB1kAAOw==
}]
set images(tab-new-background) [image create photo -data {
R0lGODlhFgAWAPZtAACIAACJAAOKAACOAAWOAACUAACXAAqVAACYAACZAACa
AACbAAKZAgKdAgWdAAaeAB+fABecFjGNACaeADKOFT2SFQClAACnAAKlAgaj
BgWmBQCrAAKrAACtAACuAAasAAWoBQatBgCwAAKwAACyAACzAAC4AAC5AAC8
ABi0ABi4AB6lHh2oHR26HS+mADenACe8ACyiFjKkHjq6OkSTAESnAEyvAEep
Hg3FDRbEFifFJybGJi/LL0zJAEO6Q1O1QVy4QUPDQ1bPVlrQVmDXWXLcWWrC
aXDEaYPXg4Pdg4Tdg43djZrWmprXmprcmo3hjcrKytfX19/f39/h39zt3ODg
4OHh4eLi4uPj4+Xl5efn5+np6evr6+zs7O3t7e7u7u/v7+3w7fDw8PHx8fLy
8vPz8/T09PX19fb29vv7+/z8/P39/f7+/v///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAG4A
LAAAAAAWABYAAAf3gG6Cg4SEDSssDIWLhQpBTkxNTj4EjIsGM0pGampHSDMG
loQZQ0Q/nEBFQyGCUGmcamlRggYaETIUnDc3MSANbmpWUsNWaoIKAbCwaWsB
CsBWX19ixYIWycqwBBvQ019Sxm4aIwcuEpw0NRMb3MFi78WcSyUjMC+cNj0q
I4JqWO9isGCxksVKCw8fXHB6kcKDiX5ZAEosQ2WHCQ8NMowogWKQGi1iyogs
YyakmDBIeODIoeMJITXTRso0I1MMl3D9vpjZybNnzy84gU0zgwbNzqJEfwZV
I4Zo0adJjRoVs/TdNDFXvWUF+jKbV6+iwoodS7asWUaBAAA7
}]
set images(view-pim-journal) [image create photo -data {
R0lGODlhEAAQAPcAAJeTk5aTlpuWlpyXl5mWmpqWmpqXm5uXm6OdnaOenqGe
oqKfopGis56tu5mrvp6vwKq2xK66xaG0yaK1yaS3y6a6z6m6zKm7zqa60Ku+
0q+/0Kq/1aq/1qu/1q3D2K3C2a7D27PD0rPF1bPG2rfH2bbJ27/N2rnL3bzM
3bfN5bnL4rnO4bzR5rrQ6LvR6b3T7LzT7bzT7r7V77/W8MHJ0cfR2sfS3czW
38DQ4MHQ4MbT4MLV5snZ5svZ58HW7sHX78fZ6sHY7sPZ7sTY78na68zc683c
69Tb4sDX8MLX8MHY8cHZ8cLY8MPY8MLZ8cPa8cLa8sPa8sTZ8MTZ8cXa8cXb
8sXc8sfc8sfd8sfc88fd88ne8sje88re88je9Mne9Mrf9Nrh597j5tni6tzj
6Mvg9Mzg9M3h9c7h9M/i9dDh8NLk9tbm99fn99vp99zp9dno+N3r+Nzq+dzr
+d/s+OXp7uXq8OHu+eLu+eLu+uTv+vDv8Ofy++z0/O31/PDy9vb19vf19/L2
+vT4/fj6/vr8/gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAACH5BAEAAIYALAAAAAAQABAAAAjDAA0JHEiwIME/
hAb54ZMnDps1Z7oMTABoQaE6R2q8gRMnD5szAwUAKiBIjJ0wNGyYQNHlS0Ey
fsbciBMBQoMTWLQMHDBSTx4bOooQ0bACC5aBAPYEiCOHhxqIXbBEyVKQR5Ec
OUKIOCPkR5SjAnkaALKDxJkGGRg4kPAjZKACX7BcGJGBAgUMFVQULCGlL5QZ
GzykeCFlJyADUaIgQfKhhYwNMqJMDLRAMZIoLT58gAGjLcEWfUNLaRLlh2eD
qFOrFhgQADs=
}]
set images(tree-minus) [image create photo -data {
R0lGODlhDAAMAIQEAJnMzJmZmWaZzGaZmf///5mZzP/M/8z/////zMzM/wAA
AMz/zMzMzP/MzMzMmcyZzGZmzP//////////////////////////////////
/////////////////////////ywAAAAADAAMAAAFKCAjjGQpEmiqjmpLsG4K
x69AKHiOi7au84ygcDgaGoFHYTEZFPBKphAAOw==
}]
set images(tree-plus) [image create photo -data {
R0lGODlhDAAMAMICAMDAwGaZzP///wAAAMzMzP//zMzMmf///ywAAAAADAAM
AAADKAix3CowyiXHmKHeSKOFBEFZJClmZXlGhVWEJ0xY8iLTsC3vgdL8gAQA
Ow==
}]
set images(img-downarrow1) [image create photo -data {
R0lGODlhDQAkAKUAAMbW797e79bO98bO987O59bW/97W3qWczt7W/+fn7/f3
/+/v9/f37+/v797n3q2l1v///6WcvTE5Ujk5czExWjkxcykpazExY62l3tbO
/87W/yEpSr29xrW9tb3Gvb29tTk5Qjk5WrW9xr3GzqWl1sbGxq2lxsbG1jE5
a+fn58bW5+//1jExQikpMTExMc7O3v//////////////////////////////
/////////////////////////////////yH5BAEKAD8ALAAAAAANACQAAAb+
QEBAMAAMBgRBgWA4IBKKBWOxaDQWCsdDwLg6Gt0GJAGJCBKSCaViuVgslQUm
o6BoCprMAK+RCxYbCBwdHh8dIAQKB38hAyIjHR0jEn8kfRQZg4YiF3QPGQsS
BR0lhJMCDSYZDRsZJyOwJhcFCwegdhIUFBIoFxoKGBopIRkqBQMIek8kCCtQ
VFFQCQsPA1ZSVgwpYSSrXldW4MFVLAwKLV0uVQ8FYFVg2hBVGAUJDPbhYQyf
YCANCSC6gJDSTYq9MA22NXigwYoCcGCiLATFAB0DF13QLWw3pQsDj1LYufMI
ch9FixgbaGToEKK5dRQPhlPIj4E/gAIJ1ruHUJ87yCnZ4s3r06DcuXTrnnzs
sgLePxMAPibI50CbAhMIoEVR8BDL1RddsFShgiWBCAwPIjww8aAtW7YHggAA
Ow==
}]
set images(img-leftarrow1) [image create photo -data {
R0lGODlhJAANAKUAAKWczq2l1qWcva2l3qWl1q2lxrW9xt7W3t7n3v///+/v
9/f3/+/v7+fn7/f3787O5zkxc87W/9bO99bO/9bW/97W/+fn5ykpazk5QjE5
UjExY8bO9zExMSkpMbW9tb3GzjE5a729tb3GvTExWu//1sbGxsbW7729xsbG
1sbW5zk5czExQiEpSjk5Wt7e787O3v//////////////////////////////
/////////////////////////////////yH5BAEKAD8ALAAAAAAkAA0AAAb+
QEBAMBgACIECYIAkDAJPZGBKDSCfhawBcEAkFIpFmBFuKBhohsORXrfZjMZi
0Qg86JDIQzKRUCIVDWRgZA4KhoeJgwwWcwUUCgkXERgZGpYaGwtsHAkMGI0d
ax0LFhgMCRxrYAESaBcUHh8GHwUgEw0WaBZwcGi9ug4IZAUPaJkhHh4iHxkV
h2psvWu90WpiARuHFxMiHskfI5pkop9oqg4caKcOHSQMCwzZZ3myHiXhkGjx
cYa9h4LgoWFlQtgICicMnPCAIkOKQwikqYnmRqIbR9oUqAC0YQKFCREmiFGw
QkEDDHI6gCF10swKB3IUtIqXYQSLFiMysBjRIiA1RWnUfkY7I8BFA5gjCSmw
8I5MHKdnoD416S+AiQoS+GQNOQFkhY4RKHwE6fEjV7GArr4YEAQAOw==
}]

#!/usr/bin/ksh
# the next line restarts using wish \
exec wish "$0" "$@"

# dynnotebook_test.tcl ---
# -------------------------------------------------------------------------
# Dynamic NoteBook based on BWidget
# -------------------------------------------------------------------------
# Revision history:
#   original code found somewhere in the tcl.tk.wiki - please add original
#   reference here !                                              
#
# Sep.'05: J.Oberdorfer, initial release
# -------------------------------------------------------------------------

# -------------------------------------------------------------------------
# - gui test -
# -------------------------------------------------------------------------
if 1 {

  # specify, where to find BWidget library (if required):
  lappend auto_path [file join [file dirname [info script]] ".."]

  package require BWidget
  package require dynnotebook


  font configure TkDefaultFont -size 12
  font configure TkTextFont -size 12


  proc PageCommand {args} {

    puts ">>>>>>>> $args <<<<<<<<<<"
    set curr_frame [lindex $args 0]
    set curr_page  [lindex $args 1]
    pack [button $curr_frame.b -text "test"]
  }

  wm withdraw .             ;# hide default wish window
    set w [toplevel .t]
    set top $w
    wm title $w "-Developement-"
    wm geometry $w "500x400+350+500"
    wm minsize $w 1 1

    wm protocol $w WM_DELETE_WINDOW {exit}
    bind $w <Escape> {exit}

  # use bwidget objects
  set mainframe [MainFrame $w.mainframe \
                            -textvariable ::app(status)]
    pack $mainframe -fill both -expand true

    $mainframe addindicator -text "User:"
    $mainframe addindicator -text "$::tcl_platform(user)"
    
    set f [frame [$mainframe getframe].f]
      pack $f -side top -fill both -expand true


      dynnotebook::dynnotebook $f.nb \
                      -pagecreatecommand "PageCommand" \
                      -font TkDefaultFont

        pack $f.nb -fill both -expand true

      # initialization using widget's initialization function,
      # addpage creates and activates a new notebook page:

      set nb1 [$f.nb addpage \
                -text "Main-Page" \
                -raisecmd {puts "Main-Page raised"}]

      # standard initialization (works as well)
      # set nb1 [$f.nb insert end test_page -text "TEST"]

      set f1 [frame $nb1.f1]
        pack $f1 -fill both -expand true

        pack [text $f1.txt -font TkTextFont] -fill both -expand true

        $f1.txt insert end "Hello World"

   $f.nb raise [$f.nb pages 0]
}