#!/usr/bin/env wish8.3
# aqdb - manage databases (eg of addresses)
#
###############################################################################
#  Copyright 1992-2002 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.                                              #
###############################################################################
## begin boiler_header

if {[info exists env(AQTOOLS_LIB)]} {
  set aq_library $env(AQTOOLS_LIB)
  set aq_pkg [file join $env(AQTOOLS_LIB) pkg]
} else {
  set aq_library /usr/lib/aq
  set aq_pkg [file join $aq_library pkg]
}

# add the aq library to the library search path:

set auto_path  [concat  [list $aq_pkg]  [list $aq_library]  $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the aq libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header

# the import 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
}

namespace eval ::aqdb { }			;# so namespace is defined
namespace eval ::aqdb::cmd { }		;# so namespace is defined

######################################################################
# BASIC INITIALISATION - VARIABLES AND USER CONFIGURATION
######################################################################

# misc:
#
global NAME			;# user's login name
global HOME			;# user's home directory

global J_PREFS AQDB_PREFS	;# user preferences

::aq::aq_init aqdb		;# prefs, libraries, bindings...

if {! [file isdirectory [file join $HOME .tk aqdb]]} {
  file mkdir [file join $HOME .tk aqdb]
}

# read in (shared) preferences:
j:read_global_prefs
switch -exact $J_PREFS(bindings) {
  basic {
    j:eb:basic_bind Entry
    j:tb:basic_bind Text
  }
  emacs {
    j:eb:emacs_bind Entry
    j:tb:emacs_bind Text
  }
  vi {
    j:eb:basic_bind Entry
    j:tb:vi_bind Text
  }
}
j:pref:panel .aqdb -array AQDB_PREFS \
  -title {Database Preferences} \
  -file aqdb-defaults
j:pref:module files -panel .aqdb -label "Files"
j:pref:module tags -panel .aqdb -label "Tags"

j:pref:preference datafile files \
  -prompt {Database file:} -default ~/.aqdb
foreach tag {0 1 2 3 4 5 6} {
  j:pref:preference tag$tag tags -prompt "Tag $tag:" -default {}
}
j:pref:preference tag7 tags -prompt "Tag 7:" -default Alternate

# read in people browser prefs:
j:pref:read_panel .aqdb {
  {datafile ~/.aqdb}
  {tag0 {}}
  {tag1 {}}
  {tag2 {}}
  {tag3 {}}
  {tag4 {}}
  {tag5 {}}
  {tag6 {}}
  {tag7 {Alternate}}
}

if {$AQSYSINFO(tinyscreen)} {
  wm minsize . $AQSYSINFO(min_width) $AQSYSINFO(min_height)
  . configure -width 240 -height 320
} else {
  . configure -width 240 -height 480
}


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


proc ::aqdb::set_mode { mode } {
  global HOME
  global aq_library
  
  set file ${mode}.tcl
  
  set NOTFOUND 1
  
  foreach directory [list \
    [file join $HOME .tk aqdb] \
    [file join $aq_library aqdb] \
  ] {
    if {[file isfile [file join $directory $file]]} {
      ::aq::debug "Reading $file in $directory."
      set NOTFOUND 0
      j:source_config -directory $directory $file
      break
    }
  }
  
  if {$NOTFOUND} {
    wm withdraw .
    
    ::aq::alert -title Error -text \
       "Don't know how to handle files of type \"$mode\" - can't find an\
appropriate configuration file."
    exit 1
  }
}

proc ::aqdb::new_id {} {
  variable ::aqdb::db
  
  # set id 0
  set id 192837465
  while {[info exists ::aqdb::db($id)]} {
    incr id
  }
  
  return $id
}

proc ::aqdb::mk_record_ui { w id } {
  # PROBLEM - The frame packed inside the canvas doesn't resize when
  # the window is resized.  I've tried binding to the Expose and 
  # Configure events, and I haven't been able to get it to work.
  
  variable ::aqdb::fieldpairs
  variable ::aqdb::record$id
  variable ::aqdb::db
  
  array unset ::aqdb::record$id		;# start with blank slate
  set datapairs {}			;# if id not already in db array
  catch {
    set datapairs $::aqdb::db($id)
  }
  
  array set ::aqdb::record$id $datapairs
  
  frame $w
  
  foreach pair $fieldpairs {
    set index [lindex $pair 0]
    set label [lindex $pair 1]
    
    frame $w.f$index
    label $w.f$index.l -width 10 -text ${label}: -anchor e
    entry $w.f$index.e -width 10 -textvariable ::aqdb::record[set id]($index)
    pack $w.f$index.l -side left
    pack $w.f$index.e -side left -fill x -expand 1
  }
  
  if {! [info exists ::aqdb::ui]} {
    foreach pair $fieldpairs {
      set index [lindex $pair 0]
      pack $w.f$index -side top -fill x -expand 1
    }
  } else {
    # quick-and-dirty custom UI - just pack stuff in, with labels
    # in the future, each panel (except the main one) is going to be in 
    #   its own frame, with an optionbutton to select the desired frame.
    foreach panel $::aqdb::ui {
      set name [lindex $panel 0]
      
      # label the panel, if its name isn't null
      if {[string length $name]} {
        label $w.l$name -text ${name}: -anchor w
        pack $w.l$name -side top -fill x -expand 1
      }
      
      # pack each field in this panel
      foreach item [lrange $panel 1 end] {
        set index [lindex $item 0]
        pack $w.f$index -side top -fill x -expand 1
      }
    }
  }
  update idletasks
  
  return $w
}

