- Add a button (though only programatically, at present)
- Delete a button (just drag it off the toolbar while customizing, or selected Delete from the context menu)
- Start "Customizing" by right-clicking the toolbar and selecting it. You can stop customizing in the same way
- Select whether or not a button "begins a group", by adding a separator before it (from context menu)
- Change how a button is displayed (toolbar's default style, text only, image only, or both, also from context menu)
- Reset a button (to toolbar's default display style/default text/default icon). There's currently no way to alter the icon/text used, except from the console, so resetting doesn't do a lot.
- Ability to add buttons properly, by dragging them onto the toolbar
- Ability to move buttons, by dragging them along the toolbar
- Ability to alter buttons more - their name, icon, more...?
- Probably more I haven't thought of, yet.
The code:}
namespace eval ::toolbar {} array set ::toolbar::functions { 0,icon ::img::new 0,text "New Document" 0,cmd "do_new_document" 1,icon ::img::open 1,text "Open Document" 1,cmd "do_open_document" 2,icon ::img::save 2,text "Save Document" 2,cmd "do_save" 3,icon ::img::save 3,text "Save As..." 3,cmd "do_save_as" 4,icon ::img::print 4,text "Print" 4,cmd "do_print" };# array set ::toolbar::functions proc ::toolbar::startCustomize {tb} { bind ToolbarButton <Enter> break bind ToolbarButton <Leave> break bind ToolbarButton <ButtonPress-1> {::toolbar::select %W ; break} bind ToolbarButton <B1-Motion> {::toolbar::drag %W %X %Y; break} ;# to allow moving/deleting buttons by dragging bind ToolbarButton <ButtonRelease-1> {::toolbar::dragRelease %W %X %Y ; break} ;# as above bind ToolbarButton <Key-space> {::toolbar::select %W ; break} bind ToolbarButton <3> {::toolbar::select %W ; ::toolbar::showOptions %W %X %Y ; break} bind Toolbar <3> {::toolbar::showToolbarOptions %W %X %Y 1; break} };# tb / startCustomize proc ::toolbar::endCustomize {tb} { bind ToolbarButton <Enter> continue bind ToolbarButton <Leave> continue bind ToolbarButton <ButtonPress-1> continue bind ToolbarButton <ButtonRelease-1> continue bind ToolbarButton <Key-space> continue bind ToolbarButton <3> {::toolbar::showToolbarOptions [winfo parent %W] %X %Y 0; break} bind Toolbar <3> {::toolbar::showToolbarOptions %W %X %Y 0; break} if { [info exists ::toolbar::this($tb,selected)] && [winfo exists $::toolbar::this($tb,selected)] } { ::toolbar::deselect $tb } };# tb / endCustomize proc ::toolbar::resetButton {btn} { variable functions set tb [winfo parent $btn] if { [winfo class $tb] != "Toolbar" } { return; } upvar 0 ::toolbar::this local set func $local($tb,func,$btn) set local($tb,text,$btn) $functions($func,text) set local($tb,icon,$btn) $functions($func,icon) ::toolbar::setCompound $btn default };# ::toolbar::resetButton proc ::toolbar::drag {w x y} { set container [winfo containing $x $y] set tb [winfo parent $w] if { $container != $tb && ![string match "${tb}.*" $container] } { # it's being dragged off the toolbar $w configure -relief ridge } else { $w configure -relief solid } };# tb / drag proc ::toolbar::dragRelease {w x y} { set container [winfo containing $x $y] set tb [winfo parent $w] if { $container != $tb && ![string match "${tb}.*" $container] } { # it's been dragged off the toolbar - delete it! ::toolbar::delete $w return; } #abc check if it's been moved, and where it should go to };# tb / dragRelease proc ::toolbar::delete {w} { upvar 0 ::toolbar::this local set tb [winfo parent $w] set pos [lsearch -exact $local($tb,bar) $w] set local($tb,bar) [lreplace $local($tb,bar) $pos $pos] destroy $w catch {destroy $local($tb,beginWidget,$w)} array unset local $tb,*,$w) };# tb / delete proc ::toolbar::toggleBegin {w} { variable counter set tb [winfo parent $w] upvar 0 ::toolbar::this local if { [info exists local($tb,beginWidget,$w)] } { destroy $local($tb,beginWidget,$w) unset local($tb,beginWidget,$w) set local($tb,beginBool,$w) 0 } else { set begin [frame $tb.[incr counter($tb)] -width 2 -borderwidth 1 -relief ridge -bg grey65] pack $begin -before $w -padx 5 -side left -pady 1 -fill y set local($tb,beginWidget,$w) $begin set local($tb,beginBool,$w) 1 } };# tb / toggleBegin proc ::toolbar::showToolbarOptions {tb x y customizing} { if { [winfo class $tb] != "Toolbar" } { return; } #abc show right-click menu with "Customize" option to start customizing! set w .toolbarOptionsMenu catch {destroy $w} menu $w -tearoff 0 if { $customizing } { $w add command -label "Stop Customizing" -underline 0 -command [list ::toolbar::endCustomize $tb] } else { $w add command -label "Customize..." -underline 0 -command [list ::toolbar::startCustomize $tb] } $w post $x $y };# tb / showToolbarOptions proc ::toolbar::showOptions {btn x y} { if { [lsearch [bindtags $btn] "ToolbarButton"] < 0 } { return; } #abc do stuff! set tb [winfo parent $btn] set w .toolbarButtonOptions catch {destroy $w} #toplevel $w #wm withdraw . #wm overrideredirect $w 1 #wm title $w "Toolbar Customization" #bind $w <FocusOut> {if { [winfo toplevel %W] == %W } {destroy %W}} menu $w -tearoff 0 $w add command -label "Reset" -underline 0 -command [list ::toolbar::resetButton $btn] $w add command -label "Delete" -underline 0 -command [list ::toolbar::delete $btn] $w add separator $w add checkbutton -label "Begin a group?" -variable ::toolbar::this($tb,beginBool,$btn) \ -command [list ::toolbar::toggleBegin $btn] $w add separator $w add radiobutton -label "Default Style" -variable ::toolbar::this($tb,compound,$btn) \ -value "default" -command [list ::toolbar::setCompound $btn var] $w add radiobutton -label "Text Only" -variable ::toolbar::this($tb,compound,$btn) \ -value "text" -command [list ::toolbar::setCompound $btn var] $w add radiobutton -label "Image Only" -variable ::toolbar::this($tb,compound,$btn) \ -value "image" -command [list ::toolbar::setCompound $btn var] $w add radiobutton -label "Image and Text" -variable ::toolbar::this($tb,compound,$btn) \ -value "both" -command [list ::toolbar::setCompound $btn var] $w post $x $y #wm geography $w $x $y #wm deiconify $w };# tb / showOptions proc ::toolbar::select {w} { set parent [winfo parent $w] ::toolbar::deselect $parent $w configure -border 2 -relief solid set ::toolbar::this($parent,selected) $w };# tb / select proc ::toolbar::deselect {tb} { upvar 0 ::toolbar::this local if { [info exists local($tb,selected)] && [winfo exists $local($tb,selected)] } { set w $local($tb,selected) $w configure -border $local($tb,border) -relief $local($tb,relief) set local($tb,selected) "" } };# tb / deselect proc ::toolbar::toolbar {w args} { variable counter if { [winfo exists $w] } { set par [winfo parent $w] set len [string length $par] if { $len > 1 } { incr len } set this [string range $w $len end] error "window name \"$this\" already exists in parent" } set ::toolbar::this($w,relief) flat set ::toolbar::this($w,border) 2 set ::toolbar::this($w,compound) image set ::toolbar::this($w,overrelief) raised set ::toolbar::this($w,bar) [list] set options [list] foreach {name value} $args { if { $name == "-buttonrelief" } { set ::toolbar::this($w,relief) $value } elseif { $name == "-buttonoverrelief" } { set ::toolbar::this($w,overrelief) $value } elseif { $name == "-buttonborder" } { set ::toolbar::this($w,border) $value } elseif { $name == "-buttoncompound" } { set ::toolbar::this($w,compound) $value } else { lappend options $name $value } } set counter($w) 0 set frame [eval ::frame $w -class Toolbar $options -padx 3] bindtags $frame [linsert [bindtags $frame] 1 "Toolbar"] ::toolbar::endCustomize $frame ;# setup default bindings return $frame; };# tb / toolbar proc ::toolbar::button {tb func {pos "end"}} { variable functions variable this variable counter if { [winfo class $tb] != "Toolbar" } { error "window \"$tb\" is not a toolbar widget" } if { ![info exists functions($func,cmd)] } { error "invalid toolbar function \"$func\"" } set button $tb.[incr counter($tb)] ::button $button -relief $this($tb,relief) -overrelief $this($tb,overrelief) -border $this($tb,border) \ -command $functions($func,cmd) upvar 0 ::toolbar::this local #($tb,bar) bar set local($tb,bar) [linsert $local($tb,bar) $pos $button] set pos [lsearch -exact $local($tb,bar) $button] if { $pos == "0" } { pack $button -side left -padx 1 -pady 1 -anchor nw } else { pack $button -side left -padx 1 -pady 1 -anchor nw -after [lindex $local($tb,bar) [expr {$pos-1}]] } bindtags $button [linsert [bindtags $button] 0 ToolbarButton] ::toolbar::balloon $button set local($tb,func,$button) $func set local($tb,text,$button) $functions($func,text) set local($tb,icon,$button) $functions($func,icon) set local($tb,beginBool,$button) 0 ::toolbar::setCompound $button default return $button; };# tb / button proc ::toolbar::setCompound {w {compound default}} { upvar 0 ::toolbar::this local variable functions set tb [winfo parent $w] set func $local($tb,func,$w) if { $compound == "var" } { # use the var setting for this button set compound $local($tb,compound,$w) } if { $compound != "text" && $compound != "image" && $compound != "both" && $compound != "default" } { set compound $local($tb,compound) ;# bad value, so we use the toolbar default } if { $compound == "default" } { set compoundDisp "default" set compound $local($tb,compound) } else { set compoundDisp $compound } if { $compound == "text" || $compound == "both" } { if { $local($tb,text,$w) == "" } { if { $functions($func,text) == "" && $compound == "text" } { set text "Function $func" } else { set text $functions($func,text) } } else { set text $local($tb,text,$w) } } else { set text "" } set image "" ; set text "" if { $compound == "image" || $compound == "both" } { if { ![catch {image type $local($tb,icon,$w)}] } { # use button-specific image set image $local($tb,icon,$w) } elseif { ![catch {image type $functions($func,icon)}] } { # use function-specific image set image $functions($func,icon) } else { # fall back to just text set compound "text" } } if { $compound == "text" || $compound == "both" } { if { $local($tb,text,$w) != "" } { # use button-specific text set text $local($tb,text,$w) } elseif { $functions($func,text) != "" } { # use function-specific text set text $functions($func,text) } else { # if we're on compound == text (not both), use default text if { $compound == "text" } { set text "Function $func" } } } if { $image == "" || $text == "" } { set compound "none" } else { set compound "left" set text " $text" ;# add a single space before text, for a better appearance. } $w configure -image $image -text $text -compound $compound set local($tb,compound,$w) $compoundDisp };# tb / setCompound proc ::toolbar::balloon {w} { bind $w <Any-Enter> "after 450 [list ::toolbar::balloonShow %W]" bind $w <Any-Leave> [list destroy %W.balloon] };# tb / balloon proc ::toolbar::balloonShow {w} { if { [eval winfo containing [winfo pointerxy .]] != $w } { return; } set tb [winfo parent $w] set text $::toolbar::this($tb,text,$w) set top $w.balloon catch {destroy $top} toplevel $top wm title $top $text $top configure -bd 1 -bg black wm overrideredirect $top 1 pack [message $top.txt -aspect 10000 -bg lightyellow \ -font {"" 8} -text $text -padx 1 -pady 0] bind $top <ButtonPress-1> {catch {destroy [winfo toplevel %W]}} set wmx [winfo pointerx $w] set wmy [expr [winfo rooty $w]+[winfo height $w]] if {[expr $wmy+([winfo reqheight $top.txt]*2)]>[winfo screenheight $top]} { incr wmy -[expr [winfo reqheight $top.txt]*2] } if {[expr $wmx+([winfo reqwidth $top.txt]+5)]>[winfo screenwidth $top]} { incr wmx -[expr [winfo reqwidth $top.txt]*2] set wmx [expr [winfo screenwidth $top]-[winfo reqwidth $top.txt]-7] } wm geometry $top \ [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy raise $top };# tb / balloonShow namespace eval ::img {} image create photo ::img::new -data { R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJyanPz+/Ozq7GxqbPz6/GxubNTK xDQyNIyKhHRydERCROTi3PT29Pz29Pzy7PTq3My2pPzu5PTi1NS+rPTq5PTe zMyynPTm1Pz69OzWvMyqjPTu5PTm3OzOtOzGrMSehNTCtNS+tAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ/ QAAgQCwWhUhhQMBkDgKEQFIpKFgLhgMiOl1eC4iEYrtIer+MxsFRRgYe3wLk MWC0qXE5/T6sfiMSExR8Z1YRFRMWF4RwYIcYFhkahH6AGBuRk2YCCBwSFZgd HR6UgB8gkR0hpJsSGCAZoiEiI4QKtyQlFBQeHrVmC8HCw21+QQAh/mhDcmVh dGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAx OTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRl dmVsY29yLmNvbQA7 } image create photo ::img::open -data { R0lGODlhEAAQAIUAAPwCBAQCBOSmZPzSnPzChPzGhPyuZEwyHExOTFROTFxa VFRSTMSGTPT29Ozu7Nze3NTS1MzKzMTGxLy6vLS2tLSytDQyNOTm5OTi5Ly+ vKyqrKSmpIyOjLR+RNTW1MzOzJyenGxqZBweHKSinJSWlExKTMTCxKyurGxu bBQSFAwKDJyanERCRERGRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaR QIBwGCgGhkhkEWA8HpNPojFJFU6ryitTiw0IBgRBkxsYFAiGtDodDZwPCERC EV8sEk0CI9FoOB4BEBESExQVFgEEBw8PFxcYEBIZGhscCEwdCxAPGA8eHxkU GyAhIkwHEREQqxEZExUjJCVWCBAZJhEmGRUnoygpQioZGxsnxsQrHByzQiJx z3EsLSwWpkJ+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9u IDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2 ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::save -data { R0lGODlhEAAQAIUAAPwCBAQCBFRSVMTCxKyurPz+/JSWlFRWVJyenKSipJSS lOzu7ISChISGhIyOjHR2dJyanIyKjHx6fMzOzGRiZAQGBFxeXGRmZHRydGxq bAwODOTm5ExOTERGRExKTHx+fGxubNza3Dw+PDQ2NAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaA QIAQECgOj0jBgFAoBpBHpaFAbRqRh0F1a30ClAhuNZHwZhViqgFhJizSjIZX QCAoHOKHYw5xRBiAElQTFAoVQgINFBYXGBkZFxYHGRqIDBQbmRwdHgKeH2Yg HpmkIR0HAhFeTqSZIhwCFIdIrBsjAgcPXlBERZ4Gu7xCRZVDfkEAIf5oQ3Jl YXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3Ig MTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5k ZXZlbGNvci5jb20AOw== } image create photo ::img::print -data { R0lGODlhEAAQAIUAAPwCBFRKNAQCBPz+/MTCxExKLPTq5Pz29Pz6/OzezPT2 9PTu7PTy7NzClOzm1PTu5LSabJyanPTm3FxaXOzCjOTKrOzi1OzaxOTSvJye nGRmZLyyTKSipDQyNERCROTi5Hx+fMzKzJSSlIyOjISChLS2tAT+BDw6PAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaY QIBwKAwIBMTkMDAYEApIpVBgOCAOg4RRGlAoEAuGIdGITgWOq4LxcCQgZkEk IHksHgYJOR6ZQCgVFhYJFxgTBVMZihoCfxUYDWUbUBGKGREcjBoQEB2TAB4C Ax+Vl5WMhyACHiEhH6IfIiMktCQgE0cZJQStr6O2t6EARxO6vK6iEx4dZsMC xbsmBB4nzUTEutVSSUdmfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8g dmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRz IHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } catch {console show} ###### TEST ####### pack [set toolbar [toolbar::toolbar .tb]] -side top -fill x -anchor nw toolbar::button $toolbar 0 toolbar::button $toolbar 1 ::toolbar::toggleBegin [toolbar::button $toolbar 2] toolbar::button $toolbar 4 pack [frame .btm] -side top -expand 1 -fill both pack [text .btm.txt -yscrollcommand ".btm.sb set" -wrap word] -side left -expand 1 -fill both pack [scrollbar .btm.sb -command ".btm.txt yview"] -side left -fill y catch {wm state . zoomed}if 0 {[Category Widget] | toolbar}