# jprefpanel.tcl - preference panel(s) and related tools
#
######################################################################
# 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 env
::aq::default J_PREFS(autoposition) 0
::aq::default J_PREFS(confirm) 1
#
######################################################################

######################################################################
# Localisation defaults:
#
::jldb::set_defaults {
  {prefs:done {Done}}
  {prefs:save {Save}}
  {title:prefs {Global Preferences}}
  {{Font:} {Font:}}
}
######################################################################

######################################################################
# make sure jprefs.tcl (and its ldb defaults) are loaded:
#
j:pref:force_jprefs_to_load
######################################################################

######################################################################
# j:global_pref_panel ?options? - preferences panel for ~/.tk/defaults
# options include
#   -title - title of toplevel window
### ADD COLOURS?
######################################################################

proc j:global_pref_panel { args } {
  j:pref:show_panel .global_prefs
}

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

######################################################################
# j:pref:string_ui w ?options? - labelled UI for global variable
# BOGUSNESS:  you need to know that the entry is $newframe.e
#   in order to bind to it!
######################################################################

proc j:pref:string_ui {args} {
  ::aq::parse_args {
    {label {Value:} }
    {variable value }
    {labelwidth {30} }
    {entrywidth {40} }
  }
  global $variable
  
  set label [::jldb::long_text $label]
  
  set newframe [lindex $args 0]
  
  frame $newframe
  set l $newframe.l
  set e $newframe.e
  label $l -text $label -width $labelwidth -anchor e
  entry $e -width $entrywidth -textvariable $variable
  
  pack $l -in $newframe -side left
  pack $e -in $newframe -side left -fill x
  
  return $newframe
}

######################################################################
# j:pref:boolean_ui w ?options? - labelled UI for global variable
######################################################################

proc j:pref:boolean_ui {args} {
  ::aq::parse_args {
    {label {Value:} }
    {variable value }
    {labelwidth {30} }
    {buttonwidth {40} }
  }
  global $variable
  
  set label [::jldb::long_text $label]
  
  set newframe [lindex $args 0]
  
  frame $newframe
  set l $newframe.l
  set cb $newframe.cb
  label $l -text $label -width $labelwidth -anchor e
  checkbutton $cb \
    -variable $variable -width $buttonwidth -anchor w -text " "
  
  pack $l -in $newframe -side left
  pack $cb -in $newframe -side left -fill x
  
  return $newframe
}

######################################################################
# j:pref:radio_ui w ?options? - labelled UI for global variable
######################################################################

proc j:pref:radio_ui {args} {
  ::aq::parse_args {
    {label {Value:} }
    {variable value }
    {labelwidth {30} }
    {buttonwidth {40} }
    {values {{1 this} {2 that} {3 {the other}}}}
  }
  global $variable
  
  set label [::jldb::long_text $label]
  
  set newframe [lindex $args 0]
  frame $newframe
  foreach valuepair $values {
    set value [lindex $valuepair 0]
    set text [lindex $valuepair 1]
    set f $newframe.f$value
    set l $f.l
    set rb $f.rb
    frame $f
    label $l -text $label -width $labelwidth -anchor e
    radiobutton $rb \
      -variable $variable -text $text \
      -width $buttonwidth -anchor w -value $value
    
    pack $l -in $f -side left
    pack $rb -in $f -side left -fill x
    
    pack $f -in $newframe -side top -fill x
    set label " "			;# so only first line is labelled
  }
  
  return $newframe
}

######################################################################
# j:pref:colour_ui w ?options? - labelled UI for global variable
######################################################################

proc j:pref:colour_ui {args} {
  ::aq::parse_args {
    {label {Colour:} }
    {variable value }
  }
  # need to support following:
  #  {labelwidth {30} }
  #  {buttonwidth {40} }
  
  global $variable
  
  set label [::jldb::long_text $label]
  
  set newframe [lindex $args 0]
  ::aq::colour_chooser $newframe -label $label -variable $variable
  return $newframe
}

proc j:pref:color_ui {args} [info body j:pref:colour_ui]

######################################################################
# j:pref:show_module module - cause panel to show prefs for module
######################################################################

proc j:pref:show_module { module } {
  global JPREF_INFO
  
  set w $JPREF_INFO(panel,$module)
  if {![winfo exists $w]} {
    j:pref:create_panel $w
  }
  catch {destroy $w.mid.module}
  j:pref:module_ui $w.mid.module $module
  place $w.mid.module -in $w.mid -relx 0.5 -rely 0.5 -anchor c
}

######################################################################
# j:pref:module_ui w module - create pref panel for module
######################################################################

