chiark / gitweb /
where-vessels: subclass smasher works; need to reorg to be a grid like Show
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 7 Aug 2010 13:58:25 +0000 (14:58 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 8 Aug 2010 11:52:15 +0000 (12:52 +0100)
yarrg/where-vessels

index a558c42..d6ce007 100755 (executable)
@@ -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