# jparseargs.tcl - parse procedure options in -name value style
#
######################################################################
# Copyright 1992-1998 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]*}
}

######################################################################
# ::aq::parse_args arglist - parse arglist in parent procedure
#   arglist is a list of option names (without leading "-");
# this proc puts their values (if any) into variables (named after
#   the option name) in d parent procedure
# any element of arglist can also be a list consisting of an option
#   name and a default value.
######################################################################

proc ::aq::parse_args { arglist } {
  upvar args args
  
  foreach pair $arglist {
    set option [lindex $pair 0]
    set default [lindex $pair 1]		;# will be null if not supplied
    set index [lsearch -exact $args "-$option"]
    if {$index != -1} {
      set index1 [expr {$index + 1}]
      set value [lindex $args $index1]
      uplevel 1 [list set $option $value]	;# caller's variable "$option"
      set args [lreplace $args $index $index1]
    } else {
      uplevel 1 [list set $option $default]	;# caller's variable "$option"
    }
  }
  return 0
}

######################################################################
# ::aq::parse_argv arglist - parse application's argv (and update argc)
#   arglist is a list of option names (without leading "-");
# this proc puts their values (if any) into variables (named after
#   the option name) in the parent procedure
# any element of arglist can also be a list consisting of an option
#   name and a default value.
######################################################################

proc ::aq::parse_argv { arglist } {
  global argv argc
  
  foreach pair $arglist {
    set option [lindex $pair 0]
    set default [lindex $pair 1]		;# will be null if not supplied
    set index [lsearch -exact $argv "-$option"]
    if {$index != -1} {
      set index1 [expr {$index + 1}]
      set value [lindex $argv $index1]
      uplevel 1 [list set $option $value]	;# caller's variable "$option"
      set argv [lreplace $argv $index $index1]
    } else {
      uplevel 1 [list set $option $default]	;# caller's variable "$option"
    }
  }
  set argc [llength $argv]
  return 0
}

######################################################################
# ::aq::parse_boolean_args arglist - parse arglist in parent procedure
#   arglist is a list of option names (without leading "-");
# this proc sets a variable (named after the option name) in the
#   parent procedure to "1" if the option is given, else "0"
######################################################################

proc ::aq::parse_boolean_args { arglist } {
  upvar args args
  
  foreach option $arglist {
    set index [lsearch -exact $args "-$option"]
    if {$index != -1} {
      uplevel 1 [list set $option 1]		;# caller's variable "$option"
      set args [lreplace $args $index $index]
    } else {
      uplevel 1 [list set $option 0]		;# caller's variable "$option"
    }
  }
  return 0
}

######################################################################
# ::aq::parse_boolean_argv arglist - parse application's argv
#   (and update argc)
#   arglist is a list of option names (without leading "-");
# this proc puts their values (if any) into variables (named after
#   the option name) in the parent procedure
# any element of arglist can also be a list consisting of an option
#   name and a default value.
######################################################################

proc ::aq::parse_boolean_argv { arglist } {
  global argv argc
  
  foreach option $arglist {
    set index [lsearch -exact $argv "-$option"]
    if {$index != -1} {
      uplevel 1 [list set $option 1]		;# caller's variable "$option"
      set argv [lreplace $argv $index $index]
    } else {
      uplevel 1 [list set $option 0]		;# caller's variable "$option"
    }
  }
  set argc [llength $argv]
  return 0
}
