X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=29c3ab720c6c5650c326637df8fa078ad3141d97;hp=0376796314509424a76952e53864e84530fc41ad;hb=d10f467c0e4205c612d0e71e787f8c6bf40ccadb;hpb=0133a79929da1c6bcbd524b6e7d23decdfc80198;ds=sidebyside

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 0376796..29c3ab7 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -166,8 +166,8 @@ proc parse-notes {} {
 	if {![string length $l]} continue
 	if {[regexp {^\#} $l]} continue
 	if {![regexp -expanded \
-		  {^ (\d+) (?: \s+([^=]*?) )? \s*
-		      (?: = \s* (\S+)
+		  {^ (\d+) (?: \s+([^=]*?) )? \s* =
+		      (?: \s* (\S+)
 		       (?: \s+ (\S+) )?)? $} \
 		  $l dummy vid vname owner note]} {
 	      errexpect-error "badly formatted"
@@ -186,12 +186,14 @@ proc note-info {lno vid name description} {
 }
 
 proc display-note-infos {} {
-    global note_infos note_missings
+    global note_infos note_missings notes
 
     set nmissing [llength $note_missings]
+    debug "display-note-infos $nmissing [array size notes]"
+
     if {[llength $note_infos]} {
 	set tiny "[llength $note_infos] warnings"
-    } elseif {$nmissing} {
+    } elseif {$nmissing && [array size notes]} {
 	set tiny "$nmissing missing"
     } else {
 	return
@@ -209,8 +211,13 @@ proc display-note-infos {} {
 
     if {$nmissing} {
 	append infodata "$nmissing vessels not mentioned in notes:\n"
-	foreach info $note_missings {
-	    manyset $info vid name
+	set last_island {}
+	foreach info [lsort $note_missings] {
+	    manyset $info island name vid
+	    if {[string compare $island $last_island]} {
+		append infodata "# $island:\n"
+		set last_island $island
+	    }
 	    append infodata [format "%-9d %-29s =\n" $vid $name]
 	}
     }
@@ -264,6 +271,7 @@ proc vessel {vin} {
     set vid [errexpect-arrayget vi vesselId]
     upvar #0 notes($vid) note
     set realname [errexpect-arrayget vi vesselName]
+    set island [errexpect-arrayget vi islandName]
 
     set owner {}
     set xabbrev {}
@@ -273,20 +281,22 @@ proc vessel {vin} {
 	    note-info $lno $vid $realname \
 		"notes say name is $notename - perhaps renamed"
 	}
-	if {![string compare $owner $pirate]} {
-	    append abbrev =
-	} else {
-	    append abbrev -
+	if {[string length $owner]} {
+	    if {![string compare $owner $pirate]} {
+		append abbrev =
+	    } else {
+		append abbrev -
+	    }
 	}
 	append abbrev $xabbrev
 	set notes_used($vid) 1
 
     } else {
-	lappend note_missings [list $vid $realname]
+	lappend note_missings [list $island $realname $vid]
     }
     lappend newnotes [list $vid $realname $owner $xabbrev]
     
-    set kk "[errexpect-arrayget vi islandName] $abbrev"
+    set kk "$island $abbrev"
     upvar #0 count($kk) k
     if {![info exists k]} { set k 0 }
     incr k
@@ -553,13 +563,14 @@ proc parser-control-failed-expected {w base emsg lno ei fulldesc newdata} {
     $eb.text.text tag add error $lno.0 $lno.end
     $eb.text.text see $lno.0	
 }
-proc parser-control-failed-unexpected {w base tiny summary fulldesc fulldata} {
+proc parser-control-failed-unexpected {w base emsg ei} {
+    global errorInfo
     parser-control-failed-core $w $base \
 	black yellow 1 \
-	$tiny $summary $fulldesc $fulldata
+	$emsg $emsg "Details and stack trace:" $ei
 }
 
-proc reparse {base varname old fulldesc okshow noneshow parse} {
+proc reparse {base varname old fulldesc okshow noneshow parse ok} {
     upvar #0 $varname var
     manyset [errexpect-catch {
 	uplevel 1 $parse
@@ -574,6 +585,8 @@ proc reparse {base varname old fulldesc okshow noneshow parse} {
 	    $emsg $lno $ei $fulldesc $var
 	set var $old
 	uplevel 1 $parse
+    } else {
+	uplevel 1 $ok
     }
 }
 
@@ -630,15 +643,23 @@ proc zoom {extail} {
 }
 
 proc invoke_acquire {} {
-    global clipboard
+    global clipboard errorInfo
     set old $clipboard
-    set clipboard [clipboard get]
 
-    reparse acquire \
-	clipboard $old "Clipboard contents:" { acquired ok } { no vessels } \
-	{ parse-clipboard }
+    if {[catch {
+	set clipboard [clipboard get]
+    } emsg]} {
+	parser-control-failed-unexpected .ctrl.acquire acquire \
+	    $emsg "fetching clipboard:\n\n$errorInfo"
+	return
+    }
 
-    display-note-infos
+    reparse acquire \
+	clipboard $old "Clipboard contents:" { acquired ok } { no vessels } {
+	    parse-clipboard
+	} {
+	    display-note-infos
+	}
     draw
 }
 
@@ -650,17 +671,17 @@ proc invoke_notes {} {
 	load-notes
     } emsg]} {
 	parser-control-failed-unexpected .ctrl.notes notes \
-	    $emsg $emsg "Details and stack trace:" \
-	    "loading $notes_loc:\n\n$errorInfo"
+	    $emsg "loading $notes_loc:\n\n$errorInfo"
 	return
     }
 
     reparse notes \
-	notes_data $old "Vessel notes:" "loaded ok" { no notes } \
-	{ parse-notes }
-
-    parse-clipboard
-    display-note-infos
+	notes_data $old "Vessel notes:" "loaded ok" { no notes } {
+	    parse-notes
+	    parse-clipboard
+	} {
+	    display-note-infos
+	}
     draw
 }