#!/bin/env tclsh
set version <20220516.1024.18>

proc helpOut {mess} {
  foreach line [split $mess \n] {
    puts stdout "[string trim $line]"
  }
}


proc xmlHelp {{why {}}} {
  if {$why != {}} {
    puts stdout $why
  }
  helpOut {
    # This tool is used to build an XML file that is used as input
    # to the WIX windows install package generator.
    #
    # This file builds instructions to build a complete windows .msi
    # file.  The install will build a start menu entry as well as
    # a desktop link. To be as general as possible this code will
    # NOT build for a given project (i.e. fr) but will only
    # require the needed information on the run line.
    #
    # This information (and the invocation sequence) is:
    #
    # msi-tool.tcl product-name=<product name>
    #              update-code=<a 16 char string that stays with the product for its life time>
    #              revision=<product revision code>
    #              path=<path on this system to product files>
    #              product-file=<file or directory relative to <path> to include in product
    #              product-manufacturer=<company or individual name>
    #                 This parameter may be repeated as needed.
    #              list-of-files=<file containing a list of files to include in product>
    #                 This parameter may be repeated as needed. Directories are not
    #                 scanned if they appear here.
    #      all the following are optional....
    #              eula=<file containg the End User License Agreement>
    #              completion-text=<text to be displayed at install completion>
    #              out-file=<name of the file to put the results in defaults to product-name>
    #                 This names two files: *.wsx and *.mft
    #                 (the file for WIX and a manifest file)
    #                 If not given (i.e. set to {} )the .xml file is put on stdout,
    #                 the *.mft is lost
    #              exclude=<file mask (glob on whole file name) to exclude from the product>
    #                 This parameter may be repeated as needed
    # The following parameters, if present, will set up desktop and start menu shortcuts
    #              short-cut-target=<file that is to be the short cut target, required to
    #                 generate shortcuts>
    #              short-cut-name=<name of the desktop short-cut file>
    #              short-cut-param=<command line for the short-cut>
    #              product-description=<description put in short-cuts>
    #              short-cut-show=<one of "normal", "minimized" or "maximized"> (default normal)
    #              icon=<icon file name>
    #              debug=1 to turn on debugging
    #              <file name>  of a file that contains some or all of the above
    #              -h prints this message.    
    #
    #  Options are process left to right, so options after <file-name> may
    #  change or override options in <file name>. The complete list of
    #  product files is sorted and duplicates are eliminated.
    #  Where <file name> and command line items conflict the latest ones
    #  extend (product-files) or replace (all others) earlier ones.  An <option>=
    # (with nothing after the \"=\" will null that option.
    #
    # Relative file names used during input (<file name>, out-file, list-of-files) are
    # resolved relative to the working directory. All other relative file names are
    # resolved relative to \"path\".
  }
 if {$why != {}} {
    puts stdout $why
  }
  exit 1
}

# The install code will produce instructions to install the program
# components in such a way that its internal structure (i.e. directories
# and sub directories) match what is passed in.

# A word about GUID.  The normal intent of this is to generate a unique id
# for each given part of the install.  There is no need for it to have
# any real meaning.  This seems like nonsense to me so we produce GUIDs
# that have only a small part being random.  We include an index to
# the file name (if the component is a file name) and, for files,
# if there is a time-string (this format: <20160407.1657.31>) in the
# first few lines of code this is converted to a 'seconds from 1970'
# format.  If no time stirng is found in the first 10 lines, the
# files 'mtime' is used. Also included in the GUID is the
# revision code of the product and an index into a file that is
# produced that has all the GUIDs and what they are for in it.

# This code produces two files, the above GUID list and the
# XML file for WIX.


########################################################
#  This is the boiler plate code ver <20160407.1842.54>#                 
########################################################
# 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 cSetAutoPath {new} {
  if {$new ni $::auto_path} {lappend ::auto_path $new};#
}                                                     ;# 
#                                                      #
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} {                                       ;#
    cSetAutoPath $it                                  ;#
    cSetAutoPath [regsub {^[a-zA-Z]:/} $it {/}]       ;#
  }                                                   ;#
  return [list $it [regsub {^[a-zA-Z]:/} $it {/}]]    ;#
}                                                     ;#
########################################################
#            End of boiler plate code                  #
########################################################

setAutoPath


# If not a windows platform we will need to set up for "wine" which means we add "z:" to
# file names and "wine " prefix to the tools.
# We also need to acknowledge that we may be in a WSL MSW environment.
# In this case the .wsx fill will be processed in windows and we must change
# the source file name prefix from '/mnt/[a-z]' to '[a-z]:'. We do this with regsub
# so we just set a do nothing pattern if not in wsl and a good one if we are

set pf $tcl_platform(platform)

