From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sun, 8 Aug 2010 19:08:32 +0000 (+0100)
Subject: where-vessels: show unsmashed code canvas for vessel when we click on the name in... 
X-Git-Tag: 6.6.2~9
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=commitdiff_plain;h=c96f16bf07dc3254155d3d31acf91e82fc69da56

where-vessels: show unsmashed code canvas for vessel when we click on the name in the report
---

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index a9c40a3..0aa7290 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -361,6 +361,13 @@ proc canvas-horiz-stack {xvar xoff y bind type args} {
     return $id
 }
 
+proc code2canvas1 {code canvas} {
+    set y 2
+    code2canvas $code $canvas 5 y {} 0 {}
+    manyset [$canvas bbox all] minx dummy maxx dummy
+    $canvas configure -width [expr {$maxx-$minx+4}]
+}
+
 proc code2canvas {code canvas x yvar qty qtylen bind} {
     global vc_code2abbrev
     upvar 1 $yvar y
@@ -1093,7 +1100,9 @@ proc draw {} {
 	set smcode [smash-code $code]
 	debug "smashed $code => $smcode"
 	set smkey "$islandname $smcode"
-	foreach vessel $found($key) { lappend smfound($smkey) $vessel }
+	foreach vessel $found($key) {
+	    lappend smfound($smkey) [list $vessel $code]
+	}
     }
 
     set islandnames {}
@@ -1400,8 +1409,12 @@ proc widgets-setup {} {
 
     listbox .cp.report.list -height 5
 
+    canvas .cp.report.abbrev1 -width 1 -height 15
+
     pack .cp.report.island .cp.report.abbrev .cp.report.details \
-	.cp.report.list -side top
+	.cp.report.list .cp.report.abbrev1 -side top
+    bind .cp.report.list <<ListboxSelect>> show-report-abbrev1
+
     #pack .cp.report.code -side top
     pack configure .cp.report.details -fill x
 
@@ -1417,22 +1430,22 @@ proc show-report {islandname code} {
     .cp.report.island configure -text $islandname
 
     .cp.report.abbrev delete all
-    set y 2
-    code2canvas $code .cp.report.abbrev 5 y {} 0 {}
-    manyset [.cp.report.abbrev bbox all] minx dummy maxx dummy
-    .cp.report.abbrev configure -width [expr {$maxx-$minx+4}]
+    code2canvas1 $code .cp.report.abbrev
 
     glset report_code $code
     show-report-decode $code
 
     set kk "$islandname $code"
-    upvar #0 smfound($kk) k
+    upvar #0 smfound($kk) vessels
 
+    global report_list_codes
+    set report_list_codes {}
     .cp.report.list delete 0 end
 
-    foreach elem $k {
+    foreach foundelem $vessels {
+	manyset $foundelem elem code
 	manyset $elem vid name owner
-	lappend owned($owner) $name
+	lappend owned($owner) [list $name $code]
     }
 
     foreach owner [lsort [array names owned]] {
@@ -1443,11 +1456,31 @@ proc show-report {islandname code} {
 	}
 	if {[have-notes]} {
 	    .cp.report.list insert end "$owndesc:"
+	    lappend report_list_codes {}
 	}
-	foreach name $owned($owner) {
+	foreach ownelem $owned($owner) {
+	    manyset $ownelem name code
 	    .cp.report.list insert end " $name"
+	    lappend report_list_codes $code
 	}
     }
+    show-report-abbrev1
+}
+
+proc show-report-abbrev1 {} {
+    global report_list_codes
+    .cp.report.abbrev1 delete all
+    set ix [.cp.report.list curselection]
+    debug "SHOW-REPORT-ABBREV1 $ix $report_list_codes"
+    if {[llength $ix] != 1} return
+    set code [lindex $report_list_codes $ix]
+    if {![string length $code]} return
+    if {![have-notes]} {
+	manyset [split $code _] inport size subclass lockown xabbrev
+	regsub {.$} $lockown 3 lockown
+	set code [join [list $inport $size $subclass $lockown $xabbrev] _]
+    }
+    code2canvas1 $code .cp.report.abbrev1
 }
 
 proc zoom {amt} {