#---------------
 # ToolBar.tcl
 #---------------
 # William J Giddings, 2006
 #---------------
 # Provide a ToolBar megawidget using the BWidget package.
 #
 # This is a hack of the code found at https://wiki.tcl-lang.org/1916.
 #---------------
 # Notes:
 # -----
 # BWidget has the ButtonBox widget but, this only adds buttons.
 # This method allows ** any ** other sort of widget to be added,
 # typically a ComboBox or spinbox.
 # To detach a toolbar, Button-1 click on the blue rule and a floating palette will appear.
 # Closing the palette will result in the toolbar re-appearing.
 #----------------

 package require BWidget

 #---------------
 # define the widget
 #---------------
 namespace eval ToolBar {
    Widget::define ToolBar ToolBar
    # include other widgets
    Widget::tkinclude ToolBar frame .f
    Widget::declare ToolBar { }
 }

 #---------------
 # create the thing..
 #---------------
 proc ToolBar::create { path args } {

  # define maps
  array set maps [list ToolBar {} :cmd {} .f {}]
  array set maps [Widget::parseArgs ToolBar $args]

  # map the various args
  Widget::initFromODB ToolBar "$path" $maps(ToolBar)

  # add the container
  set frame [eval frame $path [Widget::subcget $path :cmd] \
   -class ToolBar -relief groove -bd 1 -highlightthickness 0]

  # include other widgets here..
  set fr [eval frame $frame.f $maps(.f)]
  pack $fr -fill both -expand true

  # create the palette
  set p .pal_[string trimleft $path .]
  toplevel $p
  wm withdraw $p    
  wm attributes $p -tool 1
  wm title $p {}
  wm transient $p .
  wm resizable $p 0 0

  # create containers -palette
  pack [frame $p.fr -relief groove -borderwidth 0]  -side left -anchor nw

  # add ruler
  pack [frame $fr.rule -bg #9999ff -relief raised -borderwidth 1 -width 3] -side left -anchor nw -fill y

  # detach palette
  bind $fr.rule <Button-1>  [ list ToolBar::rule_cmd $path $p %X %Y ]

  return [Widget::create ToolBar $path]
 }

 #---------------
 # called when the palette closes
 #---------------
 proc ToolBar::palette_cmd {a b c} {
  set opts "-side left -anchor nw"
  # obtain a list of currently packed items
  set slave_list [pack slaves $c] ;
  # sort the list by ending index
  set slave_list [lsort [lappend slave_list $a]]
  # repack everything on the list
  eval pack $slave_list -in $c $opts
  # hide the assocated palette
  wm withdraw $b
 }

 #---------------
 # called when the toolbar rule is clicked
 #---------------
 proc ToolBar::rule_cmd {b p x y} {
  wm geometry $p =+$x+$y
  wm deiconify $p
  set c [lindex [pack info $b] 1]
  wm protocol $p WM_DELETE_WINDOW [list ToolBar::palette_cmd $b $p $c]
  pack forget $b
 }

 #---------------
 # change settings..
 #---------------
 proc ToolBar::configure { path args } {
  set res [Widget::configure $path $args]
  return $res
 }

 #---------------
 # inquire about currents settings..
 #---------------
 proc ToolBar::cget { path option } {
  return [Widget::cget $path $option]
 }

 #---------------
 # add a new widget to the toolbar
 #---------------
 proc ToolBar::add { path class indx args} {
  # name the palette
  set p .pal_[string trimleft $path .]
  # add rule
  if {[string tolower $class] == "rule"} {
    # one for the toolbar
    frame $path.f.r$indx -width 2 -borderwidth 1 -relief groove
    pack $path.f.r$indx -side left -anchor nw -fill y -padx 2
    # one for the palette
    frame $p.r$indx -width 2 -borderwidth 1 -relief groove
    pack $p.r$indx -side left -anchor nw -fill y -padx 2
    return
  }
  # add other types of widget
  # create some storage
  set args1 {}  ;# core widget options
  set args2 {}  ;# anything else, add switches below
  set argsp1 {} ;# same for the palette
  set argsp2 {}
  foreach {arg val} $args {
      switch -- $arg {
        -help {
          append args1 "DynamicHelp::add $path.f.$indx -help ballon -text \{$val\}"
          append argsp1 "DynamicHelp::add $p.$indx -help ballon -text \{$val\}"
        }
        default {
          append args2 " $arg \{$val\} "
          append argsp2 " $arg \{$val\} "
        }
      }
  }
  # create child widget
  eval "$class $path.f.$indx $args2"  ;# toolbar
  eval "$class $p.$indx $argsp2"       ;# palette
  # do the extra stuff -toolbar
  eval $args1
  pack $path.f.$indx -side left -padx 2
  # do the extra stuff -palette
  eval $argsp1
  pack $p.$indx -side left -padx 2
  return $path.f.$indx
 }

 #---------------
 # the ubiquitous demo
 #---------------
 proc ToolBar::demo {} {
 
  catch {console show}
 
  BWidget::place . 500 500 center
  
  # create toolbar holder and sample text
  set base [frame .fr -relief groove -bd 2]
  pack $base -side top -anchor nw -fill x 
  pack [text .txt] -side top -anchor nw -expand 1 -fill both

  # populate the toolbar holder  
  pack [ToolBar .tb1 ] -in $base -side left  -padx 0 -anchor nw
  foreach {i img hlp} {
    1 New "New Document"
    2 Open "Open New File"
    3 Save "Save Work"
  } {
      .tb1 add button b$i \
        -image [Bitmap::get $img] \
        -relief flat -overrelief raised \
        -help abc \
        -command cmd$img
  }

  # create toolbar 2 -EDIT
  pack [ToolBar .tb2 ] -in $base -side left -padx 0 -anchor nw

  foreach {i img hlp} {
    1 Cut "Cut selection to clipboard"
    2 Copy "Copy selection to clipboard"
    3 Paste "Paste clipboard into selection"
  } {
    .tb2 add button b$i \
      -image [Bitmap::get $img] \
      -relief flat -overrelief raised \
      -help abc \
      -command cmd$img
  }

  # and some BWidget buttons
  pack [ToolBar .tb3 ] -in $base -side left -padx 0 -anchor nw

  foreach {i img hlp} {
    1 Bold "Embolden Selection"
    2 Overstrike "Overstrike Selection"
    3 Underline "Underline Selection"
  } {
    .tb3 add Button b$i \
      -image [Bitmap::get $img] \
      -relief link \
      -help abc \
      -command cmd$img
  }

  # and, a combox
  .tb3 add Rule 2
  .tb3 add ComboBox cmb1 -values {How Now Brown Cow}
  .tb3 add Rule 3
  .tb3 add checkbutton cb1 -text test
  
 }

 ToolBar::demo