48 lines
1.2 KiB
C
48 lines
1.2 KiB
C
char cobtools[] = "set argc 0\n"
|
|
"set argv {}\n"
|
|
"if {![info exists env(LD_LIBRARY_PATH)] ||\n"
|
|
" [lsearch [split $env(LD_LIBRARY_PATH) :] .] < 0} {\n"
|
|
" set lplst [split $env(LD_LIBRARY_PATH) :]\n"
|
|
" lappend lplst .\n"
|
|
" set env(LD_LIBRARY_PATH) [join $lplst :]\n"
|
|
"}\n"
|
|
"proc split_fields {} {\n"
|
|
" global cobol_fields data_block\n"
|
|
" set ix 0\n"
|
|
" foreach {varname size} $cobol_fields {\n"
|
|
" global $varname\n"
|
|
" set $varname [string range $data_block $ix [expr $ix+$size-1]]\n"
|
|
" incr ix $size\n"
|
|
" }\n"
|
|
"}\n"
|
|
"proc ::do_exit {} {\n"
|
|
" global cobol_fields result ready\n"
|
|
" set result \"\"\n"
|
|
" catch {\n"
|
|
" foreach {varname size} $cobol_fields {\n"
|
|
" global $varname\n"
|
|
" append result [format \"%-$size.${size}s\" [set $varname]]\n"
|
|
" }\n"
|
|
" }\n"
|
|
" set ready 1\n"
|
|
"}\n"
|
|
"proc ::cobol_preprocess {} { }\n"
|
|
"proc ::cobol_update {} { }\n";
|
|
|
|
char compute_block_size[] = "set block_size 0\n"
|
|
"foreach {varname size} $cobol_fields {\n"
|
|
" incr block_size $size\n"
|
|
"}\n";
|
|
|
|
char wait_ready[] = "split_fields\n"
|
|
"set ready 0\n"
|
|
"cobol_preprocess\n"
|
|
"if {!$ready} {\n"
|
|
" tkwait variable ready\n"
|
|
"}\n";
|
|
|
|
char newgui[] = "foreach child [winfo children .] {\n"
|
|
" destroy $child\n"
|
|
"}\n";
|
|
|