if 0 { [MG] Dec 21 2005 - In certain [Microsoft] programs like MS Word (and probably many others, by MS and other companies), you can right-click on the toolbar, select "Customize" and alter the toolbar - you can add and remove buttons of your choosing, change whether they display a picture, text, or both, add a separator before the button, and all kinds of other stuff. The idea is that the user can customize the app to their liking. In a moment of boredom, I thought I'd see if I could introduce something similar in Tcl and Tk. This is very much a work in progress, but it does seem to be working. I started it a couple of days ago, and I'm adding features whenever I get a moment. Currently, you can... * Add a button (though only programatically, at present) * Delete a button (just drag it off the toolbar while customizing) * Start "Customizing" by right-clicking the toolbar and selecting it. ''You can't "stop" customizing yet, apart from at the Tcl prompt, with ::toolbar::endCustomize $toolbar'' * Select whether or not a button "begins a group", by adding a separator before it (also only programatically at the moment, with ''::toolbar::toggleBegin $button'' It also includes basic balloon code, so that the buttons tell you what they are, when you move over them with the cursor. It could really use some custom cursors, so that when you drag a button off the toolbar, the cursor changes to tell you what's going to happen, but that's likely to be the last thing I ever get around to adding. Some more features I hope to add, over the coming days... * Ability to add buttons properly, by dragging them onto the toolbar * A button to stop the customizing! * Ability to move buttons, by dragging them along the toolbar * Ability to alter buttons - name, icon, wheter they "begin a group", how they're displayed (picture/text/both) from a context menu * Probably more I haven't thought of, yet. Even with the basic features it has so far, though, you can get an idea for how it's going to work. (And for anyone with MS Word installed, just open it up, right-click the toolbars, and select "Customize" - that's what I'm hoping to have, when I'm done :) Any comments, thoughts, or criticisms are highly appreciated. Mike ---- The code: } namespace eval ::toolbar {} proc ::toolbar::startCustomize {tb} { bind ToolbarButton break bind ToolbarButton break bind ToolbarButton {::toolbar::select %W ; break} bind ToolbarButton {::toolbar::drag %W %X %Y; break} ;# to allow moving/deleting buttons by dragging bind ToolbarButton {::toolbar::dragRelease %W %X %Y ; break} ;# as above bind ToolbarButton {::toolbar::select %W ; break} bind ToolbarButton <3> {::toolbar::select %W ; ::toolbar::showOptions %W ; break} bind Toolbar <3> {continue} };# tb / startCustomize proc ::toolbar::endCustomize {tb} { bind ToolbarButton continue bind ToolbarButton continue bind ToolbarButton continue bind ToolbarButton continue bind ToolbarButton continue bind ToolbarButton <3> continue bind Toolbar <3> {::toolbar::showToolbarOptions %W %X %Y ; break} if { [info exists ::toolbar::this($tb,selected)] && [winfo exists $::toolbar::this($tb,selected)] } { ::toolbar::deselect $tb } };# tb / endCustomize proc ::toolbar::drag {w x y} { };# 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,begin,$w)} unset -nocomplain local($tb,begin,$w) };# tb / delete proc ::toolbar::toggleBegin {w} { variable counter set tb [winfo parent $w] upvar 0 ::toolbar::this local if { [info exists local($tb,begin,$w)] } { destroy $local($tb,begin,$w) unset $local($tb,begin,$w) } 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,begin,$w) $begin } };# tb / toggleBegin proc ::toolbar::showToolbarOptions {tb x y} { 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 $w add command -label "Customize..." -underline 0 -command [list ::toolbar::startCustomize $tb] $w post $x $y };# tb / showToolbarOptions proc ::toolbar::showOptions {w} { if { [winfo class $w] != "ToolbarButton" } { return; } #abc do stuff! };# 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) none 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) \ -compound $this($tb,compound) -image $functions($func,icon) \ -text $functions($func,name) -command $functions($func,cmd) upvar 0 ::toolbar::this($tb,bar) bar set bar [linsert $bar $pos $button] set pos [lsearch -exact $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 $bar [expr {$pos-1}]] } bindtags $button [linsert [bindtags $button] 0 ToolbarButton] ::toolbar::balloon $button $functions($func,name) return $button; };# tb / button proc ::toolbar::balloon {w help} { bind $w "after 450 [list ::toolbar::balloonShow %W [list $help]]" bind $w [list destroy %W.balloon] };# tb / balloon proc ::toolbar::balloonShow {w text} { if { [eval winfo containing [winfo pointerxy .]] != $w } { return; } 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 {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 if 0 { And a short "demo program". The buttons will all throw errors when clicked, so don't click them ;) Just right-click beside/between them and select "Customize", then drag 'em off the toolbar or click them to select them. That's about all you can do, so far, without going back to the Tcl prompt. } 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== } array set ::toolbar::functions { 0,icon ::img::new 0,name "New Document" 0,cmd "do_new_document" 1,icon ::img::open 1,name "Open Document" 1,cmd "do_open_document" 2,icon ::img::save 2,name "Save Document" 2,cmd "do_save" 3,icon ::img::save 3,name "Save As..." 3,cmd "do_save_as" 4,icon ::img::print 4,name "Print" 4,cmd "do_print" };# array set ::toolbar::functions 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] }