TEA (tclconfig) Source Code

###
# Practcl
# An object oriented templating system for stamping out Tcl API calls to C
###
puts [list LOADED practcl.tcl from [info script]]
package require TclOO

###
# Seek out Tcllib if it's available
###
set tcllib_path {}
foreach path {.. ../.. ../../..} {
  foreach path [glob -nocomplain [file join [file normalize $path] tcllib* modules]] {
    set tclib_path $path
    lappend ::auto_path $path
    break
  }
  if {$tcllib_path ne {}} break
}

###
# Build utility functions
###
namespace eval ::practcl {}

###
# A command to do nothing. A handy way of
# negating an instruction without
# having to comment it completely out.
# It's also a handy attachment point for
# an object to be named later
###
if {[info command ::noop] eq {}} {
  proc ::noop args {}
}

proc ::practcl::debug args {
  #puts $args
  ::practcl::cputs ::DEBUG_INFO $args
}

###
# Drop in a static copy of Tcl
###
proc ::practcl::doexec args {
  puts [list {*}$args]
  exec {*}$args >&@ stdout
}

proc ::practcl::dotclexec args {
  puts [list [info nameofexecutable] {*}$args]
  exec [info nameofexecutable] {*}$args >&@ stdout
}

proc ::practcl::domake {path args} {
  set PWD [pwd]
  cd $path
  puts [list *** $path ***]
  puts [list make {*}$args]
  exec make {*}$args >&@ stdout
  cd $PWD
}

proc ::practcl::domake.tcl {path args} {
  set PWD [pwd]
  cd $path
  puts [list *** $path ***]
  puts [list make.tcl {*}$args]
  exec [info nameofexecutable] make.tcl {*}$args >&@ stdout
  cd $PWD
}

proc ::practcl::fossil {path args} {
  set PWD [pwd]
  cd $path
  puts [list {*}$args]
  exec fossil {*}$args >&@ stdout
  cd $PWD
}


proc ::practcl::fossil_status {dir} {
  if {[info exists ::fosdat($dir)]} {
    return $::fosdat($dir)
  }
  set result {
tags experimental
version {}
  }

      dict set result tags $tags
      break
    }
  }
  set ::fosdat($dir) $result
  return $result
}



















proc ::practcl::os {} {
  if {[info exists ::project(TEACUP_OS)] && $::project(TEACUP_OS) ni {"@TEACUP_OS@" {}}} {
    return $::project(TEACUP_OS)
  }
  set info [::practcl::config.tcl $::project(builddir)]
  if {[dict exists $info TEACUP_OS]} {

  if {$::tcl_platform(platform) eq {unix}} {
    file attributes $d2 -permissions 0755
  } else {
    file attributes $d2 -readonly 1
  }
}

proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
  if {$toplevel} {
    puts [list ::practcl::copyDir $d1 -> $d2]
  }
  #file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      copyDir $f [file join $d2 $ftail] 0
    } elseif {[file isfile $f]} {
      file copy -force $f [file join $d2 $ftail]
    }
  }
}

::oo::class create ::practcl::metaclass {

      --include [::practcl::file_relative $path [file join $TKSRC generic]] \
      --include [::practcl::file_relative $path [file join $TKSRC win]] \
      --include [::practcl::file_relative $path [file join $TKSRC win rc]]
    foreach item [${PROJECT} define get resource_include] {
      lappend cmd --include [::practcl::file_relative $path [file normalize $item]]
    }
    lappend cmd $RCSRC
    ::practcl::doexec {*}$cmd

    lappend OBJECTS $RSOBJ
    set LDFLAGS_CONSOLE {-mconsole -pipe -static-libgcc}
    set LDFLAGS_WINDOW  {-mwindows -pipe -static-libgcc}
  } else {
    set LDFLAGS_CONSOLE {}
    set LDFLAGS_WINDOW  {}

    foreach item [my link list core.library] {
      set name  [$item define get name]
      set libsrcroot [$item define get srcroot]
      if {[file exists [file join $libsrcroot library]]} {
        ::practcl::copyDir [file join $libsrcroot library] [file join $vfspath boot $name]
      }
    }
    # Assume the user will populate the VFS path
    #if {[my define get installdir] ne {}} {
    #  ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib]

    #}
    foreach arg $args {
       ::practcl::copyDir $arg $vfspath
    }

    set fout [open [file join $vfspath packages.tcl] w]
    puts $fout {
  set ::PKGIDXFILE [info script]

    # Handle teapot installs
    ###
    set pkg [my define get pkg_name [my define get name]]
    my unpack
    set DEST [my <project> define get installdir]
    set prefix [string trimleft [my <project> define get prefix] /]
    set srcroot [my define get srcroot]
    ::practcl::dotclexec [file join $srcroot installer.tcl] \
      -pkg-path [file join $DEST $prefix lib $pkg]  \
      -no-examples -no-html -no-nroff \
      -no-wait -no-gui -no-apps
  }
}

###

    if {[my define get static 1]} {
      puts "BUILDING Static $name $srcroot"
    } else {
      puts "BUILDING Dynamic $name $srcroot"
    }
    if {[my define get USEMSVC 0]} {
      cd $srcroot
      ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir] release
    } else {
      cd $::CWD
      set builddir [file normalize [my define get builddir]]
      file mkdir $builddir
      if {![file exists [file join $builddir Makefile]]} {
        my Configure
      }
      if {[file exists [file join $builddir make.tcl]]} {
        ::practcl::domake.tcl $builddir library
      } else {
        ::practcl::domake $builddir all
      }
    }
    cd $PWD
  }

  
  method Configure {} {

      }
    }
    my compile
    if {[my define get USEMSVC 0]} {
      set srcroot [my define get srcroot]
      cd $srcroot
      puts "[self] VFS INSTALL $PKGROOT"
      ::practcl::doexec nmake -f makefile.vc INSTALLDIR=$PKGROOT install
    } else {
      set builddir [my define get builddir]
      if {[file exists [file join $builddir make.tcl]]} {
        # Practcl builds can inject right to where we need them
        puts "[self] VFS INSTALL $PKGROOT (Practcl)"
        ::practcl::domake.tcl $builddir install-package $PKGROOT
      } elseif {[my define get broken_destroot 0] == 0} {
        # Most modern TEA projects understand DESTROOT in the makefile
        puts "[self] VFS INSTALL $PKGROOT (TEA)"
        ::practcl::domake $builddir install DESTDIR=$PKGROOT
      } else {
        # But some require us to do an install into a fictitious filesystem
        # and then extract the gooey parts within.
        # (*cough*) TkImg
        set PREFIX [my <project> define get prefix]
        set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]]
        file delete -force $BROKENROOT
        file mkdir $BROKENROOT
        ::practcl::domake $builddir $install
        ::practcl::copyDir $BROKENROOT  [file join $PKGROOT [string trimleft $PREFIX /]]
        file delete -force $BROKENROOT
      }
    }
    cd $PWD
  }
  

  }
  
  method linktype {} {
    return {subordinate core.library}
  }
}

package provide practcl 0.6