You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
291 lines
9.3 KiB
291 lines
9.3 KiB
11 years ago
|
#!/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, either version 3 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, 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
|
||
|
|
|