From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sat, 7 Aug 2010 13:58:25 +0000 (+0100)
Subject: where-vessels: subclass smasher works; need to reorg to be a grid like Show
X-Git-Tag: 6.6.2~29
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=commitdiff_plain;h=ea3cffe854b1c540bc68cd2218fdb2be732197fa

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 a558c42..d6ce007 100755
--- 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