#! /usr/bin/env tclsh
# -*- tcl -*- 
# <20200213.1158.06>

# build a file list.
proc help {} {
  puts {
    #
    # This bit of tcl builds a file list by looking at files and directories
    # as specified in the run string (as per below):
    #
    # Here are the parms:
    # -c file     Read parameters (just like these) from "file". You may put any
    #             number on a line. Info after "#" on a line is treated as a
    #             comment. These parameters are added prior to the remaining
    #             parameters in the run string. There may be more than one -c
    #             and the "file" itself may include -c parameters.
    # -i file     Include files listed in "file".  This file may be a tclIndex
    #             or just a simple list of file names. Names should include
    #             paths relative to the files location (i.e. if file is in
    #             "-r dir", no path, if in "-r dir"/foo and reference name is
    #             in "-r dir" the path should be "../"
    # -r dir      Arrange to make the file name relative to "dir". This is for
    #             tclIndex files. If not give the working directory is used.
    # -f filter   Will exclude files that match "filter" (glob matching) may be 
    #             more than one "-f filter" pair. May be exact to exclude a 
    #             given file. The filter "*~*" is automatically included.
    # +f filter   Will cancel a '-f' filter.
    # -p file     Poison pill. If dir contains this file exclude it.
    # +p          Removes all Poison pills
    # -e file     Will exclude all file that are listed in "file". Treats each
    #             entry as a pattern (see -f above).
    #             Lines starting with '#' are comments.  
    #             More than one "-e file" is allowed.
    # -d dir      Includes files in directory "dir" may be more than one. 
    #             Does not recur.
    # +d dir      Includes files in directory "dir" may be more than one.
    #             Recurs to include subdirectories.
    # + name      Includes "name" (does not check if it is an actual file, could be
    #             a comment). More than one allowed.
    # -o file     Puts result in file, if not given, puts result in "filelist".
    # -#          Do not put comments in the output file.
    # +#          Put comments in output file (this is default and reverse prior -#)
    # -h          Generates this message.
  }
  exit 1
}


