Updated 2013-09-01 23:29:38 by RLE ▲

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) Here's revised version of the earlier code (now deleted). 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. I did look at GP's ToolBar, nice work. GP's package allows for the side and bottom packing of toolbars which I haven't allowed for. It's not particularly a feature that I would personally use, but seeing as it's what's expected perhaps I'll have a go at it 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.
 # 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

Category Widget