#!/usr/bin/env tclsh

#Создан:  Ср 29 июн 2011 22:35:00
#Изменён: Пн 14 апр 2014 22:42:56

#****F* main/nprs *****************************************************
#
# NAME
#    makeTclKit - script for building Tcl/Tk tclkits
#
# COPYRIGHT
#    Copyright (C) 2011-2014, Likhachev Maxim, mail@domain.com
#
# LICENSE
#     
#     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, version 3.
#    
#     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, see <http://www.gnu.org/licenses/>.
#
# VERSION
#    0.2
#
# DESCRIPTION
#    makeTclKit is a script for building Tcl/Tk tclkits with the
#    dependencies checking. All tclkit wrappers can be found on tclkit web
#    page: http://equi4.com/pub/tk/downloads.html.
#
#    Use the command 'makeTclKit.tcl --help' to get information about usage.
#
#******************************************************************************

package require fileutil
package require textutil::tabify

interp alias {} mkdir {} file mkdir
interp alias {} rm-rf {} file delete -force --
interp alias {} cp    {} file copy -force --

#Procedures for packages manipulating
namespace eval package {
	#Find package in directory tree
	proc whereis? {package} {
		lindex [package ifneeded $package [package require $package]] 1
	}
	
	#Copying package in local directory
	proc copy {package _to directory} {
		if {"$package" eq "sqlite3"} {
			return
		}
		set packageFile    [package::whereis? $package]
		set packageDir     [file dirname $packageFile]
		set packageRootDir [file tail $packageDir]
		set packageIndex   [file join $packageDir pkgIndex.tcl]
		set destinationDir [file join $directory $packageRootDir]

		file mkdir $destinationDir
		catch {cp [string map {; {}} $packageFile] $destinationDir} code
		catch {cp $packageIndex $destinationDir} code
	}
}

namespace eval starkit {
	if 0 {
		if {\$tcl_platform(platform) eq {windows}} {
			package require Tk
			wm withdraw .
			console show
		}
	}

