#!/usr/local/bin/tclsh
#!/opt/BIN/tclsh

set Program [file tail $argv0]
set cligVersion |Version|

##### The last word of the next lines should be set by the
##### installation script.
##### tclbase -- directory containing tcl-files to source
##### cbase -- directory containing template-files of C programs.
set tclbase |tclbase|
set cbase |cbase|

if { "$tclbase"=="|tclbase|" } {
  set tclbase /home1/kir/work/clig/tcl
  set cbase /home1/kir/work/clig/c
}

source $tclbase/genUsage.tcl
source $tclbase/genStruct.tcl
source $tclbase/genParse.tcl
source $tclbase/genDotH.tcl
source $tclbase/genDotC.tcl
source $tclbase/genMan.tcl
source $tclbase/genDefault.tcl
source $tclbase/genCheckMandatory.tcl
source $tclbase/genShowOptionValues.tcl
########################################################################
##
## GLOBAL VARIABLES:
##
## <option> denotes s.th. like `-v'. The string `...' for <option>
## denotes the entries of D describing command line arguments not
## associated with any option (see proc Rest).
##
## D(<option>,type) -- type of <option>, i.e. int, float, char*, flag
## D(<option>,typename) -- english name of option type
## D(<option>,name) -- name of <option>, also used as variable name in
##                     generated C code
## D(<option>,usage) -- usage string for <option>
## D(<option>,mandatory) -- set to 1, if <option> is mandatory
## D(<option>,default) -- default value(s) for <option>
## D(<option>,min) -- minimum value of <option>'s arguments
## D(<option>,max) -- maximum value of <option>'s arguments
## D(<option>,cmin) -- minimum number of arguments of <option>
## D(<option>,cmax) -- maximum number of arguments of <option>

## L -- list of all options specified
## usageString -- one-liner describing the generated program
## nameString -- name of generated program
## versionString -- version to use for generated program
## descriptionString -- description to enter into generated manual
##                      page
## argvString -- if set, it is the name of the struct entry which will
##               contain the whole command line as one string
## haveMandatory -- set to 1 if any option is mandatory
## manFile -- name of manual page file to generate