proc ::aqdb::edit_record { id } {
  global AQSYSINFO
  
  set w [::aq::new_toplevel .id]
  $w configure -width 240 -height 480
  pack propagate $w 0
  wm title $w "DB Edit"
  if {$AQSYSINFO(tinyscreen)} {
    wm minsize $w $AQSYSINFO(min_width) $AQSYSINFO(min_height)
  }
  
  ############################################################################
  # Following should really be a buttonbar (at least on a large screen)
  ############################################################################
  frame $w.b
  pack $w.b -side bottom -fill x
  
  button $w.b.done -text "Done" \
    -command "::aqdb::record_edit_done $id ; destroy $w"
  button $w.b.del -text "Delete" \
    -command "
      if {\[::aq::confirm -priority 10 -text {Delete this record?}\]} {
        unset ::aqdb::db($id)
        destroy $w
        ::aqdb::pickfields_to_listbox .picker.lb
      }
    "
  button $w.b.cancel -text "Cancel" \
    -command "destroy $w"
  
  pack $w.b.done $w.b.del $w.b.cancel -side right
  
  label $w.b.id -text "ID: $id" -anchor w -foreground gray33
  pack $w.b.id -side left
  ############################################################################
  
  frame $w.f -highlightthickness 0 -borderwidth 0
  canvas $w.c -highlightthickness 0 -borderwidth 0
  
  place $w.c -in $w.f -relwidth 1.0 -relheight 1.0
  
  scrollbar $w.s -command "$w.c yview"
  if {$AQSYSINFO(tinyscreen)} {
    # following might help usability with xstroke keyboard recognition
    # on PDAs:
    
    $w.s configure -takefocus 0
  }
  ::aqdb::mk_record_ui $w.c.rec $id
  
  update idletasks
  $w.c configure -width [expr {
    [winfo width $w] - [winfo reqwidth $w.s] - [$w cget -borderwidth] * 2
  }]
  
  
  $w.c configure -width [expr {
    [winfo width $w] - [winfo reqwidth $w.s] - [$w cget -borderwidth] * 2
  }]
  
  $w.c configure -yscrollcommand "$w.s set"
  $w.c create window 2 2 -window $w.c.rec -tag recordframe -anchor nw
  $w.c itemconfigure recordframe -width [$w.c cget -width]
  
  $w.c configure -scrollregion \
    [list 0 0 [winfo width $w.c.rec] [winfo reqheight $w.c.rec]]
  
  pack $w.f -fill both -expand 1 -side left
  pack $w.s -fill y -side left
}

proc ::aqdb::record_edit_done { id } {
  variable ::aqdb::record$id
  variable ::aqdb::db
  
  set ::aqdb::db($id) {}
  
  # add all elements with non-empty values to the record
  # (only adding non-empty values saves lots of space)
  #
  foreach {index value} [array get ::aqdb::record$id] {
    if {[string length $value]} {
      lappend ::aqdb::db($id) $index $value
    }
  }
  
  # if *all* fields were empty, the list of key-value pairs will also
  # be empty.  don't bother saving that.
  
  if {[llength $::aqdb::db($id)] == 0} {
    unset ::aqdb::db($id)
  }
  ::aqdb::pickfields_to_listbox .picker.lb
}

proc ::aqdb::delete_record { id } {
  variable ::aqdb::db
  catch {
    unset ::aqdb::db($id)
  }
}

proc ::aqdb::get_pickfields { args } {
  variable ::aqdb::pickfields		;# fields shown in picker
  variable ::aqdb::db
  
  ::aq::parse_args {
    filter {}
  }
  
  set values {}
  foreach id [array names ::aqdb::db] {
    array unset record
    array set record $::aqdb::db($id)
    
    set list {}
    foreach field $::aqdb::pickfields {
      set value ""
      catch {set value $record($field)}
      if {[string length $value]} {
        lappend list $value
      }
    }
    lappend list "ID $id"
    set line [join $list ", "]
    if {[regexp -nocase -- $filter $line]} {
      lappend values $line
    }
  }
  return $values
}

