# jldb.tcl - procedures to support a database of natural-language strings
#
###############################################################################
#  Copyright 1992-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.                                              #
###############################################################################

package provide jldb 0.2

# following has side-effect of making sure ::jldb namespace is defined
namespace eval ::jldb {
  namespace export {[a-z]*}
}

# following has side-effect of making sure ::jldb::shortcuts n/s is defined
namespace eval ::jldb::shortcuts {
  namespace export {*}			;# note: non-alphabetic!
}

namespace eval ::jldb {
  ######################################################################
  # global and package variables:
  #
  global env
  global aq_pkg				;# path to package files
  variable db_root			;# path to database files
  variable language			;# language to use
  
  if {![info exists language]} {set language en}
  if {![info exists aq_pkg]} {set aq_pkg /home/js/aqtools/lib/pkg}
  if {![info exists db_root]} {
    set db_root [file join $aq_pkg ldb]
  }
}

######################################################################
# ::jldb::init app - initialise database for application app
######################################################################

proc ::jldb::init { app {lang_arg {}} {db_arg {}} } {
  variable db_root			;# path to database files
  variable language			;# language to use
  if {[string length $lang_arg]} {
    set language $lang_arg
  }
  if {[string length $db_arg]} {
    set db_root $db_arg
  }
  
  ::jldb::read_database $app $language
}

######################################################################
# ::jldb::long_text key [default] -
#   return the natural-language string corresponding to key
######################################################################

proc ::jldb::long_text { key {default {}} } {
  variable db
  
  if {"x$default" == "x"} {
    set default $key
  }
  
  if {[info exists ::jldb::db(s,$key)]} {
    return $::jldb::db(s,$key)
  } else {
    return $default
  }
}

######################################################################
# ::jldb::short_text key [default] -
#   return a short natural-language string corresponding to key
#   same as ::jldb::long_text if no special short string defined
######################################################################

proc ::jldb::short_text { key {default {}} } {
  variable db
  
  if {"x$default" == "x"} {
    set default $key
  }
  
  if {[info exists ::jldb::db(s,SHORT-$key)]} {
    return $::jldb::db(s,SHORT-$key)
  } else {
    if {[info exists ::jldb::db(s,$key)]} {
      return $::jldb::db(s,$key)
    } else {
      return $default
    }
  }
}

######################################################################
# ::jldb::underline key - return underline position, if any, for key
#   returns -1 if no underline position is appropriate
######################################################################

proc ::jldb::underline { key } {
  variable db
  
  if {![info exists db(s,$key)]} {
    return -1
  } else {
    if {[info exists db(u,$key)]} {
      return $db(u,$key)
    } else {
      return -1
    }
  }
}

######################################################################
# ::jldb::binding key - return event sequence, if any, for key
#   returns {} if no event sequence is appropriate
######################################################################

proc ::jldb::binding { key } {
  variable db
  
  if {![info exists db(s,$key)]} {
    return {}
  } else {
    if {[info exists db(b,$key)]} {
      return $db(b,$key)
    } else {
      return {}
    }
  }
}

######################################################################
# ::jldb::accelerator key - return accelerator text, if any, for key
#   returns {} if no event sequence is appropriate
######################################################################

proc ::jldb::accelerator { key } {
  variable db
  
  if {![info exists db(s,$key)]} {
    return {}
  } else {
    if {[info exists db(a,$key)]} {
      return $db(a,$key)
    } else {
      return [::jldb::binding $key]
    }
  }
}


######################################################################
# ::jldb::_source_file app db - load strings from language database db
### PATH NEEDS TO BE MORE FLEXIBLE! ###
######################################################################

proc ::jldb::_source_file { app dbfile } {
  variable db_root
  variable db
  variable language
  
  set db_path [list \
    [file join $db_root $app] \
    [file join $db_root default] \
    [file join [glob ~] .tk jldb $app] \
    [file join [glob ~] .tk jldb default] \
  ]
  
  foreach dir $db_path {
    set fullpath [file join $dir $dbfile]
    if {[file readable $fullpath]} {
      set fd [open $fullpath r]
      set data [read $fd]
      eval ::jldb::set_strings [list $data]
      close $fd
      return
    }
  }
}

######################################################################
# ::jldb::read_database app dbfile -
#   load strings from db and all less specific databases
######################################################################

proc ::jldb::read_database { app dbfile } {
  set parent_db $dbfile
  if {[regexp {\.} $dbfile]} {
    regsub {\.[^\.]*$} $dbfile {} parent_db
    ::jldb::read_database $app $parent_db
  }
  ::jldb::_source_file $app $dbfile
}

######################################################################
# ::jldb::set_strings { {key string}... } -
#   set strings corresponding to keys for a particular language
######################################################################

proc ::jldb::set_strings { list } {
  variable db
  
  foreach item $list {
    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 db(s,$key) $string
    if {"x$underline" != "x"} {
      set db(u,$key) $underline
    }
    if {"x$binding" != "x"} {
      set db(b,$key) $binding
    }
    if {"x$accelerator" != "x"} {
      set db(a,$key) $accelerator
    }
  }
}

######################################################################
# ::jldb::set_defaults { {key string}... } -
#   set strings corresponding to keys for a particular language, like
#   ::jldb::set_strings, but only if they're not already in the database
######################################################################

proc ::jldb::set_defaults { list } {
  variable db
  
  foreach item $list {
    set key [lindex $item 0]
    if {[info exists db(s,$key)]} {	;# already in database, don't re-set
      continue
    }
    set string [lindex $item 1]
    set underline [lindex $item 2]
    set binding [lindex $item 3]
    set accelerator [lindex $item 4]
    set db(s,$key) $string
    if {"x$underline" != "x"} {
      set db(u,$key) $underline
    }
    if {"x$binding" != "x"} {
      set db(b,$key) $binding
    }
    if {"x$accelerator" != "x"} {
      set db(a,$key) $accelerator
    }
  }
}

######################################################################
# Shortcut procedures for getting values from the database.
# These are intended to be imported with
#   "namespace import ::jldb::shortcuts::*"
#   so you can say e.g. "puts [= hello]"
######################################################################

# same as ::jldb::long_text
proc ::jldb::shortcuts::= { key {default {}} } [info body ::jldb::long_text]

# same as ::jldb::short_text
proc ::jldb::shortcuts::- { key {default {}} } [info body ::jldb::short_text]