proc j:pref:module_ui { w module } {
  global JPREF_PREFS JPREF_INFO
  
  frame $w
  label $w.l -text $JPREF_INFO(module_name,$module)
  pack $w.l [::aq::filler $w] -fill x
  set count 0
  foreach pref $JPREF_PREFS($module) {
    set panel $JPREF_INFO(panel,$module)
    set array $JPREF_INFO(panel_array,$panel)	;# name of array for module
    set element [set array]($pref)		;# array element this pref sets
    switch -exact $JPREF_INFO(type,$pref) {
      string {
        j:pref:string_ui $w.pref$count \
          -label $JPREF_INFO(prompt,$pref) \
          -variable $element
        pack $w.pref$count -in $w -side top -fill x -anchor w -expand 1
      }
      boolean {
        j:pref:boolean_ui $w.pref$count \
          -label $JPREF_INFO(prompt,$pref) \
          -variable $element
        pack $w.pref$count -in $w -side top -fill x -anchor w -expand 1
      }
      radio {
        j:pref:radio_ui $w.pref$count \
          -label $JPREF_INFO(prompt,$pref) \
          -values $JPREF_INFO(values,$pref) \
          -variable $element
        pack $w.pref$count -in $w -side top -fill x -anchor w -expand 1
      }
      colour {
        j:pref:colour_ui $w.pref$count \
          -label $JPREF_INFO(prompt,$pref) \
          -variable $element
        pack $w.pref$count -in $w -side top -fill x -anchor w -expand 1
      }
      color {
        j:pref:colour_ui $w.pref$count \
          -label $JPREF_INFO(prompt,$pref) \
          -variable $element
        pack $w.pref$count -in $w -side top -fill x -anchor w -expand 1
      }
      default {
        # default to handling as a string preference:
        j:pref:string_ui $w.pref$count \
          -label $JPREF_INFO(prompt,$pref) \
          -variable $element
        pack $w.pref$count -in $w -side top -fill x -anchor w -expand 1
      }
    }
    incr count
  }
  return $w
}

######################################################################
# j:pref:create_panel w - create pref panel
######################################################################

proc j:pref:create_panel { panel } {
  global JPREF JPREF_MODULES JPREF_INFO AQSYSINFO
  
  catch {destroy $panel}		;# make sure it doesn't already exist
  
  # Create an array so we can map from module labels to modules
  # Also create a list of the module names
  set title $JPREF_INFO(panel_title,$panel)
  set JPREF(module_names,$panel) {}
  foreach module $JPREF_MODULES($panel) {
    set JPREF(module,$JPREF_INFO(module_name,$module)) $module
    lappend JPREF(module_names,$panel) $JPREF_INFO(module_name,$module)
  }
  
  toplevel $panel
  wm title $panel $title
  set count 0
  pack [frame $panel.top] -fill x
  ::aq::option_button $panel.top.moduleoption \
    -list $JPREF(module_names,$panel) \
    -variable JPREF(current_module) \
    -command {j:pref:show_module $JPREF(module,$JPREF(current_module))}
  pack $panel.top.moduleoption -anchor c -pady 5
  pack [::aq::rule $panel] -fill x
  if {! $AQSYSINFO(tinyscreen)} {
    pack [frame $panel.mid -width 500 -height 300]	;######## DON'T HARDCODE
    pack propagate $panel.mid 0
  } else {
    frame $panel.mid_back
    
    set canvwidth [expr [winfo screenwidth $panel] * 0.75]
    if {$canvwidth > 500} {set canvwidth 500}
    set canvheight [expr [winfo screenheight $panel] * 0.66]
    if {$canvheight > 300} {set canvheight 300}
    
    canvas $panel.mid_canvas \
      -width $canvwidth -height $canvheight \
      -yscrollcommand "$panel.mid_sb_y set" \
      -xscrollcommand "$panel.mid_sb_x set" \
      -scrollregion {0 0 404 304}
    frame $panel.mid -width 400 -height 300	;######## DON'T HARDCODE
    scrollbar $panel.mid_sb_y -command "$panel.mid_canvas yview"
    scrollbar $panel.mid_sb_x -command "$panel.mid_canvas xview" \
      -orient horizontal
    $panel.mid_canvas create window 2 2 -window $panel.mid -anchor nw
    
    grid $panel.mid_canvas \
      -in $panel.mid_back -sticky nsew \
      -column 0 -row 0 \
      -columnspan 1 -rowspan 1
    grid $panel.mid_sb_y \
      -in $panel.mid_back -sticky nsew \
      -column 1 -row 0 \
      -columnspan 1 -rowspan 1
    grid $panel.mid_sb_x \
      -in $panel.mid_back -sticky nsew \
      -column 0 -row 1 \
      -columnspan 1 -rowspan 1
    grid columnconfigure $panel.mid_back 0 -weight 1
    grid rowconfigure $panel.mid_back 0 -weight 1
    pack $panel.mid_back
    lower $panel.mid_canvas $panel.top
    lower $panel.mid_back $panel.mid_canvas
  }
  pack [::aq::rule $panel] -fill x
  
  ::aq::buttonbar $panel.b -default save -buttons [format {
    {
      save prefs:save {
        j:pref:write_panel %s
        destroy %s
      }
    } {
      done prefs:done {
        destroy %s
      }
    }
  } $panel $panel $panel]
  pack $panel.b -side right
  ::aq::dialogue $panel		;# position nicely
}

######################################################################
# j:pref:show_panel w - create w if necessary and show first module
######################################################################

proc j:pref:show_panel { panel } {
  global JPREF_MODULES JPREF_INFO
  
  j:pref:create_panel $panel

  set old_focus [focus]			;# so we can restore original focus
  set module \
    [lindex $JPREF_MODULES($panel) 0]	;# find first pref module in panel
  j:pref:show_module $module		;# display module
  grab $panel
  tkwait window $panel
  focus -force $old_focus		;# can't figure out a better way...
}
