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

# THIS IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  # following likely to fail, because done by other libraries too
  namespace import ::jldb::shortcuts::*
}

catch {
  package require aq
  namespace eval ::aq { }			;# so namespace is defined
}

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


######################################################################
# Localisation defaults:
#
::jldb::set_defaults {
  {pref:title {Preferences}}
  
  {title:general_prefs {General}}
  {prefs:language {Language:}}
  {prefs:autoposition {Auto-position dialogue boxes}}
  {prefs:confirm {Confirm actions}}
  {prefs:j_fs_fast {Fast file selector}}
  {prefs:tk_strictMotif {Strict Motif emulation}}
  {prefs:scrollbarside {Scrollbar side}}
  {prefs:visiblebell {Visible bell}}
  {prefs:audiblebell {Audible bell}}
  
  {title:printing_prefs {Printing}}
  {prefs:printer {Printer:}}
  {prefs:printtype {How to print:}}
  {prefs:printcmd {Custom print command:}}
  {prefs:printfile {Output file:}}
  
  {title:keyboard_prefs {Keyboard}}
  {prefs:bindings {Keyboard Bindings:}}
  {prefs:basic {Basic bindings}}
  {prefs:vi {vi bindings}}
  {prefs:edt {EDT bindings}}
  {prefs:emacs {Emacs bindings}}
  {prefs:typeover {Typing replaces selection}}
  
  {title:helper_prefs {Helper Apps}}
  {prefs:web_browser {Web browser:}}
  {prefs:mosaic {Mosaic}}
  {prefs:netscape {Netscape}}
  {prefs:arena {arena}}
  {prefs:lynx {lynx in an xterm}}
  {prefs:man_viewer {Man page viewer:}}
  {prefs:man_builtin {builtin}}
  {prefs:man_tkman {TkMan}}
  {prefs:man_man {man(1) in an xterm}}
  
  {title:screen_font_prefs {Screen Fonts}}
  {prefs:screen_roman_font {Roman font:}}
  {prefs:screen_italic_font {Italic font:}}
  {prefs:screen_bold_font {Bold font:}}
  {prefs:screen_bolditalic_font {Bold italic font:}}
  {prefs:screen_monospace_font {Monospaced font:}}
  {prefs:screen_heading0_font {Title font:}}
  {prefs:screen_heading1_font {Heading 1 font:}}
  {prefs:screen_heading2_font {Heading 2 font:}}
  {prefs:screen_heading3_font {Heading 3 font:}}
  {prefs:screen_heading4_font {Heading 4 font:}}
  {prefs:screen_heading5_font {Heading 5 font:}}
  
  {prefs:ps_prefs {PostScript}}
  {prefs:ps_roman_font {Roman font:}}
  {prefs:ps_italic_font {Italic font:}}
  {prefs:ps_bold_font {Bold font:}}
  {prefs:ps_bolditalic_font {Bold italic font:}}
  {prefs:ps_monospace_font {Monospaced font:}}
  {prefs:ps_heading_font {Heading font:}}
  {prefs:ps_normal_size {Normal font size:}}
  {prefs:ps_monospace_size {Monospaced font size:}}
  {prefs:ps_linespacing {Line spacing:}}
}
######################################################################


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

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

  set file [lindex $args 0]
  global HOME

  if {$directory == {}} then {
    set directory [file join $HOME .tk]
  }

  if {[file isfile [file join $directory $file]]} then {
    uplevel 1 "source [file join $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 } {
  ::aq::parse_args {
    {array J_PREFS}
    {prefix {}}
    {directory {} }
    {file defaults}
  }
  set defaults [lindex $args 0]
  
  set file $file.tcl
  
  global tk_strictMotif
  global  $array
  global HOME
  
  if {"x$directory" == "x"} {
    set directory [file join $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 aq preferences from ~/.tk/defaults
### Does this all need to be here, or can I just rely on the defaults created
###   when the preference panel is set up?

proc j:read_global_prefs {} {
  global J_PREFS
  
  j:pref:read_panel .global_prefs {
    {language en}
    {autoposition 0}
    {confirm 1}
    {j_fs_fast 0}
    {tk_strictMotif 0}
    {scrollbarside right}
    {visiblebell 1}
    {audiblebell 1}
    {printer lp}
    {printtype lpr}
    {printcmd {lpr -P$J_PREFS(printer)}}
    {printfile outputfile}
    {bindings emacs}
    {typeover 1}
    {web_browser mosaic}
    {man_viewer builtin}
    {screen_roman_font {{Helvetica 12}}}
    {screen_italic_font {{Helvetica 12 italic}}}
    {screen_bold_font {{Helvetica 12 bold}}}
    {screen_bolditalic_font {{Helvetica 12 bold italic}}}
    {screen_monospace_font {{Courier 12}}}
    {screen_heading0_font {{Helvetica 24 bold}}}
    {screen_heading1_font {{Helvetica 18 bold}}}
    {screen_heading2_font {{Helvetica 14 bold}}}
    {screen_heading3_font {{Helvetica 12 bold}}}
    {screen_heading4_font {{Helvetica 10 bold}}}
    {screen_heading5_font {{Helvetica 8 bold}}}
    {ps_roman_font {/Times-Roman}}
    {ps_italic_font {/Times-Italic}}
    {ps_bold_font {/Times-Bold}}
    {ps_bolditalic_font {/Times-BoldItalic}}
    {ps_monospace_font {/Courier}}
    {ps_heading_font {/Helvetica}}
    {ps_normal_size {12}}
    {ps_monospace_size {11}}
    {ps_linespacing {14}}
  }
}

# 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 } {
  ::aq::parse_args {
    {array J_PREFS}
    {prefix ""}
    {directory {} }
    {file defaults}
  }
  global $array
  global HOME
  
  set file $file.tcl
  
  if {! [string length $directory]} then {
    set directory [file join $HOME .tk]	;# NOTE: created if necessary!
  }
  
  # make sure that ~ is properly expanded
  regsub -- {^~/} $directory $HOME/ directory
  
  if {! [file isdirectory $directory]} {;# make sure directory exists
    file mkdir $directory
  }
  set f [open [file join $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
}

######################################################################
# j:pref:read_panel - read preferences from file associated with panel
######################################################################

proc j:pref:read_panel { panel { defaults {}} } {
  global JPREF_INFO
  
  set array $JPREF_INFO(panel_array,$panel)
  set file $JPREF_INFO(panel_file,$panel)
  set directory $JPREF_INFO(panel_directory,$panel)
  
  j:read_prefs -array $array -file $file -directory $directory $defaults
}

######################################################################
# j:pref:write_panel - write preferences from array associated with 
#   panel to file associated with panel
######################################################################

proc j:pref:write_panel { panel } {
  global JPREF_INFO
  
  set array $JPREF_INFO(panel_array,$panel)
  set file $JPREF_INFO(panel_file,$panel)
  set directory $JPREF_INFO(panel_directory,$panel)
  
  j:write_prefs -array $array -file $file -directory $directory
}

######################################################################
# j:pref:panel - register new panel
######################################################################

proc j:pref:panel { panel args } {
  ::aq::parse_args {
    {title pref:title}
    {array J_PREFS}
    {file defaults}
    {directory {}}
  }
  global JPREF_INFO			;# various preference info
  global HOME
  upvar #0 $array global		;# this is the variable for this panel
  set global(0) 1			;# make sure it exists and is an array
  
  if {! [string length $directory]} then {
    set directory [file join $HOME .tk]	;# NOTE: created if necessary!
  }
  
  set JPREF_INFO(panel_title,$panel) [::jldb::long_text $title]
  set JPREF_INFO(panel_array,$panel) $array
  set JPREF_INFO(panel_file,$panel) $file
  set JPREF_INFO(panel_directory,$panel) $directory
  # return value
  set panel
}

######################################################################
# j:pref:module - create new module, creating it if necessary
######################################################################

proc j:pref:module { module args } {
  ::aq::debug
  ::aq::parse_args {
    {label {Preferences}}
    {panel .global_prefs}
  }
  global JPREF_MODULES			;# list of defined modules
  global JPREF_INFO			;# various preference info
  
  append JPREF_MODULES($panel) ""	;# make sure it exists
  if {[lsearch -exact $JPREF_MODULES($panel) $module] == -1} {
    ::aq::debug "adding $module to $panel"
    lappend JPREF_MODULES($panel) $module 	;# record existence of module
  }
  set JPREF_INFO(module_name,$module) [::jldb::long_text $label]
  set JPREF_INFO(array,$module) $JPREF_INFO(panel_array,$panel)
  set JPREF_INFO(panel,$module) $panel
}

######################################################################
# j:pref:preference - define new preference
######################################################################

proc j:pref:preference { global module args } {
  ::aq::parse_args {
    {prompt {}}
    {type string}
    {link {}}
    {text {}}
    {values {{{} nothing} {something something}}}
    {default {}}
  }
  global JPREF_MODULES			;# list of defined modules
  global JPREF_PREFS			;# list of prefs in each module
  global JPREF_INFO			;# characteristics of each pref
  
  set panel $JPREF_INFO(panel,$module)	;# panel module is in
  set array \
    $JPREF_INFO(panel_array,$panel)	;# name of global array for preference
  set element [set array]($global)	;# particular element this pref sets
  upvar #0 $element variable		;# alias "variable" to real global
  ::aq::default variable $default		;# set if undefined
  
  # append JPREF_MODULES($panel) ""		;# make sure it exists
  # if {[lsearch -exact $JPREF_MODULES($panel) $module] == -1} {
  #   lappend JPREF_MODULES($panel) $module	;# record name of preference
  # }
  append JPREF_PREFS($module) ""		;# make sure it exists
  if {[lsearch -exact $JPREF_PREFS($module) $global] == -1} {
    lappend JPREF_PREFS($module) $global	;# record name of preference
  }
  append JPREF_INFO(module_name,$module) ""	;# make sure it exists
  set JPREF_INFO(type,$global) $type		;# string, boolean, etc.
  set JPREF_INFO(prompt,$global) $prompt	;# localised when used !!!
  set JPREF_INFO(module,$global) $module	;# not sure this is needed
  set JPREF_INFO(link,$global) $link		;# NOT YET USED
  set JPREF_INFO(text,$global) [::jldb::long_text $text]	;# NOT YET USED
  set JPREF_INFO(values,$global) $values	;# {{en English} {fr French}}
  set JPREF_INFO(default,$global) $default	;# for eg "factory settings"
}

# alias for backwards-compatibility:
proc j:pref:create_pref { global module args } [info body j:pref:preference]

######################################################################
# j:pref:create_global_prefs - create standard prefs for main panel
######################################################################

proc j:pref:create_global_prefs {} {
  j:pref:panel .global_prefs			;# defaults work here
  
  j:pref:module general \
    -label title:general_prefs \
    -panel .global_prefs
  
  j:pref:preference language general \
    -prompt prefs:language \
    -default en
  j:pref:preference autoposition general \
    -type boolean \
    -default 0 \
    -prompt prefs:autoposition
  j:pref:preference confirm general \
    -type boolean \
    -default 1 \
    -prompt prefs:confirm
  j:pref:preference j_fs_fast general \
    -type boolean \
    -default 0 \
    -prompt prefs:j_fs_fast
  j:pref:preference tk_strictMotif general \
    -type boolean \
    -default 0 \
    -prompt prefs:tk_strictMotif
  j:pref:preference scrollbarside general \
    -type radio \
    -default right \
    -values {{left left} {right right}} \
    -prompt prefs:scrollbarside
  j:pref:preference visiblebell general \
    -type boolean \
    -default 1 \
    -prompt prefs:visiblebell
  j:pref:preference audiblebell general \
    -type boolean \
    -default 1 \
    -prompt prefs:audiblebell
  
  j:pref:module printing \
    -label title:printing_prefs \
    -panel .global_prefs
  j:pref:preference printer printing \
    -default lp \
    -prompt prefs:printer
  j:pref:preference printtype printing \
    -type radio \
    -default lpr \
    -values {
      {lpr lpr}
      {lp lp}
      {custom custom}
      {file file}
    } \
    -prompt prefs:printtype
  j:pref:preference printcmd printing \
    -default {lpr -P$J_PREFS(printer)} \
    -prompt prefs:printcmd
  j:pref:preference printfile printing \
    -default {outputfile} \
    -prompt prefs:printfile
  
  j:pref:module keyboard \
    -label title:keyboard_prefs \
    -panel .global_prefs
  
  j:pref:preference bindings keyboard \
    -type radio \
    -default emacs \
    -values {
        {basic basic}
        {vi vi}
        {edt edt}
        {emacs emacs}
      } \
    -prompt prefs:bindings
  j:pref:preference typeover keyboard \
    -type boolean \
    -default 1 \
    -prompt prefs:typeover
  
  j:pref:module helpers \
    -label title:helper_prefs \
    -panel .global_prefs
  j:pref:preference web_browser helpers \
    -type radio \
    -values {
        {mosaic mosaic}
        {netscape netscape}
        {arena arena}
        {lynx lynx}
      } \
    -prompt prefs:web_browser
  
  j:pref:preference man_viewer helpers \
    -type radio \
    -values {
        {builtin builtin}
        {tkman tkman}
        {man man}
      } \
    -prompt prefs:man_viewer
  
  j:pref:module fonts \
    -label title:screen_font_prefs \
    -panel .global_prefs
  
  j:pref:preference screen_roman_font fonts \
    -prompt prefs:screen_roman_font \
    -default {{Helvetica 12}}
  j:pref:preference screen_italic_font fonts \
    -prompt prefs:screen_italic_font \
    -default {{Helvetica 12 italic}}
  j:pref:preference screen_bold_font fonts \
    -prompt prefs:screen_bold_font \
    -default {{Helvetica 12 bold}}
  j:pref:preference screen_bolditalic_font fonts \
    -prompt prefs:screen_bolditalic_font \
    -default {{Helvetica 12 bold italic}}
  j:pref:preference screen_monospace_font fonts \
    -prompt prefs:screen_monospace_font \
    -default {{Courier 12}}
  
  j:pref:preference screen_heading0_font fonts \
    -prompt prefs:screen_heading0_font \
    -default {{Helvetica 24 bold}}
  j:pref:preference screen_heading1_font fonts \
    -prompt prefs:screen_heading1_font \
    -default {{Helvetica 18 bold}}
  j:pref:preference screen_heading2_font fonts \
    -prompt prefs:screen_heading2_font \
    -default {{Helvetica 14 bold}}
  j:pref:preference screen_heading3_font fonts \
    -prompt prefs:screen_heading3_font \
    -default {{Helvetica 12 bold}}
  j:pref:preference screen_heading4_font fonts \
    -prompt prefs:screen_heading4_font \
    -default {{Helvetica 10 bold}}
  j:pref:preference screen_heading5_font fonts \
    -prompt prefs:screen_heading5_font \
    -default {{Helvetica 8 bold}}
  
  j:pref:module ps \
    -label prefs:ps_prefs \
    -panel .global_prefs
  
  j:pref:preference ps_roman_font ps \
    -prompt prefs:ps_roman_font \
    -default /Times-Roman
  j:pref:preference ps_italic_font ps \
    -prompt prefs:ps_italic_font \
    -default /Times-Italic
  j:pref:preference ps_bold_font ps \
    -prompt prefs:ps_bold_font \
    -default /Times-Bold
  j:pref:preference ps_bolditalic_font ps \
    -prompt prefs:ps_bolditalic_font \
    -default /Times-BoldItalic
  j:pref:preference ps_monospace_font ps \
    -prompt prefs:ps_monospace_font \
    -default /Courier
  j:pref:preference ps_heading_font ps \
    -prompt prefs:ps_heading_font \
    -default /Helvetica
  j:pref:preference ps_normal_size ps \
    -prompt prefs:ps_normal_size \
    -default 12
  j:pref:preference ps_monospace_size ps \
    -prompt prefs:ps_monospace_size \
    -default 11
  j:pref:preference ps_linespacing ps \
    -prompt prefs:ps_linespacing \
    -default 14
  
  return .global_prefs
}

proc j:pref:create_standard_prefs {} [info body j:pref:create_global_prefs]

######################################################################
# dummy procedure to call to ensure this file and its language defaults
#   are loaded
######################################################################

proc j:pref:force_jprefs_to_load { args } {}
