Version 6 of ToolBar -An Alternative to the BWidget ButtonBox

Updated 2006-06-09 14:38:10

WJG (06/06/06) Ah, 666, the number of the beast or the beastly BWidget ButtonBox? This stalwart member of the BWidget set is useful for making clusters of Buttons but what if you want other items such as everyone's favourite -ComboBox? Mmm, not really. So, here'a an alternative.

RH (07/06/06) There is already a nice Toolbar from George Petasis. It doesn't rely on any widget extension.

WJG (09/06/06) Find a revised version of the earlier code. The proc arguments remain the same but now toolbars can be detached into floating palettes. Close the palette and the toolbar returns to its orginal ordering in its container. Is did looke at GP's ToolBar, nice work. GP's work allows for the side and bottom packing of toolbars which I haven't allowed for. Its not particularly a feature that I would personally use, but seeing as its what's expected perhaps I'll have ago next.

 #---------------
 # ToolBar.tcl
 #---------------
 # William J Giddings, 2006
 #---------------
 # Provide a ToolBar megawidget using the BWidget package.
 #
 # This is a hack of the code found at http://wiki.tcl.tk/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.
 #----------------

 package require BWidget

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

  # DragButton stuff  

# variable palettes # set moving 1 # set active {}

 }

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

    # 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 _rule_cmd $path $p %X %Y ]

    return [Widget::create ToolBar $path]
 }

 proc _palette_cmd {a b} {    
    set slave_list [pack slaves [winfo parent $a]] ;# obtain a list of currently packed items
    set opts [pack info [lindex $slave_list 1]]

    set slave_list [lsort [lappend slave_list $a]]

    eval pack $slave_list $opts

    pack $a -side left -anchor nw
    wm withdraw $b    
 }

 # rule handler routine
 proc _rule_cmd {b p x y} {
  wm attributes $p -tool 1
  wm title $p {}
  wm geometry $p =+$x+$y
  wm deiconify $p
  wm transient $p .
  wm protocol $p WM_DELETE_WINDOW [list _palette_cmd $b $p]
  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 {} {
  BWidget::place . 500 500 center
  # create toolbar 1 -FILE
  pack [ToolBar .tb1 ] -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 ] -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 ] -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