proc putsd { text } { global DEBUG if { !$DEBUG } { return } puts $text\n set DEBUGFOUT [open c:/temp/kk.err a] puts $DEBUGFOUT $text\n close $DEBUGFOUT } proc ErrorAndQuit { text } { ErrorNoQuit $text exit 2 } proc bgerror { text } { ErrorAndQuit $text } proc ErrorNoQuit { text } { global NumLine DEBUG ProgramErrorFile if { $DEBUG } { set DEBUGFOUT [open /temp/kk.err a] } if { !$NumLine } { if { [info command wm] != "" } { wm withdraw . tk_messageBox -icon error -title "error in .bat file" -type ok \ -message "$text" } elseif { $DEBUG } { puts $text\n puts $DEBUGFOUT $text\n } else { puts $text\n } if { $ProgramErrorFile != "" } { catch { set fout [open $ProgramErrorFile a] puts $fout "error in .bat file: " puts $fout $text\n close $fout putsd "filled $ProgramErrorFile" } } } else { if { [info command wm] != "" } { wm withdraw . tk_messageBox -icon error -title "error in .bat file" -type ok \ -message "line: $NumLine.- $text" } elseif { $DEBUG } { puts "line: $NumLine.- $text\n" puts $DEBUGFOUT "line: $NumLine.- $text\n" } else { puts "line: $NumLine.- $text\n" } if { $ProgramErrorFile != "" } { catch { set fout [open $ProgramErrorFile a] puts $fout "error in .bat file: " puts $fout "line: $NumLine.- $text\n" close $fout puts $DEBUGFOUT "filled $ProgramErrorFile" } } } if { $DEBUG } { close $DEBUGFOUT } } proc WarnWin {text} { global NumLine tk_messageBox -icon error -title "error in .bat file" -type ok \ -message "line: $NumLine.- $text" } proc EraseElement { inum } { global line linelen for { set i [expr $inum+1] } { $i < $linelen } { incr i } { set iprev [expr $i-1] set line($iprev) $line($i) } incr linelen -1 } proc CommandExecuter { inum } { global errorCode arv0 env global line linelen ProgramErrorFile switch -- [string tolower $line($inum)] { rem { if { [info exists line([expr $inum+1])] && [info exists line([expr $inum+2])] && \ $line([expr $inum+1]) == "ErrorFile:" } { set ProgramErrorFile [file join $line([expr $inum+2])] putsd ProgramErrorFile=$ProgramErrorFile } # nothing } cd - chdir { set dir "" incr inum if { $inum < $linelen } { set dir $line($inum) } if { [catch { regsub -all {\\} $dir {/} dir set dir [lindex $dir 0] cd $dir } ] } { ErrorAndQuit "error: trying to change directory to '$dir'" } } del - delete - erase { incr inum for { set i $inum } { $i < $linelen } { incr i } { set file $line($i) if { [string match /* $file] } { continue } catch { regsub -all {\\} $file {/} file set file [lindex $file 0] file delete $file } } } copy { if { [expr $linelen-$inum] != 3 } { ErrorAndQuit "error, only accepted simple form: $line($inum) from to" } incr inum set file1 "" set file2 "" for { set i $inum } { $i < $linelen } { incr i } { set file $line($i) if { [regexp {[+]} $file] } { ErrorAndQuit "error, only accepted simple form: $line($inum) from to" } if { [string match /* $file] } { continue } regsub -all {\\} $file {/} file set file [lindex $file 0] if { $file1 == "" } { set file1 $file } else { set file2 $file break } } catch { file copy -force $file1 $file2 } } ren - rename - move { if { [expr $linelen-$inum] != 3 } { ErrorAndQuit "error: $line($inum) needs two arguments" } incr inum set file1 "" set file2 "" for { set i $inum } { $i < $linelen } { incr i } { set file $line($i) if { [string match /* $file] } { continue } regsub -all {\\} $file {/} file set file [lindex $file 0] if { $file1 == "" } { set file1 $file } else { set file2 $file break } } catch { file rename $file1 $file2 } } md - mkdir { incr inum for { set i $inum } { $i < $linelen } { incr i } { set file $line($i) if { [string match /* $file] } { continue } regsub -all {\\} $file {/} file set file [lindex $file 0] catch { file mkdir $line($i) } } } set { incr inum set execline "" for { set i $inum } { $i < $linelen } { incr i } { append execline $line($i) if { $inum < [expr $linelen-1] } { append execline " " } } if { [regexp {^[ ]*$} $execline] } { break } set var "" set value "" if { [regexp {([^=]*)=(.*)} $execline {} var value] } { if { $var != "" } { set var [string trim $var " \""] set value [string trim $value " \""] set env($var) $value } } } echo - @echo { incr inum if { [expr $linelen-$inum] == 1 && ( [string tolower $line($inum)] == "on" || \ [string tolower $line($inum)] == "off") } { } else { set type "" for { set i [expr $linelen-1] } { $i >= $inum } { incr i -1} { set item $line($i) if { ![regexp {^[\"]} $item] } { if { [string match *>* $item] } { regexp {^([^>]*)(>>?)(.*)} $item {} before sign after set ifile [expr $i+1] if { $before == "" } { EraseElement $i incr ifile -1 } else { set line($i) $before } if { $after == "" } { if { $ifile == $linelen } { ErrorAndQuit [concat "error: in echo command after "\ "> or >> need filename"] } set after $line($ifile) EraseElement $ifile } if { $type == "" } { if { $sign == ">" } { set type w } else { set type a } set file $after } } } } if { $type == "" } { for { set i $inum } { $i < $linelen } { incr i } { puts -nonewline $line($i) if { $inum < [expr $linelen-1] } { puts -nonewline " " } else { puts "" } } } else { regsub -all {\\} $file {/} file set file [lindex $file 0] if { [catch { set fout [open $file $type] } err] } { ErrorAndQuit "error ($err): trying to echo to file '$file'" } for { set i $inum } { $i < $linelen } { incr i } { puts -nonewline $fout $line($i) if { $inum < [expr $linelen-1] } { puts -nonewline $fout " " } else { puts $fout "" } } close $fout } } } "if" { incr inum set negate 0 if { [string tolower $line($inum)] == "not" } { set negate 1 incr inum } set val 0 set ifpos [string tolower $line($inum)] if { [regexp {^\"?([^ =]+)[ ]*==[ ]*([^ ]+)[ ]+(.*)\"?$} ifpos {} caden1 caden2] } { set val [expr [string compare $caden1 $caden2] == 0] } elseif { $line([expr $inum+1]) == "==" } { set caden1 $ifpos if { [expr $inum+1] >= $linelen } { ErrorAndQuit "error: expression 'if c1 == c2' not correct" } set caden2 $line([expr $inum+2]) set val [expr [string compare $caden1 $caden2] == 0] } elseif { $ifpos == "errorlevel" } { incr inum set number $line($inum) if { [catch { [expr int($number)] }] } { ErrorAndQuit "error: after 'if errorlevel' one number is needed" } set errorlevel 0 if { [lindex $errorCode 0] == "CHILDSTATUS" } { set errorlevel [lindex $errorCode 2] } set val [expr $errorlevel>=$num] incr inum } elseif { $ifpos == "exist" } { incr inum set file $line($inum) regsub -all {\\} $file {/} file set file [lindex $file 0] set val [file exists $file] incr inum } else { ErrorAndQuit "Unknown condition for 'if' command: '$ifpos'" } if { $negate } { set val [expr !$val] } if { $val } { CommandExecuter $inum } } call { set errorCode NONE set execline "" lappend execline $arv0 append execline " " for { set i $inum } { $i < $linelen } { incr i } { append execline $line($i) if { $inum < [expr $linelen-1] } { append execline " " } } regsub -all {\\} $execline {\\\\} execline global RunningProcess set RunningProcess running if { [catch { set pid [eval exec $execline &] } errorchar] } { if { [lindex $errorCode 0] != "CHILDSTATUS" } { ErrorAndQuit "error: $errorchar " } } while 1 { if { $RunningProcess == "" } { kill $pid vwait forever } if { ![isalive $pid] } { break } after 200 update } unset RunningProcess } goto { incr inum return $line($inum) } default { set errorCode NONE set execline "" for { set i $inum } { $i < $linelen } { incr i } { append execline $line($i) if { $inum < [expr $linelen-1] } { append execline " " } } regsub -all {\\} $execline {\\\\} execline global RunningProcess set RunningProcess running putsd execline=--$execline-- if { [catch { set pid [eval exec $execline &] } errorchar] } { if { [lindex $errorCode 0] != "CHILDSTATUS" } { ErrorAndQuit "error: $errorchar " } } while 1 { if { $RunningProcess == "" } { putsd "Before killing..." kill $pid putsd "after killing" vwait forever } if { ![isalive $pid] } { break } after 100 update } putsd "after finishing" unset RunningProcess } } return "" } proc ReadAndExecute { fbat } { global NumLine rargc rargv global line linelen global env for { set i 0 } { $i < $rargc } { incr i } { set f($i) [lindex $rargv $i] catch { set f($i) [file native [file attributes $f($i) -shortname]] } aa } catch { unset labels } while { ![eof $fbat] } { gets $fbat aa putsd "executing: $aa" incr NumLine if { [regexp {^[ ]*$} $aa] } { continue } if { [regexp {^[ ]*:[ ]*([^ ]+)} $aa {} label] } { set labels($label) [tell $fbat] continue } set word "" set linelen 0 catch { unset line } set thereisspace 0 set openpar 0 for { set i 0 } { $i < [string length $aa] } { incr i } { set l [string index $aa $i] if { $l == "\"" } { if { $openpar } { append word "\"" set line($linelen) $word incr linelen set word "" set thereisspace 0 set openpar 0 } elseif { $word == "" } { set openpar 1 set word "\"" } else { append word "\"" } } elseif { !$openpar && ($l == " " || $l == "\t") } { if { $word != "" } { if { $thereisspace && [string index $word 0] != "\"" } { set word "\"$word" } set last [expr [string length $word]-1] if { $thereisspace && [string index $word $last] != "\"" } { append word "\"" } set line($linelen) $word incr linelen set word "" set thereisspace 0 } } else { if { $l == "%" } { incr i set l [string index $aa $i] switch -- $l { 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { if { [info exists f($l)] } { if { [llength $f($l)] > 1 } { set thereisspace 1 } append word $f($l) } } default { if { [regexp {^([a-zA-Z_0-9]+)%} [string range $aa $i end] {} varname] } { if { [info exists env($varname)] } { if { [llength $env($varname)] > 1 } { set thereisspace 1 } append word $env($varname) incr i [string length $varname] } else { ErrorAndQuit "Error: variable '$varname' not known" } } else { incr i -1 } } } } else { append word $l } } } if { $word != "" } { if { $thereisspace && [string index $word 0] != "\"" } { set word "\"$word" } set last [expr [string length $word]-1] if { $thereisspace && [string index $word $last] != "\"" } { append word "\"" } set line($linelen) $word incr linelen } set retval [CommandExecuter 0] if { $retval != "" } { if { [info exists labels($retval)] } { fseek $fbat $labels($retval) } else { while { ![eof $fbat] } { gets $fbat aa incr NumLine set label "" if { [regexp {^[ ]*:[ ]*([^ ]+)} $aa {} label] } { set labels($label) [tell $fbat] } if { $retval == $label } { break } } if { $retval != $label } { ErrorAndQuit "error: label for goto not found '$retval'" } } } } } if { [info command wm] != "" } { wm withdraw . } set NumLine 0 set errorCode NONE set DEBUG 0 set ProgramErrorFile "" putsd encoding=[encoding system] putsd argv0=$argv0 set i 1 foreach j $argv { putsd "argv $i=$j" incr i } if { $argc < 4 } { ErrorAndQuit [concat "error; usage: $argv0 file.bat basename projectdirectory "\ "problemtypedirectory "] } proc ExitReal {} { putsd "exit real" exit } proc Exit { args } { global RunningProcess putsd "exiting..." if { [info exists RunningProcess] } { set RunningProcess {} } after 400 ExitReal return "goodbye" } load tcldde83.dll dde dde servername [pid] set rargc 0 set rargv "" for { set i 0 } { $i < $argc } { incr i } { if { ![regexp {^/[a-zA-Z]$} [lindex $argv $i]] } { incr rargc lappend rargv [lindex $argv $i] } } set file [lindex $rargv 0] if { [catch { set fbat [open $file r] }] } { ErrorAndQuit "error: file $file does not exist" } #set rargv [lrange $argv 1 end] ReadAndExecute $fbat ExitReal