#!/bin/sh
#
# Contribution to "Sprachwahl" from Linux Magazin 2008/10
#
# Solution for script language TCL
#
#    (c) Gerhard Reithofer,
#    Techn. EDV Reithofer; 2008-09-07
#
# Usage: Usage: tclsh reorder [debug] [sortopt] [memopt] infile [outfile]
#
#  sortopt: none .. footnotes are rebuild in order as they appear in
#                   footnote list (1..n)
#           -t .... footnotes are renumbered as they appear in text,
#                   order of footnotes in list is preserved
#           -f .... footnotes are renumbered as they appear in text,
#                   footnotes list is reordered also
# memopt:   none .. file is preprocessed line by line
#           -m .... complete file is read into memory at begin, 
#                   no check for existing memory is done
# debug:    -d .... displays timing values for various program parts
#
# infile: ......... name of input file, not checked (exit, readable...)
# outfile: ........ name of output file, will be overwritten without 
#                   confirmation, default is stdout
#
# Program version 0.2
#  20080908: ignoring references which are not in footnotelist
#            bug: puts $fn(mark) -> puts $ofd $fn(mark)
#            adding debug option -d for timings
#
# starting tclsh \
exec tclsh $0 "$@"

### switch between file mode and memory mode 
set file_mode_solution 1

### footnote begin marker
set fn(mark) "@footnote:"

### footnote counter
set fn(cntr) 0

### default - do not sort footnotes in text
set fn(sort) 0

### default - do not (re)sort footnotes
set fn(note) 0

### do not display runtime information
set fn(debg) 0

### footnote data
array set fn_data {}

### default standard output
set ofd stdout

###
proc syntax {args} {
  if {[llength $args]} { puts [lindex $args 0] }
  puts "Usage: [file tail $::argv0] \[-t|-f\] \[-m\] infile \[outfile\]"
  puts " -t .. sort footnotes in text (default: sort footnotes at end only)"
  puts " -f .. sort footnotes in text and reorder footnotes at end"
  puts " -m .. read complete file to memory (default: line by line file I/O)"
  puts " -d .. display timing values for main program parts"
  exit 1
}

### simple add & count note function
proc add_note id {
  global fn_data fn
  if {![info exists fn_data($id)]} {
    set fn_data($id) [incr fn(cntr)]
  }
  return $fn_data($id)
}

###
### process text and reorder footnotes 
### in text if ($reorder == 1)
###
proc process_text {fd ofd reorder} {
  global fn fn_data
  set cnt 0
  next $fd line
  while {$line ne $fn(mark)} {
    incr cnt
    set rres [regexp -indices {\[([0-9]+)\]} $line pos num]
    if {!$rres} {
      puts $ofd $line
      next $fd line
      continue
    }

### process all footnotes in $line
###
    set eidx 0
    set rlin ""
    while {$rres} {
      set id [string range $line [lindex $num 0] [lindex $num 1]]
      set s1 [string range $line $eidx [lindex $pos 0]]
      append rlin $s1
      if {$reorder} {
        if {[info exists fn_data($id)]} {
          append rlin $fn_data($id)
        } else {
          puts stderr "Warning: found unreferenced entry \[$id\] in line $cnt!"
        }
      } else {
        set new [add_note $id]
        append rlin $new
      }
      set eidx [lindex $pos 1]
      set rres [regexp -indices -start $eidx {\[([0-9]+)\]} $line pos num]
    }

    set s2 [string range $line [lindex $pos 1] end]
    append rlin $s2

### write out corrected line and read next...
###
    puts $ofd $rlin
    next $fd line
  }
}

###
### process footnote section  
###
proc write_notes {fd ofd reorder} {
  global fn fn_data

  puts $ofd $fn(mark)

  next $fd line
  while {![enddata $fd]} {
    if {$line eq ""} {
      if {![info exists data]} {puts $ofd ""}
      next $fd line
      continue
    }
    if {[string first {[} $line]>=0} {
      set lc [string first {]} $line]
      set id [string range $line 1 [incr lc -1]]
      set line [string range $line [incr lc 2] end]
      lappend data [list $fn_data($id) $line]
    } 
    next $fd line
  }

  if {$reorder} {
    set data [lsort -index 0 -integer $data]
  }

  foreach r $data {
    set id [lindex $r 0]
    puts $ofd "\[$id\][lindex $r 1]"
  }
}

###
### read footnote section 1st, for 
### determination of footnote order
proc preproc_notes fd {
  global fn fn_data

  # read over all text lines...
  set line ""
  while {$line ne $fn(mark)} {
    next $fd line
  }

  while {![enddata $fd]} {
    next $fd line
    if {[string index $line 0] ne {[}} continue
    set lc [string first {]} $line]
    set id [string range $line 1 [incr lc -1]]
    add_note $id 
  }
  
  # rewind file
  reset $fd
}

###
### commandline handling and opening of 
### files - no further file checks are made!!!
###
if {$argc<1} { syntax }
foreach p $argv {
  if {[string index $p 0] eq "-"} {
    switch -- $p {
      "-d" {set fn(debg) 1}
      "-t" {set fn(sort) 1}
      "-f" {set fn(sort) 1;set fn(note) 1}
      "-m" {set file_mode_solution 0}
      default {syntax "Invalid option: '$p'"}
    }
  } else {
    if {[info exists ifd]} {
      set ofd [open $p w+]
    } else {
      set ifd [open $p r]
    }
  }
}

##########################################################
### begin of dummy file functions
###
if {$file_mode_solution} {
  proc next {dv rv} { upvar 1 $rv line ; gets $dv line }
  proc enddata {dv} { return [eof $dv] }
  proc reset {dv}   { seek $dv 0 }
} else {
  array set lines {cnt -1 max 0 mem {}}
  proc next {dv rv} {
    global lines ; upvar 1 $rv line
    set line [lindex $lines(mem) [incr lines(cnt)]]
  }
  proc enddata {dv} { 
    global lines
    return [expr {$lines(cnt)>=$lines(max)}] 
  }
  proc reset {dv} { global lines ; set lines(cnt) -1}
}
###
### end of dummy file functions
##########################################################


if {![info exists ifd]} {
  syntax "Syntax error: no inputfile given!"
}

###
### M A I N part starts here
###
if {!$file_mode_solution} {
  if {$fn(debg)} {
    puts "reading file to mem [time {
      set lines(mem) [split [read -nonewline $ifd] "\n"]
   }]"
  } else {
    set lines(mem) [split [read -nonewline $ifd] "\n"]
  }
  set lines(max) [llength $lines(mem)]
}

if {!$fn(sort)} { 
  if {$fn(debg)} {
    puts "preproc. footnotes  [time {preproc_notes $ifd}]"
    puts "processing text     [time {process_text $ifd $ofd 1}]"
  } else {
    preproc_notes $ifd
    process_text $ifd $ofd 1
  }
} else {
  if {$fn(debg)} {
    puts "proc. text reorder  [time {process_text $ifd $ofd 0}]"
  } else {
    process_text $ifd $ofd 0
  }
}

if {$fn(debg)} {
  puts "writing footnotes   [time {write_notes  $ifd $ofd $fn(note)}]"
} else {
  write_notes  $ifd $ofd $fn(note)
}
close $ifd
close $ofd