where-vessels: Put "last seen at" question mark at front of abbrev

[ypp-sc-tools.main.git] / yarrg / where-vessels

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 0376796314509424a76952e53864e84530fc41ad..66d8527a6a6d88784491efcb9d41487b599676c9 100755 (executable)
--- 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]
        }
     }
@@ -229,6 +236,12 @@ proc display-note-infos {} {
 proc vessel {vin} {
     global pirate notes_used note_missings newnotes
     upvar 1 $vin vi
+    set abbrev {}
+    switch -exact [errexpect-arrayget vi inPort] {
+       true            { }
+       false           { append abbrev ? }
+       default         { errexpect-error "unexpected inPort" }
+    }
     switch -exact [errexpect-arrayget vi vesselClass] {
        smsloop         { set sz 00sl }
        lgsloop         { set sz 01ct }
@@ -243,7 +256,7 @@ proc vessel {vin} {
        grandfrig       { set sz 10gf }
        default         { errexpect-error "unknown class" }
     }
-    set abbrev $sz
+    append abbrev $sz
     switch -exact [errexpect-arrayget vi vesselSubclass] {
        null            { }
        icy             { append abbrev F }
@@ -256,14 +269,10 @@ proc vessel {vin} {
        false/true      { append abbrev 0* }
        default         { errexpect-error "unexpected isLocked/isBattleReady" }
     }
-    switch -exact [errexpect-arrayget vi inPort] {
-       true            { }
-       false           { append abbrev ? }
-       default         { errexpect-error "unexpected inPort" }
-    }
     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 +282,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 +564,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 +586,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 +644,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 +672,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
 }