# !/bin/sh
#
# This file implements a "make" program.  Unlike the usual make, this
# version of "make" reads Makefile.tcl instead of Makefile, and interprets
# Makefile.tcl as a TCL script.  Two new TCL commands are defined which
# can be used in Makefile.tcl to construct the dependency tree:
#
#    Make               This command tells how to construct an object from
#                       its component parts.
#
#    Shell              The argument to this command is a shell command that
#                       is executed to build some component of the system.
#
# After executing all of Makefile.tcl, this program walks the dependency 
# tree created by Makefile.tcl and executes all commands necessary to 
# build the target(s) specified on the command line.  If this program 
# is invoked with no arguments, then the first object named in any
# "Make" command in Makefile.tcl is built.
#
# The Makefile.tcl file can contain any TCL code the user desires.  However,
# this file defines several private variables and procedures that the
# Makefile.tcl file should avoid using.  All private variables and
# procedures begin with the prefix "make_".  "Make" and "Shell" are the
# only publicly accessible procedures defined.
#

# Check to make sure we have at a working "tclsh"
tclsh <<\END_OF_SCRIPT || \
(echo 'You must have the program "tclsh" installed on your system in order
to use tclmake.' >&2; exit 1)
exit 0
END_OF_SCRIPT

# No go ahead and run the large TCL script that actually implements the
# new make.
exec tclsh -- $@ <<\END_OF_TCL_SCRIPT

#
# Implement the "Make" command.
#
#    Make TARGET from DEPENDENCY
#    Make TARGET using CODE
#    Make TARGET from DEPENDENCY using CODE
#
# All this command does is stuff information into global variables
# for later use by "make_build".  Basically, it does this:
#
#    set make_from(TARGET) DEPENDENCY
#    set make_using(TARGET) CODE
#
# Note that both TARGET and DEPENDENCY can be lists.
#
proc Make {targets args} {
  global make_from make_using make_default_target

  # Set the default target if there isn't already a default
  if ![info exists make_default_target] {
    set make_default_target [lindex $targets 0]
  }

  # Process the "from" section of the command 
  if \"[lindex $args 0]\"==\"from\" {
    set list [lindex $args 1]
    foreach t $targets {
      if ![info exists make_from($t)] {
        set make_from($t) $list
      } else {
        set make_from($t) [concat $make_from($t) $list]
      }
    }
    set args [lrange $args 2 end]
  }

  # Process the "using" section
  if \"[lindex $args 0]\"==\"using\" {
    set list [lindex $args 1]
    foreach t $targets {
      set make_using($t) $list
    }
    set args [lrange $args 2 end]
  } else {
    foreach t $targets {
      if {![info exists make_using($t)]} {
        set make_using($t) {}
      }
    }
  }

  # Report a syntax error
  if [llength $args]>0 {
    make_error {Bad arguments to "Make"}
  }
}

# Report an error and die
#
proc make_error {msg} {
  puts stderr $msg
  global make_quiet
  if {!$make_quiet} {
    puts "** End make in [pwd] **"
  }
  exit 1
}

