#!/usr/bin/env wish8.3
# jldbed.tk - edit jldb databases visually
#
###############################################################################
#  Copyright 1998-2001 by Jay Sekora.  This file may be freely distributed,   #
#  modified or unmodified, for any purpose, provided that this copyright      #
#  notice is retained verbatim in all copies and no attempt is made to        #
#  obscure the authorship of this file.  If you distribute any modified       #
#  versions, I ask, but do not require, that you clearly mark any changes     #
#  you make as such and that you provide your users with instructions for     #
#  getting the original sources.                                              #
###############################################################################
## begin boiler_header

if {[info exists env(AQTOOLS_LIB)]} {
  set aq_library $env(AQTOOLS_LIB)
  set aq_pkg [file join $env(AQTOOLS_LIB) pkg]
} else {
  set aq_library /usr/lib/aq
  set aq_pkg [file join $aq_library pkg]
}

# add the aq library to the library search path:

set auto_path  [concat  [list $aq_pkg]  [list $aq_library]  $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the aq libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header

wm withdraw .

proc load_jldb_file { identifier filename } {
  global db
  if {[file readable $filename]} {
    set fd [open $filename r]
    set data [read $fd]
    
    foreach item $data {
      set_strings $identifier $item
    }
    
    close $fd
    return
  } else {
    error "$filename does not exist or is not a readable file"
  }
}

# DESPERATELY NEEDS ERROR CHECKING
# currently ignores filename argument
#
proc save_jldb_file { id {filename {}}} {
  global db
  global keys_$id
  
  set filename [tk_getSaveFile]
  set fd [open $filename w]
  foreach key [lsort [array names keys_$id]] {
    set string $db($id,s,$key)
    set underline $db($id,u,$key)
    set binding $db($id,b,$key)
    set accelerator $db($id,a,$key)
    set comment $db($id,c,$key)
    
    puts $fd [list $key $string $underline $binding $accelerator $comment]
  }
  close $fd
}

proc set_strings { id item } {
  global db
  global keys_$id
  
  set key [lindex $item 0]
  set string [lindex $item 1]
  set underline [lindex $item 2]
  set binding [lindex $item 3]
  set accelerator [lindex $item 4]
  set comment [lindex $item 5]
  
  set keys_[set id]($key) 1		;# this keeps track of all keys in db
  
  set db($id,s,$key) $string
  set db($id,u,$key) $underline
  set db($id,b,$key) $binding
  set db($id,a,$key) $accelerator
  set db($id,c,$key) $comment
}

proc editing_frame { w key id {editable 1} } {
  global db
  
  frame $w
  # using an entry instead of a frame so it can be scrolled if it's long
  entry $w.key -relief flat -width 15
  $w.key delete 0 end
  $w.key insert end $key
  $w.key configure -state disabled -relief flat
  
  entry $w.string -width 40 -textvariable db($id,s,$key)
  entry $w.underline -width 3 -textvariable db($id,u,$key)
  entry $w.binding -width 15 -textvariable db($id,b,$key)
  entry $w.accelerator -width 5 -textvariable db($id,a,$key)
  entry $w.comment -width 20 -textvariable db($id,c,$key)
  
  if { ! $editable } {
    $w.string configure -state disabled -relief flat
    $w.underline configure -state disabled -relief flat
    $w.binding configure -state disabled -relief flat
    $w.accelerator configure -state disabled -relief flat
    $w.comment configure -state disabled -relief flat
  }
  
  pack $w.key $w.string $w.underline $w.binding $w.accelerator $w.comment \
    -in $w -side left -expand y -fill x
  return $w
}

proc comparative_editing_frames { w key id1 id2 } {
  if {$w == "."} {
    set w ""
  }
  set count 0
  while {[winfo exists $w.ed$count]} {
    incr count
  }
  set f $w.ed$count
  frame $f -borderwidth 1 -relief raised
  pack [editing_frame $f.id1 $key $id1 0] -side top -fill x
  pack [editing_frame $f.id2 $key $id2 1] -side top -fill x
  pack $f -side top -fill x
  return $f
}

proc edit_values { w id1 id2 } {
  global keys_$id1 keys_$id2
  foreach key [lsort [array names keys_$id1]] {
    pack \
      [comparative_editing_frames $w $key $id1 $id2] \
      -side top -fill x
  }
}

proc ask_new_key { args } {
  global j_prompt
  set old_focus [focus]			;# so we can restore original focus

  toplevel .pr
  wm withdraw .pr			;# lets us "update" without flashing
  wm title .pr "New key name"
  
  message .pr.msg -width 300 -anchor w -text "New key name:"
  
  frame .pr.mid				;# has entry, history buttons if any
  entry .pr.mid.e -width 40
  pack .pr.mid.e -in .pr.mid -side left -fill x
  
  frame .pr.b
  button .pr.b.ok -text OK -command {
    set j_prompt(result) [.pr.mid.e get]
    destroy .pr
  }
  button .pr.b.clear -text Clear -command {
    .pr.mid.e delete 0 end
  }
  button .pr.b.cancel -text Cancel -command {
    set j_prompt(result) ""
    destroy .pr
  }
  pack .pr.b.ok .pr.b.clear .pr.b.cancel -side right
  
  pack .pr.msg -side top -fill both -expand yes -padx 10
  pack .pr.mid -side top -padx 10 -pady 10
  pack .pr.b -side bottom -fill x
  frame .pr.rule -width 200 -height 2 -relief sunken
  pack .pr.rule -side bottom -fill x

  .pr.mid.e delete 0 end
  
  focus .pr.mid.e
  update
  wm deiconify .pr
  grab .pr
  tkwait window .pr
  focus -force $old_focus	;# can't figure out a better way...
  return $j_prompt(result)
}

######################################################################

if {[llength $argv] != 3} {
  puts stderr "Usage: $argv0 sourcelang targetlang app"
  puts stderr " e.g.: $argv0 en fr aq"
  exit 1
}

set lang1 [lindex $argv 0]
set lang2 [lindex $argv 1]
set app [lindex $argv 2]

load_jldb_file $lang1 /home/js/aq/lib/pkg/ldb/$app/$lang1
load_jldb_file $lang2 /home/js/aq/lib/pkg/ldb/$app/$lang2

######################################################################

frame .b
button .b.save -width 8 -text Save -command [list save_jldb_file $lang2]
button .b.new -width 8 -text New -command [format {
  set key [ask_new_key]
  if {[string length $key]} {
    set lang1 %s
    set lang2 %s
    foreach lang [list $lang1 $lang2] {
      set keys_[set lang]($key) 1
      foreach letter {s u b a c} {
        set db($lang,$letter,$key) ""
      }
    }
    pack \
      [comparative_editing_frames .scroller.editor $key $lang1 $lang2] \
      -side top -fill x
  }
} [list $lang1] [list $lang2]]
button .b.quit -width 8 -text Quit -command {exit 0}
pack .b.save .b.new .b.quit -side right
pack .b -side bottom -fill x -anchor e

######################################################################

frame .scroller
catch {destroy .scroller.editor}
frame .scroller.editor
edit_values .scroller.editor $lang1 $lang2

update

set width [winfo reqwidth .scroller.editor]
set height [expr [winfo screenheight .] * 0.8]
.scroller configure -width $width
.scroller configure -height $height

scale .v -orient vertical -showvalue 0 \
  -from 0 -to -[winfo reqheight .scroller.editor] \
  -resolution 40 -command \
  {place .scroller.editor -in .scroller -y}

pack .scroller .v -fill y -expand yes -side left

place .scroller.editor -in .scroller -x 0 -y 0

wm deiconify .

