where-vessels: subclass smasher works; need to reorg to be a grid like Show

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index a558c42a2e068c316c1fbed96552ae6d8bb60169..d6ce007785919ea21f67911f8d1532ac9bcc018f 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -444,13 +444,27 @@ proc smash-code {code} {
     manyset [split $code _] inport class subclass lockown xabbrev
 
     global smash_subclass
-    if {$smash_subclass && [string length $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
+    }
+}
+
 #---------- filtering ----------
 
 set filters {}
@@ -1051,14 +1065,14 @@ proc widgets-setup {} {
     frame .smash -relief groove -bd 2 -padx 1
     frame .filter -relief groove -bd 2 -padx 1
     frame .islands -pady 2
-    pack .cp .smash .filter .islands -side top
+    pack .cp .filter .islands .smash -side top
 
     label .smash.title -text Smash
-    pack .smash.title -side left
+    pack .smash.title -side top
 
-    checkbutton .smash.subclass -text Subclass \
-       -variable smash_subclass -command redraw-needed
-    pack .smash.subclass -side left
+    make-radio-smasher .smash.subclass Subclass smash_subclass \
+       {Show Normal/LE Hide}
+    pack .smash.subclass -side top
 
     set filterstyle 1
     trace add variable filterstyle write filterstyle-changed