where-vessels bugfixes

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 0376796314509424a76952e53864e84530fc41ad..29c3ab720c6c5650c326637df8fa078ad3141d97 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 \
        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"
                       (?: \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 {} {
 }
 
 proc display-note-infos {} {

-    global note_infos note_missings
+    global note_infos note_missings notes

 
     set nmissing [llength $note_missings]
 
     set nmissing [llength $note_missings]

+    debug "display-note-infos $nmissing [array size notes]"
+

     if {[llength $note_infos]} {
        set tiny "[llength $note_infos] warnings"
     if {[llength $note_infos]} {
        set tiny "[llength $note_infos] warnings"

-    } elseif {$nmissing} {
+    } elseif {$nmissing && [array size notes]} {

        set tiny "$nmissing missing"
     } else {
        return
        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"
 
     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]
        }
     }
            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 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 {}
 
     set owner {}
     set xabbrev {}


@@ -273,20 +281,22 @@ proc vessel {vin} {
            note-info $lno $vid $realname \
                "notes say name is $notename - perhaps renamed"
        }
            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 {
        }
        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]
     
     }
     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
     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   
 }
     $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 \
     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
     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
            $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 {} {
 }
 
 proc invoke_acquire {} {

-    global clipboard
+    global clipboard errorInfo

     set old $clipboard
     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
 }
 
     draw
 }
 


@@ -650,17 +671,17 @@ proc invoke_notes {} {
        load-notes
     } emsg]} {
        parser-control-failed-unexpected .ctrl.notes 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 \
        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
 }
 
     draw
 }