########################################################
#     This is the boiler plate code                    #
########################################################
# This bit of code figures out where the rest of the   #  
# routines are on the assumption that they are in the  #
# same directory as the initial code file.             #
# If 'setIt' is 1 or not coded auto_path is set in any #
# case the resulting dir is returned to the caller     #
# A second dir is also returned, which is the same     #
# with a leading C:/ removed as required by Wrap code  # 
# for windows. If not windows the two will be the same.#
#                                                      #
# To function correctly this code MUST be called prior #
# to completion of the 'source' command that brings it #
# in. Also, since it is used to set up auto_path it    #
# can not be auto loaded.  It may be sourced, but      #
# again the from where issue is there.                 #
#                                                      #
# It is best if this is just merger with the using     #
# code in a location prior to its call.                #
#                                                      #
proc setAutoPath {{setIt 1}} {
  set it [info script]
  set it [expr {$it == "" ? "[pwd]/*" : $it}]
  set it [file dir [file dir [file norm $it/*]]]
  # Wrap code requires we not have the drive letter...
  if {$setIt} {
    lappend ::auto_path $it [regsub {^[a-zA-Z]:/} $it {/}]
  }
  return [list $it [regsub {^[a-zA-Z]:/} $it {/}]]
}
##########################################################
#            End of boiler plate code                    #
##########################################################
if {0} { ; # set to 1 to debug
  lappend auto_path [file norm ../]
  setupDebug 1
  frputs "[info script] [setAutoPath] "
} else {
  proc frputs {args} {}
}

#
proc insertFile {file} {
  # read the file and assemble the parameters (anything not prefexed by "#").
  # Insert them at the head of argv
  lappend ::filesVisited $file
  if {$file in [lrange $::filesVisited 0 end-1]} {
    puts "File \"$file\" was visited already. This order:"
    puts "$::filesVisited"
    exit 1
  }
  set r [catch {split [read [set fid [open $file r]]] \n} lines]
  if {$r != 0} {
    puts "Error trying to read \"$file\": $lines"
    exit 1
  }
  close $fid
  set newParms {}
  foreach line $lines {
    set ln [string trim $line]
    if {$ln == "" || [string index $ln 0] == "#" } {continue}
    set prior {}
    # The following way of nibbling a line does not run afoul of
    # nasty list conventions like ") being illegal
    # except for '-h' and '-#' these entries come in pairs...
    # and both must be on the same line... Names with blanks must be quoted...
    while {[regexp { *([^ ]+)(.*)} $ln ma el ln]} {
      lappend newParms $el
      if {$el in {"-#" "+#" "+p"  "-h"} } {continue}
	  set ln [string trim $ln]
      if {[string index $ln 0] == "\""} {
	if {[set end [string first "\"" $ln 1]] == -1} {
	  puts "\n  Command '$el $ln' needs a terminating quote."
	  help
	}
	set p2 [string range $ln 1 $end-1]
      } else {
	if {[set end [string first " " $ln]] == -1} {
	  set end "end"
	}
	set p2  [string trim [string range $ln 0 $end]]
      }
      if {$p2 == ""} {
	puts "\n   Command '$el $ln' is missing second operand."
	help
      }
      frputs ma el ln p2
      lappend newParms $p2
      set ln [string range $ln $end+1 end]
    }	
  }
  lappend ::pargv [concat "Commands from file $file:" $newParms]
  return $newParms
}

set relativeDir [pwd]
set includeFiles {}
set excludeFiles {}
set namedFiles {}
lappend filters "*~*"
set canFilters {}
set dirs {}
set recurDirs {}
set out "filelist"
# preserve argv for later...
set pargv [list $argv]
set noCom 0
if {[llength $argv] == 0} {help}

while {[llength $argv] != 0} {
  set next [lassign $argv prm opt]
  switch -exact $prm {
    -c {set next [concat [insertFile $opt] $next] }
    -i {lappend includeFiles $opt}
    -e {lappend excludeFiles $opt}
    -r {set relativeDir [file dir [file normalize $opt/doo]]}
    -d {lappend dirs $opt}
    +d {lappend recurDirs $opt}
    -f {lappend filters $opt}
    +f {lappend canFilters $opt}
    -p {lappend ppill $opt}
    -o {set out $opt}
    +  {lappend namedFiles $opt}
    +p {set ppill {};  set next [concat $opt $next]}
    {-#} {incr noCom;  set next [concat $opt $next]}
    {+#} {set noCom 0; set next [concat $opt $next]}
    default {
      puts ""
      puts "   Don't understand: \"$prm $opt\""
      help
    }
  }
  set argv $next
}
# Process the +f commands
foreach f $canFilters {
  while {[set l [lsearch -exact $filters $f]] != -1} {
    set filters [lreplace $filters $l $l]
  }
}
frputs "## $relativeDir "

# A little routine to remove ".." and "." from paths
# without removing links or making the name absolute.

proc rmDots {file} {
  set nfile {}
  set pts [file split $file]
  foreach part $pts {
    if {$part == ".."} {
      set nfile [lrange $nfile 0 end-1]
    } elseif {$part == "."} {
      continue
    } else {
      lappend nfile $part
    }
  }
  return [join $nfile /]
}


# A little function to figure relative file paths
# given 'file' and 'rel' a directory we wish to access
# a file in the same dir as 'file' useing a relative path, 
# return the prefix needed. If no prefix is needed 
# return "", otherwise a '/' preceeded by what is needed.


proc getRel {file rel} {
  # return the string to prepend to a file name to 
  # make it relative to 'rel'
  # first, what we want to do is remove . and .. but NOT
  # mess with links.
  # try this...
  set nfile {}
  set pts [file split [file join [pwd] $file]]
  foreach part $pts {
    if {$part == ".."} {
      set nfile [lrange $nfile 0 end-1]
    } elseif {$part == "."} {
      continue
    } else {
      lappend nfile $part
    }
  }
  # Trust that the dir is presented without links...
  set thisDir [file join {*}$nfile]
  set relParts [file split [file norm $rel]]
  set lnParts [llength $relParts]
  while {$lnParts > 0 && [lrange $nfile 0 $lnParts-1] != $relParts} {
    set nfile [linsert $nfile $lnParts-1 ".."]
    set relParts [lreplace $relParts end end]
    incr lnParts -1
  }
  return [file join {*}[lrange $nfile $lnParts end]]/
}


proc getNamesFromFile {file rel} {
  # file may be a tclIndes or a simple file list... 
  # try the tclIndex first
  set prefix [getRel $file $rel]
  set prefix {}
  frputs prefix file rel
  if {[catch {split [read [set fid [open $file r]]] \n} lines] != 0} {
    puts "Error trying to read \"$file\": $lines"
    exit 1
  }
  close $fid
  set filelist {}
  set type {}
  foreach line $lines {
    set ln [string trim $line]
    if {$ln == {} || [string range $ln 0 0] == "#" } {continue}
    if {[string match "set auto_index(*" $ln]} {
      # this is a tclIndex line...
      if {$type == "file"} {
	puts "File $file is not a pure list of files. Aborting"
	exit 1
      }
      set type "tclIndex"
      regexp {.*file join \$dir ([^\]]*).*} $ln m fileref
      #frputs "adding [join $fileref /]"
      lappend filelist [join $fileref /]
    } else {
      # this is a list of files...
      if {$type == "tclIndex"} {
 	puts "File $file is not a pure tclIndex file. Aborting"
	exit 1
      }
      lappend filelist [rmDots $prefix$ln]
    }
  }
  return $filelist 
}

# build a list of excluded files
#

foreach exin {exclude include} {
  set ${exin}files {}
  foreach file [set ${exin}Files] {
    set ${exin}files [concat  [set ${exin}files]\
			  [getNamesFromFile $file $relativeDir]]
  }
  set ${exin}files [lsort -unique [set ${exin}files]]
  frputs ${exin}files
}

proc PPill {dir} {
  foreach f $::ppill {
    if {[file exists $dir/$f]} {return 1}
  }
  return 0
}

# now the dirs we are to recur over..
# we just add them to the list...

foreach rdir $recurDirs {
  while {$rdir != {}} {
    set rdir [lassign $rdir this]
    if {[PPill $this]} {continue}
    lappend dirs $this
    set rdir [concat $rdir [glob -nocomplain -type d -directory $this *]]
    set rdir2 [glob -nocomplain -type d -directory $this .*]
    foreach dir $rdir2 {
      if {[file tail $dir] ni {. ..}} {
	frputs dir
	lappend rdir $dir
      }
    }
  }
}
# now the include dirs...
set includeDfiles {}
foreach dir $dirs {
  frputs dir relativeDir
  set prefix [getRel $dir $relativeDir]
  #puts "pre $dir/x & $relativeDir -> $prefix"
  # include the dir name...
  if {[PPill $dir]} {continue}
  if {$prefix != {}} {
    lappend includeDfiles [file dir $prefix/x]
  }
  if {![file exists $dir] || [file type [file dir [file norm $dir/]]] != "directory"} {
    frputs "[pwd] " dir
    frputs dir "is not a directory "
  }
  set r1 [catch {glob -tails -type f -directory $dir *} files] 
  set r2 [catch {glob -tails -type f -directory $dir .*} files2]
  # frputs files files2
  if {$r1 != 0 && $r2 != 0} {
    if {$dir ni $recurDirs } {
      puts "Directory $dir appears to be empty: $files"
    }
    set files2 [set files {}]
  }
  foreach {f r} "files $r1 files2 $r2" {
    if {$r == 0} {
      foreach file [set $f] {
	frputs file
	lappend  includeDfiles  $prefix$file
      }
    }
  }
}
set comments {}
foreach named $namedFiles {
  if {[string index [string trim $named] 0] == "#"} {
    #puts "addeding comment $named"
    lappend comments $named
  } else {
    #puts "adding $named"
    #puts "pwd [pwd] $::relativeDir >[getRel $named $::relativeDir]"
    lappend includefiles $named
    set cd [pwd]
    cd $::relativeDir
    while {[file exists $named]} {
      set named [file dir $named]
      if {$named != "."} {
	# puts "adding $named"
	lappend includeDfiles $named
      } else {
	break
      }
    }
    cd $cd
  }
}

#set includeDfiles [lsort -unique $includeDfiles]
set includefiles [lsort -unique [concat $includeDfiles $includefiles]]

frputs includefiles
set r [catch {open $out w} fid]
if {$r != 0} {
  puts "Failed to open $out with error $fid"
  exit 1
}
set fileInserts [lassign $pargv runstring]
if {$noCom == 0} {
  puts $fid "#"
  puts $fid "# File list built by \"buildtclfilelist\""
  puts $fid "#"
  puts -nonewline $fid "# Command line: "
  puts $fid "$runstring"
  puts $fid "#"
  foreach fileI $fileInserts {
    puts $fid "# $fileI"
    puts $fid "#"
  }
  puts $fid "# Build time: [clock format [clock seconds]]"
  puts $fid "#"
  puts $fid "# Explicit lines:"
  puts $fid "#"
  foreach named $comments {
    puts $fid "$named"
  }

  puts $fid "#"
  puts $fid "# Files:"
  puts $fid "#"
}
cd  $::relativeDir
set warn 0
set pureFiles {}
foreach name $includefiles {
  set no 0
  foreach pat [concat $filters $excludefiles] {
    # we assume a pattern such as ...fo/* really should be ...fo*
    set pat [expr {[string range $pat end-1 end] == "/*" ? \
		       [string replace $pat end-1 end "*"] : $pat}]
    if {[string match $pat $name]} {
      incr no
      break
    }
  }
  if {$no} {continue}
  if {![file exists $name]} {
    if {!$warn} {
      puts "The following files seem not to exist???:"
      incr warn
    }
  }
  # Here we scheme to put the dirs and their contents first...
  if {[file dir $name] == "."} {
    lappend pureFiles $name
  } else {
    puts $fid "$name"
  }
}
foreach name $pureFiles {
  if {[set name [string trim $name]] != {}} {
    puts $fid "$name"
  }
}
close $fid
exit 0
