#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}

########################################################################
#
# This file is part of bras, a program similar to the (in)famous
# `make'-utitlity, written in Tcl.
#
# Copyright (C) 1996-2000 Harald Kirsch
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Revision: 1.1 $, $Date: 2002/05/27 20:13:29 $
########################################################################

##
## This is the driver file which tries to mimic the command line
## behaviour of `make' as much as possible.
##

########################################################################
## Set up the environment to work on. We make sure that the path were
## bras was installed is available in ::bras::base and is the first
## one in auto_path.
##
namespace eval ::bras {}

set ::bras::VERSION 2.3.2
set ::bras::VERDATE 0000-00-00
set ::bras::base [file join [pwd] rules]
#BEGIN: bras.tcl
namespace eval ::bras {

  namespace eval gendep {
    ## This namespace will contain procs which map a target matching a 
    ## pattern rule into a useful dependency. See enterPatternRule for 
    ## more information.
  }

  ##### namespace variables

  ## base
  ##   Directory holding files sourced in by this script, as well as
  ##   files someone might find useful sourcing, in particular those
  ##   with suffix .rules. It is set in .version

  ## Opts
  ##   An array of options controlling bras.
  variable Opts
  set Opts(-d) 0;			# debug output
  set Opts(-de) 0;			# don't fix error messages
  set Opts(-k) 0;
  set Opts(-s) 0;			# silent operation
  set Opts(-v) 0;			# verbose operation
  set Opts(-n) 0;			# don't execute any commands
  set Opts(-ve) 0;			# show exec'ed commands

  ## Brasfile
  ##   Name of the rule file used, typically "brasfile" or "Brasfile" 
  variable Brasfile brasfile

  ## Targets
  ##   List of default targets to consider. It is set by the very
  ##   first rule entered into the database

  ## Indent
  ##   Current indent string used by debug messages
  variable Indent ""

  ## Tinfo
  ##   array holding information about targets. With <t> a target,
  ##   <d> its directory, the indices used are:
  ##   <t>,<d>,rule -- index into Rule denoting the rule for <t>,<d>
  ##   <t>,<d>,done -- set, if target was already considered.
  ##                   0: no need to make target
  ##                   1: target will be made
  ##                  -1: target needs to be made, but don't know how

  ## Rule
  ##   database of rules. With integer <i>, the indices are as follows
  ##   <i>,targ -- targets
  ##   <i>,deps -- dependencies
  ##   <i>,cmd  -- command
  ##   all      -- a list of all valid <i>s.
  variable Rule
  set Rule(all) {}

  ## Prule
  ##   database of pattern-rules. Pattern rules are stored and accessed in
  ##   the same order as they are introduced. Therefore each one gets a
  ##   number. The indices are used as follows (<i> denotes an integer):
  ##   all        -- list of all known pattern-rule IDs.
  ##   <i>,trexp  -- regular expression to match target 
  ##   <i>,gendep -- name of dependency generating funciton in
  ##                 ::bras::gendep 
  ##   <i>,cmd    -- command for target/dependency pair
  ##   <i>,cure   -- used by lastMinuteRule, set to 1 if CUrrently
  ##                 REcursively considered.
  variable Prule
  set Prule(all) {}

  ## nextID
  ##   a counter returning unique indices
  variable nextID 0

  ## Known
  ##   array with an element for all files sourced either by following
  ##   an @-target or by an explicit `include'. The directory-part of
  ##   the filename is always normalized by means of [pwd].
  ##

  ## Considering
  ##   is an array with targets as indices. The array element is set
  ##   while ::bras::Consider is working on a target to prevent
  ##   dependency loops

  ## Searchpath
  ## is an array indexed by [pwd] and contains for each directory the
  ## dependency search path. Elements are set by command `searchpath'.

  ## Searched
  ## is an array indexed by [pwd],<name> . If a certain index exists,
  ## <name> is the result of an expansion along brasSearchPath and it
  ## will not be expanded again.
  
  ## Namespace
  ## is an array indexed by [pwd] holding a unique namespace name like 
  ## ::ns123 used as an execution environment for the Brasfile from
  ## [pwd]. 
  
  ## Pstack
  ##   internal variable holding the name of the namespace used for
  ##   predicates to leave values like deps and trigger for the next
  ##   command to run (see installPredicate). The initial value is
  ##   never used except if someone feels like calling a predicate by
  ##   hand instead of via consider.
  variable Pstack ::
}

