Use tmpfile trick for pixmaps too [-iwj]

[ypp-sc-tools.web-live.git] / pctb / dictionary-manager

diff --git a/pctb/dictionary-manager b/pctb/dictionary-manager
index 5079defd1d00abfbc9995a6f439f21efe95758ba..5e108a7ea72583e29a958ac60027dac37f73f845 100755 (executable)
--- a/pctb/dictionary-manager
+++ b/pctb/dictionary-manager
@@ -25,9 +25,10 @@
 # sponsored by Three Rings.
 
 
-# ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict-test/pctb /home/ftp/users/ijackson/pctb/test
 # ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict/pctb /home/ftp/users/ijackson/pctb
 
+# ./dictionary-manager --approve-updates ijackson@login.chiark.greenend.org.uk /home/ijackson/things/ypp-sc-tools.pctb-dict-test/pctb /home/ftp/users/ijackson/pctb/test
+
 # ./dictionary-manager --approve-updates '' . .
 
 
@@ -41,6 +42,9 @@
 #  if it wrote a byte to fd 4, it can take another question
 
 
+set aadepth 2
+
+
 #---------- library routines ----------
 
 proc manyset {list args} {
@@ -141,6 +145,7 @@ static unsigned char csr_bits[] = {
 
     button .pe.ok -text OK
     pack .pe.grid .pe.ok -side left
+    bind .pe.ok <Key-Return> { .pe.ok invoke }
 
     pack .d.mi .d.ctx -side top -anchor w
     pack .d -fill x -padx 2 -pady 2
@@ -284,7 +289,7 @@ proc required/char {} {
     label .selctx.title -text \
        {Select match context for altering dictionary:}
     pack .selctx.title -side left
-    set new_context [lindex $unk_contexts 0]
+    set new_context {}
 
     set ci 0; foreach ctx [lsort [array names all_contexts]] {
        set all_contexts($ctx) $ci
@@ -362,7 +367,9 @@ proc pixmap_select {ncol} {
        if {$col==$ncol} continue
        .pe.grid.l$col selection clear 0 end
     }
-    pixmap_maybe_ok
+    if {[pixmap_maybe_ok]} {
+       focus .pe.ok
+    }
 }
 proc pixmap_maybe_ok {} {
     global alloptions pixmap_selcol pixmap_selrow
@@ -378,8 +385,10 @@ proc pixmap_maybe_ok {} {
     if {$nsel==1} {
        debug "MAYBE_OK YES col=$pixmap_selcol row=$pixmap_selrow."
        .pe.ok configure -state normal -command pixmap_ok
+       return 1
     } else {
        .pe.ok configure -state disabled -command {}
+       return 0
     }
 }
 proc pixmap_ok {} {
@@ -413,8 +422,10 @@ proc required/pixmap {} {
        if {![string length $ppml]} break
        append ppm $ppml "\n"
     }
-    set data [exec pnmscale 2 << $ppm]
-    image create photo image/main -data $data
+    set tmpfile ./#dictimage#.tmp
+    exec pnmscale 2 << $ppm >$tmpfile
+    image create photo image/main -file $tmpfile
+    file delete $tmpfile
 
     set alloptions [exec ./database-info-fetch $unk_what]
 
@@ -448,7 +459,7 @@ proc required/pixmap {} {
     pixmap_maybe_ok
     
     helptext {
-       {{Indicate the meaning of this image, and click OK.}}
+       {{Indicate the meaning of this image; then click OK or hit Return.}}
     }
 }
 
@@ -513,7 +524,7 @@ proc upload_status {} {
 }
 
 proc maybe_upload_entry {im def} {
-    global reqkind privacy_setting env dbname quiet
+    global reqkind privacy_setting env dbname quiet aadepth
 
     debug "DB-UPDATE PRIVACY $privacy_setting"
     if {!$privacy_setting} return
@@ -522,6 +533,8 @@ proc maybe_upload_entry {im def} {
 
     set pl {}
     lappend pl dict $dbname
+    lappend pl version 3
+    lappend pl depth $aadepth
 
     if {$privacy_setting>=2} {
        set pirate [string totitle $env(YPPSC_PIRATE)]
@@ -689,9 +702,11 @@ proc char_read_pgm {f} {
        append o $ointerl
     }
 
-#    debug "DATA $o"
-    set data [exec pnmscale 1 << $o]
-    image create photo image/main -data $data
+    debug "DATA1 $o"
+    set tmpfile ./#dictimage#.tmp
+    exec pnmscale 1 << $o >$tmpfile
+    image create photo image/main -file $tmpfile
+    file delete $tmpfile
 }
 
 #---------- character set editor display ----------
@@ -723,7 +738,7 @@ proc startup_cursor {} {
     global glyphsdone unk_l unk_r
     
     set cur_already [expr {[llength $glyphsdone]/5-1}]
-    set cur_mode 1 ;# one of:   0 1 already text
+    set cur_mode 0 ;# one of:   0 1 already text
 
     set cur_0 $unk_l
     set cur_1 [expr {$unk_r+1}]
@@ -764,7 +779,7 @@ proc recursor//01 {z1} {
        if {[lsearch -exact $okctxts $ctx] >= 0} {
            bind_key [string tolower $key] "
                [list set new_context $ctx]
-                recursor
+               char_start_define_text
             "
        } else {
            bind_key [string tolower $key] {}
@@ -772,7 +787,7 @@ proc recursor//01 {z1} {
        lappend context_help $key
     }
     set context_help [list [join $context_help " "] \
-                         {Set match context for new glyph.}]
+      {Set match context for new glyph, confirm location, and start entry.}]
 
     bind_key space { othercursor }
     bind_leftright_q cur_$z1 0 [expr {$cols-1}]
@@ -897,7 +912,7 @@ proc recursor {} {
 
 # $database($context 0x<bits> 0x<bits>...) = $hex
 
-set database_magic/char {# ypp-sc-tools pctb font v2}
+set database_magic/char "# ypp-sc-tools pctb font v3 depth=$aadepth"
     
 proc read_database_header/char {f} {
     global rows
@@ -1133,10 +1148,10 @@ proc chop_counted {var} {
 }
 
 proc approve_decompose_data {specdata} {
-    global data
+    global data aadepth
     set data $specdata
     
-    regsub-data {^ypp-sc-tools dictionary update v2\n} {}
+    regsub-data "^ypp-sc-tools dictionary update v3 depth=$aadepth\\n" {}
     uplevel 1 chop_counted pirate
     uplevel 1 chop_counted caller
     uplevel 1 chop_counted dict
@@ -1146,7 +1161,7 @@ proc approve_decompose_data {specdata} {
     uplevel 1 chop_counted key
     uplevel 1 chop_counted val
 
-    return [uplevel 1 {list $dict $def $image}]
+    return [uplevel 1 {list $dict $ctx $def $image}]
 }
 
 proc approve_compare {fd1 fd2} {
@@ -1241,6 +1256,8 @@ proc approve_check_server {} {
 
 proc approve_confirm {} {
     global approve_ixes approve_entryhow
+    .ok configure -state disabled
+    update idletasks
     approve_check_server
     foreach ix $approve_ixes {
        set how $approve_entryhow($ix)
@@ -1275,6 +1292,7 @@ proc approve_fetch_list {} {
 
     set approve_list [lsort -command approve_compare $approve_list]
     approve_show_page 0
+    .ok configure -state normal
 }
 
 proc main/approve {} {