chiark / gitweb /
Seems to be able to do the whole thing
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Fri, 5 Jun 2009 23:09:11 +0000 (00:09 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Fri, 5 Jun 2009 23:09:11 +0000 (00:09 +0100)
pctb/charset-15.txt
pctb/convert.c
pctb/ocr.c
pctb/ocr.h
pctb/show-thing.tcl

index 873cf51269fd95b7ada5d50435c6a2f956fbdc66..8c7b13a06b174fda6c91492e82311d029a147001 100644 (file)
@@ -1,6 +1,188 @@
 # ypp-sc-tools pctb font v1
 15
 
 # ypp-sc-tools pctb font v1
 15
 
+Digit
+0
+3e0
+410
+808
+808
+410
+3e0
+
+Digit
+1
+810
+808
+ff8
+800
+800
+
+Digit
+2
+c08
+a08
+908
+888
+870
+
+Digit
+3
+1008
+888
+888
+948
+630
+
+Digit
+4
+180
+140
+120
+110
+ff8
+100
+
+Digit
+5
+878
+848
+848
+488
+308
+
+Digit
+6
+3e0
+490
+848
+848
+488
+308
+
+Digit
+7
+8
+c08
+308
+c8
+28
+18
+
+Digit
+8
+730
+8c8
+888
+888
+8c8
+730
+
+Digit
+9
+860
+890
+908
+908
+490
+3e0
+
+Digit
+>
+820
+440
+440
+280
+100
+100
+
+Lower
+'
+38
+
+Lower
+-
+100
+100
+100
+100
+100
+
+Lower
+D
+ff8
+808
+808
+808
+808
+410
+3e0
+
+Lower
+F
+ff8
+88
+88
+88
+
+Lower
+J
+2000
+2000
+1ff8
+
+Lower
+K
+ff8
+40
+c0
+120
+210
+408
+800
+
+Lower
+N
+ff8
+10
+60
+80
+300
+400
+ff8
+
+Lower
+R
+ff8
+88
+88
+188
+248
+430
+800
+
+Lower
+W
+18
+3e0
+c00
+3e0
+18
+3e0
+c00
+3e0
+18
+
+Lower
+Y
+8
+10
+60
+f80
+60
+10
+8
+
 Lower
 a
 640
 Lower
 a
 640
@@ -10,6 +192,46 @@ a
 fc0
 800
 
 fc0
 800
 
+Lower
+b
+ff8
+440
+820
+820
+820
+7c0
+
+Lower
+c
+7c0
+820
+820
+820
+
+Lower
+d
+7c0
+820
+820
+820
+440
+ff8
+
+Lower
+e
+7c0
+920
+920
+920
+9c0
+
+Lower
+f
+20
+ff0
+28
+8
+
 Lower
 g
 27c0
 Lower
 g
 27c0
@@ -18,6 +240,68 @@ g
 2420
 1fe0
 
 2420
 1fe0
 
+Lower
+h
+ff8
+40
+20
+20
+fc0
+
+Lower
+i
+fe8
+
+Lower
+k
+ff8
+100
+180
+240
+420
+800
+
+Lower
+l
+ff8
+
+Lower
+m
+fe0
+40
+20
+20
+fc0
+40
+20
+20
+fc0
+
+Lower
+n
+fe0
+40
+20
+20
+fc0
+
+Lower
+o
+7c0
+820
+820
+820
+7c0
+
+Lower
+p
+3fe0
+440
+820
+820
+820
+7c0
+
 Lower
 r
 fe0
 Lower
 r
 fe0
@@ -25,6 +309,19 @@ fe0
 20
 20
 
 20
 20
 
+Lower
+s
+8c0
+920
+920
+620
+
+Lower
+t
+20
+7f0
+820
+
 Lower
 u
 7e0
 Lower
 u
 7e0
@@ -33,6 +330,209 @@ u
 400
 fe0
 
 400
 fe0
 
+Lower
+v
+20
+c0
+700
+800
+700
+c0
+20
+
+Lower
+vy
+20
+c0
+700
+800
+700
+c0
+60
+180
+2600
+1800
+600
+180
+60
+
+Lower
+w
+60
+380
+c00
+380
+60
+380
+c00
+380
+60
+
+Lower
+y
+60
+180
+2600
+1800
+600
+180
+60
+
+Lower
+yw
+60
+180
+2600
+1800
+600
+180
+60
+380
+c00
+380
+60
+380
+c00
+380
+60
+
+Lower
+z
+c20
+a20
+920
+8a0
+860
+
+Upper
+B
+ff8
+888
+888
+888
+770
+
+Upper
+C
+3e0
+410
+808
+808
+808
+808
+
+Upper
+D
+ff8
+808
+808
+808
+808
+410
+3e0
+
+Upper
+E
+ff8
+888
+888
+888
+888
+808
+
+Upper
+F
+ff8
+88
+88
+88
+
+Upper
+G
+3e0
+410
+808
+808
+808
+808
+f08
+
+Upper
+H
+ff8
+80
+80
+80
+80
+80
+ff8
+
+Upper
+I
+ff8
+
+Upper
+J
+2000
+2000
+1ff8
+
+Upper
+K
+ff8
+40
+c0
+120
+210
+408
+800
+
+Upper
+L
+ff8
+800
+800
+800
+800
+
+Upper
+M
+ff8
+30
+1c0
+600
+1c0
+30
+ff8
+
+Upper
+N
+ff8
+10
+60
+80
+300
+400
+ff8
+
+Upper
+P
+ff8
+88
+88
+88
+70
+
+Upper
+R
+ff8
+88
+88
+188
+248
+430
+800
+
 Upper
 S
 830
 Upper
 S
 830
@@ -42,4 +542,61 @@ S
 708
 8
 
 708
 8
 
+Upper
+T
+8
+8
+8
+ff8
+8
+8
+8
+
+Upper
+V
+18
+60
+380
+c00
+380
+60
+18
+
+Upper
+W
+18
+3e0
+c00
+3e0
+18
+3e0
+c00
+3e0
+18
+
+Upper
+Y
+8
+10
+60
+f80
+60
+10
+8
+
+Upper
+c
+7c0
+820
+820
+820
+
+Upper
+o
+7c0
+820
+820
+820
+7c0
+
 .
 .
index 93c713708187bfe04361c4f34cac039f3960eaf0..f90ca4a450456d3b5d437e4a093da3569fa6f975 100644 (file)
@@ -30,6 +30,7 @@ static inline char get_p(Point p) { return get(p.x,p.y); }
 #define START_MAIN {200,200}
 #define MIN_COLUMNS         6
 #define INTERESTING_COLUMNS 6
 #define START_MAIN {200,200}
 #define MIN_COLUMNS         6
 #define INTERESTING_COLUMNS 6
+#define TEXT_COLUMNS        2
 #define MAX_COLUMNS         7
 
 static Rect mainr = { START_MAIN,START_MAIN };
 #define MAX_COLUMNS         7
 
 static Rect mainr = { START_MAIN,START_MAIN };
@@ -238,7 +239,7 @@ static void load_image_and_canonify(void) {
   debug_flush();
 }
 
   debug_flush();
 }
 
