diff --git a/src/build.tcl b/src/build.tcl new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/src/build.tcl @@ -0,0 +1 @@ + diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 8941c00b..6c09d932 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -107,8 +107,8 @@ namespace eval punk { debug off punk.pipe.args debug level punk.pipe.args 3 debug off punk.pipe.rep 2 - debug on punk.pipe.compile - debug level punk.pipe.compile 4 + debug off punk.pipe.compile + debug level punk.pipe.compile 2 debug header "dbg> " @@ -2736,12 +2736,11 @@ namespace eval punk { variable re_dot_assign {^([^ \t\r\n=\{]*)\.=(.*)} #match_assign is tailcalled from unknown - uplevel 1 gets to caller level proc match_assign {scopepattern equalsrhs args} { - #review - :: is legal in atoms! if {[string match "*::*" $scopepattern]} { error "match_assign scopepattern '$scopepattern' contains namespace separator '::' - invalid." } - puts stderr ">> match_assign '$scopepattern=$equalsrhs' $args" + #puts stderr ">> match_assign '$scopepattern=$equalsrhs' $args" set fulltail $args set homens ::punk::pipecmds @@ -4688,7 +4687,7 @@ namespace eval punk { } set cond [string map [list $glob] {expr {[string length $item] && [string match $item]}}] #env members such as ''path' not case sensitive on windows - but are on some other platforms (at least FreeBSD) - return [list .= {set ::env(PATH)} |> .=/2 string trimright $sep |> .=/1 split $sep |> list_filter_cond $cond ] + return [list .= set ::env(PATH) |> .=>2 string trimright $sep |> .=>1 split $sep |> list_filter_cond $cond ] } proc path_list {{glob *}} { set pipe [punk::path_list_pipe $glob] @@ -6938,7 +6937,10 @@ namespace eval punk { interp alias {} linelistraw {} punk::linelistraw interp alias {} linelist {} punk::linelist ;#critical for = assignment features interp alias {} linesort {} punk::linesort - interp alias {} path {} punk::path + + # 'path' collides with kettle path in kettle::doc function - todo - patch kettle? + interp alias {} PATH {} punk::path + interp alias {} path_list {} punk::path_list interp alias {} list_as_lines {} punk::list_as_lines interp alias {} list_filter_cond {} punk::list_filter_cond diff --git a/src/modules/punk/mix-0.2.tm b/src/modules/punk/mix-0.2.tm index d550c940..53a4c581 100644 --- a/src/modules/punk/mix-0.2.tm +++ b/src/modules/punk/mix-0.2.tm @@ -109,12 +109,19 @@ namespace eval punk::mix::cli { } else { puts stderr "warning: Missing $projectdir/src/README.md" } + #todo - tag substitutions in src/doc tree + + cd $projectdir foreach m $opt_modules { newmodule $m -project $projectname -type $opt_type -force $opt_force } + #generate www/man/md output in 'embedded' folder which should be checked into repo for online documentation + cd $projectdir/src + Kettle doc + cd $projectdir if {![file exists $projectdir/_FOSSIL_]} { set first_fossil 1 @@ -246,7 +253,7 @@ namespace eval punk::mix::cli { set sourcefolder $startdir } if {([file tail $sourcefolder] ne "src") || (![file exists $sourcefolder/make.tcl])} { - puts stderr "mix make must be run from src folder containing make.tcl - unable to proceed" + puts stderr "mix make must be run from src folder containing make.tcl - unable to proceed (cwd: [pwd])" return false } #use run so that stdout visible as it goes @@ -261,11 +268,137 @@ namespace eval punk::mix::cli { } } + proc Kettle {args} { + tailcall kettle_call lib {*}$args + } + proc KettleShell {args} { + tailcall kettle_call shell {*}$args + } + + proc kettle_call {calltype args} { + if {$calltype ni [list lib shell]} { + error "pmix kettle_call 1st argument must be one of: 'lib' for direct use of kettle module or 'shell' to call as separate process" + } + if {$calltype eq "shell"} { + set kettleappfile [file dirname [info nameofexecutable]]/kettle + set kettlebatfile [file dirname [info nameofexecutable]]/kettle.bat + + if {(![file exists $kettleappfile]) && (![file exists $kettlebatfile])} { + error "pmix kettle_call unable to find installed kettle application file '$kettleappfile' (or '$kettlebatfile' if on windows)" + } + if {[file exists $kettleappfile]} { + set kettlescript $kettleappfile + } + if {$::tcl_platform(platform) eq "windows"} { + if {[file exists $kettlebatfile]} { + set kettlescript $kettlebatfile + } + } + } + set startdir [pwd] + if {![file exists $startdir/build.tcl]} { + error "pmix kettle must be run from a folder containing build.tcl (cwd: [pwd])" + } + if {[catch {package present kettle}]} { + puts stdout "Loading kettle package - may be delay on first load ..." + package require kettle + } + set first [lindex $args 0] + if {[string match @* $first]} { + error "pmix kettle doesn't support special operations - try calling tclsh kettle directly" + } + if {$first eq "-f"} { + set args [lassign $args __ path] + } else { + set path $startdir/build.tcl + } + set opts [list] + + if {[lindex $args 0] eq "-trace"} { + set args [lrange $args 1 end] + lappend opts --verbose on + } + set goals [list] + + if {$calltype eq "lib"} { + file mkdir ~/.kettle + set dotfile ~/.kettle/config + if {[file exists $dotfile] && + [file isfile $dotfile] && + [file readable $dotfile]} { + ::kettle io trace {Loading dotfile $dotfile ...} + set args [list {*}[::kettle path cat $dotfile] {*}$args] + } + } + + #hardcoded kettle option names (::kettle option names) - retrieved using kettle::option names + #This is done so we don't have to load kettle lib for shell call (both loading as module and running shell are annoyingly SLOW) + #REVIEW - needs to be updated to keep in sync with kettle. + set knownopts [list\ + --exec-prefix --bin-dir --lib-dir --prefix --man-dir --html-dir --markdown-dir --include-dir \ + --ignore-glob --dry --verbose --machine --color --state --config --with-shell --log \ + --log-append --log-mode --with-dia --constraints --file --limitconstraints --tmatch --notfile --single --valgrind --tskip --repeats \ + --iters --collate --match --rmatch --with-doc-destination --with-git --target --test-include \ + ] + + while {[llength $args]} { + set o [lindex $args 0] + switch -glob -- $o { + --* { + #instead of using: kettle option known + if {$o ni $knownopts} { + error "Unable to process unknown option $o." {} [list KETTLE (pmix)] + } + lappend opts $o [lindex $args 1] + #::kettle::option set $o [lindex $args 1] + set args [lrange $args 2 end] + } + default { + lappend goals $o + set args [lrange $args 1 end] + } + } + } + + if {![llength $goals]} { + lappend goals help + } + if {"--prefix" ni [dict keys $opts]} { + dict set opts --prefix [file dirname $startdir] + } + if {$calltype eq "lib"} { + ::kettle status clear + ::kettle::option::set @kettle $startdir + foreach {o v} $opts { + ::kettle option set $o $v + } + ::kettle option set @srcscript $path + ::kettle option set @srcdir [file dirname $path] + ::kettle option set @goals $goals + ::source $path + puts stderr "recipes: [::kettle recipe names]" + ::kettle recipe run {*}[::kettle option get @goals] + + set state [::kettle option get --state] + if {$state ne {}} { + puts stderr "saving kettle state: $state" + ::kettle status save $state + } + + } else { + #shell + puts stdout "Running external kettle process with args: $opts $goals" + run -n tclsh $kettlescript -f $path {*}$opts {*}$goals + } - proc libexample {} { - set result [lib::libfunc1 test] - return $result } + + #proc libexample {} { + # set result [lib::libfunc1 test] + # return $result + #} + + namespace eval lib { proc libfunc1 {args} { return libfunc1-$args diff --git a/src/modules/punk/mix/base-0.1.tm b/src/modules/punk/mix/base-0.1.tm index 7ef2515e..b99fa92f 100644 --- a/src/modules/punk/mix/base-0.1.tm +++ b/src/modules/punk/mix/base-0.1.tm @@ -30,19 +30,19 @@ namespace eval punk::mix::base { if {![string length $extension]} { set extension [namespace qualifiers [lindex [info level -1] 0]] } - puts stderr "arglen:[llength $args]" - puts stdout "_unknown '$ns' '$args'" + #puts stderr "arglen:[llength $args]" + #puts stdout "_unknown '$ns' '$args'" set d_commands [get_commands -extension $extension] set all_commands [list {*}[dict get $d_commands main] {*}[dict get $d_commands base]] error "Unknown subcommand \"[lindex $args 0]\": must be one of: $all_commands" "punk::mix::base _unknown $ns $args" [list unknown_ensemble_subcommand ensemble punk::mix::base] } proc _redirected {from_ns subcommand args} { - puts stderr "_redirected from_ns: $from_ns subcommand:$subcommand args:$args" + #puts stderr "_redirected from_ns: $from_ns subcommand:$subcommand args:$args" set pname [namespace current]::$subcommand if {$pname in [info procs $pname]} { set argnames [info args $pname] - puts stderr "$subcommand argnames: $argnames" + #puts stderr "_redirected $subcommand argnames: $argnames" if {[lindex $argnames end] eq "args"} { set pos_argnames [lrange $argnames 0 end-1] } else { diff --git a/src/modules/punk/mix/templates/layouts/project/src/build.tcl b/src/modules/punk/mix/templates/layouts/project/src/build.tcl new file mode 100644 index 00000000..2addab4b --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/build.tcl @@ -0,0 +1,5 @@ +#!/bin/sh +# -*- tcl -*- \ +exec kettle -f "$0" "${1+$@}" +kettle tcl +kettle doc diff --git a/src/modules/punk/mix/templates/layouts/project/src/doc/include/general.inc b/src/modules/punk/mix/templates/layouts/project/src/doc/include/general.inc new file mode 100644 index 00000000..69ac59e4 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/doc/include/general.inc @@ -0,0 +1,6 @@ +[comment {-*- tcl -*- --- !doctools --- manpage}] +[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] +[moddesc {%project% - a Tcl project}] +[category {unspecified}] +[keywords {keyword1 keyword2}] +[require Tcl 8.6] diff --git a/src/modules/punk/mix/templates/layouts/project/src/doc/include/welcome.inc b/src/modules/punk/mix/templates/layouts/project/src/doc/include/welcome.inc new file mode 100644 index 00000000..36241a53 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/doc/include/welcome.inc @@ -0,0 +1,6 @@ +[comment {-*- tcl -*- --- !doctools --- manpage}] +[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] +[include welcome_basic.inc] + +[para] Please read the document [term {%project% - Introduction to %project%}], +if you have not done so already, to get an overview of the whole system. diff --git a/src/modules/punk/mix/templates/layouts/project/src/doc/include/welcome_basic.inc b/src/modules/punk/mix/templates/layouts/project/src/doc/include/welcome_basic.inc new file mode 100644 index 00000000..b8dc5f63 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/doc/include/welcome_basic.inc @@ -0,0 +1,5 @@ +[comment {-*- tcl -*- --- !doctools --- manpage}] +[comment {- - -- --- ----- -------- ------------- ---------------------}] +[para] + +Welcome to the %project% project. diff --git a/src/modules/punk/mix/templates/layouts/project/src/doc/main.man b/src/modules/punk/mix/templates/layouts/project/src/doc/main.man new file mode 100644 index 00000000..5c2f40ee --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/doc/main.man @@ -0,0 +1,13 @@ +[comment {-*- tcl -*- --- doctools ---}] +[manpage_begin %project% n 1] +[include include/general.inc] +[titledesc {%project% - Core}] +[description] +[para] +[include include/welcome.inc] +[para] + +This document is the reference to all commands provided by %project% + + +[manpage_end] \ No newline at end of file diff --git a/src/modules/punk/mix/templates/utility/tclbatheader.txt b/src/modules/punk/mix/templates/utility/tclbatheader.txt new file mode 100644 index 00000000..b2e0367f --- /dev/null +++ b/src/modules/punk/mix/templates/utility/tclbatheader.txt @@ -0,0 +1,3 @@ +::lindex tcl;#\ +@call tclsh "%~dp0%~n0.bat" %* & goto :eof +# --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl diff --git a/src/modules/punk/mix/templates/utility/tclbattest.bat b/src/modules/punk/mix/templates/utility/tclbattest.bat new file mode 100644 index 00000000..396aea56 --- /dev/null +++ b/src/modules/punk/mix/templates/utility/tclbattest.bat @@ -0,0 +1,8 @@ +::lindex tcl;#\ +@call tclsh "%~dp0%~n0.bat" %* & goto :eof +# --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl +puts stdout "exe: [info nameof]" +puts stdout "scr: [info script]" +puts stdout "argc: $::argc" +puts stdout "argv: '$::argv'" + diff --git a/src/modules/punk/mix/templates/utility/tclbattest2.bat b/src/modules/punk/mix/templates/utility/tclbattest2.bat new file mode 100644 index 00000000..fbf2fcd0 --- /dev/null +++ b/src/modules/punk/mix/templates/utility/tclbattest2.bat @@ -0,0 +1,19 @@ +::set - { +@goto start +# -- tcl bat +:start +@echo off +set script=%0 +echo %* +if exist %script%.bat set script=%script%.bat +tclsh %script% %* +goto end of BAT file +};unset - ;# --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl + +puts stdout "exe: [info nameof]" +puts stdout "scr: [info script]" +puts stdout "argc: $::argc" +puts stdout "argv: '$::argv'" + +# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---end Tcl\ +:end of BAT file diff --git a/src/modules/shellfilter-0.1.8.tm b/src/modules/shellfilter-0.1.8.tm index 2894a5cb..22382ded 100644 --- a/src/modules/shellfilter-0.1.8.tm +++ b/src/modules/shellfilter-0.1.8.tm @@ -1274,7 +1274,7 @@ namespace eval shellfilter { proc ::shellfilter::redir_channel_to_log {chan args} { variable sources set default_logsettings [dict create \ - -tag redirected_$chan -syslog 127.0.0.1:514 -file ""\ + -tag redirected_$chan -syslog "" -file ""\ ] if {[dict exists $args -action]} { set action [dict get $args -action] @@ -1304,7 +1304,7 @@ namespace eval shellfilter { proc ::shellfilter::redir_output_to_log {tagprefix args} { variable sources - set default_settings [list -tag ${tagprefix} -syslog 172.16.6.42:51500 -file ""] + set default_settings [list -tag ${tagprefix} -syslog "" -file ""] set opts [dict create -action "" -settings {}] set opts [dict merge $opts $args] @@ -1777,7 +1777,8 @@ namespace eval shellfilter { variable sources set runtag "shellfilter-run" - set tid [::shellfilter::log::open $runtag [list -syslog 127.0.0.1:514]] + #set tid [::shellfilter::log::open $runtag [list -syslog 127.0.0.1:514]] + set tid [::shellfilter::log::open $runtag [list -syslog ""]] ::shellfilter::log::write $runtag " commandlist:'$commandlist' len:[llength $commandlist]" #flush stdout