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"
}
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
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]
}
}
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 {}
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
$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
$emsg $lno $ei $fulldesc $var
set var $old
uplevel 1 $parse
+ } else {
+ uplevel 1 $ok
}
}
}
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
}
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
}