-static void ocr_rectangle(Rect r) {
+static void ocr_rectangle(Rect r, const OcrCellType ct) {
   OcrResultGlyph *results, *res;
 
   int w= r.br.x - r.tl.x + 1;
   OcrResultGlyph *results, *res;
 
   int w= r.br.x - r.tl.x + 1;
@@ -257,7 +258,7 @@ static void ocr_rectangle(Rect r) {
   }
   cols[w]= 0;
 
   }
   cols[w]= 0;
 
-  results= ocr(rd,w,cols);
+  results= ocr(rd,ct,w,cols);
   printf("YES! \"");
   for (res=results; res->s; res++)
     printf("%s",res->s);
   printf("YES! \"");
   for (res=results; res->s; res++)
     printf("%s",res->s);
@@ -282,7 +283,10 @@ int main(void) {
     
     for (colno=0; colno<MIN_COLUMNS; colno++) {
       find_table_entry(thisr,colno,&entryr);
     
     for (colno=0; colno<MIN_COLUMNS; colno++) {
       find_table_entry(thisr,colno,&entryr);
-      ocr_rectangle(entryr);
+      ocr_rectangle(entryr,
+                   colno<TEXT_COLUMNS
+                   ? &ocr_celltype_text
+                   : &ocr_celltype_number);
     }
   }
   return 0;
     }
   }
   return 0;