	#Creating starkit's startup file main.tcl
	proc makeMainStarkitFile {mainScript} {
		fileutil::writeFile main.tcl \
			[textutil::tabify::untabify "
				package require starkit
				starkit::startup

				source \[file join \[file dirname \[info script\]\] \[file tail $mainScript\]\]
			" 2]
	}

	#Wraping starkit
	proc wrap {tclkit sdx bin runtime directory mainScript} {
		set execDirectory [pwd]
		cd $directory; makeMainStarkitFile $mainScript
		cd ..;  eval exec $tclkit $sdx wrap $bin -runtime $runtime
		cp [file tail $bin] $execDirectory
		cd $execDirectory
	}
}

#Copying all dependences in local directory tree
proc copyDepends {directory _to libdir {deps {}}} {
	set depends [getDepends $directory]

	if {$depends ne $deps} {
		foreach package $depends {
			#FIXME!!!
			catch {package::copy $package to $libdir}
		}
		copyDepends $libdir to $libdir $depends
	}
}

#TRYEVAL with reports: "ok" if success and "$ERRORCODE" if fail.
proc tryEval {title code ? ok : fail {-> {}} {finally {}}} {
	puts -nonewline stderr [format "  %-40s" $title]
	if {![catch $code err]} {
		puts $ok
	} else {
		puts stderr "$fail      $err"
		eval $finally
	}
}

#Find dependences of built program
proc getDepends {directory} {
	set packages {}

	foreach s [fileutil::grep {^[^#\{]*package[\t ]require} [fileutil::find $directory isTCL]] {
		regexp -- {package[\s]+require[\s]+([\w:]+)} $s -> package
		lappend packages $package
	}
	return [lsort -unique [string map {Tcl {} Tk {} http {} starkit {}} $packages]]
}

#Test for tcl source file
proc isTCL {name} {
	return [string match *.tcl $name]
}

#Encoding cyrillic files
proc iconv! {filename {encoding cp1251}} {
	fileutil::writeFile -encoding $encoding -- $filename [fileutil::cat $filename]
}

#Report about missing wrap of runtime file(s)
proc fileNotFound {filetype directory filename} {
	set filename [file tail $filename]
	set posPlatform [string first {-} $filename 1]
	set posArch     [string first {-} $filename [expr {$posPlatform + 1}]]
	set posUI       [string first {-} $filename [expr {$posArch + 1}]]

	puts "ERROR: Following $filetype file not found in directory ${directory}/:\n"
	puts "          $filename"
	puts "          [string repeat { } $posPlatform]  ^\
			[string repeat { } [expr $posArch - $posPlatform - 3]] ^\
			[string repeat { } [expr $posUI - $posArch - 3]] ^"
	puts "          [string repeat { } $posPlatform]  |\
			[string repeat { } [expr $posArch - $posPlatform - 3]] |\
			[string repeat { } [expr $posUI - $posArch - 3]] |"
	puts " Platform [string repeat {-} $posPlatform]--+\
			[string repeat { } [expr $posArch - $posPlatform - 3]] |\
			[string repeat { } [expr $posUI - $posArch - 3]] |"
	puts "     Arch [string repeat {-} $posArch]--+\
			[string repeat { } [expr $posUI - $posArch - 3]] |"
	puts "       UI [string repeat {-} $posUI]--+\n"
	puts " All tclkit wrappers can be found on tclkit web page: http://equi4.com/pub/tk/downloads.html\n"
		
	exit 1
}


#------------------------------------------------------------------------------

#Parsing command line options
proc setArg {arg {val {}}} {
	if {$val eq ""} {
		set ::$arg [lindex $::argv [expr {$::i + 1}]]
		incr ::i
	} else {
		set ::$arg $val
	}
}

#Set default variable value
proc setDefault {var value} {
	if {![info exists ::$var]} {
		set ::$var $value
	}
}

#Help message
proc showHelp {{code 1}} {
	puts "\n    \[Make TclKit v0.2\]\n\n    Usage: [file tail [info script]] \[options\]
	-t, --target  -- target operation system
	-a, --arch    -- machine arch
	-d, --dir     -- source directory
	-s, --source  -- main script file
	-n, --name    -- project name \[default value is directory name\]
	-c, --cli     -- cli wrapper
	-g, --gui     -- gui wrapper (for programs with using Tk)
	-h, --help    -- show this help
	"
	exit $code
}

#Entry point
if {$argc <= 0} {
	showHelp 0
} else {
	#Parsing command line arguments
	for {set i 0; set flag 0} {$i < $argc} {incr i} {
		switch -- [lindex $argv $i] {
			-t    - --target  { setArg PLATFORM }
			-a    - --arch    { setArg TCLKIT(TARGET_ARCH) }
			-c    - --cli     { setArg TCLKIT(UI) cli }
			-g    - --gui     { setArg TCLKIT(UI) gui }
			-d    - --dir     { setArg SOURCEDIR }
			-s    - --source  { setArg TCLKIT(MAIN_SCRIPT) }
			-n    - --name    { setArg TCLKIT(PROJECT) }
			-h    - --help    { showHelp 0 }
			default { puts "\n    ERROR: Unknown argument \"[lindex $argv $i]\""
					showHelp 1
				}
		}
	}
}

# -------------------------------------------------------------------------------------------

set TCLKIT(ROOT_DIR)         [file join [file dirname [file normalize [info script]]] tclkit]
set TCLKIT(SOURCEDIR)        [file normalize $SOURCEDIR]
set TCLKIT(CURRENT_PLATFORM) [string tolower $::tcl_platform(os)]
set TCLKIT(CURRENT_ARCH)     [string tolower $::tcl_platform(machine)]
set TCLKIT(TARGET_PLATFORM)  [string tolower $PLATFORM]

setDefault TCLKIT(PROJECT)     [file tail $TCLKIT(SOURCEDIR)]
setDefault TCLKIT(TARGET_ARCH) $tcl_platform(machine)

set TCLKIT(BUILD_DIR) [file join [fileutil::tempdir] TclKits $TCLKIT(PROJECT)_${TCLKIT(TARGET_PLATFORM)}.vfs]
set TCLKIT(LIB_DIR)   [file join $TCLKIT(BUILD_DIR) lib]
set TCLKIT(BIN_FILE)  [string map {vfs kit} [file tail $TCLKIT(BUILD_DIR)]]
set TCLKIT(BIN_EXT)   [expr { $TCLKIT(TARGET_PLATFORM) eq "WINDOWS" ? {exe} : {bin}}]
set TCLKIT(STARKIT)   [string map "kit $::TCLKIT(BIN_EXT)" $::TCLKIT(BIN_FILE)]

set TCLKIT_FILE(SDX)     [file join $TCLKIT(ROOT_DIR) sdx.kit]
set TCLKIT_FILE(TCLKIT)  [file join $TCLKIT(ROOT_DIR) \
	    tclkit-$TCLKIT(CURRENT_PLATFORM)-$TCLKIT(CURRENT_ARCH)-$TCLKIT(UI)_wrap]
set TCLKIT_FILE(RUNTIME) [file join $TCLKIT(ROOT_DIR) \
	    tclkit-$TCLKIT(TARGET_PLATFORM)-$TCLKIT(TARGET_ARCH)-$TCLKIT(UI)]

parray tcl_platform; puts ""
parray TCLKIT_FILE;  puts ""
parray TCLKIT;       puts ""

if {![file exists $TCLKIT_FILE(TCLKIT)]} {
	fileNotFound wrapper tclkit $TCLKIT_FILE(TCLKIT)
}

if {![file exists $TCLKIT_FILE(RUNTIME)]} {
	fileNotFound runtime tclkit $TCLKIT_FILE(RUNTIME)
}

#------------------------------------------------------------------------------

set INIT_COMMAND(WINDOWS)    {iconv!}

tryEval "CLEAR BUILD DIRECTORY: " {rm-rf $::TCLKIT(BUILD_DIR)} ? {[OK]} : {[FAIL]} -> {exit 1}
tryEval "MAKE BUILD DIRECTORY:  " {mkdir $::TCLKIT(BUILD_DIR)} ? {[OK]} : {[FAIL]} -> {exit 1}
tryEval "COPY SOURCES:          " {cp {*}[glob -directory $::TCLKIT(SOURCEDIR) *] $::TCLKIT(BUILD_DIR)} ? {[OK]} : {[FAIL]} -> {exit 1}
tryEval "DEPENDENS:             " {copyDepends $::TCLKIT(SOURCEDIR) to $::TCLKIT(LIB_DIR)} ? {[OK]} : {[FAIL]} -> {exit 1}

if {[info exists ::INIT_COMMAND($::TCLKIT(TARGET_PLATFORM))]} {
	foreach sourceFile [fileutil::find $::TCLKIT(BUILD_DIR) isTCL] {
		eval $::INIT_COMMAND($::TCLKIT(TARGET_PLATFORM)) $sourceFile
	}
}

tryEval "CREATE STARKIT:        " {starkit::wrap $::TCLKIT_FILE(TCLKIT) \
					$::TCLKIT_FILE(SDX) \
					$::TCLKIT(STARKIT) \
					$::TCLKIT_FILE(RUNTIME) \
					$::TCLKIT(BUILD_DIR) \
					$::TCLKIT(MAIN_SCRIPT)
} ? {[OK]} : {[FAIL]} -> {exit 1}

#Quit Tk
exit