# Implement the "Shell" command.  This command works like "exec" except:
#
#     * Variables in the argument to Shell are expanded as if they were
#       global variables before the command is executed.
#
#     * The command is executed by a real shell, not by execve().
#
#     * If the Shell command occurs within the "using" clause of a "Make"
#       command, then the variable $source in the argument is expanded
#       to a list of every DEPENDENCY.  Similarly, $target is expanded
#       to the current TARGET for the Make command.
#
#     * The command is printed on standard output before it is executed.
#       The output of the command also goes to standard output during
#       execution.
#
proc Shell {cmd} {
  global make_quiet
  set cmd [uplevel #0 set make_bogus \"$cmd\"]
  if !$make_quiet {puts $cmd}
  set exec_cmd [format {exec sh -c {%s} >@stdout 2>@stderr} $cmd]
  set retcode [catch $exec_cmd errmsg]
  if {$retcode!=0} {
    global errorInfo
    error $errmsg $errorInfo
  }
}

# The following command builds the object named in its argument.  It
# returns success or failure, as appropriate.  This function may call
# itself recursively to build other objects that depend on the object
# named in the argument.
#
# This routine is for internal use only.
#
proc make_build {make_t} {
  global make_from make_using make_busy make_verbose make_done make_error_count

  # early out if the target has already been built.
  if [info exists make_done($make_t)] return

  # Block infinite recursion
  if [info exists make_busy($make_t)] {
    make_error "$make_t depends upon itself"
  }
  set make_busy($make_t) 1

  if $make_verbose {puts "begin building $make_t"}

  # The "make_d" variable holds a list of dependencies.
  if [info exists make_from($make_t)] {
    set make_d $make_from($make_t)
  } else {
    set make_d {}
  }

  set make_build_flag 0;         # This flag is 1 if a rebuild is necessary

  # Check to see if any dependencies need to be built first
  foreach d $make_d {
    make_build $d
  }

  # Check to see if the target is older than any dependency
  if ![file exists $make_t] {
    set make_build_flag 1
  } else {
    set t_time [file mtime $make_t]
    foreach d $make_d {
      if {[file exists $d] && $t_time<[file mtime $d]} {
        set make_build_flag 1
        break
      }
    }
  }

  # Do the build, if necessary
  if $make_build_flag {
    if ![info exists make_using($make_t)] {
      error "Don't know how to make $make_t"
    } else {
      global target source make_quiet
      set target $make_t
      set source {}
      foreach make_x $make_d {lappend source $make_x}
      if {!$make_quiet} {puts "** $make_t **"}
      catch "exec rm -f {$make_t}"
      if [catch {uplevel #0 $make_using($make_t)} msg] {
        catch "exec rm -f {$make_t}"
        make_error "$msg\nMake failed for target $make_t"
      }
    }
  }

  # clean up
  if $make_verbose {puts "finished building $make_t"}
  unset make_busy($make_t)
  set make_done($make_t) 1
}

# Process command-line arguments and switches
set make_verbose 0
set make_quiet 0
set make_error_count 0
set make_option_stop 0
set make_build_list {}
set make_file Makefile.tcl
set make_i 1
set make_options {}
while {$make_i<$argc} {
  set make_x [lindex $argv $make_i]
  incr make_i
  switch -glob -- $make_x {
    --  {
       incr make_i
       set make_build_list [concat $make_build_list [lrange $argv $make_i end]]
       set make_i $argc
    }
    -D -
    --define  {
       set make_right {}
       lappend make_options $make_x
       set make_x [lindex $argv $make_i]
       lappend make_options $make_x
       incr make_i
       if [scan $make_x {%[^=]=%[^=]} make_left make_right] {
          set $make_left $make_right
       }
    }
    --verbose -
    -v  {
       lappend make_options $make_x
       set make_verbose 1
       set make_quiet 0
    }
    --quiet -
    -q  {
       lappend make_options $make_x
       set make_verbose 1
       set make_quiet 1
    }
    --file -
    -f {
       set make_file [lindex $argv $make_i]
       incr make_i
    }
    -* {
       puts stderr "Unknown command-line option: $make_x"
       incr make_error_count
    }
    default {
      lappend make_build_list $make_x
    }
  }
}
if $make_error_count {exit 1}

# Find and source the makefile
if ![file readable $make_file] {
  error "Can't find \"$make_file\""
  exit 1
}
if {!$make_quiet} {
  puts "** Begin make in [pwd] **"
}
if [catch "source $make_file" errmsg] {
  make_error "Syntax error in $make_file: $errmsg"
}

# Do the build
if {[string length $make_build_list]>0} {
  foreach t $make_build_list {make_build $t}
} else {
  make_build $make_default_target
}
if {!$make_quiet} {
  puts "** End make in [pwd] **"
}
exit $make_error_count
END_OF_TCL_SCRIPT