index fd4fcf4f8de99642291fb3e9c5410a2884c642fb..04aecc0d48a0431642d73c85f8b65144fa74b491 100644 (file)
@@ -19,7 +19,7 @@ typedef struct DatabaseNode {
 static const char *context_names[]= {
   "Lower",
   "Upper",
 static const char *context_names[]= {
   "Lower",
   "Upper",
-/*  "Digit"*/
+  "Digit"
 };
 
 #define NCONTEXTS (sizeof(context_names)/sizeof(context_names[0]))
 };
 
 #define NCONTEXTS (sizeof(context_names)/sizeof(context_names[0]))
@@ -144,7 +144,19 @@ static void readdb(OcrReader *rd) {
   }
   eassert(!ferror(db));
   eassert(!fclose(db));
   }
   eassert(!ferror(db));
   eassert(!fclose(db));
-}      
+}
+
+static void cu_pr_ctxmap(unsigned ctxmap) {
+  fprintf(resolver,"{");
+  const char *spc="";
+  int ctxi;
+  for (ctxi=0; ctxi<NCONTEXTS; ctxi++) {
+    if (!(ctxmap & (1u << ctxi))) continue;
+    fprintf(resolver,"%s%s",spc,context_names[ctxi]);
+    spc=" ";
+  }
+  fprintf(resolver,"}");
+}
 
 static void callout_unknown(OcrReader *rd, int w, Pixcol cols[],
                            int unk_l, int unk_r, unsigned unk_ctxmap) {
 
 static void callout_unknown(OcrReader *rd, int w, Pixcol cols[],
                            int unk_l, int unk_r, unsigned unk_ctxmap) {
@@ -175,18 +187,13 @@ static void callout_unknown(OcrReader *rd, int w, Pixcol cols[],
     resolver= fdopen(jobpipe[1],"w"); eassert(resolver);
     resolver_done= donepipe[0];
   }
     resolver= fdopen(jobpipe[1],"w"); eassert(resolver);
     resolver_done= donepipe[0];
   }
-  fprintf(resolver,"%d %d {",unk_l,unk_r);
-  const char *spc="";
-  int ctxi;
-  for (ctxi=0; ctxi<NCONTEXTS; ctxi++) {
-    if (!(unk_ctxmap & (1u << ctxi))) continue;
-    fprintf(resolver,"%s%s",spc,context_names[ctxi]);
-    spc=" ";
-  }
-  fprintf(resolver,"}");
+  fprintf(resolver,"%d %d ",unk_l,unk_r);
+  cu_pr_ctxmap(unk_ctxmap);
   for (i=0, s=rd->results; i<rd->nresults; i++, s++) {
     if (!strcmp(s->s," ")) continue;
   for (i=0, s=rd->results; i<rd->nresults; i++, s++) {
     if (!strcmp(s->s," ")) continue;
-    fprintf(resolver," %d %d %s ",s->l,s->r,context_names[s->ctx]);
+    fprintf(resolver," %d %d ",s->l,s->r);
+    cu_pr_ctxmap(s->ctxmap);
+    fprintf(resolver," ");
     for (p=s->s; (c= *p); p++) {
       if (c=='\\') fprintf(resolver,"\\%c",c);
       else if (c>=33 && c<=126) fputc(c,resolver);
     for (p=s->s; (c= *p); p++) {
       if (c=='\\') fprintf(resolver,"\\%c",c);
       else if (c>=33 && c<=126) fputc(c,resolver);
@@ -247,7 +254,8 @@ static void callout_unknown(OcrReader *rd, int w, Pixcol cols[],
   readdb(rd);
 }
 
   readdb(rd);
 }
 
-static void add_result(OcrReader *rd, const char *s, int l, int r, int ctx) {
+static void add_result(OcrReader *rd, const char *s, int l, int r,
+                      unsigned ctxmap) {
   if (rd->nresults >= rd->aresults) {
     rd->aresults++; rd->aresults<<=1;
     rd->results= realloc(rd->results,sizeof(*rd->results)*rd->aresults);
   if (rd->nresults >= rd->aresults) {
     rd->aresults++; rd->aresults<<=1;
     rd->results= realloc(rd->results,sizeof(*rd->results)*rd->aresults);
@@ -256,23 +264,37 @@ static void add_result(OcrReader *rd, const char *s, int l, int r, int ctx) {
   rd->results[rd->nresults].s= s;
   rd->results[rd->nresults].l= l;
   rd->results[rd->nresults].r= r;
   rd->results[rd->nresults].s= s;
   rd->results[rd->nresults].l= l;
   rd->results[rd->nresults].r= r;
-  rd->results[rd->nresults].ctx= ctx;
+  rd->results[rd->nresults].ctxmap= ctxmap;
   rd->nresults++;
 }
 
   rd->nresults++;
 }
 
-OcrResultGlyph *ocr(OcrReader *rd, int w, Pixcol cols[]) {
-  int nspaces=-w;
-  unsigned ctxmap=2; /* uppercase */
+struct OcrCellTypeInfo {
+  unsigned initial, nextword, midword;
+};
+const struct OcrCellTypeInfo ocr_celltype_number= {
+  4,4,4
+};
+const struct OcrCellTypeInfo ocr_celltype_text= {
+  .initial=2 /* Uppercase */,
+  .nextword=3 /* Either */,
+  .midword=1 /* Lower only */
+};
+
+OcrResultGlyph *ocr(OcrReader *rd, OcrCellType ct, int w, Pixcol cols[]) {
+  int nspaces;
+  unsigned ctxmap;
   int ctxi, i, x;
 
   int ctxi, i, x;
 
-  rd->nresults=0;
+ restart:
 
 
+  nspaces=- w;
+  ctxmap= ct->initial;
+  rd->nresults=0;
   fprintf(debug,"OCR h=%d w=%d",rd->h,w);
   for (x=0; x<w; x++) fprintf(debug," %"PSPIXCOL(PRIx),cols[x]);
   fprintf(debug,"\n");
   debug_flush();
 
   fprintf(debug,"OCR h=%d w=%d",rd->h,w);
   for (x=0; x<w; x++) fprintf(debug," %"PSPIXCOL(PRIx),cols[x]);
   fprintf(debug,"\n");
   debug_flush();
 
- restart:
   x=0;
   for (;;) {
     debug_flush();
   x=0;
   for (;;) {
     debug_flush();
@@ -286,7 +308,7 @@ OcrResultGlyph *ocr(OcrReader *rd, int w, Pixcol cols[]) {
       if (nspaces==3) {
        fprintf(debug,"OCR  x=%x nspaces=%d space\n",x,nspaces);
        add_result(rd," ",x-nspaces,x+1,0);
       if (nspaces==3) {
        fprintf(debug,"OCR  x=%x nspaces=%d space\n",x,nspaces);
        add_result(rd," ",x-nspaces,x+1,0);
-       ctxmap=3; /* either */
+       ctxmap= ct->nextword;
       }
       continue;
     }
       }
       continue;
     }
@@ -296,7 +318,7 @@ OcrResultGlyph *ocr(OcrReader *rd, int w, Pixcol cols[]) {
     int lx=x;
 
     DatabaseNode *uniquematch= 0;
     int lx=x;
 
     DatabaseNode *uniquematch= 0;
-    int uniquematch_rx=-1, uniquematch_ctxi=-1;
+    int uniquematch_rx=-1;
     
     fprintf(debug,"OCR  lx=%d ctxmap=%x  ",lx,ctxmap);
 
     
     fprintf(debug,"OCR  lx=%d ctxmap=%x  ",lx,ctxmap);
 
@@ -336,22 +358,21 @@ OcrResultGlyph *ocr(OcrReader *rd, int w, Pixcol cols[]) {
       }
       
       if (bestmatch) {
       }
       
       if (bestmatch) {
-       if (uniquematch) {
+       if (uniquematch && strcmp(bestmatch->s, uniquematch->s)) {
          fprintf(debug, " ambiguous");
          uniquematch= 0;
          break;
        }
        uniquematch= bestmatch;
        uniquematch_rx= bestmatch_rx;
          fprintf(debug, " ambiguous");
          uniquematch= 0;
          break;
        }
        uniquematch= bestmatch;
        uniquematch_rx= bestmatch_rx;
-       uniquematch_ctxi= ctxi;
       }
     }
 
     if (uniquematch) {
       fprintf(debug," || YES\n");
       }
     }
 
     if (uniquematch) {
       fprintf(debug," || YES\n");
-      add_result(rd, uniquematch->s, lx, uniquematch_rx, uniquematch_ctxi);
+      add_result(rd, uniquematch->s, lx, uniquematch_rx, ctxmap);
       x= uniquematch_rx+1;
       x= uniquematch_rx+1;
-      ctxmap= 1; /* Lower only */
+      ctxmap= ct->midword;
     } else {
       int rx;
       fprintf(debug," || UNKNOWN");
     } else {
       int rx;
       fprintf(debug," || UNKNOWN");
index d08ae15ba8b0878a990b0a135e39fbf84cdbb0e9..a03f1f508dfc5e350f589a9a458c8b138a1783e7 100644 (file)
@@ -19,17 +19,17 @@ typedef uint32_t Pixcol;
 typedef struct {
   const char *s; /* valid until next call to ocr() */
   int l,r; /* column numbers */
 typedef struct {
   const char *s; /* valid until next call to ocr() */
   int l,r; /* column numbers */
-  int ctx; /* match context index */
+  unsigned ctxmap; /* match context index */
 } OcrResultGlyph;
 
 } OcrResultGlyph;
 
-typedef const struct OcrGlyphContextDeveloperInfo *OcrCellContext;
-extern const struct OcrGlyphContextDeveloperInfo *ocr_celltype_text;
-extern const struct OcrGlyphContextDeveloperInfo *ocr_celltype_number;
+typedef const struct OcrCellTypeInfo *OcrCellType;
+extern const struct OcrCellTypeInfo ocr_celltype_text;
+extern const struct OcrCellTypeInfo ocr_celltype_number;
 
 typedef struct OcrReader OcrReader;
 OcrReader *ocr_init(int h);
 
 
 typedef struct OcrReader OcrReader;
 OcrReader *ocr_init(int h);
 
-OcrResultGlyph *ocr(OcrReader *rd, int w, Pixcol cols[]);
+OcrResultGlyph *ocr(OcrReader *rd, OcrCellType, int w, Pixcol cols[]);
   /* return value is array terminated by {0,-1,-1}
    * array is valid until next call to ocr()
    */
   /* return value is array terminated by {0,-1,-1}
    * array is valid until next call to ocr()
    */
index 440f9c6a13a0cc88b994e7bbfd7f76defb9d9dff..d71c36ef6381c54a885ab038dd55ef5b9840c280 100755 (executable)
@@ -69,8 +69,8 @@ proc show_context {maxhv x ctxs} {
     upvar 1 $maxhv maxh
     set w .d.ctx.at$x
     if {[llength $ctxs]==1} { set fg blue } { set fg yellow }
     upvar 1 $maxhv maxh
     set w .d.ctx.at$x
     if {[llength $ctxs]==1} { set fg blue } { set fg yellow }
-    label $w -bg black -fg $fg -text [join $ctxs "/\n "]
-    place $w -x [expr {$x*$mul}] -y 0
+    label $w -bg black -fg $fg -text [join $ctxs "/\n"] -justify left
+    place $w -x [expr {($x-1)*$mul}] -y 0
     set wh [winfo reqheight $w]
     if {$wh > $maxh} { set maxh $wh }
 }
     set wh [winfo reqheight $w]
     if {$wh > $maxh} { set maxh $wh }
 }
@@ -90,8 +90,8 @@ proc resize_widgets {} {
     eval destroy [winfo children .d.ctx]
 
     set maxh 0
     eval destroy [winfo children .d.ctx]
 
     set maxh 0
-    foreach {min max context got} $glyphsdone {
-       show_context maxh $min [list $context]
+    foreach {min max contexts got} $glyphsdone {
+       show_context maxh $min $contexts
     }
     show_context maxh $unk_l $unk_contexts
     .d.ctx configure -height $maxh
     }
     show_context maxh $unk_l $unk_contexts
     .d.ctx configure -height $maxh
@@ -115,8 +115,28 @@ proc read_xpm {f} {
        }
        if {$y==-3} {
            manyset $l cols rows colours cpp
        }
        if {$y==-3} {
            manyset $l cols rows colours cpp
-           #assert {$colours==2}
-           #assert {$cpp==1}
+           if {$colours!=2 || $cpp!=1} { error "$l ?" }
+
+           set chop_l [expr {$unk_l - 80}]
+           set chop_r [expr {$cols - $unk_l - 100}]
+           if {$chop_l<0} { set chop_l 0 }
+
+           set unk_l [expr {$unk_l - $chop_l}]
+           set unk_r [expr {$unk_r - $chop_l}]
+           set ngd {}
+           foreach {min max contexts got} $glyphsdone {
+               lappend ngd \
+                   [expr {$min-$chop_l}] \
+                   [expr {$max-$chop_l}] \
+                   $contexts $got
+           }
+           set glyphsdone $ngd
+
+           set realcols $cols
+           set cols [expr {$cols - $chop_l - $chop_r}]
+           puts stderr "NOW cols=$cols chop_l,r=$chop_l,$chop_r rows=$rows\
+                $unk_l $unk_r $ngd"
+           
            set mulcols [expr {$cols*$mul+$inter}]
            set mulrows [expr {$rows*$mul+$inter}]
            append o "\"$mulcols $mulrows 9 1\",\n"
            set mulcols [expr {$cols*$mul+$inter}]
            set mulrows [expr {$rows*$mul+$inter}]
            append o "\"$mulcols $mulrows 9 1\",\n"
@@ -138,13 +158,19 @@ proc read_xpm {f} {
            set x 0
            set ol "\"+"
            set olh $ol
            set x 0
            set ol "\"+"
            set olh $ol
+           if {$chop_r>=0} {
+               set l [string range $l $chop_l end-$chop_r]
+           } else {
+               set l [string range $l $chop_l end]
+               append l [string repeat " " [expr -$chop_r]]
+           }
            foreach c [split $l ""] {
                set how "u"
                if {$x >= $unk_l && $x <= $unk_r} {
                    set how q
                } else {
                    set ab 0
            foreach c [split $l ""] {
                set how "u"
                if {$x >= $unk_l && $x <= $unk_r} {
                    set how q
                } else {
                    set ab 0
-                   foreach {min max context got} $glyphsdone {
+                   foreach {min max contexts got} $glyphsdone {
                        set rhsmost_max $max
                        if {$x >= $min && $x <= $max} {
                            set how [lindex {a b} $ab]
                        set rhsmost_max $max
                        if {$x >= $min && $x <= $max} {
                            set how [lindex {a b} $ab]
@@ -186,7 +212,7 @@ proc read_xpm {f} {
 proc draw_glyphsdone {} {
     global glyphsdone mul inter
     eval destroy [winfo children .d.got]
 proc draw_glyphsdone {} {
     global glyphsdone mul inter
     eval destroy [winfo children .d.got]
-    foreach {min max context got} $glyphsdone {
+    foreach {min max contexts got} $glyphsdone {
        frame .d.got.m$min -bd 0 -background \#888
        label .d.got.m$min.l -text "$got" -fg white -bg black -bd 0
        pack .d.got.m$min.l -padx 1 -pady 1
        frame .d.got.m$min -bd 0 -background \#888
        label .d.got.m$min.l -text "$got" -fg white -bg black -bd 0
        pack .d.got.m$min.l -padx 1 -pady 1
@@ -397,6 +423,7 @@ proc write_database {} {
     foreach o [lsort $ol] {
        puts $f $o
     }
     foreach o [lsort $ol] {
        puts $f $o
     }
+    puts $f "."
     close $f
     file rename -force $database_fn.new $database_fn
 }
     close $f
     file rename -force $database_fn.new $database_fn
 }
@@ -416,8 +443,8 @@ proc update_database/DEFINE {c0 c1 strq} {
     if {$c0 == $unk_l} {
        set ncontexts $unk_contexts
     } else {
     if {$c0 == $unk_l} {
        set ncontexts $unk_contexts
     } else {
-       foreach {l r context got} $glyphsdone {
-           if {$l==$c0} { set ncontexts [list $context]; break }
+       foreach {l r contexts got} $glyphsdone {
+           if {$l==$c0} { set ncontexts $contexts; break }
        }
        if {![info exists ncontexts]} {
            puts stderr "must start at letter LHS!"
        }
        if {![info exists ncontexts]} {
            puts stderr "must start at letter LHS!"
@@ -432,10 +459,12 @@ proc update_database/DEFINE {c0 c1 strq} {
     write_database
 }
 
     write_database
 }
 
-proc update_database/DELETE {l r ctx} {
+proc update_database/DELETE {l r ctxs} {
     global database
     global database
-    set bm [dbkey $ctx $l $r]
-    unset database($bm)
+    foreach ctx $ctxs {
+       set bm [dbkey $ctx $l $r]
+       catch { unset database($bm) }
+    }
     write_database
 }
     
     write_database
 }