proc ::aqdb::pickfields_to_listbox { lb args } {
  ::aq::parse_args {
    filter {}
  }
  
  $lb delete 0 end
  eval [list $lb insert end] \
    [lsort -dictionary [::aqdb::get_pickfields -filter $filter]]
}

proc ::aqdb::mk_picker_window {} {
  global filename
  global AQSYSINFO
  
  variable ::aqdb::fieldpairs
  variable ::aqdb::pickfields		;# fields shown in picker
  variable ::aqdb::db
  
  set w .picker				;# There can be only one!
  
  if {[winfo exists $w]} {
    bind $w <Destroy> {}
    destroy $w
  }
  
  frame $w
  wm title [winfo toplevel $w] "DB Pick"
  bind $w <Destroy> {exit 0}
  place $w -in . -relwidth 1.0 -relheight 1.0
  
  ############################################################################
  # Following should really be a buttonbar (at least on a large screen)
  ############################################################################
  frame $w.b
  pack $w.b -side bottom -fill x
  
  button $w.b.quit -text "Quit" \
    -command "exit 0"
  button $w.b.load -text "Load" \
    -command "
      ::aqdb::load_file $filename
      ::aqdb::pickfields_to_listbox .picker.lb
    "
  button $w.b.save -text "Save" \
    -command "
      ::aqdb::save_file $filename
      ::aqdb::pickfields_to_listbox .picker.lb
    "
  button $w.b.new -text "New" \
    -command "
      ::aqdb::edit_record \[::aqdb::new_id\]
    "
  
  pack $w.b.quit $w.b.load $w.b.save $w.b.new -side right
  
  frame $w.file
  label $w.file.l -text "File:"
  entry $w.file.e -textvariable filename
  
  pack $w.file.l -side left
  pack $w.file.e -side left -expand 1 -fill x
  pack $w.file -side bottom -fill x
  
  frame $w.filter
  button $w.filter.filter -text "Filter:" -command "
    ::aqdb::pickfields_to_listbox $w.lb -filter \[$w.filter.e get\]
  "
  entry $w.filter.e
  button $w.filter.clear -text "Clear" -command "
    $w.filter.e delete 0 end
  "
  bind $w.filter.e <Return> "$w.filter.filter invoke"
  focus $w.filter.e
    
  pack $w.filter.filter -side left
  pack $w.filter.e -side left -expand 1 -fill x
  pack $w.filter.clear -side left
  pack $w.filter -side top -fill x
  
  ############################################################################
  listbox $w.lb -yscrollcommand "$w.sb set"
  scrollbar $w.sb -command "$w.lb yview"
  if {$AQSYSINFO(tinyscreen)} {
    # following might help usability with xstroke keyboard recognition
    # on PDAs:
    
    $w.sb configure -takefocus 0
  }
  
  pack $w.lb -side left -expand 1 -fill both
  pack $w.sb -side left -fill y
  
  ::aqdb::pickfields_to_listbox $w.lb
  
  bind $w.lb <Double-1> {
    ::aqdb::edit_record [::aqdb::selected_id_in %W]
  }
}

proc ::aqdb::selected_id_in { w } {
  set numselections [llength [$w curselection]]
  
  if {$numselections == 0} {
    error "No selection"
  } elseif {$numselections > 1} {
    error "Too many selections"
  } else {
    set line [$w get [$w curselection]]
    regsub -all {.*, *ID ([0-9a-zA-Z_]*) *$} $line {\1} id
    
    return $id
  }
}

proc ::aqdb::merge_file { filename } {
  # This is a no-op if the file doesn't exist
  if {[file exists $filename]} {
    array set ::aqdb::db [::aq::read_file $filename]
  }
}

proc ::aqdb::load_file { filename } {
  array unset ::aqdb::db
  ::aqdb::merge_file $filename
}

proc ::aqdb::save_file { filename } {
  if {[file exists $filename]} {
    catch {file delete $filename.bak}
    file rename $filename $filename.bak
  }
  
  ::aq::write_file $filename [array get ::aqdb::db]
}

if {[llength $argv] == 1} {
  set filename [lindex $argv 0]
} else {
  error "No filename specified."
}

set type [file extension $filename]

if {! [string length $type]} {
  error "Filename \"$filename\" has no extension - don't know what kind of database it is"
  exit 1
}

::aqdb::set_mode [string trimleft $type .]

::aqdb::load_file $filename

::aqdb::mk_picker_window
