# jprefs.tcl - utilities for user preferences and configuration
#
######################################################################
# 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.     #
######################################################################

### TO DO

######################################################################
# global variables:
#
global J_PREFS env
j:default J_PREFS(autoposition) 0
j:default J_PREFS(confirm) 1
#
######################################################################


######################################################################
# j:source_config ?options? file - read user configuration from a file
#   option is -directory
# file is assumed to be in env(HOME)/.tk unless dir is specified
# NOTE: this can also be used just to source an arbitrary Tcl file
######################################################################

proc j:source_config { args } {
  j:parse_args { {directory {} } }

  set file [lindex $args 0]
  global env

  if {$directory == {}} then {
    set directory $env(HOME)/.tk
  }

  if {[file isfile "$directory/$file"]} then {
    uplevel 1 "source $directory/$file"
  }
}

######################################################################
# j:read_prefs ?options? defaults - read preferences from file, set array
# options are:
#   -file (default defaults)
#   -directory (default ~/.tk)
#   -array (default J_PREFS)
#   -prefix (default "")
# <defaults> is a list of two-element sublists.  the first element of
#   each sublist is the name of the default (in the file and in the
#   $array array); the second is the value to use if no such default
#   exists (ie, the hardwired application default)
# If a _default_ is "tk_strictMotif", it sets the element of $array,
#   but also the global tk_strictMotif variable
# If -prefix is non-null, it (plus a comma) is prepended to each 
#   preference name, so that for instance you can set -prefix to
#   "friend" and access preferences (and array indices) like
#   "friend,name", "friend,age", etc.
######################################################################

proc j:read_prefs { args } {
  j:parse_args {
    {array J_PREFS}
    {prefix {}}
    {directory {} }
    {file defaults}
  }
  set defaults [lindex $args 0]
  
  set file $file.tcl
  
  global env tk_strictMotif $array
  
  if {"x$directory" == "x"} {
    set directory $env(HOME)/.tk	;# NOTE: created if necessary!
  }
  
  if {"x$prefix" != "x"} {		;# if prefix is non-null...
    set prefix "$prefix,"		;# ...add a comma to it
  }
  
  set [format {%s(0)} $array] 1		;# dummy to make sure it's an array

  foreach pair $defaults {
    set pref_name [lindex $pair 0]
    set hard_default [lindex $pair 1]
    
    set [format %s($prefix$pref_name) $array] $hard_default
  }
  
  j:source_config -directory $directory $file

  foreach pair $defaults {
    set pref_name [lindex $pair 0]
    set hard_default [lindex $pair 1]
    
    if {"x$pref_name" == "xtk_strictMotif"} {
      set tk_strictMotif [set [format %s($prefix$pref_name) $array]]
    }
  }
}

######################################################################
# j:read_global_prefs - read common jstools preferences from ~/.tk/defaults
######################################################################

proc j:read_global_prefs {} {
  global J_PREFS
  
  j:read_prefs {
    {language en}
    {autoposition 0}
    {bindings basic}
    {typeover 1}
    {confirm 1}
    {visiblebell 1}
    {audiblebell 1}
    {printer lp}
    {scrollbarside right}
    {j_fs_fast 0}
    {tk_strictMotif 0}
    {web_browser mosaic}
    {man_viewer builtin}
  }
}

# alias for backwards-compatibility:
proc j:read_standard_prefs {} [info body j:read_global_prefs]

######################################################################
# j:write_prefs ?options? - write X defaults to file from array
# options are:
#   -file (default defaults)
#   -directory (default ~/.tk)
#   -array (default J_PREFS)
#   -prefix (default "")
# writes all elements of array $array
# If -prefix is null, writes all elements of array $array which
#   don't have a comma in their names.
# If -prefix is non-null, writes all elements of array $array whose
#   names start with "$prefix,"
# For instance you can set -prefix to "friend" and access preferences
#   (and array indices) like "friend,name", "friend,age", etc.
######################################################################

proc j:write_prefs { args } {
  j:parse_args {
    {array J_PREFS}
    {prefix ""}
    {directory {} }
    {file defaults}
  }
  global env $array
  
  set file $file.tcl
  
  if {"x$directory" == "x"} then {
    set directory $env(HOME)/.tk	;# NOTE: created if necessary!
  }

  if {! [file isdirectory $directory]} {;# make sure directory exists
    exec mkdir -p $directory
  }
  set f [open $directory/$file {w}]
  
  if {"x$prefix" == "x"} {		;# just names with no comma
    foreach pref_name [lsort [array names $array]] {
      if {[string first , $pref_name] == -1} {
        set value [set [format {%s(%s)} $array $pref_name]]
        puts $f [list set ${array}(${pref_name}) ${value}]
      }
    }
  } else {
    foreach pref_name [lsort [array names $array]] {
      if [string match "$prefix,*" $pref_name] {
        set value [set [format {%s(%s)} $array $pref_name]]
        puts $f [list set ${array}(${pref_name}) ${value}]
      }
    }
  }
  
  close $f
  return 0
}