########################################################################
proc isInt {val} {
  return [regexp {^[+-]?[0-9]+$} $val]
}
########################################################################
proc isFloat {val} {
  if {[catch {expr $val+0.0} res]} {return 0}
  #if {$res!=$val} {return 0}
  return 1
}
########################################################################
proc negInfty {val} {
  return [string match -oo $val]
}
########################################################################
proc Infty {val} {
  return [string match oo $val]
}
########################################################################
proc scanMandatory {opt arg} {
  global D Program haveMandatory

  if {[string match *mandatory* $arg]} {
    if {[info exist D($opt,default)]} {
      puts -nonewline stderr \
	  "${Program}: `$opt' cannot be mandatory and"
      puts stderr " have a default at the same time"
      exit 1
    }
    set D($opt,mandatory) 1
    set haveMandatory 1
    return 1
  }
  return 0
}
########################################################################
proc scanDefault {opt arg} {
  global D Program

  if {! [regexp {^ *default *=(.*)} $arg dummy val]} {return 0}
  if {[info exist D($opt,mandatory)]} {
      puts -nonewline stderr \
	  "${Program}: `$opt' cannot be mandatory and"
      puts stderr " have a default at the same time"
    exit 1
  }
  set D($opt,default) [string trim $val]
  return 1
}
########################################################################
proc scanRange {opt arg int} {
  global D Program

  if {! [regexp {^ *range *=(.*)} $arg dummy val]} {return 0}

  if {! [regexp {(.*),(.*)} $val dummy lo hi]} {
    puts stderr \
	"${Program}: missing comma in range `$val' for option `$opt'"
    exit 1
  }
  set lo [string trim $lo]
  set hi [string trim $hi]

  if {$int} {
    if {[negInfty $lo] || [isInt $lo]} {
      set D($opt,min) $lo
    } else {
      puts stderr \
	  "${Program}: non-int min value `$lo' for option `$opt'"
      exit 1
    }

    if {[Infty $hi] || [isInt $hi]} {
      set D($opt,max) $hi
    } else {
      puts stderr \
	  "${Program}: non-int max value `$hi' for option `$opt'"
      exit 1
    }
  } else {
    if {[negInfty $lo] || [isFloat $lo]} {
      set D($opt,min) $lo
    } else {
      puts stderr \
	  "${Program}: non-float min value `$lo' for option `$opt'"
      exit 1
    }

    if {[Infty $hi] || [isFloat $hi]} {
      set D($opt,max) $hi
    } else {
      puts stderr \
	  "${Program}: non-float max value `$hi' for option `$opt'"
      exit 1
    }
  }

  if {   ![negInfty $D($opt,min)] 
	 && ![Infty $D($opt,max)] 
	 && $D($opt,max)<$D($opt,min) } {
    puts stderr \
	"$Program: max<min in range `$val' for option `$opt'"
    exit 1
  }
  return 1
}
########################################################################
proc scanCount {opt arg} {
  global D Program

  if {! [regexp {^ *count *=(.*)} $arg dummy val]} {return 0}

  if {! [regexp {(.*),(.*)} $val dummy lo hi]} {
    puts stderr \
     "${Program}: missing comma in count-range `$val' for option `$opt'"
    exit 1
  }
  set lo [string trim $lo]
  set hi [string trim $hi]

  if { ![isInt $lo] || $lo<0 } {
    puts stderr \
   "${Program}: wrong min value `$lo' in count-range for option `$opt'"
    exit 1
  }
  set D($opt,cmin) $lo

  if {![isInt $hi] && ![Infty $hi]} {
    puts stderr \
   "$Program: non-int max value `$hi' in count-range for option `$opt'"
    exit 1
  }
  set D($opt,cmax) $hi

  if {![Infty $hi] && $hi<$lo} {
    puts stderr \
	"$Program: max<min in count-range `$val' for option `$opt'"
    exit 1
  }

  if { $hi==0 } {
    puts stderr \
    "$Program: max value of count-range zero for option `$opt'"
    puts stderr \
	"\tPlease use type `Flag' for options without parameters"
  }

  return 1
}
########################################################################
proc defaultRange {opt} {
  global D

  if { [info exist D($opt,min)] } return
  set D($opt,min) -oo
  set D($opt,max) oo
}
########################################################################
proc defaultCount {opt} {
  global D

  if { [info exist D($opt,cmin)] } return
  set D($opt,cmin) 1
  set D($opt,cmax) 1
}
########################################################################
proc checkDefault {opt} {
  global D Program
  ## This function is not yet complete. Actually the number, type and
  ## range of all default values should be checked.

  if { ![info exist D($opt,default)] } return

  ##### First check the number of default values
  set l [llength $D($opt,default)]
  if { $D($opt,cmin)>$l } {
    puts stderr "$Program: not enough default values for option `$opt'"
    exit 1
  }
  if { $D($opt,cmax)<$l } { 
    puts stderr "$Program: to many default values for option `$opt'"
    exit 1
  }
}
########################################################################
proc Int {opt name usage args} {
  global D L Program

  if {[info exist D($opt,type)]} {
    puts stderr \
	"$Program: option `$opt' specified twice"
    exit 1
  }
  
  lappend L $opt
  set D($opt,type) int
  set D($opt,typename) integer
  set D($opt,name) $name
  set D($opt,usage) $usage
  
  foreach x $args {
    if { [scanMandatory $opt $x] } continue
    if { [scanRange $opt $x 1] } continue
    if { [scanCount $opt $x] } continue
    if { [scanDefault $opt $x] } continue
    puts stderr "${Program}: Wrong arg `$x' for `Int $opt ...'"
    exit 1
  }
  defaultRange $opt
  defaultCount $opt
  checkDefault $opt
}
########################################################################
proc Float {opt name usage args} {
  global D L Program

  if {[info exist D($opt,type)]} {
    puts stderr \
	"$Program: option `$opt' specified twice"
    exit 1
  }
  
  lappend L $opt
  set D($opt,type) float
  set D($opt,typename) {floating-point}
  set D($opt,name) $name
  set D($opt,usage) $usage
  
  foreach x $args {
    if { [scanMandatory $opt $x] } continue
    if { [scanRange $opt $x 0] } continue
    if { [scanCount $opt $x] } continue
    if { [scanDefault $opt $x] } continue
    puts stderr "${Program}: Wrong arg `$x' for `Float $opt ...'"
    exit 1
  }
  defaultRange $opt
  defaultCount $opt
  checkDefault $opt
}
########################################################################
proc String {opt name usage args} {
  global D L Program

  if {[info exist D($opt,type)]} {
    puts stderr "$Program: option `$opt' specified twice"
    exit 1
  }
  
  lappend L $opt
  set D($opt,type) {char*}
  set D($opt,typename) string
  set D($opt,name) $name
  set D($opt,usage) $usage
  
  foreach x $args {
    if { [scanMandatory $opt $x] } continue
    if { [scanCount $opt $x] } continue
    if { [scanDefault $opt $x] } continue
    puts stderr "${Program}: Wrong arg `$x' for `String $opt ...'"
    exit 1
  }
  defaultCount $opt
  checkDefault $opt
}
########################################################################
proc Flag {opt name usage} {
  global D L Program

  if {[info exist D($opt,type)]} {
    puts stderr "$Program: option `$opt' specified twice"
    exit 1
  }
  
  lappend L $opt
  set D($opt,type) flag
  set D($opt,typename) flag
  set D($opt,name) $name
  set D($opt,usage) $usage
}   
########################################################################
proc Rest {name usage args} {
 global D Program

  set D(...,typename) string
  set D(...,name) $name
  set D(...,usage) $usage
  foreach x $args {
    if { [scanCount {...} $x] } continue
    puts stderr "${Program}: Wrong arg `$x' for `Rest ...'"
    exit 1
  }
  if { [info exists D(...,cmin)] } return
  set D(...,cmin) 1
  set D(...,cmax) oo
}
########################################################################
proc Usage {usage} {
  global usageString
  set usageString $usage
}
########################################################################
proc Name {name} {
  global nameString
  set nameString $name
}
########################################################################
proc Version {v} {
  global versionString
  set versionString $v
}
########################################################################
proc Description {desc} {
  global descriptionString
  set descriptionString $desc
}
########################################################################
proc Commandline {name} {
  global argvString
  set argvString $name
}
########################################################################
proc printCligUsage {} {
  global Program cligVersion
  puts stderr "usage: $Program infile \[-o outprefix\] \[-m manpage\] \[-d\]
  -o: name of .c and .h file
      Default: infile with suffix removed
  -m: manual page to edit or generate
      Default: `Name' specified in description file with suffix .1
  -d: generate the function showOptionValues

  clig version $cligVersion"
  
  exit 1
}
########################################################################
proc main {argc argv} {
  global D L Program debug usageString nameString haveMandatory manFile

  set debug 0		;# 1 will generate the function showOptionValues
  set haveMandatory 0	;# set by scanMandatory

  set Argv $argv
  set argv {}
  set c $argc
  set argc 0
  for {set i 0} {$i<$c} {incr i} {
    set x [lindex $Argv $i]
    switch -glob -- $x {
      -d {set debug 1}
      -o {
	incr i
	if {$i>=$c} {
	  puts stderr "$Program: missing output file prefix after `$x'"
	  exit 1
	} else {
	  set outprefix [lindex $Argv $i]
	}
      }
      
      -m {
	incr i
	if {$i>=$c} {
	  puts stderr "$Program: missing file name after `$x'"
	  exit 1
	} else {
	  set manFile [lindex $Argv $i]
	}
      }
      -* printCligUsage
      default {lappend argv $x ; incr argc}
    }
  }
  if { $argc != 1 } printCligUsage
  
  set infile [lindex $argv 0]

  if { ![info exist outprefix]} {
    set outprefix [file rootname $infile]
  } 

  source $infile

  if { ![info exist usageString] } {
    puts stderr "$Program: missing `Usage'-command in `$infile'"
    exit 1
  }
  
  if { ![info exist nameString] } {
    puts stderr "$Program: missing `Name'-command in `$infile'"
    exit 1
  }

  if { ![info exist manFile] } {
    set manFile $nameString.1
  }

  genDotH $outprefix.h
  genDotC $outprefix.c
  genMan $manFile
}
########################################################################
if {[catch "main $argc {$argv}"]} {
  puts $errorInfo
}

