+#---------- smashing ----------
+
+set smash_subclass 0
+
+proc smash-code {code} {
+ manyset [split $code _] inport class subclass lockown xabbrev
+
+ global smash_subclass
+ if {$smash_subclass > 1} {
+ set subclass {}
+ } elseif {$smash_subclass && [string length $subclass]} {
+ set subclass !
+ }
+
+ return [join [list $inport $class $subclass $lockown $xabbrev] _]
+}
+
+proc make-radio-smasher {w label variable descs} {
+ frame $w
+ label $w.label -text $label
+ pack $w.label -side left
+ for {set i 0} {$i < [llength $descs]} {incr i} {
+ radiobutton $w.v$i \
+ -variable $variable -value $i -command redraw-needed \
+ -text [lindex $descs $i]
+ pack $w.v$i -side left
+ }
+}
+