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

######################################################################
# global variables:
#
global J_PREFS env jstools_library JLDB_ROOT
if {! [info exists J_PREFS(language)]} {set J_PREFS(language) en}
if {! [info exists jstools_library]} {set jstools_library /usr/local/jstools}
if {! [info exists JLDB_ROOT]} {set JLDB_ROOT $jstools_library/jldb}

######################################################################
# j:ldb:init app - initialise database for application app
######################################################################

proc j:ldb:init { app } {
  global J_PREFS
  
  set db $J_PREFS(language)
  j:ldb:read_database_recursively $app $J_PREFS(language)
}

######################################################################
# j:ldb key [default] -
#   return the natural-language string corresponding to key
######################################################################

proc j:ldb { key {default {}} } {
  global j_ldb
  
  if {"x$default" == "x"} {
    set default $key
  }
  
  if [info exists j_ldb(s,$key)] {
    set result $j_ldb(s,$key)
  } else {
    set result $default
  }
  
  # using info commands rather than j:tk4 avoids dependency on jtkversion.tcl
  if {"x[info commands subst]" != "x"} {
    set result [uplevel 1 [list subst $result]]
  } else {
    regsub -all {"} $result {\\"} result
    regsub -all {%} $result {%%} result
    set result [uplevel 1 format "\"$result\""]
    					;# uplevel so vars expanded in
    					;# calling proc's context
  }
  return $result
}

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

proc j:ldb:short { key {default {}} } {
  global j_ldb
  
  if {"x$default" == "x"} {
    set default $key
  }
  
  if [info exists j_ldb(s,SHORT-$key)] {
    set result $j_ldb(s,SHORT-$key)
  } else {
    return [uplevel 1 [list j:ldb $key $default]]
  }
  
  # using info commands rather than j:tk4 avoids dependency on jtkversion.tcl
  if {"x[info commands subst]" != "x"} {
    set result [uplevel 1 [list subst $result]]
  } else {
    regsub -all {"} $result {\\"} result
    regsub -all {%} $result {%%} result
    set result [uplevel 1 format "\"$result\""]
    					;# uplevel so vars expanded in
    					;# calling proc's context
  }
  return $result
}

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

proc j:ldb:underline { key } {
  global j_ldb
  
  if {![info exists j_ldb(s,$key)]} {
    return -1
  } else {
    if [info exists j_ldb(u,$key)] {
      return $j_ldb(u,$key)
    } else {
      return -1
    }
  }
}

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

proc j:ldb:binding { key } {
  global j_ldb
  
  if {![info exists j_ldb(s,$key)]} {
    return {}
  } else {
    if [info exists j_ldb(b,$key)] {
      return $j_ldb(b,$key)
    } else {
      return {}
    }
  }
}

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

proc j:ldb:accelerator { key } {
  global j_ldb
  
  if {![info exists j_ldb(s,$key)]} {
    return {}
  } else {
    if [info exists j_ldb(a,$key)] {
      return $j_ldb(a,$key)
    } else {
      return [j:ldb:binding $key]
    }
  }
}


######################################################################
# j:ldb:read_database app db - load strings from language database db
### PATH NEEDS TO BE MORE FLEXIBLE! ###
######################################################################

proc j:ldb:read_database { app db } {
  global JLDB_ROOT
  global j_ldb
  
  set db_path [list \
    $JLDB_ROOT/$app \
    $JLDB_ROOT/default \
    [glob ~]/.tk/jldb/$app \
    [glob ~]/.tk/jldb/default \
  ]
  
  foreach dir $db_path {
    if [file readable $dir/$db] {
      source $dir/$db
      return
    }
  }
}

######################################################################
# j:ldb:read_database_recursively app db -
#   load strings from db and all less specific databases
######################################################################

proc j:ldb:read_database_recursively { app db } {
  set parent_db $db
  if [regexp {\.} $db] {
    regsub {\.[^\.]*$} $db {} parent_db
    j:ldb:read_database_recursively $app $parent_db
  }
  j:ldb:read_database $app $db
}

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

proc j:ldb:set_strings { list } {
  global j_ldb
  
  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 j_ldb(s,$key) $string
    if {"x$underline" != "x"} {
      set j_ldb(u,$key) $underline
    }
    if {"x$binding" != "x"} {
      set j_ldb(b,$key) $binding
    }
    if {"x$accelerator" != "x"} {
      set j_ldb(a,$key) $accelerator
    }
  }
}

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

proc j:ldb:set_defaults { list } {
  global j_ldb
  
  foreach item $list {
    set key [lindex $item 0]
    if [info exists j_ldb(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 j_ldb(s,$key) $string
    if {"x$underline" != "x"} {
      set j_ldb(u,$key) $underline
    }
    if {"x$binding" != "x"} {
      set j_ldb(b,$key) $binding
    }
    if {"x$accelerator" != "x"} {
      set j_ldb(a,$key) $accelerator
    }
  }
}
