# jhistory.tcl - tools to manage short "histories"
#
######################################################################
# Copyright 1992-1999 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.     #
######################################################################

package provide aq 0.1

# following has side-effect of making sure ::aq namespace is defined
namespace eval ::aq {
  namespace export {[a-z]*}
}

######################################################################
# start using a particular history
######################################################################

proc ::aq::history_begin { args } {
  ::aq::parse_args {
    {directory {}}
    {size 30}
    {position -1}
  }
  
  set history [lindex $args 0]
  global env
  global j_history
  
  if {$directory == {}} then {
    set directory $env(HOME)/.tk/history
  }
  
  file mkdir $directory			;# make sure it exists
  
  set file $directory/$history
  
  if [file exists $file] {
    set j_history($history) [::aq::read_file $file]
  } else {
    set j_history($history) {}
    ::aq::write_file $file ""
  }
  
  set j_history($history,position) $position
  set j_history($history,directory) $directory
  set j_history($history,size) $size
}

######################################################################
# go back (up) in the history list
######################################################################

proc ::aq::history_up { args } {
  set history [lindex $args 0]
  global j_history
  
  set length [llength $j_history($history)]
  if {$j_history($history,position) + 1 < $length} {
    incr j_history($history,position)
  }
  return [lindex $j_history($history) $j_history($history,position)]
}


######################################################################
# go forward (down) in the history list
######################################################################

proc ::aq::history_down { args } {
  set history [lindex $args 0]
  global j_history
  
  if {$j_history($history,position) >= 0} {
    incr j_history($history,position) -1
    return [lindex $j_history($history) $j_history($history,position)]
  } else {
    return {}
  }
}

  
######################################################################
# add to the end of a particular history
######################################################################

proc ::aq::history_append { history value } {
  global j_history
  
  set directory $j_history($history,directory)
  set size $j_history($history,size)
  
  set file $directory/$history
  
  if [file exists $file] {
    set j_history($history) [::aq::read_file $file]
  } else {
    set j_history($history) {}
  }
  
  # Check if the value is the same as the last one - don't duplicate:
  set latest [lindex $j_history($history) 0]
  if {[string compare $value $latest] == 0} {
    return
  }
  
  set j_history($history) [linsert $j_history($history) 0 $value]
  set j_history($history) [lrange $j_history($history) 0 [expr $size - 1]]
  
  ::aq::write_file $file "$j_history($history)\n"
  
  set j_history($history,position) -1
  return
}