proc ::bras::nextID {} {
  variable nextID
  incr nextID
  return $nextID
}
proc ::bras::lappendUnique {_list elem} {
  upvar $_list list
  
  if {-1==[lsearch -exact $list $elem]} {
    lappend list $elem
  }
}
proc ::bras::vbackup {_store vars {p {}}} {
  upvar $_store store

  foreach varname $vars {
    if {[info exist store(T${p}$varname)]} {
      return -code error \
	  "a variable with name ${prefix}$varname is already stored"
    }
  }
  foreach varname $vars {
    upvar ${p}$varname var
    if {[array exist var]} {
      set store(T${p}$varname) a
      set store(V${p}$varname) [array get var]
    } elseif {[info exist var]} {
      set store(T${p}$varname) s
      set store(V${p}$varname) $var
    } else {
      set store(T${p}$varname) u
    }
  }
}
proc ::bras::vrestore {_store} {
  upvar $_store store

  foreach ele [array names store T*] {
    set varname [string range $ele 1 end]
    #if {![info exist store(T$varname)]} continue
    upvar $varname var
    catch {unset var}
    switch $store(T$varname) {
      a {
	array set var $store(V$varname)
      }
      s {
	set var $store(V$varname)
      }
      u {
	# just leave unset
      }
      * {
	error "this cannot happen"
      }
    }
  }
}
proc ::bras::concatUnique {_list newElems} {
  upvar $_list list
  
  foreach elem $newElems {
    if {-1!=[lsearch -exact $list $elem]} continue
    lappend list $elem
  }
}
proc stripAt {l} {
  set result {}
  foreach x $l {
    if {[string match @* $x]} {
      lappend result [string range $x 1 end]
    } else {
      lappend result $x
    }
  }
  return $result
}
proc ::bras::runscript {ns script} {
  set code [catch {uplevel \#0 [list namespace eval $ns $script]} res]

  ## Reminder from tcl.h
  # define TCL_OK          0
  # define TCL_ERROR       1
  # define TCL_RETURN      2
  # define TCL_BREAK       3
  # define TCL_CONTINUE    4       
  switch -- $code {
    0 {return $res}
    1 {#error
      return -code error -errorinfo [fixErrorInfo 8 ""]
    }
    2 {#return
      set msg "invocation of `return' not within a proc"
      return -code error -errorinfo $msg
    }
    3 {#break
      return $res
    }
    4 {#continue
      return -code error \
	  -errorinfo "invocation of `continue' not in loop context"
    }
    default {
      return -code error \
	  -errorinfo "unknown exception `$code' caught"
    }
  }
  error "This cannot happen"
}
proc ::bras::fixErrorInfo {n emsg} {
  global errorInfo
  variable Opts

  if {$Opts(-de)} {set n 0}
  set ei [split $errorInfo \n]
  set ei [join [lrange $ei 0 [expr {[llength $ei]-$n-1}]] \n]
  if {""!=$emsg} {append ei "\n    ($emsg)"}
  return $ei
}
rename cd _cd
proc cd {dir} {
  if {"$dir"=="."} return
  _cd $dir
}
proc ::bras::verboseExec args {
  ::bras::report -ve $args
  return [eval ::bras::exec_orig $args]
}
proc ::bras::report {type text {newline 1} } {
  switch -exact -- $type {
    warn {
      set out stderr
    }
    norm -
    -d -
    -v -
    -ve {
      set out stdout
    }
    default {
      return -code error -errorinfo "wrong type `$type'"
    }
  }
  if {$newline} {
    puts $out $text
  } else {
    puts -nonewline $out $text
  }
}    
proc ::bras::followTarget {target} {
  #puts "followTarget $target"

  set oldpwd [pwd]
  
  ## The `@' in front shall not confuse [file dir]
  set dir "@[file dir [string range $target 1 end]]"

  include $dir
  cd [string range $dir 1 end]
  return $oldpwd
}
proc ::bras::defaultGendep {target gendepName} {
  set rootname [file rootname $target]
  return "${rootname}$gendepName"
}
proc ::bras::enterPatternRule {trexp gendep bexp cmd} {
  variable Prule

  ## Emtpy commands are rather useless here
  if {0==[string length $cmd]} {
    return -code error \
	"empty commands are not allowed in pattern rules"
  }

  ## enter the rule
  set id [nextID]
  set Prule(all) [concat $id $Prule(all)]
  set Prule($id,trexp) $trexp
  set Prule($id,gdep)  $gendep
  set Prule($id,bexp)  $bexp
  set Prule($id,cmd)   $cmd
  set Prule($id,cure)  0

  #puts ">>$gendep"
  ## create pattern replacement commands for the dependency
  if { 0==[llength [info commands ::bras::gendep::$gendep]] } {
    proc ::bras::gendep::$gendep {target} \
	"return \[::bras::defaultGendep \$target $gendep\]"
  }
}
proc ::bras::enterRule {targets gdep bexp {cmd {}} } {
  variable Targets
  variable Rule
  variable Tinfo

  if {[llength $targets]==0} {
    return -code error "The target list may not be empty"
  }

  #puts "enterRule: {$type} {$targets} {$deps} {$cmd} {$bexp}"

  ## if this is the very first explicit rule seen, and if no target was
  ## specified on the command line, this is the default target-list.
  ## It suffices to put just the first element into Targets,
  ## because all of them are made by the command of this rule.
  ## We also record the current directory, because the brasfile may
  ## contain cd-commands.
  if {![info exist Targets]} {
    set Targets [list [pwd] [lindex $targets 0]]
  }

  ## Although more than one `Make'-command for a target is allowed in
  ## a brasfile, all of those are pooled into one rule
  ## internally. Consequently, if a `Make'-command specifies more than
  ## one target which has already a rule associated, they must all
  ## have that same rule.
  set rid {}
  set tmp {}
  set err 0
  foreach t $targets {
    if {[info exist Tinfo($t,[pwd],rule)]} {
      if {"$rid"==""} {
	set rid $Tinfo($t,[pwd],rule)
      } elseif {$rid!=$Tinfo($t,[pwd],rule)} {
	set err 1
      }
      lappend tmp $t
    }
  }
  if {$err} {
    append msg "The targets `$tmp' all have already a rule, but "\
	"these rules are not all same."
    return -code error -errorinfo $msg
  }

  ## If rid is not set now, initialize a rule 
  if {[llength $rid]==0} {
    set rid [nextID]
    lappend Rule(all) $rid
    set Rule($rid,targ) {}
    set Rule($rid,bexp) {}
    set Rule($rid,cmd) {}
  }

  ## We are sure now, all targets either don't have a rule yet or they 
  ## all have the same.
  foreach t $targets {
    set Tinfo($t,[pwd],rule) $rid
  }

  ## Add the new information into Rule($rid,...)
  concatUnique Rule($rid,targ) $targets
  if {"$cmd"!=""} {
    ## It is no good to have more than one command for a target.
    if {""!="$Rule($rid,cmd)" && "$Rule($rid,cmd)"!="$cmd"} {
      set msg {}; append msg \
	  "bras(warning) in `[pwd]': overriding command " \
	  "`$Rule($rid,cmd)' for target `$targets'" \
	  " with `$cmd'"
      report warn $msg
    }
    set Rule($rid,cmd) $cmd

    ## If this rule has a command, we want its boolean expression to
    ## be the first in the list so that it enters its dependencies it
    ## has in front of the dependency list so that [lindex $deps 0] is
    ## equivalent to make's $< .
    set Rule($rid,bexp) \
	[concat [list $targets $gdep $bexp] $Rule($rid,bexp)]
  } else {
    lappend Rule($rid,bexp) $targets $gdep $bexp
  }
  set Rule($rid,run) 0
}
#END: bras.tcl
#BEGIN: consider.tcl

proc ::bras::dmsg {msg} {
  variable Indent
  regsub -all "\n" $msg "\n\#$Indent" msg
  report -d "\#$Indent$msg"
}
proc ::bras::searchDependency {dep} {
  variable Searchpath
  variable Searched
  variable Tinfo

  ## Don't expand @-names
  if {[string match @* $dep]} {
    return $dep
  }

  ## Don't search for targets which are the result of a search already.
  if {[info exist Searched([pwd],$dep)]} {
    return $dep
  }

  ## Don't expand non-relative paths
  set ptype [file pathtype $dep]
  if {"$ptype"!="relative"} {
    if {[file exist $dep] || [info exist Tinfo($dep,[pwd],rule)]} {
      set Searched([pwd],$dep) 1
      return $dep
    } else {
      return {}
    }
  }

  ## If there is no searchpath, assume .
  if {[info exist Searchpath([pwd])]} { 
    set path $Searchpath([pwd])
  } else {
    set path [list {}]
  }

  ## Try to find the dep as a file along the searchpath
  foreach x $path {
    if {"$x"=="."} {set x {}}
    set t [file join $x $dep]
    ## Now it may be an @-target. We must test if the name without
    ## leading @ exists, but then we return the name with @.
    if {[string match @* $t]} {
      set y [string range $t 1 end]
    } else {
      set y $t
    }
    if {[file exist $y]} {
      set Searched([pwd],$t) 1
      return $t
    }
  }

  ## Try to find an explicit rule for the dependency along the
  ## searchpath 
  foreach x $path {
    if {"$x"=="."} {set x {}}
    set t [file join $x $dep]
    ## Now it may be an @-target
    if {[string match @* $t]} {
      set keepPWD [followTarget $t]
      set tail [file tail $t]
      set found [info exist Tinfo($tail,[pwd],rule)]
      cd $keepPWD
    } else {
      set found [info exist Tinfo($t,[pwd],rule)]
    }
    if {$found} {
      set Searched([pwd],$t) 1
      return $t
    }
  }

  return {}
}
proc ::bras::leaveDir {newDir} {
  variable Opts

  if {"$newDir"=="."} return

  if {!$Opts(-s) && !$Opts(-d)} {
    report norm "cd $newDir"
  }
  cd $newDir
}
proc ::bras::touchOtherTargets {rid target res} {
  variable Rule
  variable Tinfo
  set also ""
  foreach t $Rule($rid,targ) {
    if {"$target"!="$t"} {
      lappend also "'$t'"
      set Tinfo($t,[pwd],done) $res
    }
  }
  return $also
}
proc ::bras::cleanupForConsider {target keepPWD res} {
  variable Tinfo 
  variable Considering

  catch {unset Considering($target,[pwd])}  
  set Tinfo($target,[pwd],done) $res
  leaveDir $keepPWD
}
proc ::bras::considerOne {target} {
  variable Opts
  variable Tinfo
  variable Rule
  variable Considering
  variable Indent
  variable Pstack

  ## change dir, if target starts with `@'. Save current dir in
  ## keepPWD.
  set keepPWD .
  if {[string match @* $target]} {
    set keepPWD [followTarget $target]
    set target [file tail [string range $target 1 end]]
    if {"$keepPWD"=="[pwd]"} {
      set keepPWD .
    } else {
      if {!$Opts(-s) && !$Opts(-d)} {
	report norm "cd [pwd]"
      }
    }
  }

  ## check, if this target was handled already along another line of
  ## reasoning 
  if {[info exist Tinfo($target,[pwd],done)]} {
    if {$Opts(-d)} {
      dmsg "have seen `$target' in `[pwd]' already"
    }
    set pwd [pwd]
    leaveDir $keepPWD
    return $Tinfo($target,$pwd,done)
  }

  ## check for dependeny loops
  if {[info exist Considering($target,[pwd])]} {
    set msg "dependency loop detected for `$target' in `[pwd]'" 
    leaveDir $keepPWD
    return -code error -errorinfo $msg
  }

  ## Mark the target as being under consideration to prevent
  ## dependency loops.
  set Considering($target,[pwd]) 1

  ## describe line of reasoning
  if {$Opts(-d)} {dmsg "considering `$target' in `[pwd]'" }

  ## Prepare for further messages
  append Indent "  "

  ## handle targets without rule
  if {![info exist Tinfo($target,[pwd],rule)]} {
    lastMinuteRule $target

    ## Check if there is still no rule available
    if {![info exist Tinfo($target,[pwd],rule)]} {
      set Indent [string range $Indent 2 end]
      if {[file exist $target]} {
	## The target exists as a file, this is ok.
	if {$Opts(-d)} {
	  dmsg "`$target' is ok, file exists and has no rule"
	}
	cleanupForConsider $target $keepPWD 0
	return 0
      } else {
	## The file does not exist, so we decide it must be remade, but
	## we don't know how.
	if {$Opts(-d)} {
	  dmsg "don't know how to make, no rule and file does not exist"
	}
	cleanupForConsider $target $keepPWD -1
	return -1
      }
    }
  } else {
    ## Try to find a command, if there is none. Again, lastMinuteRule
    ## is called. This might even add a depenency to the front of the
    ## dependency list, which is quite right if the command found uses
    ## [lindex $deps 0].
    set rid $Tinfo($target,[pwd],rule)
    if {![string length $Rule($rid,cmd)]} {
      lastMinuteRule $target
    }
  }

  ##
  ## Find the target's rule.
  ##
  set rid $Tinfo($target,[pwd],rule) 


  ## Set up a namespace in which predicates, by means of
  ## installPredicate, will leave values (like trigger, deps) later
  ## made available to the command to be run. 
  set keptPstack $Pstack
  set Pstack ::bras::ns[nextID]
  namespace eval $Pstack {}

  ##
  ## Call the target's rule. [catch] is used because it is assumed
  ## that a rule calls ::bras::listConsider for the dependency list,
  ## which may return an error. 
  ##
  if {[catch [list ::bras::checkMake $rid $target] res]} {
    set Indent [string range $Indent 2 end]
    cleanupForConsider $target $keepPWD 0
    return -code error [fixErrorInfo 4 ""]
  }
  set Indent [string range $Indent 2 end]
  
  ## If target was up-to-date already, return (almost) immediately
  if {$res==0} {
    set also [touchOtherTargets $rid $target 0]
    if {$Opts(-d)} {
      dmsg "`$target' in `[pwd]' is up-to-date"
      if {[llength $also]} {
	dmsg "same holds for: [join $also {, }]"
      }
    }
    namespace delete $Pstack; set Pstack $keptPstack
    cleanupForConsider $target $keepPWD 0
    return 0
  }
  if {$res!=1} {return -code error "this should not happen"}

  ## if someone wants to call consider explicitly for the same target
  ## in the command of the rule, let him/her do so
  unset Considering($target,[pwd])
  
  ## announce running command
  if {$Opts(-d)} {
    if {![info exist [set Pstack]::reason]} {
      set reason "\n    (no reason given by condition)"
    } else {
      regsub -all "\n" [set [set Pstack]::reason] "\n    " reason
    }
    dmsg "making `$target' in `[pwd]' because$reason"
  }
  catch {unset [set Pstack]::reason}

  ## now run the stuff
  if {[catch {invokeCmd $rid $target $Pstack}]} {
    namespace delete $Pstack; set Pstack $keptPstack
    return -code error -errorinfo [fixErrorInfo 2 ""]
  }

  ## clean up a bit
  namespace delete $Pstack; set Pstack $keptPstack

  
  ## All other targets of this rule are assumed to be made now. Mark
  ## them accordingly and filter them out for a message
  set also [touchOtherTargets $rid $target 1]
  if {"$also"!="" && $Opts(-d)} {
    dmsg "same command makes: [join $also {, }]"
  }

  ## finish up and return
  #returnFromConsider $target $keepPWD 1
  cleanupForConsider $target $keepPWD 1
  return 1
}
#END: consider.tcl
#BEGIN: evalCmds.tcl

proc ::bras::unknown args {
  
  #puts "unknown: `$args'"

  set args [eval concat $args]
  #puts "would exec $args"

  ## Finally I decided to not rely on the original unknown, mainly
  ## because it does not cleanly report if it could executed the
  ## command or not. There is no difference in error return codes
  ## between `command not found' and `command found but returned
  ## error'. 
  set cmd [lindex $args 0]
  #puts "unknown for `$cmd'"
  if {![info exists ::auto_noload]} {
    global ::bras::unknown_pending
    if {[info exists ::bras::unknown_pending($cmd)]} {
      return -code error -errorinfo \
	  "self-referential `unknown' for `$cmd'"
    }
    set ::bras::unknown_pending($cmd) 1
    set code [catch {auto_load $cmd [uplevel 1 {namespace current}]} ok]
    unset ::bras::unknown_pending($cmd)
    if {$code} {
      return -code error -errorcode $::errorCode \
	   -errorinfo $::errorInfo
    }
    if {$ok} {
      ## We found and loaded the command
      set code [catch {uplevel 1 $args} msg]
      if {$code==1} {
	## a true error, strip the uplevel
	return -code error -errorcode $errorCode \
	    -errorinfo [fixErrorInfo 0 ""] $msg
      } else {
	return -code $code $msg
      }
    }
  }
  
  ## Arrive here if either auto_noload is set or the command could not
  ## be found by autoload. Note, we don't take care for auto_noexec.
  if {[catch {uplevel 1 exec <@stdin >@stdout $args} res]} {
    return -code error -errorinfo [::bras::fixErrorInfo 5 ""]
  }
  #eval exec <@stdin 2>@stderr >@stdout $args
}
proc ::bras::invokeCmd {rid Target pstack} {
  variable Rule
  variable Opts

  ## find the command to execute
  set cmd $Rule($rid,cmd)
  if {""=="$cmd"} {
    foreach {x y bexp} $Rule($rid,bexp) {
      lappend l $bexp
    }
    set l [join $l "|"]
    append msg \
	"bras(warning) in `[pwd]': no command found to " \
	"make `$Target' for `$l' (hope that's ok)"
    report warn $msg
    return
  }
  
  ## silently ignore commands which contain nothing but .relax.,
  ## possibly surrouned by whitespace.
  if {".relax."=="[string trim $cmd]"} return

  set Rule($rid,run) 1

  if {"[info command ::bras::unknown.orig]"=="::bras::unknown.orig"} {
    ## Someone called `consider' within a rule's command
    set haveUnknown 1
  } else {
    set haveUnknown 0
    rename ::unknown ::bras::unknown.orig
    rename ::bras::unknown ::unknown
  }

  
  ## Set up a namespace within which the command will be executed. The 
  ## main reason for this is that we want to have the variables
  ## targets, target, and those from $values to be unique for this
  ## command. They cannot be global because the command may call
  ## `consider', thereby invoking another command which also wants to
  ## have these variables.

  # The namespace in which the command is run is bound to the current
  # directory. We now set up some additional variables in that
  # namespace, namely target, targets and whatever was communicated by
  # the predicates in the namespace given by $pstack. Because a
  # command may call [consider] recursively, we have to backup and
  # later restore the variables we are going to overwrite.
  set currentDir [pwd]
  set dirns [dirns .]

  set ptails {}
  foreach x [info vars [set pstack]::*] {
    lappend ptails [namespace tail $x]
  }
  vbackup store [concat $ptails {target targets}] [set dirns]::

  namespace eval $dirns [list variable target $Target]
  namespace eval $dirns [list variable targets $Rule($rid,targ)]
  foreach ptail $ptails {
    catch {unset [set dirns]::$ptail}
    ## Sorry, currently only scalars are supported, mainly because
    ## $pstack should normally only contain scalars (see
    ## initialization of vars in installPredicate)
    set [set dirns]::$ptail [set [set pstack]::$ptail]
  }

  if {$Opts(-v)} {
    report -v "\# -- running command --"
    foreach name [info vars [set dirns]::*] {
      set tail [namespace tail $name]
      if {[string match reason $tail]} continue
      report -v "\# $tail = `[set $name]'"
    }
    report -v  [string trim $cmd \n]
  }
 
  if {!$Opts(-n)} {

    if {!$Opts(-v) && !$Opts(-d) && !$Opts(-s)} {
      report norm "\# making `$Target'"
    }

    ## 
    ## Run the command
    ##
    set result [catch {runscript $dirns $cmd}]
    cd $currentDir
    if {$result} {
      set emsg  "running command to make `$Target' in [pwd]"      
      return -code error -errorinfo [fixErrorInfo 2 $emsg]
    }
  }

  vrestore store

  if {!$haveUnknown} {
    rename ::unknown ::bras::unknown
    rename ::bras::unknown.orig ::unknown
  }

}
#END: evalCmds.tcl
#BEGIN: exported.tcl


namespace eval ::bras {
  namespace export configure getenv searchpath \
      include consider dumprules dirns linkvar
}


proc ::bras::configure {option {on {1}} } {
  variable Opts

  switch -exact -- $option {
    -d -
    -de -
    -s -
    -k -
    -v {
      set Opts($option) $on
    }
    -n {
      set Opts($option) $on
      set Opts(-v) $on
    }
    -ve {
      if {$Opts($option)==$on} return
      set Opts($option) $on
      if {$on} {
	rename ::exec ::bras::exec_orig
	rename ::bras::verboseExec ::exec
      } else {
	## we need this for the case that bras is used with wish
	rename ::exec ::bras::verboseExec
	rename ::bras::exec_orig ::exec
      }
    }
    default {
      return -code error "unknown options $option"
    }
  }
}    
proc ::bras::getenv {_var {default {}} } {
  upvar $_var var
  global env

  ## special handling of global vars which are explicitely qualified
  ## with ::
  if {""==[namespace qualifiers $_var]} {
    set _var [namespace tail $_var]
  }
  if {[info exist env($_var)]} {
    set var $env($_var)
  } else {
    set var $default
  }
}
proc ::bras::dirns {dir} {
  variable Namespace

  set here [pwd]

  ## We have to change to that directory to get the normalized
  ## answer from pwd. 
  cd $dir 
  if {[info exist Namespace([pwd])]} {
    set ns $Namespace([pwd])
  } else {
    ## There was no brasfile [include]d for $dir, so the best we can do
    ## is to return ::. This happens in particular, if someone just
    ## uses bras as a package and simple runs some bras commands.
    set ns ::
  }
  cd $here
  return $ns
}
proc ::bras::linkvar {args} {
  if {[llength $args]<2} {
    append err "::bras::linkvar needs at least two params: varname dir"
    return -code error $err
  }
  set dir [lindex $args end]
  if {![file isdir $dir]} {
    append err "last param must be a directory but is `$dir'"
    return -code error $err
  }
  set L [llength $args]
  incr L -1
  foreach varname [lrange $args 0 $L] {
    uplevel \#1 \
	upvar \#0 \[dirns [list $dir]\]::[list $varname] [list $varname]
  }
}
proc ::bras::searchpath { {p {never used}} } {
  variable Searchpath

  if {[llength [info level 0]]==2} {
    ## something was explicitly passed in
    if {[llength $p]} {
      set Searchpath([pwd]) $p
    } else {
      unset Searchpath([pwd])
      return {}
    }
  } elseif {![info exist Searchpath([pwd])]} {
    return {}
  }

  return $Searchpath([pwd])
}
proc ::bras::include {name} {
  variable Known
  variable Brasfile
  variable Namespace 

  if {[string match @* $name]} {
    set name [file join [string range $name 1 end] $Brasfile]
    set haveAt 1
  } else {
    set haveAt 0
  }

  ## We first have to move to the destination directory to get the
  ## correct answer from [pwd]. _NO_, just stripping the directory part
  ## from $name is useless, because it may contain relative parts and
  ## parts leading through one or more soft-links.
  set dir [file dir $name]
  set file [file tail $name]
  set oldpwd [pwd]

  if {[catch "cd $dir" msg]} {
    set at [expr {$haveAt ? "@" : ""}]
    set err "cannot include $at$name, no such directory"
    return -code error -errorinfo $err
  }
  set pwd [pwd]

  if {[info exist Known([file join $pwd $file])]} {
    cd $oldpwd
    return 0
  }
  set Known([file join $pwd $file]) 1

  ## If this was called with an @-name, the file must be sourced in
  ## that directory.
  if {$haveAt} {
    ## @-names are allowed not to exist.
    if {![file exist $file]} {
      report warn "bras warning: no `$Brasfile' found in `[pwd]'"
      cd $oldpwd
      return 1
    }
    ## Set up the namespace for this directory
    set Namespace($pwd) ::ns[nextID]
    set ns $Namespace($pwd)
  } else {
    ## Not an @-include, so we source the file right here, even if it
    ## has a directory part.
    cd $oldpwd
    set ns ::
    set file $name
  }

  ## Read the file while taking care of possible exceptions
  set code [catch {runscript $ns [list source $file]}]
  #set code [catch "uplevel #0 {namespace eval $ns {source $file}}"]

  if {!$code} {
    ## everthing worked fine
    if {$haveAt} {cd $oldpwd}
    return 1
  }

  ## sourcing produced an error. We remove the entries off the error
  ## stack which originate from source/namespace/uplevel/catch
  set emsg "including `$file' in [pwd]"
  if {$haveAt} {cd $oldpwd}
  return -code error -errorinfo [fixErrorInfo 2 $emsg]
}
proc ::bras::consider {targets} {
  variable Opts
  variable Indent

  if {![llength $targets]} {return {}}
  
  if {$Opts(-d)} {
    if {1==[info level]} {
      set caller [info script]
      set procname ""
    } else {
      set caller [info level -1]
      if {"$caller"==""} {
	set caller "global invocation"
	set procname ""
      } else {
	set procname [uplevel [list namespace which [lindex $caller 0]]]
      }
    }
    if {![string match ::bras::* $procname]} {
      dmsg "=> on behalf of `$caller':"
      append Indent "  "
      set msg 1
    }
  }

  set res {}
  set err {}
  foreach t $targets {
    if {[catch {::bras::considerOne $t} r]} {
      if {$Opts(-k)} {
	## User requested to keep going anyway
	set emsg {}
	append emsg \
	    [fixErrorInfo 2 ""] \
	    "\nbras warning: ignoring error while making `$t' in `[pwd]'"
	report warn $emsg
	set r 1
      } else {
	return -code error -errorinfo [fixErrorInfo 2 ""]
      }
    } elseif {$r<0} {
      ## Failed to find a way to make the target
      if {$Opts(-k)} {
	## User requested to assume that it was made and keep going
	report warn \
	    "bras warning: don't know how to make `$t' in `[pwd]'"
	set r 1
      } else {
	append err "don't know how to make `$t' in `[pwd]'"
	break
      }
    }
    lappend res $r
  }

  if {[info exist msg]} {
    set Indent [string range $Indent 2 end]
    dmsg "<= done"
  }

  if {"$err"!=""} {
    return -code error -errorinfo $err $err
  } else {
    return $res
  }
}
proc ::bras::forget { {pattern *} {dir *} } {
  foreach name [array names ::bras::Tinfo $pattern,$dir,done] {
    unset ::bras::Tinfo($name)
  }
}
proc ::bras::dumprules {} {
  variable Known
  variable Prule
  variable Rule

  puts "\#\# bras dumping rules"
  puts "\#\# known files are:"
  foreach x [array names Known] {
    puts "\#\#   `$x'"
  }
  puts ""

  puts "\#\# pattern rules:"
  foreach id $Prule(all) {
    set gd $Prule($id,gdep)
    puts -nonewline "proc $gd {[info args ::bras::gendep::$gd]} {"
    puts -nonewline "[info body ::bras::gendep::$gd]"
    puts "}"
    puts "PatternMake $Prule($id,trexp) $gd {"
    puts "  $Prule($id,bexp)"
    puts -nonewline "} {"
    puts "  $Prule($id,cmd)}"
    puts ""
  }

  puts "\#\# rules:"
  foreach id $Rule(all) {
    puts "Make $Rule($id,targ) {"
    foreach {t d b} $Rule($id,bexp) {
      puts "$b"
    }
    puts "} {"
    puts "$Rule($id,cmd)"
    puts "}"
  }
}
#END: exported.tcl
#BEGIN: lastMinuteRule.tcl

proc ::bras::lastMinuteRule {target} {
  variable Opts
  variable Indent
  variable Tinfo
  variable Rule
  variable Prule

  global brasSearched

  ## If this was called to only generate a command, target has
  ## already a rule
  if {[info exist Tinfo($target,[pwd],rule)]} {
    set reason "trying to find a command to make `$target'"
  } else {
    set reason "trying to derive a rule for target `$target'"
  }

  ## In the first step, we check if there is a rule which matches the
  ## target and generates a dependency which exists as a file
  set ruleID -1
  set activeRules {}
  set activeCandidates {}

  foreach id $Prule(all) {
    ## match the target
    if {![regexp "^$Prule($id,trexp)\$" $target]} continue

    ## don't check recursively active rules
    if {$Prule($id,cure)} {
      append reason \
	  "\n+ `$Prule($id,trexp)' <- `$Prule($id,gdep)' " \
	  "already active"
      continue
    }

    set which $Prule($id,gdep)

    ## If the dependency-generator is empty, which is not strictly
    ## disallowed, this is a way to make this target.
    if {"$which"==""} {
      set ruleID $id
      set dep {}
      append reason " ... success"
      break
    }

    ## generate the dependency with the pattern rule
    set dep [::bras::gendep::$which $target]

    append reason \
	"\n+ with `$dep' " \
	"derived from `$Prule($id,trexp)' <- `$Prule($id,gdep)'"
 
    ## Expand the dependency along the search path
    if {"[set t [searchDependency $dep]]"!=""} {
      ## good one, use it
      set ruleID $id
      set dep $t
      append reason "\n+ success, `$dep' exists or has explicit rule"
      break
    }

    lappend activeRules $id $dep
  }

  if {$Opts(-d) && ""!="$reason"} {dmsg $reason}

  ## If we did not find a rule-id yet, go recursive
  if {$ruleID==-1} {
    if {$Opts(-d) && [llength $activeRules]} {
      dmsg "+ no success, going recursive ($activeRules)"
    }
    foreach {id dep} $activeRules {
      set Prule($id,cure) 1
      append Indent "  "
      set ok [lastMinuteRule $dep]
      set Indent [string range $Indent 2 end]
      set Prule($id,cure) 0
      if {$ok} {
	set ruleID $id
	break
      }
    }
  }

  if {$ruleID==-1} {
    if {$Opts(-d)} {dmsg "nothing found"}
    return 0
  }

  ## If we arrive here, ruleID>=0 denotes the rule to use.  
  if {$Opts(-d)} {
    if {[info exist Tinfo($target,[pwd],rule)]} {
      set oldt $Rule($Tinfo($target,[pwd],rule),targ)
      foreach {t d b} $Rule($Tinfo($target,[pwd],rule),bexp) {
	lappend oldb $b
      }
      set msg {}; append msg \
	  "adding command to rule `$oldt'<-`$oldb'\n" \
	  "+ as well as expression `$Prule($id,bexp)'"
    } else {
      set msg "creating rule `$target' <- `$Prule($id,bexp)' "
    }
	
    dmsg $msg
  }

  ## Enter the rule into the database
  ::bras::enterRule $target $dep $Prule($id,bexp) $Prule($id,cmd)

  return 1
}
#END: lastMinuteRule.tcl
#BEGIN: makeRule.tcl

namespace eval ::bras {
  namespace export Make PatternMake
  namespace export Newer PatternNewer
  namespace export Always PatternAlways
  namespace export Exist PatternExist
}

proc ::bras::Make {targets bexp {cmd {}}} {
  ::bras::enterRule $targets {} $bexp $cmd
}
proc ::bras::PatternMake {trexp gendep bexp cmd} {
  ::bras::enterPatternRule $trexp $gendep $bexp $cmd
}
proc ::bras::checkMake {rid theTarget} {
  set currentDir [pwd]
  set dirns [dirns .]

  ## This namespace is soleley set up to run the boolean
  ## expressions. This helps people to remember not to run predicates
  ## by hand. Doing so messes up the variable scopes I try to
  ## maintain. 
  set bns ::bras::ns[nextID]
  namespace eval $bns {namespace import ::bras::p::*}
  foreach x [info vars [set dirns]::*] {
    namespace eval $bns [list upvar $x [namespace tail $x]]
  }

  set res 0
  foreach {targets d b} $::bras::Rule($rid,bexp) {
    ## transfer values into $bns
    set [set bns]::target $theTarget
    set [set bns]::targets $targets
    if {""=="$d"} {
      catch {unset [set bns]::d}
    } else {
      set [set bns]::d $d    
    }

    ## we want to run $b by expr in namespace $bns
    #set cmd [list namespace eval $bns [list expr $b]]

    ## $b contains user's code, so care must be taken when
    ## running the command.
    if {[catch {runscript $bns [list expr $b]} r]} {
      set emsg "checking test `$b' for target `$theTarget' in [pwd]"
      cd $currentDir
      return -code error -errorinfo [fixErrorInfo 2 $emsg]
    }
    cd $currentDir
    set res [expr {$res || $r}]
  }
  namespace delete $bns

  return $res
}
proc ::bras::Newer {targets deps {cmd {}}} {
  Make \
      $targets \
      [concat "\[" older [list $targets] [list $deps] "\]"] \
      $cmd
  #puts "Newer $targets $deps"
}
proc ::bras::PatternNewer {rexp dep cmd} {
  PatternMake $rexp $dep {[older $target $d]} $cmd
}

proc ::bras::Always {targets deps {cmd {}}} {
  Make $targets [concat "\[" true [list $deps] "\]"] $cmd
}

proc ::bras::PatternAlways {rexp dep cmd} {
  PatternMake $rexp $dep {[true $d]} $cmd
}

proc ::bras::Exist {targets {cmd {}}} {
  Make $targets [concat "\[" missing [list $targets] "\]"] $cmd
}

#END: makeRule.tcl
#BEGIN: predicates.tcl

namespace eval ::bras::p {
  namespace export older pairedolder updated missing true \
      dcold oldcache \
      varchanged or notinitialized md5older
}
proc ::bras::p::installPredicate { names {depvars {}} } {
  upvar \#0 ::bras::Opts Opts 

  if {$Opts(-d)} {::bras::dmsg "testing \[[info level -1]\]"}

  ## Within the calling predicate, we install all variables listed in
  ## $names as local variables linked to variables of the same name in 
  ## the namespace $::bras::nspace. One additional variable called
  ## `reason' is always installed that way.
  foreach n $names {
    uplevel 1 [list upvar \#0  [set ::bras::Pstack]::$n $n]
    uplevel 1 "if {!\[info exist $n\]} {set $n {}}"
  }
  uplevel 1 [list upvar \#0 [set ::bras::Pstack]::reason reason]

  ## Expand dependencies stored in any of the varialbles noted in
  ## depvars along the searchpath. The result is put into these
  ## variables again.
  foreach v $depvars {
    upvar $v deps
    set res {}
    foreach d $deps {
      set s [::bras::searchDependency $d]
      if {""=="$s"} {set s $d}
      lappend res $s
    }
    set deps $res
    if {$Opts(-d)} {::bras::dmsg "expanded deps: `$deps'"}
  }
}
proc ::bras::p::older {targets inDeps} {
  installPredicate {trigger deps} inDeps

  #puts "older:: $targets < $inDeps"

  ## Consider all dependencies in turn
  set results [::bras::consider $inDeps]

  ## potential @ in deps no longer needed after consider
  set inDeps [stripAt $inDeps]

  ## cache all mtimes of inDeps
  foreach  d $inDeps   x $results  {
    if {![file exist $d]} {
      ## Ooops. Obviously $d is not really a file but some other
      ## strange stuff. We cannot test its mtime to compare with the
      ## targets but we have $x indicating if $d was just made or
      ## not. If it was made ($x==1) we set the mtime to -1 meaning
      ## that it is very new.
      set mtime($d) [expr {$x?-1:0}]
    } else {
      set mtime($d) [file mtime $d]
    }
  }
  
  set res 0
  foreach t $targets {
    ## check if target exists, get its mtime
    if {[file exist $t]} {
      set ttime [file mtime $t]
    } else {
      set ttime 0
      append reason \
	  "\n`$t' is considered very old because it does not exist"
      set res 1
    }
    ## Now check if $t is older than any of inDeps
    set older {}
    set fresh {}
    foreach d $inDeps {
      if {$mtime($d)<0} {
	## Yes, $d was just made (yet does not exist)
	set res 1
	lappend fresh $d
	::bras::lappendUnique trigger $d
      } elseif {$ttime<$mtime($d)} {
	## NOTE: The test above *must* feature '<' not '<=' because on
	## a fast computer, dependencies and the target can easily be
	## made all within one second. This would cause this rule to
	## trigger over and over again.
	set res 1
	lappend older $d
	::bras::lappendUnique trigger $d
      }
    }
    if {[llength $fresh]} {
      append reason \
	  "\n`$t' is considered older than just created `$fresh'"
    }
    if {[llength $older]} {
      append reason "\n`$t' is older than `$older'"
    }
  }

  ::bras::concatUnique deps $inDeps

  return $res
}
proc ::bras::p::pairedolder {targets inDeps} {
  if {[llength $targets]!=[llength $inDeps]} {
    return -code error "input lists must have equal length"
  }

  installPredicate {trigger deps} inDeps
  ## Consider all dependencies in turn
  set results [::bras::consider $inDeps]

  ## potential @ in deps no longer needed after consider
  set inDeps [stripAt $inDeps]

  set res 0
  foreach t $targets   d $inDeps   x $results {
    if {![file exist $t]} {
      set res 1
      append reason "\n`$t' does not exist"
      ::bras::lappendUnique trigger $d
      continue
    }
    if {![file exist $d]} {
      if {$x} {
	set res 1
	append reason "\n`$d' was just made"
	::bras::lappendUnique trigger $d
      }
      continue
    }
    set ttime [file mtime $t]
    set dtime [file mtime $d]
    if {$ttime<$dtime} {
      set res 1
      append reason "\n`$t' is older than `$d'"
      ::bras::lappendUnique trigger $d
    }
  }
  ::bras::concatUnique deps $inDeps
  return $res
}
proc ::bras::p::updated {inDeps} {
  installPredicate {trigger deps} inDeps

  ## Consider all dependencies in turn
  set results [::bras::consider $inDeps]

  ## potential @ in deps no longer needed after consider
  set inDeps [stripAt $inDeps]

  set res 0
  ::bras::concatUnique deps $inDeps
  foreach d $inDeps   x $results {
    if {$x} {
      set res 1
      ::bras::lappendUnique trigger $d
      append reason "\n`$d' was made"
    }
  }

  return $res
}
proc ::bras::p::missing {file} {
  installPredicate trigger

  if {![file exist $file]} {
    append reason "\n`$file' does not exist"
    ::bras::lappendUnique trigger $file
    return 1
  }
  return 0
}
proc ::bras::p::true {{inDeps {}}} {
  installPredicate deps inDeps

  ::bras::consider $inDeps

  ## potential @ in deps no longer needed after consider
  set inDeps [stripAt $inDeps]

  append reason "\nmust always be made"
  ::bras::concatUnique deps $inDeps
  return 1
}
proc ::bras::fetchvalues-not-supported-dont-use {_ary file} {
  upvar $_ary ary

  ## Want to source in a fresh interpreter
  set ip [interp create]
  
  ## we don't consider predefined variables like tcl_patchLevel.
  foreach x [$ip eval info vars] {
    set predefined($x) 1
  }

  ## source the file
  if {[catch {$ip eval source $file} msg]} {
    return -code error $msg
  }

  ## copy all vars, except thte predefined ones, from $ip into ary
  foreach x [$ip eval info vars] {
    if {[info exist predefined($x)]} continue

    if {[$ip eval array exist $x]} {
      foreach elem [$ip eval array names $x] {
	set ary($x\($elem\)) [$ip eval set $x\($elem\)]
      }
    } else {
      set ary($x) [$ip eval set $x]
    }
  }
  interp delete $ip
}
proc ::bras::p::dcold {doto dc} {  
  installPredicate {} dc

  ## First of all, the dependency cache $dc must be up-to-date
  ::bras::consider $dc

  if {[string match @* $dc]} {
    set dc [string range $dc 1 end]
  }

  ## The rest is trivial
  set in [open $dc r]; set dlist [join [split [read $in]]]; close $in
  return [older $doto $dlist]
}    
proc ::bras::p::oldcache {dc dotc} {
  installPredicate {trigger deps} dotc

  if {[file exist $dc]} {
    set in [open $dc r]; set dlist [join [split [read $in]]]; close $in
    set dlist [concat $dotc $dlist]
  } else {
    set dlist $dotc
  }

  return [older $dc $dlist]
}
proc ::bras::p::varchanged {varnames oldResults} {
  variable varChanged

  installPredicate [list trigger deps] {}

  ::bras::consider $varnames

  ## potential @ in some of the var name no longer needed after consider
  set varnames [stripAt $varnames]

  ## create a new interpreter and source $oldResults into it. If the
  ## file does not even exist, this means that all given vars are
  ## changed.
  if {![file exist $oldResults]} {
    if {![llength $varnames]} {return 0}
    append reason "\ncache file `$oldResults' does not exist"
    return 1
  }

  set ip [interp create]
  $ip eval source $oldResults

  ## Now compare the current values of all listed variables with the
  ## copies found in $ip.
  set res 0
  foreach v $varnames {
    ## If $v, which can also reference an array element, does not
    ## exist, it was obviously changed.
    if {![$ip eval info exist [list $v]]} {
      append reason "\nvariable `$v' was unknown before"
      ::bras::lappendUnique trigger $v
      set res 1
      continue
    }

    if {[array exist $v]} {
      # Arrays are a pain, because we have to check every index.
      foreach x [array names $v] {
	if {![$ip eval info exist [list $v\($x\)]]} {
	  append reason "\nat least element `$x' of `$v' is new"
	  ::bras::lappendUnique trigger $v
	  set res 1
	  break
	}
	  
	set currentvalue [set $v\($x\)]
	set storedvalue [$ip eval set [list $v\($x\)]]
	if {"$currentvalue"=="$storedvalue"} continue
	append reason "\nat least element `$x' of `$v' changed"
	::bras::lappendUnique trigger $v
	set res 1
	break
      }
      continue
    }

    set currentvalue [set $v]
    set storedvalue [$ip eval set [list $v]]
    if {"$currentvalue"!="$storedvalue"} {
      append reason "\n`$v' was changed"
      ::bras::lappendUnique trigger $v
      set res 1
    }
  }

  interp delete $ip
  return $res
}
proc ::bras::p::or {args} {
  set e [join $args ||]
  return [expr $e]
}
proc ::bras::p::notinitialized {names} {
  variable notInitialized

  installPredicate [list trigger deps] {}

  set res 0
  foreach name $names {
    ::bras::lappendUnique deps $name
    if {[info exist notInitialized($name)]} continue
    set notInitialized($name) 1
    ::bras::lappendUnique trigger $name
    append reason "\n`$name' not yet initialized"
    set res 1
  }
  return $res
}
proc ::bras::p::md5older {target inDeps} {
  installPredicate {trigger deps} {}

  ## Consider all dependencies in turn
  set results [::bras::consider $inDeps]

  ## potential @ in deps no longer needed after consider
  set inDeps [stripAt $inDeps]

  ## create array of new md5sums. Care must be taken to interprete the
  ## output of md5sum. It does not escape funny characters in
  ## filenames. In fact it cannot handle itself file names containing
  ## e.g. newlines.
  set text [eval exec md5sum $inDeps]
  foreach line [split $text \n] {
    set s [string range $line 0 31]
    set name [string range $line 34 end]
    set sum($name) $s
  }

  set md5 $target.md5

  if {[file exist $md5]} {
    set in [open $md5]
    array set old [read $in]
    close $in

    set res 0
    foreach d $inDeps {
      ::bras::lappendUnique deps $d
      if {[info exist old($d)] && $old($d)==$sum($d)} continue
      set res 1
      ::bras::lappendUnique trigger $d
      append reason "\nmd5sum of `$d' changed"
    }
  } else {
    set res 1
    append reason "\nmd5 cache `$md5' did not exist"
    foreach x $inDeps {::bras::lappendUnique deps $x}
  }

  if {!$res} {return 0}

  set out [open $md5 w]
  puts $out [array get sum]
  close $out

  return 1
}
#END: predicates.tcl
#BEGIN: sourceDeps.tcl

namespace eval ::bras {
  namespace export sourcedeps
}
proc ::bras::oneLine {in} {
  set line {}
  while { -1!=[set c [gets $in l]] && [string match {*\\} $l] } {
    append line $l
  }
  append line $l
  set line [string trim $line "\n \t"]
  regsub -all "\\\\" $line { } line
  regsub -all "\[\t \n\]+" $line { } line
  set line [split $line " "]
  if {![llength $line] && $c==-1} {return -1}
  return $line
}
proc ::bras::readDeps {in ignore _Deps} {
  upvar $_Deps Deps

  ## create regexp to filter unwanted dependencies
  if [llength $ignore] {
    set rex "^[join $ignore |^]"
    set ex 1
  } else {
    set ex 0
  }
  
  while 1 {
    ## get next line, gobble continuations also
    set line [oneLine $in]
    if { "$line"=="-1" } break
    if {"$line"==""} continue

    ## extract target
    regsub {:} $line { } line
    set target [lindex $line 0]
    if {![info exist Deps($target)]} {
      set Deps($target) {}
    }

    ## collect dependencies while filtering unwanted ones
    if $ex {
      foreach d [lrange $line 1 end] {
	if [regexp $rex $d] continue
	lappend Deps($target) $d
      }
    } else {
      foreach d [lrange $line 1 end] {
	lappend Deps($target) $d
      }
    }
  }
}
proc ::bras::sourcedeps {file args} {

  if {![file readable $file]} {
    report warn \
	"bras warning: cannot read `[file join [pwd] $file]'"
    return
  }
  set in [open $file]
  readDeps $in $args Deps
  close $in

  foreach x [array names Deps] {
    Newer $x $Deps($x)
  }
}
#END: sourceDeps.tcl
#BEGIN: cvsknown.tcl

namespace eval ::bras {}
proc ::bras::cvsknown { {dir {}} } {
  #puts ">>> `$dir'"
  if {![file readable CVS/Entries]} {
    return {}
  }

  set res {}
  set in [open CVS/Entries r]; set entries [read $in]; close $in
  foreach l [split $entries \n] {
    set l [split $l /]
    if {[llength $l]!=6} continue
    if {[string match D* [lindex $l 0]]} continue
    lappend res [file join $dir [lindex $l 1]]
  }
  
  set pwd [pwd]
  foreach x [glob -nocomplain .* *] {
    if {"$x"==".." || "$x"=="." || "$x"=="CVS"} continue
    if {![file isdir $x]} continue
    cd $x
    set res [concat $res [cvsknown [file join $dir $x]]]
    cd $pwd
  }
  #  puts (($res))
  return $res
}
#END: cvsknown.tcl
#BEGIN: install.tcl

proc ::bras::install {target source {perm ""}} {
  file mkdir [file dir $target]
  file delete -force $target
  file copy -force $source $target
  if {"$perm"!="" && "$::tcl_platform(platform)"=="unix"} {
    file attributes $target -permission $perm
  }
}
#END: install.tcl
#BEGIN: makedeps2bras.tcl



proc ::bras::makedeps2bras {text exclude} {
  ## Join continuation lines, i.e. lines ending with backslash
  ## get the next line attached.
  regsub -all "\[\\\\\]\n" $text " " text

  ## Every line should now look like 
  ##   target : dep1 dep2 dep3
  ## We don't try to be cute about funny characters within file
  ## names, because `make' would probably not work with them too.
  ## And we don't care for the target. It should be always the
  ## same.
  set deps {}
  foreach line [split $text "\n"] {
    regsub {^[^:]+:} $line {} line
    foreach dep [split $line] {
      set dep [string trim $dep]
      if {""=="$dep"} continue
      if {""!="$exclude" && [regexp $exclude $dep]} continue
      lappend deps $dep
    }
  }
  return $deps
}
#END: makedeps2bras.tcl
#BEGIN: packjar.tcl

namespace eval ::bras {}
proc ::bras::packjar {jar pkgroot pkgdirs {glob *.class}} {
  set here [pwd]

  cd $pkgroot
  set files {}
  foreach dir $pkgdirs {
    foreach g $glob {
      set files [concat $files [glob -nocomplain [file join $dir $g]]]
    }
  }
  jar cf [file join $here $jar] $files
}
#END: packjar.tcl
#BEGIN: updateCacheC.tcl

proc ::bras::updateCacheC {target src _cmd _opts _exclude} {
  upvar $_cmd cmd
  upvar $_opts opts
  upvar $_exclude exclude
  set text [eval exec "$cmd $opts $src"]
  if {[info exist exclude]} {
    set l [makedeps2bras $text $exclude]
  } else {
    set l [makedeps2bras $text ""]
  }
  set out [open $target w]
  puts $out $l
  close $out
}
#END: updateCacheC.tcl

namespace import ::bras::\[A-Za-z\]*

########################################################################
proc ::bras::usage {} {
  global argv0 VERSION VERDATE
  puts stderr \
      "usage: $argv0 \[-f brasfile\] \[-d\] \[-h\] \[-n\] \[-p\]\
\[-s\] \[-v\] \[-ve\] \[var=value]\
\[--\] \[target ...\]
construct files based on a rule-file
  brasfile - rule-file to use (defaults: Brasfile or brasfile)
        -d - show reasoning in addition to normal processing
       -de - don't try to fix error messages (mainly to debug bras)
        -k - continue as much as possible after an error
        -n - don't execute any commands (implies -v)
        -p - print database of rules, then exit
        -s - don't show anything except error messages
        -v - show all commands to be executed
       -ve - use verbose version of exec
        -- - use the rest of the command-line as target list
             (necessary, if a target starts with `-')
 var=value - just before starting to read brasfiles, element var of
             the global array env is set to value
    target - target to be rebuilt (default: the target of the first
             rule in brasfile)

This is version $::bras::VERSION, shipped on $::bras::VERDATE.
"
  exit 1
}
########################################################################
proc ::bras::main {argc args} {
  global env
  set options(-p) 0
  set options(=) {}
  for {set i 0} {$i<$argc } {} {
    set opt [lindex $args $i]
    incr i
    switch -glob -- $opt {
      -d -
      -de -
      -s -
      -v -
      -k -
      -n -
      -ve {::bras::configure $opt}
      -p {set options(-p) 1}
      -f {
	if {$i>=$argc } {
	  puts stderr "$bras: missing file name after option `$opt'"
	  exit 1
	}
	set brasfile [lindex $args $i]
	incr i
      }
      -- {
	for {} {$i<$argc} {incr i} {
	  lappend targets [lindex $args $i]
	}
      }
      -* ::bras::usage
      default {
	if {[string match *=* $opt]} {
	  lappend options(=) $opt
	} else {
	  lappend targets $opt
	}
      }
    }
  }

  ## Set env-entries from the command line
  foreach equ $options(=) {
    set var {}
    set value {}
    regexp {(.*)=(.*)} $equ dummy var value
    if {$::bras::Opts(-v)} {puts "setting `env($var)' to `$value'"}
    set env($var) $value
  }

  ## Find out which rule file to use
  if {![info exists brasfile]} {
    ## option -f was not used
    if {[file exists brasfile]} {
      set ::bras::Brasfile brasfile
    } elseif {[file exists Brasfile]} {
      set ::bras::Brasfile Brasfile
    } else {
      puts stderr "bras: no brasfile found"
      exit 1
    }
  } else {
    set ::bras::Brasfile $brasfile
  }

  ## Read the rule file
  #include $::bras::Brasfile
  if {[catch {include @.}]} {
    return -code error -errorinfo [fixErrorInfo 2 ""]
  }

  if {$options(-p)} {
    ::bras::dumprules
    exit 0
  }

  ## Check if there is a target to consider
  if {![info exist targets]} {
    if {![info exist ::bras::Targets]} {
      puts stderr "bras: no target given"
      exit 1
    }
    foreach {startdir targets} $::bras::Targets break
  }

  ## We (may) have to change to another directory before we start
  if {[info exist startdir]} {cd $startdir}
  if {!$::bras::Opts(-s) && !$::bras::Opts(-d)} {
    report norm "cd [pwd]"
  }

  
  if {[catch {::bras::consider $targets}]} {
    return -code error -errorinfo [fixErrorInfo 0 ""]
  }
}
########################################################################
if { [catch "::bras::main $argc $argv" result] } {  
  puts stderr [::bras::fixErrorInfo 2 ""]
  puts stderr "    invoked from within\n\"bras\""
  exit 1
}
########################################################################

##### Local Variables: #
##### mode:tcl #
##### End: #