set wsl 0
set regsubPat {^(#)}

if {$pf != "windows"} {
  set wsl [string match -nocase *microsoft* [read [set pdf [open /proc/version r]]]]
  close $pdf
  if {$wsl} {
    set regsubPat {/mnt/([a-z])}
  }
}
puts "WSL=$wsl platform=$pf"
set filePrefix  [expr {$pf == "windows" || $wsl ? {} : "z:"}]
set toolPrefix  [expr {$pf == "windows" || $wsl ? {} : "wine "}]
set toolPostfix [expr {$pf == "windows" || $wsl ? {".exe"} : {}}]

set assertFlag 0

# globals for GUID
set manifestBody {}
set manifestTypes {}

# XML management globals
set xmlStack {}
set xmlLookAside {}
set xmlBuffer {}
set xmlSelfClose " />"
set xmlIndent "  "
set xmlContinueIndent "     "
set xmlFid {}
set xmlOut {}

# Parameters:
set revision {}
set short-cut-name {}
set short-cut-param {}
set short-cut-target {}
set short-cut-show {normal}
set product-name {}
set product-manufacturer {}
set eula {}
set completion-text {}
set out-file {}
set path {}
set icon {}
set product-file {}
set product-description {}
set update-code {}
set exclude {}
set list-of-files {}
set debug 0

# working globals

set product-dirs {}
set product-files {}
set productFiles {}
set productDirs {}

# Lets put our procs here...

# Mostly for debug
proc lst {st} {
  foreach ent $st {
    puts "$ent"
  }
}

proc assert {exp args} {
  global assertFlag

  if {![info exists assertFlag] || ! $assertFlag} {return}
  set r [uplevel expr  $exp]
  if {$r} {return}
  error  "Assert failed expression $exp"
}
#assert {1 == 2}

# Here is a 'file normalize' replacement which does NOT remove
# soft links from the path.

proc normKeepSl {file} {
  set nfile {}
  set pts [file split [file join [pwd] $file]]
  set elm1 [lindex $pts 0]
  if {[string index $elm1 0]  == "~"} {
    set pts [lreplace $pts 0 0 [file norm $elm1]]
  }
  foreach part $pts {
    if {$part == ".."} {
      set nfile [lrange $nfile 0 end-1]
    } elseif {$part == "."} {
      continue
    } else {
      lappend nfile $part
    }
  }
  return [file join {*}$nfile]
}

#
# A GUID is a string of upper case hex digits in 4 groups:

#                 8digits-4digits-4digits-4digits-12digits
# something like: D1DE9AAD-F9C5-42C5-AAA5-327F2B861DE6
#
# The Product code is the encoded input string.
# Other types use the following:
# The rev code we assume 4 dot seperated bits with
#    each at most 255, another 8 hex (first 8 digits)
# A time in seconds take 8 hex (second 8 digits)
# We use one digit to encode the type (first of 3ed 4 digit field)
# Leaving 6 for a random number (last 3 of 3ed field + first 3 of last)
# The index, lets assume at most 4000 or 16*256 for 9 hex (least 9)

# The call:

#   xmlGUID type args
#
# Types file & directory require file & directory names respectively
#         These names should be relative to the product directory
#         just as for WIX. The name will be put in the manifest.
# Type Product requires a string to convert to hex.
# Other types do not require additional arguments and generate
#       GUIDs with the current time as the time entry.
# The type is put in the manifest.

# xmlGUID expects the following globals:
#                  revCode the product Revision
#                  path    the root directory for files. This will be
#                          joined with the file name to interrogate it
#
# xmlGUID also writes the manifest to a couple of globals:
#                 manifestBody has one line for each GUID produced the line 
#                      contains {GUID} type for files & dirs the time and name
#                 manifestTypes makeGUID ke ps a list of types here. The type
#                               ordinal in the list is the type number.
#                               It is expected that the builder of the
#                               manifest will use this to build a human
#                               readable type index for the manifest header.

proc xmlGUID {type args} {
  global revision manifestBody manifestTypes
  if {$type ni $manifestTypes} {
    lappend manifestTypes $type
  }
  if {$type == "Product"} {
    set fdata [binary encode hex [lindex $args 0]]
    # need 32 chars. If too short extend.
    set no [expr { 16 - [string length $fdata] }]
    if {$no > 0} {
      append $fdata [string repeat $no " "]
    }
    foreach {st en} {0 7 8 11 12 15 16 19 20 31} {
      append GUID -[string range $fdata $st $en]
    }
    set GUID [string range $GUID 1 end]
    lappend manifestBody [list $GUID $type]
 } else {
   set rev [format "%02X%02X%02X%02X" {*}[scan [split $revision .] {%d %d %d %d}]]
    if {$type == "file" || $type == "directory"} {
      set tim [file mtime [lindex $args 0]]
     if {$type == "file"} {
	set ffid [open [lindex $args 0] r]
	set fdata [read $ffid 900]
	close $ffid
	set tm {}
	regexp {.*<([0-9]{8}\.[0-9]{4}\.[0-9]{2})>.*} $fdata dum tm
	if {$tm != {}} {
	  set tim [clock scan $tm -format "%Y%m%d.%H%M.%S"]
	}
      }
    } else {
      set tim [clock seconds]
    }
    set time [format "%08X" $tim]
    set timeGUID [string range $time 0 3]-[string range $time 4 end]
    set typeIndex [lsearch -exact $manifestTypes $type]
    set typeHex [format "%01X" $typeIndex]
    
   set rand [format "%06X" [expr { int(0xffffff * rand())}]]
    set randHex [string range $rand 0 2]-[string range $rand 3 end]
    set indexHex [format "%09X" [llength $manifestBody]]
    set GUID $rev-$timeGUID-$typeHex$randHex$indexHex
    if {$type == "file" || $type == "directory"} {
      set displayTime [clock format $tim -format "%D at %T"]
 
      lappend manifestBody [list $GUID $type $displayTime [lindex $args 0]]
    } else {
      lappend manifestBody [list $GUID $type]
    }
  }
  return $GUID
}

# Now some XML formating stuff.
# We keep a stack of XML keys or levels. (Actually we invert it so we always work
# with the last entry or so.
# When an entry is opened, we push a "quick close" (i.e. />) on the stack and keep
# the open entry in a look aside.  On the next open we will pop the "quick close"
# and replace it with the look aside followed by a "quick close".  This way on
# close, the close code is on top of the stack. If it is a quick close, it will
# always be put at the end of the current buffer and that buffer flushed. A pop
# also clears the lookaside. We also manage the indention.
#
proc xmlFlush {{n 1}} {
  global xmlBuffer xmlFid xmlOut
  if {$xmlFid != {}} {
    puts $xmlFid "$xmlBuffer"
    while {[incr n -1] > 0} {
      puts $xmlFid
    }
  } else {
    lappend xmlOut $xmlBuffer
    while {[incr n -1] > 0} {
      lappend xmlOut {}
    }
  }
  set xmlBuffer {}
}
  
  
proc xmlOpen {tag str} {
  global xmlStack xmlLookAside xmlBuffer xmlSelfClose xmlIndent xmlContinueIndent
  global debug

  set defeatQuote "\\\""
  set nstr [regsub -all {\"} $str $defeatQuote]
  uplevel 1 "set nstr  [list [regsub -all {\"} $str $defeatQuote]]"
  #puts "before $str"
  set str [uplevel  1 {subst  $nstr}]
  if {$debug > 1} {
    puts "xmlOpen: $tag $str"
  }
  #puts "after $str"
  # Here we need to figure out how to close the prior line...
  # For now assume ">\n\n"
  set stackTop [lindex $xmlStack end]
  
  if {$stackTop != $xmlSelfClose} {
    # buffer should be empty..
    assert {$xmlBuffer == {}}
    
    lappend xmlStack $xmlSelfClose
    set xmlLookAside "/$tag>"
  } else {
    # There should be a pending entry in the buffer
    assert {$xmlBuffer != {}}
    
    set xmlStack [lreplace $xmlStack end end $xmlLookAside $xmlSelfClose]
    set xmlLookAside "/$tag>"
    append xmlBuffer ">"
    xmlFlush 1
  }
  # The above finishes the completion of the current line, if any.
  # I also set up the stack for this entry
  
  # start the new entry...
  set xmlBuffer [string repeat $xmlIndent [expr [llength $xmlStack] - 1]]
  append xmlBuffer "<$tag "
  # Here we do str which may contain more than one line...
  set flag 1
  foreach strLn [split [regsub -all {\\"} $str {"}] \n] {
    if {$flag} {
      set flag 0
    } else {
      xmlFlush 1
      set xmlBuffer [string repeat $xmlIndent [llength $xmlStack]]
      append xmlBuffer $xmlContinueIndent
    }
    append xmlBuffer [string trim $strLn]
  }
}

# format and produce a comment

proc xmlComment {text} {
  global xmlIndent xmlBuffer xmlStack xmlContinueIndent

  if {$xmlBuffer != {}} {
    xmlFlush 
  }
  set defeatQuote "/YYXYY/"
  set nstr [regsub -all {\"} $text $defeatQuote] 
  #puts "before $str"
  set text [regsub -all $defeatQuote [uplevel "subst \"$nstr\""] {\"}]
  set first 1
  set xmlBuffer "[string repeat $xmlIndent [llength $xmlStack]]"
  append xmlBuffer "<!-- "
  foreach line [split [regsub -all {\\"} $text {"}] \n] {
    if {$first} {
      set first 0
    } else {
      xmlFlush
      set xmlBuffer "[string repeat $xmlIndent [llength $xmlStack]]"
    }
    append xmlBuffer [string trim $line]
  }
  append xmlBuffer "-->"
  xmlFlush
}
proc xmlClose {} {
  global xmlStack xmlLookAside xmlBuffer xmlSelfClose xmlIndent

  set stackTop [lindex $xmlStack end]
  set xmlStack [lrange $xmlStack 0 end-1]
  
  if {$stackTop != $xmlSelfClose} {
    # Buffer should be empty
   assert {$xmlBuffer == {}}
    set xmlBuffer [string repeat $xmlIndent [llength $xmlStack]]
    append xmlBuffer "<$stackTop"
  } else {
    append xmlBuffer $stackTop
  }
  xmlFlush 1
}

# Now combine these two to make a new command...

proc xmlStatement {key data {body {}} args} {
  global debug
  if {$debug != 0} {
    if {$args != {}} {
      puts "Extra args to xmlStatement $args"
    }
    # puts "xmlStatement: key >$key< data >$data<"
  }
  uplevel "xmlOpen $key [list $data]"
  #puts "BODY $body"
  if {$body != {}} {
    uplevel "eval [list $body]"
  }
  xmlClose
}

# This proc opens the given file name and returns the contents

proc xmlOpenAndRead {opt} {
  set r [catch "open $opt r" fid]
  if {$r != 0} {
    xmlHelp "Can not open file $opt: $fid"
  }
  # ok, we have an open file.
  set fileData [read $fid]
  close $fid
  return $fileData
}

# Expands and adds all files from dir and sub dirs to the file & dir lists
#
proc  xmlAddDirContents {dirIn} {
  global product-file product-dirs exclude debug
  lappend dir $dirIn
  set idx 0
  while {$idx < [llength $dir]} {
    set thisDir [lindex $dir $idx]
    if {$debug} {
      puts "Searching $idx of [llength $dir] $thisDir"
    }
    foreach f [glob -nocomplain -directory $thisDir -tails -types d -- *] {
      if {[filterList $thisDir/$f $exclude] != {}} {
	lappend dir $thisDir/$f
	lappend product-dirs $thisDir/$f
      }
    }
    # Now get the files...
    foreach f [glob -nocomplain -directory $thisDir -tails -types f -- *] {
      if {$debug}  {
	puts "Adding $thisDir/$f"
      }
      if {[filterList $thisDir/$f $exclude] != {}} {   
	lappend product-file $thisDir/$f
      }
    }
    incr idx
  }
}

# filters entries in 'list' removing any that match any of the patterns in a list
# patterns in a list of patterns

proc filterList {list patterns} {
  global debug
  set productFileList {}
  foreach file $list {
    set match 0
    foreach pattern $patterns {
      if {[string match $pattern $file]} {
	if {$debug} {
	  puts "Excluding $file on pattern $pattern"
	}
	incr match
	break
      }
    }
    if {$match != 0} {continue}
    lappend productFileList $file
  }
  return $productFileList
}

# Id's must be composed of only A-Z,a-z,_ and . only. Here we
# mnuge a file name to fit into the rules of an Id.
set xmlIdMap {- _ / . \\ . { } .. : _}

proc fileToId {file} {
  global path
  global xmlIdMap

  # First, if present remove $path prefix
  if {[string equal -length [string length $path] $path $file] == 1} {
    set file [string range $file [string length $path]+1 end]
  }
  return [string map $xmlIdMap $file]
}
#-----------------------------------------------------------------------------------#
# OK, lets get to work.
#
# First lets get the passed in items...
#
for {set idx 0} {$idx < [llength  $argv]} {incr idx} {
  set ar [lindex $argv $idx]
  set arSplit [split $ar "="]
  lassign $arSplit opt val
  if {[llength $arSplit] == 1} {
    switch -nocase -glob $opt {
      -h    -
      *-help {xmlHelp}
      -*         {xmlHelp  "Parameter \"$opt\" not supported."}
    }

    set fileStuff {}
    # puts "Processing argv: $ar -> >$opt< >$val<"
    foreach line [split [xmlOpenAndRead $opt] \n] {
      set lineClean [string trim $line]
      if {$lineClean == {} || [string index $lineClean 0] == "#"} {continue}
      lappend fileStuff $lineClean
    }
    if {$idx + 1 == [llength $argv]} {
      lappend argv {*}$fileStuff
    } else {
      set argv [lreplace $argv $idx+1 $idx {*}$fileStuff]
    }
    continue
  }
  
  # singletons done, now the "=" pairs
  # allow expressions...
  set val [subst $val]
  #
  #puts "$opt $val"
  switch -exact  $opt {
    debug -
    revision -
    product-name -
    short-cut-name -
    short-cut-param -
    short-cut-show -
    product-description -
    product-manufacturer -
    update-code -
    completion-text -
    short-cut-target {set [set opt] [expr {$val=="{}" ? {} : $val}]}
    eula -
    out-file -
    icon -
    product-file -
    exclude {lappend  [set opt] $val}
    path {
      set path [normKeepSl $val]
      if {![file readable $path] || ![file isdirectory $path]} {
	xmlHelp "Path ($val -> $path) either does not exists or is not readable"
      }
    }							 
   list-of-files {
      #puts "list-of-files with $opt $val"
     foreach ln [split [xmlOpenAndRead $val] \n] {
       set fi [normKeepSl [file join $path [string trim $ln]]]
       if {![file isdir $fi]} {
	 lappend product-file $fi
	 lappend product-dirs [file dir $fi]
       } else {
	 lappend product-dirs $fi
       }
     }
   }
   default {xmlHelp "Parameter \"$opt\" not supported." }
  }
}

# we don't include parms that are verified while processing argv (i.e. path, list-of-files)

set listOfReadable {
  eula
  icon
  short-cut-target
  product-file
  exclude
}
# only the last entry for these parms
set onlyLast {eula icon short-cut-target out-file short-cut-show}

set listOfNonFileParms {
  debug 
  short-cut-name 
  short-cut-param
  short-cut-show
  product-description
  update-code
  product-manufacturer
  list-of-files
}

set listOfRequired {
  revision
  product-name
  product-file
  product-manufacturer
  update-code
  path
}


set listOfAllParms [lsort -unique [concat \
				       $listOfRequired \
				       $listOfNonFileParms \
				       $onlyLast \
				       $listOfReadable]]


if {$debug != 0} {
  foreach var $listOfAllParms {
    #if {$var == "product-file"} {continue}
    set foo [set $var]
    if {$var in $listOfNonFileParms || $var == "path"} {
      puts "$var is: $foo"
      continue
    }
    if {$var == "product-file" && $debug < 2} {continue}
    puts "$var is: [lindex $foo 0]"
    if {[llength $foo] > 1} {
      foreach val [lrange $foo 1 end] {
	puts "[string repeat " " [string length $var]]     $val"
      }
    }
  }
}
 
# Make sure it makes sense (at least on the surface)

# These must exist:
set notDefined {}
foreach elm $listOfRequired {
  if {[set $elm] == {} } {
    lappend notDefined $elm
  }
}

if {$notDefined != {} } {
  xmlHelp "The following option(s) must be defined: $notDefined"
}

# Expand any dirs in the product-file list and verify existance and
# readability of each. Create a seperate list of dirs.

set notReadable {}

for {set idx 0} {$idx < [llength ${product-file}]} {incr idx} {
  set rawFl [lindex ${product-file} $idx]
  set fl [normKeepSl [file join $path $rawFl]]
  if {[file isdirectory $fl]} {
    lappend product-dirs $fl
    xmlAddDirContents $fl
    continue
  }
  if {![file readable $fl]} {
    lappend notReadable
  }
  lappend product-files $fl
  # pick up any directories required
  set noDirBelow [list $path . / {}]
  while {[set fl [file dirname $fl]] ni $noDirBelow} {
    # puts "adding dir $fl"
    lappend product-dirs $fl
  }
}

set product-files [lsort -unique ${product-files}]
set product-dirs  [lsort -unique ${product-dirs}]

# Now filter out the excludes...

set productFiles [filterList ${product-files} $exclude]
set productDirs  [filterList ${product-dirs} $exclude]

foreach fl $listOfReadable {
  set sub [set $fl]
  foreach file $sub {
    set file [file join $path $file]
    if {![file readable $file]} {
      lappend notReadable $file
    }
  }
}

if {$notReadable != {} } {
  xmlHelp "The following files  either do not exists or are not readable:
\n[join $notReadable \n]"
}

# Build a list of just the subdirs under the target (i.e. dump the path part}
# also make it a list of subdirs (i.e. change the "/" to " ")

set subDirs {}

foreach dir $productDirs {
  if {$dir == $path} {continue}
  if {[string equal -length [string length $path] $path $dir] != 1} {
    xmlHelp "Do not know how to handle ($dir) a directory not in the product path ($path)"
  }
  lappend subDirs [split [string range $dir [string length $path]+1 end] /\\ ]
}

if {$debug != 0} {
  puts "\nSorted list of product dirs."
  lst $productDirs
  puts " "
  puts "\nAnd the short form:"
  lst $subDirs
  puts "\nSorted list of product files."
  lst $productFiles
}

# Make sure we are about to tell windows to execute a file we are producing...




# check other files

foreach fl {icon short-cut-target} {
  set fl [set $fl]
  set tf [file join $path $fl]
  if {$fl != {} && (![file isfile $tf] || ![file readable $tf])} {
    xmlHelp "File $tf is not a normal readable file"
  }
}

# now the parms that have fixed options...

switch -glob ${short-cut-show} {
  n*  {set an "normal"}
  mi* {set an "minimized"}
  ma* {set an "maximized"}
}
if {![info exists an] || ![string match "${short-cut-show}*" $an]} {
  xmlHelp "short-cut-show (${short-cut-show}) must be one of \
           normal, minimized or maximized or an abbreviation thereof."
}
set short-cut-show $an

# Lastly lets check the rev code.  It must be "." seperate numbers
# and we need 4 of them
#
set revList [split $revision "."]
foreach bit $revList {
  if {[string is digit $bit] && $bit <= 255} {continue}
  incr revFail
}
if {[info exists revFail] || [llength $revList] != 4} {
  xmlHelp "Revision ($revision) must be 4 dot seperated numbers, each less than 256"
}

# And another recursive proc to product the directory structure

proc xmlDirectories {listIdx subIdx} {
  global subDirs
  # puts "$subDirs $listIdx $subIdx"
  while {$listIdx < [llength $subDirs]} {
    set dir [lindex $subDirs $listIdx $subIdx]
    if {$dir == {}} {return $listIdx}
    # puts "Open $listIdx $subIdx  subdir $dir [join [lindex $subDirs $listIdx] /]"
    xmlStatement Directory {Id="Dir_[fileToId [join [lindex $subDirs $listIdx] /]]" Name="$dir"} {
      incr listIdx
      set next [expr {$subIdx + 1}]
      while {[lindex $subDirs $listIdx $subIdx] == $dir} {
	# puts "Try $listIdx $next"
	set nlistIdx [xmlDirectories $listIdx $next]
	# puts "Back from Try $listIdx $next return was $nlistIdx"
	if {$nlistIdx == $listIdx} {break}
	set listIdx $nlistIdx
      }
    }
    # puts "close $dir"
    # do close subdir
  }
  return $listIdx
}

# All is cool to this point, lets build the msi xml file
#
set xmlBuffer {<?xml version="1.0" encoding="ASCII"?>}
xmlFlush
xmlFlush

xmlComment {This file produced by msi-tool.tcl version $version
  on [clock format [clock seconds] -format {%m/%d/%y at %H:%M:%S}]}
xmlFlush

xmlStatement Wix {xmlns="http://schemas.microsoft.com/wix/2006/wi"} {
  xmlStatement Product {
    Id="*"
    UpgradeCode="[xmlGUID Product ${update-code} ]"
    Version="$revision"
    Language="1033"
    Name="${product-name}"
    Manufacturer="${product-manufacturer}"} {
      xmlStatement Package {InstallerVersion="300" Compressed="yes"} 
      xmlStatement Media {Id="1" Cabinet="${product-name}.cab" EmbedCab="yes"}
      xmlFlush
      xmlComment {
	Step 1: Define the directory structure
      }
      xmlFlush

      if {$icon != {} } {
	xmlStatement Icon {
	  Id="[fileToId $icon]"\
	      SourceFile="[regsub $regsubPat [file join $path $icon] {\1:}]"
	}
      }
      if {$eula != {} } {
	xmlStatement WixVariable {
	  Id="WixUILicenseRtf"\
	      Value="[regsub $regsubPat [file join $path $eula] {\1:}]"
	}
      }
      xmlStatement Property {Id="ARPNOREPAIR" Value="yes" Secure="yes"}
      xmlStatement MajorUpgrade {
	DowngradeErrorMessage="Newer Version of ${product-name} is already installed."
	AllowSameVersionUpgrades="yes"}
      #
      xmlStatement Directory {Id="TARGETDIR" Name="SourceDir"} {
	
	if {${short-cut-name} != {} } {
	  xmlStatement Directory {Id="DesktopFolder" Name="Desktop"}
	  xmlStatement Directory {Id="ProgramMenuFolder"} {
	    xmlStatement Directory {Id="ApplicationsProgramFolder" Name="${product-name}"}
	  }
	}
	xmlStatement  Directory {Id="INSTALLDIR" Name="Program Files"} {
	  xmlStatement Directory {Id="APPROOT" Name="${product-name}"} {
	    xmlDirectories 0 0
	  }
	}
      }
      if {${completion-text} != {} } {
	xmlStatement Property {Id="WIXUI_EXITDIALOGOPTIONALTEXT"
	  Value="${completion-text}"}
      }
      xmlStatement Property {Id="ApplicationFolderName" Value="${product-name}"}
      xmlStatement Property {Id="WixAppFolder" Value="WixPerMachineFolder"}
      xmlStatement Property {Id="WIXUI_INSTALLDIR" Value="INSTALLDIR"}
      #xmlStatement UIRef {Id="WixUI_InstallDir"}
      xmlStatement UIRef {Id="WixUI_Mondo"}
      
      xmlFlush
      xmlComment {Step 2: Add files to your installer package
      }
      set pathL {}
      lappend pathL $path
      foreach dir [concat  $pathL $subDirs] {
	if {$dir == $path} {
	  set Id APPROOT
	} else {
	  
	  set Id Dir_[fileToId [join $dir /]]
	}
	xmlStatement DirectoryRef {Id="$Id"} {
	  set searchPath [expr {$dir == $path ? $path : [ join [concat $pathL  $dir] / ]}]
	  #puts "$searchPath"
	  foreach file ${productFiles} {
	    # if {$file == $icon} {continue}
	    if {[file dir $file] == $searchPath} {
	      set tail [file tail $file]
	      xmlStatement Component {Id="Comp_[fileToId $file]"
		Guid="[xmlGUID file $file]"} {
		  xmlStatement File {Id="[fileToId $file]"
		    Source="[regsub $regsubPat [normKeepSl $file] {\1:}]"
		    KeyPath="yes"}
		}
	    }
	  }
	  if {$Id == "APPROOT"} {
	    xmlStatement Component {Id="RemoveDir" Guid="[xmlGUID removeProductDir]"} {
	      xmlStatement RemoveFolder {Id="$Id" On="uninstall"}
	    }
	  }
	}
      }
      if {${short-cut-target} != {} } {
	set iconref Icon=\"[fileToId $icon]\"
	
	xmlStatement DirectoryRef {Id="ApplicationsProgramFolder"} {
	  xmlStatement Component {Id="ApplicationShortCut" Guid="[xmlGUID startShortCut]"} {
	    xmlStatement Shortcut {Id="ApplicationStartMenuShortcut"
	      Target="\[![file tail ${short-cut-target}]\]"
	      [expr {$icon == {} ? {} : $iconref} ]
	      Name="${short-cut-name}"
	      Show="${short-cut-show}"
	      Description="${product-description}"}
	    
	    xmlStatement RemoveFolder {Id="ApplicationsProgramFolder" On="uninstall"}
	    xmlStatement RegistryValue {
	      Root="HKCU"
	      Key="Software\Microsoft/${product-name}"
	      Name="installed"
	      Type="integer"
	      Value="1"
	      KeyPath="yes" }
	  }
	}
	xmlStatement DirectoryRef {Id="DesktopFolder"} {
	  xmlStatement Component {Id="DesktopShortCut" Guid="[xmlGUID startShortCut]"} {
	    xmlStatement Shortcut {Id="DesktopShortcut"
	      Name="${short-cut-name}"
	      Description="${product-description}"
	      [expr {$icon == {} ? {} : $iconref}]
	      Show="${short-cut-show}"
	      Target="\[![file tail ${short-cut-target}]\]"}
	    
	    xmlStatement RemoveFile {Id="DesktopShortcut"
	      Name="${short-cut-name}"
	      On="uninstall"}
	    xmlStatement RegistryValue {
	      Root="HKCU"
	      Key="Software\Microsoft/${product-name}"
	      Name="installed"
	      Type="integer"
	      Value="1"
	      KeyPath="yes" }
	  }
	}
      }
      xmlComment {Step 3: Tell WiX to install the files}
      #xmlStatement UIRef {Id="WixUI_FeatureTree" }
      
      xmlStatement Feature {Id="MainApplication"
	Title="${product-name}"
	ConfigurableDirectory="INSTALLDIR"
	Display="expand"
	Level="1"} {
	  set searchPath [expr {$dir == $path ? $path : [ join [concat $pathL  $dir] / ]}]
	  # puts "$searchPath"
	  foreach file ${productFiles} {
	    # if {$file == $icon} {continue}
	    xmlStatement ComponentRef {Id="Comp_[fileToId $file]"}
	  }
	  xmlStatement ComponentRef {Id="RemoveDir"}
	}
      if {${short-cut-target} != {} } {
	xmlStatement Feature {Id="MenuItem"
	  Absent="allow"
	  Title="Put ${product-name} in the system run menu?"
	  Display="expand"
	  AllowAdvertise="yes"
	  Level="1"} {
	    xmlStatement ComponentRef {Id="ApplicationShortCut"}
	  }
	    xmlStatement Feature {Id="DesktopItem"
	      Absent="allow"
	      Title="Put ${product-name} on the desktop?"
	      Display="expand"
	      Level="2"} {
		xmlStatement ComponentRef {Id="DesktopShortCut"}
	      }
      }
    }
}



# Clear the stack
# puts "Ending Stack >$xmlStack<"
while {[llength $xmlStack]} {xmlClose}
puts "wsx Success! Result in [normKeepSl ${out-file}]"
puts "Now trying to compile!"

if {${out-file} == {}} {

  lst $xmlOut
} else {
  set r [catch "open ${out-file}.wsx w" fid]
  if {$r != 0} {
    xmlHelp "Error opening out-file (${out-file}.wsx): $fid"
  }
  foreach line $xmlOut {
    puts $fid "$line"
  }
  close $fid
  
  set r [catch "open ${out-file}.mft w" fid]
  if {$r != 0} {
    xmlHelp "Error opening out-file (${out-file}.mft): $fid"
  }
  puts $fid "Manifest Types:"
  puts $fid ""
  foreach line $manifestTypes {
    puts $fid "$line"
  }

  puts $fid "Manifest:"
  puts $fid ""
  foreach line $manifestBody {
    puts $fid "$line"
  }
  close $fid
}

# Here we need to run candle and light as follows:

#    candle  -o . filerunner.wsx

#    light -v -ext WixUIExtension -cultures:en-us -sval -o filerunner.msi filerunner.wixobj

# notes: if wix is down loaded to linux and run from directory "dir"
#        then these two need to run with "dir" as the working dir.
#
#        Also, the "." must be expanded to "[pwd]\\" (windows remember)
#        and other file references should be full paths.
#        On my system validation fails, thus the -sval

# Helper routine

proc exists {dir files} {
  foreach file $files {
    if {![file exists $dir/$file]} {return 0}
    # In this case we want to remove the sym links...
    lappend rtn [file dir [file norm $dir/$file/x]]
  }
  return $rtn
}

# First, lets figure out if we are on windows or *nix and act accordingly
#
set candle {}
set light {}

set path [pwd]
if {[info exists env(WIX)]} {
  set path [list $env(WIX)]
}

if {$tcl_platform(platform) == "windows" } {
  # Its windows, that is cool.
  # See if the processes we need are available
  if {$path != {}} {
    set found [exists $path {candle.exe light.exe}]
  }
  if {$found == 0} {
    set found [list [auto_execok candle.exe] [auto_execok light.exe]]
    set cmdc [frECF "exec candle -v -o %s %s" [list [file norm ${out-file}.wixobj]\
						   [file norm ${out-file}.wsx] ] -fonly 1]
    
     set cmdl [frECF "exec light -v -ext WixUIExtension -pedantic -sval -out %s %s" \
		  [list [file norm ${out-file}.msi]\
		       [file norm ${out-file}.wixobj]] -fonly 1]
  }
} else {
  # The platform is linux or some such..
  # We try to find the required code in two ways:
  # a) the programs are in one of the dirs on the path, (not executable of course) or
  # b) the environmet variable WIXPATH is set to the location.
  foreach dir [concat $path [split $env(PATH) :]] {
    set found [exists $dir {candle.exe light.exe}]
    if {$found != 0} {break}
  }
  if {$found != 0} {
    lassign $found candle light
  }
  if {$candle == {} || $light == {}} {
    helpOut {At this point the "msi" build requires the Wix programs "candle" and "light".
      One of these was not found.  Please:
      (A.)  load the Wix package and
      (B.)  put the Wix dir in your path or, if not windows
      (B.1) put the Wix dir in enviornment variable "WIX" (Wix install seems to do this) or
      (B.2) put links to candle.exe and light.exe in a dir on your path
    }
    helpOut "Found \"$candle\" for \"candle.exe\" and \"$light\" for \"light.exe\""
    exit 1
  }
  if {!$wsl} {
    set cmdc [frECF "exec $toolPrefix %s -v -o %s %s" \
		  [list $filePrefix$candle\
		       $filePrefix[file norm ${out-file}.wixobj]\
		       $filePrefix[file norm ${out-file}.wsx] ] -fonly 1]
    
     set cmdl [frECF "exec $toolPrefix %s  -v -ext WixUIExtension -pedantic -sval -out %s %s" \
		   [list $filePrefix$light\
			$filePrefix[file norm ${out-file}.msi]\
			$filePrefix[file norm ${out-file}.wixobj]] -fonly 1]
    
  } else {
    # We are in a MSW WSL environment, i.e. linux code using a windows program
    # set cmdc [list {*}$candle -v -o [regsub {/mnt/([a-z])} [pwd] {\1:}]\\ \
    # 		  [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.wsx/x]] {\1:}]
    # 	     ]
    set cmdc [frECF "exec candle -v -o %s %s" \
		  [list\
		       [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.wixobj/x]] {\1:}]\
		       [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.wsx/x]] {\1:}]\
		      ] -fonly 1]
    
    # set cmdl [list {*}$light -v -ext WixUIExtension -cultures:en-us -sval\
    # 		  -o [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.msi/x]] {\1:}]\
    # 		  [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.wixobj/x]] {\1:}]
    
     set cmdl [frECF "exec light -v -ext WixUIExtension -pedantic -sval -out %s %s" \
		  [list [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.msi/x]] {\1:}]\
		       [regsub {/mnt/([a-z])} [file dir [file norm ${out-file}.wixobj/x]] {\1:}]\
		      ] -fonly 1]
	       
  }
}

# At this point we have the two required Wix programs
file delete ${out-file}.wixobj
file delete ${out-file}.msi

foreach {cmd result} [list $cmdc .wixobj $cmdl  .msi] {
  set bad 0
  puts "\nTrying >$cmd<"
  set r [catch "$cmd" resp]
  foreach rs $result {
    if {![file exists ${out-file}$rs]} {incr bad}
  }
  if {!$bad} {continue}
  puts "$r $resp"
  foreach line [split $resp \n] {
    if {[string range $line 0 5] == "fixme:"} {continue}
    puts stdout $line
    if {![file exists ${out-file}.wixobj]} {
      puts "Something is wrong, quit now"
      exit 1
    }
  }
}


if {[file exists ${out-file}.msi]} {
  puts stdout "\nSuccess!!!!!!!!"
  exit 0
}
