ngcgui.tcl
1 #!/usr/bin/wish 2 3 #----------------------------------------------------------------------- 4 # ngcgui.tcl is a front-end gui that reads one or more single function 5 # gcode subroutine files, provides user prompts for parameters for an 6 # arbitrary number of invocations, and creates a single output file 7 # of gcode. 8 9 # ngcgui can be run as a standalone application or its functionality 10 # can be embedded in a parent tcl application including the axis gui. 11 12 # Example standalone Usage, create link: 13 # $ ln -s somewhere/ngcgui.tcl directory_in_your_PATH/ngcgui 14 # 15 # Usage: 16 # ngcgui --help | -? 17 # ngcgui [Options] -D nc_files_directory_name 18 # ngcgui [Options] -i LinuxCNC_inifile_name 19 # ngcgui [Options] 20 # 21 # Options: 22 # [-S subroutine_file] 23 # [-p preamble_file] 24 # [-P postamble_file] 25 # [-o output_file] 26 # [-a autosend_file] (autosend to axis default:auto.ngc) 27 # [--noauto] (no autosend to axis) 28 # [-N | --nom2] (no m2 terminator (use %)) 29 # [--font [big|small|fontspec]] (default: "Helvetica -10 bold") 30 # [--horiz|--vert] (default: --horiz) 31 # [--cwidth comment_width] (width of comment field) 32 # [--vwidth varname_width] (width of varname field) 33 # [--quiet] (fewer comments in outfile) 34 # [--noiframe] (default: frame displays image) 35 # 36 #----------------------------------------------------------------------- 37 # ngcgui was first developed on git-master version 2.4.0-pre 38 # named "O" words available since: LinuxCNC 2.3.0, April 19, 2009 39 40 #----------------------------------------------------------------------- 41 # Copyright: 2010-2013 42 # Author: Dewey Garrett <dgarrett@panix.com> 43 # 44 # This program is free software; you can redistribute it and/or modify 45 # it under the terms of the GNU General Public License as published by 46 # the Free Software Foundation; either version 2 of the License, or 47 # (at your option) any later version. 48 # 49 # This program is distributed in the hope that it will be useful, 50 # but WITHOUT ANY WARRANTY; without even the implied warranty of 51 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 52 # GNU General Public License for more details. 53 # 54 # You should have received a copy of the GNU General Public License 55 # along with this program; if not, write to the Free Software 56 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 57 #----------------------------------------------------------------------- 58 59 # ngcgui allows a user to write subroutine files that contain 60 # a single subroutine as described in 61 # 3.7 Calling Files of the LinuxCNC ________ manual 62 # and then use or test them with a gui frontend that simplifies 63 # user entry of calling arguments (positional parameters #1,#2,...) 64 65 # If the subroutine includes lines to equate positional parameters 66 # (#n) to named parameters (#<parmname>) on special association lines like: 67 # 68 # #<parmname> = #n (optional_comment_text) 69 # 70 # then the positional parameter will be supplemented with the more 71 # descriptive #<parmname> in the gui entry box and any optional_comment_text 72 # will be included in the gui. Use of the descriptive #<parmname> in 73 # the body of the subroutine will make it more readable but is not 74 # mandatory. 75 # 76 # When this format is used, the order of appearance of the positional 77 # parameters must be monotonically increasing with no omissions. This 78 # helps to prevent user errors in assignment of parmnames to parameters. 79 # 80 # A default value can also be specified on the special association line like: 81 # #<parmname> = #n (=dvalue) 82 # or 83 # #<parmname> = #n (=dvalue optional_comment_text) 84 85 # All positional parameters used in the body of the subroutine must be 86 # entered -- an error occurs if an item entry is missing when a feature 87 # is made with "Create Feature" 88 89 # The linuxcnc gcode language does not provide a mechanism for returning 90 # results so subroutines must set global parameters for results. 91 # Within ngcgui, _globals with names that contain a colon (:) character 92 # are ignored in the creation of entry boxes. 93 # For example, a subroutine called from a Subfile named o<line> returns 94 # results in globals like: #<_line:theta>, $<_line:length>, etc. 95 # This feature can be used to hide globals from entry boxes for any purpose 96 # or for communication between routines 97 98 # Workflow (for standalone usage): 99 100 # 1) The directory location for ngc gcode files used in linuxcnc is specified 101 # in the ini file by: [DISPLAY]PROGRAM_PREFIX. 102 # In linuxcnc2.5, multiple directories can be specified using 103 # [RS274NGC]SUBROUTINE_PATH if 104 105 # 2) Candidate subroutine files for use with this utility should contain 106 # a single subroutine as described in: 107 # 3.7 Calling Files of the LinuxCNC ________ manual 108 109 # 3) Optionally, user supplies a Preamble file of gcode 110 # No substitutions are performed on this file 111 112 # 4) User specifies a subroutine file (Subfile). 113 # Entry boxes are created for each positional parameter 114 115 # 5) Optionally, user supplies a Postamble file of gcode 116 # No substitutions are performed on this file 117 118 # 6) "Create Feature" Button adds feature to queue for output file. 119 # The gui will verify that all positional parameters are not 120 # null but makes no checks on values. 121 122 # 7) "Finalize" button prompts for filename, and writes output file 123 # for all features and adds a terminating m2 124 125 # 8) After finalizing the file, the user may send the file to 126 # the axis gui with the SendFileToAxis button. If axis is not running, 127 # an error is displayed. User should verify axis state before 128 # sending. Errors detected by axis are shown within the axis 129 # application. 130 131 # 9) To create a file with multiple sections from one or more 132 # subroutine files: 133 # a) enter values for Preamble, Subfile, Postamble 134 # b) fill in positional parameters 135 # d) "Create Feature" number_1 136 137 # e) If this this the only feature, select "Finalize" to write 138 # the file. Then select "SendFileToAxis" to send the file to axis 139 # or "Create Feature" to start a new file 140 141 # f) For multiple features, continue: 142 # enter different parameter values 143 # or 144 # specify new values for Preamble, Subfile, Postamble 145 # and fill in the new entry box values 146 # g) "Create Feature" number_2 147 # h) Repeat f),g) for all features 148 # i) "Finalize" the file (as above) 149 150 # The Preamble and Postamble files are optional, for example one 151 # might specify the Preamble only for the first subroutine and the 152 # Postamble only for the last subroutine in making a output file 153 # for a set of features with common parameters specified in a 154 # single preamble file of features. 155 156 # Options: 157 # "Retain values on Subfile read" 158 # After opening a Subfile (and creating an output file) a second 159 # Subfile (third,fourth, ...) may be opened while retaining values 160 # for positional parameters where the names are 161 # _matched_ in the subsequent file. This is useful when 162 # testing new subroutines and may be useful when combining multiple 163 # feature routines if they share parameters with common names like 164 # "#<zsafe>", "#<zstart>", etc. 165 # Values for _numbered_ positional parameters (#n) without a name 166 # association are never retained. 167 168 # "Expand subroutine" 169 # When checked, subroutines are expanded in the 170 # output file. This allows the axis_gui to highlight 171 # gcode lines in the text window when paths are left-clicked in 172 # the 3D window (and vice-vera) when subroutines are used. 173 # In expanding subroutines, labels within are made unique 174 # to avoid name collision with labels in other expansions or 175 # other included subroutines. Only one level of subroutine 176 # expansion is performed. If the interpreter detects an error, it 177 # is sometimes unclear where it occurs when subroutines are called. 178 # Expanding the Subfile and rerunning often gives a line number 179 # as an aid in finding the problem. 180 # 181 # When not checked, subroutines are called and not expanded. 182 183 # Button Shortcut bindings: 184 # Preamble, Subfile, Postamble buttons 185 # Instead of using the button and file selection dialog, enter 186 # a new file name in the associated entry and <Return> to open 187 # and read different file. When the filename differs from the 188 # currently laoded file, the filename text changes color. 189 # This shortcut is useful when you are debugging/editing one of the 190 # input files -- enter a <Return> in the corresponding entry item 191 # for the filename to reload the file. 192 193 # Notes: 194 # 0. configuring ngcgui is simplified with linuxcnc2.5; support for 195 # linuxcnc2.4 will cease when linuxcnc2.5 is released 196 197 # 1. ngcgui supports subroutine files that contain a _single_ 198 # subroutine in a file where the name of the subroutine 199 # is the same as the name of the file. 200 # ex: 201 # $ cat rect.ngc 202 # o<rect> sub 203 # ... 204 # o<rect> endsub 205 # Only comments and empty lines may appear before sub or after endsub 206 207 # 2. The parameters passed to a subroutine (Postional parameters) 208 # are identified as "Numbered parameters" #1,#2,...,#n with 209 # n <= 30 210 # ngcgui finds any instances of #1,...,#30 and identifies 211 # each as a positional parameter for invocation of the subroutine. 212 # So, if you have a subroutine with 3 parameters (#1,#2,#3), 213 # it is not a good idea to use parameters like #4 or #30 in the 214 # body of the routine since they will increase the number of 215 # entry-box items in the ngcgui front-end and cause great confusion. 216 # 217 # In the manual: 218 # "O- call takes up to 30 optional arguments, which are passed 219 # to the subroutine as #1, #2, ..., #N. Parameters from #N+1 to 220 # #30 have the same value as in the calling context." 221 222 # 3. LinuxCNC gcode supports labels for conditional blocks and subroutines 223 # in both "Numbered" (ex: o100) and "Named" (ex: o<l101>) forms. 224 # Support for the "Numbered" label format is included, but 225 # it would be clearer to limit ngcgui support to: 226 # Positional Parametrs --> #1, ..., #n 1<=n<=30 227 # Named Labels --> o<label_name> 228 # This seems consistent with the trajectory of LinuxCNC gcode and 229 # accomodation of earlier styles (numbered labels like 230 # #n+1 to #30) is a small matter of editing:). 231 232 # 4. removed 233 234 # 5. If a file (subfile,preamble,postamble) is removed or modified by 235 # another application (like an editor), the color for its name will 236 # change to notify the ngcgui user that it should probably be reloaded. 237 238 # 6. The preamble file is provided to support simple setup actions 239 # like g20/g21,g40 etc. Similarly, the postamble file supports 240 # terminating actions as required like m5. 241 # The preamble and postamble file can be more complex even 242 # including subroutines. Such inclusion requires care 243 # by the user if multiple files are used to make a single output 244 # file with ngcgui because if a file containing subroutines 245 # is included more than once, a multiple definition error is 246 # flagged. The user can avoid this by carefully selecting/deselecting 247 # preamble/postamble files but a better course is to avoid 248 # subroutines in these files and rely on a library of "subroutine-only" 249 # files in the [DISPLAY]PROGRAM_PREFIX directory. 250 251 # 7. ngcgui inserts a special global variable named #<_feature:> that begins 252 # with a value of 0 and is incremented for each added feature. This 253 # _global can be tested in subroutines; no entry box is created for it. 254 255 # Similarly, ngcgui inserts a special global variable named #<_remaining_features:> 256 # that indicates the number of features remaining after the current feature. 257 # A value of zero indicates the current feature is the last feature. 258 259 # 8. entry boxes for positional parameters include key bindings 260 # for keys x,y,z,a,b,c,u,v,w, and d. When embedded in axis, typing these keys 261 # cause the current value (emc_rel_act_pos) to be entered into the 262 # entry box. This function makes it simple to enter current coordinate 263 # values. The d key will enter the 2*x for the diameter on a lathe) 264 # 265 # (If there is a tcl global ::entrykeybinding proc, it will 266 # be used instead for these key bindings so that other embedding 267 # applications can handle these keys -- see the source for the parameters 268 # passed to the proc.) 269 270 # 9. lines before the o<>sub line and after the o<>endsub line must 271 # be comments (enclosed in parentheses) or begun with a semicolon (;) 272 273 # 10. each time an output file is finished, ngcgui saves a copy in 274 # /tmp/ngcgui_bak/ just in case you want to see it or reuse it later 275 # The /tmp directory is normally purged at restart or after 276 # a number of days determined by the variable TMPTIME in 277 # the system file /etc/default/rcS (ubuntu for example) 278 279 # 11. key bindings 280 # Escape return to Preview page (only if embed_in_axis) 281 # Ctrl-a Toggle autosend 282 # Ctrl-c Clear entries 283 # Ctrl-d Set entries to default values 284 # Ctrl-e Open editor specified by $VISUAL on last outfile 285 # Ctrl-f Create feature 286 # Ctrl-F Finalize 287 # Ctrl-k Show key bindings 288 # Ctrl-n Restart (cancel pending) 289 # Ctrl-p (re)Read Preamble 290 # Ctrl-P (re)Read Postamble 291 # Ctrl-r (re)Read Subfile 292 # Ctrl-s Show status 293 # Ctrl-S Show full status (debug info) 294 # Ctrl-u Open editor specified by $VISUAL on current subfile 295 # Ctrl-U Open editor specified by $VISUAL on current preamble 296 297 # 12. All entry boxes are checked for valid numbers and the entry is 298 # turned red if invalid. 299 300 # 13. Emc gcode (2.3 19apr09) allows a single semicolon use for comments. 301 # This gui supports semicolon comments but the syntax for special 302 # association lines requires the () form: 303 # 304 # for positional parameters 1<=n<=30: 305 # #<parmname> = #n (=defaultvalue comment_text) 306 307 # 14. Features requiring linuxcnc-2.4pre (that I can remember): 308 # a) error detection when sending file to axis 309 310 # 15. Helper subroutine files that are included in the 311 # [DISPLAY]PROGRAM_PREFIX (or the[RS274NGC]SUBROUTINE_PATH) 312 # directory may not be suitable for use as a subfile. 313 # To indicate this to a user, include a special comment line: 314 # (not_a_subfile) 315 # Alternatively, these files can be placed in a different 316 # directory specified in the ini file [WIZARD]WIZARD_ROOT 317 318 # 16. Using a launcher (like ubuntu gnome destop launcher) doesn't 319 # make it easy to pass in environmental variables like VISUAL. 320 # This works for a launcher: put ngcgui.tcl in a directory 321 # such as /home/yourname/bin and create script such as 322 # $ cat /home/yourname/bin/launch_ngc 323 # #!/bin/sh 324 # export VISUAL=gedit ;# your favorite editor 325 # /home/yourname/bin/ngcgui.tcl -a auto -i your inifile 326 # 327 # make it executable: 328 # $ chmod 755 /home/yourname/bin/launch_ngc 329 # configure the launcher so the command is: 330 # Command: /home/yourname/bin/launch_ngc 331 # 332 # 17. obsolete: xembed support removed, internal embedding works better 333 # 334 # 18. If --vwidth 0 is used and a parameter has no comment, the variable 335 # name is placed in the comment field 336 # 337 # 19. For linuxcnc 2.4, the tcl proc embed_in_axis_tab will embed directly 338 # in an axis tab using [DISPLAY]USER_COMMAND_FILE (or ~/.axisrc) 339 # example: 340 # w = widgets.right.insert("end", 'ngcgui', text='Ngcgui') 341 # w.configure(borderwidth=1, highlightthickness=0) 342 # f = Tkinter.Frame(w, container=0, borderwidth=0, highlightthickness=0) 343 # f.pack(fill="both", expand=1, anchor="nw",side="top") 344 # root_window.tk.call("source","somepath/ngcgui.tcl") 345 # root_window.tk.call("::ngcgui::embed_in_axis_tab",f,"nameof_ngcgui_subfile") 346 # 347 # 20. The Preamble and Postamble entry fields may be used to insert 348 # immediate gcode commands instead of reading files. The immediate 349 # syntax is signaled by a leading colon (:), commands are separated by 350 # semicolons (;). Example: 351 # :t0m6;(debug, pausing);m0 (pause) 352 # The commands are not validated by ngcgui but are added to the 353 # output gcode file 354 # 355 # 21. When embedding in axis directly, multiple tabpages can be specified. Each 356 # can be used independently to add multiple features from the initial or 357 # newly selected subfiles. If multiple tabpages have created features, the 358 # Finalize action will offer to finalize all tabpages in left-to-right order. 359 # Beware of this ordering. If the order is incorrect, cancel and then 360 # rearrange page order before finalizing. 361 # 362 # 22. Subfiles can optionally include a special comment: 363 # (info: info_text) 364 # The info text will be displayed (embed_in_axis only) 365 # 366 # 23. An optional image file (.png,.gif,.jpg,.pgm) can accompany a subfile. 367 # The image file can help clarify the parameters; a window displaying 368 # the image is popped up when the subfile is read. The image file 369 # should be in the same directory as the subfile and have the same 370 # name with an appropriate image suffix, e.g. the subfile iquad.ngc 371 # should be accompanied by an image file iquad.png 372 # 373 # 24. When ngcgui pages are embedded in the axis gui, options can 374 # be specified: 375 # NGCGUI_OPTIONS = opt1 opt2 ... 376 # opt items: 377 # nonew -- disallow making new tab page 378 # noremove -- disallow removing any tab page 379 # noauto -- noautosend (makeFile, then manually send) 380 # noiframe -- put image inside a toplevel instead of a frame 381 # so all controls are available 382 # nom2 -- no m2 terminator (use %) 383 # 384 # 25. When ngcgui pages are embedded in the axis gui and the user 385 # is allowed to open new subroutines, the initial starting directroy 386 # for subfiles is: 387 # the first directory in [RS274NGC]SUBROUTINE_PATH if 388 # [RS274NGC]SUBROUTINE_PATH is specified 389 # or 390 # the dir specified by [DISPLAY]PROGRAM_PREFIX if 391 # [DISPLAY]PROGRAM_PREFIX is specified 392 # otherwise 393 # "." 394 395 # 26. removed 396 397 # 27. Ngcgui supports .gcmc files (for gcmc the G-Code Meta Compiler) 398 # http://www.vagrearg.org/content/gcmc 399 # Special tags in the .gcmc file are used to: 400 # 1) specify the info text for the tab page (optional) 401 # 1) specify variable names requiring an ngcgui entry box 402 # 2) specify gcmc options (optional) 403 # 404 # When creating a feature from a gcmc file, the gcmc program 405 # is run with the variable values from the entry boxes and the gcmc 406 # options specified. 407 # 408 409 #----------------------------------------------------------------------- 410 411 namespace eval ::ngcgui { 412 namespace export ngcgui ;# public interface 413 } 414 415 #----------------------------------------------------------------------- 416 # Internationalization 417 418 # use the tcl-package named Emc to set up I18n support 419 if [catch {package require Linuxcnc} msg] { 420 # if user is trying to use as standalone in an unconfigured (non-Emc) 421 # environment, just continue without internationalization 422 puts stdout "Internationalization not available: <$msg>" 423 } 424 # use a command or proc named "_" for ::msgcat::mc 425 # when embedded in axis, a command named "_" is predefined, 426 # since "_" is not defined for standalone usage, make a proc named "_" 427 if {"" == [info command "_"]} { 428 package require msgcat 429 proc _ {s} {return [::msgcat::mc $s]} 430 } 431 432 #----------------------------------------------------------------------- 433 proc ::ngcgui::parse_ngc {hdl ay_name filename args} { 434 # return 1 for ok 435 # return 0 for error and lappend to (parse,msg) 436 upvar $ay_name ay 437 set ay($hdl,parse,msg) "" 438 439 # default info, supersede expected: 440 set ay($hdl,info) "[_ "Current subfile: $filename"]" 441 442 if {"$filename" == ""} { 443 lappend ay($hdl,parse,msg) "[_ "Need non-null file name"]" 444 return 0 445 } 446 if [catch {set fd [open $filename r]} msg] { 447 lappend ay($hdl,parse,msg) $msg 448 return 0 449 } 450 set basename [file tail $filename] 451 set idx [string last . $basename] 452 set ay($hdl,subroutine,name) [string replace $basename $idx end] 453 new_image $hdl $filename 454 455 retain_or_unset $hdl $ay_name 456 457 set min_num 999999; set max_num -1 458 set last_num 0 459 set ay($hdl,label_maxwidth) 0 460 set lct 0 461 set lno 1 462 463 catch { 464 foreach n [array names ::ngc_sub $hdl,*] { 465 unset ::ngc_sub($n) 466 } 467 } 468 469 while {![eof $fd]} { 470 gets $fd theline 471 incr lno 472 473 #remove blanks and tabs, use lower case (ngc rs274 format): 474 set line [string map {" " "" " " ""} $theline] ;#sp,tab to "" 475 set line [string tolower $line] 476 477 # theline: original line, may have whitespace, caps, etc. 478 # line: collapsed whitespace, lowercase 479 set line_end [expr -1 + [string len $line]] ;# last index 480 if {"$line" == ""} continue ;# discard empty lines 481 set iscomment 0 482 if { ([string first ( $line] == 0 && [string last ) $line] == $line_end)\ 483 || [string first \; $line] == 0 } { 484 set iscomment 1 485 # match to theline for caps to find spaceFEATUREspace on a comment line 486 if [string match "*\[ \]FEATURE\[ \]*" $theline] { 487 lappend emsg "[_ "Disallowed use of ngcgui generated file as Subfile"]" 488 set ay($hdl,parse,msg) $emsg 489 catch {unset ay($hdl,argct)} ;# make parmcheck fail 490 return 0 491 } 492 if [string match "(not_a_subfile)" $theline] { 493 lappend emsg "[_ "File"] <$filename> [_ "marked (not_a_subfile)\nNot intended for use as a subfile"]" 494 catch {unset ay($hdl,argct)} ;# make parmcheck fail 495 set ay($hdl,parse,msg) $emsg 496 return 0 497 } 498 if {[string first "(info:" $theline] >= 0} { 499 set idx [string first : $theline] 500 set info [string range $theline [expr $idx +1] end] 501 set ay($hdl,info) [string trim $info " )"] 502 } 503 } 504 505 # disallow embedded numbered subroutines within a single-file subroutine 506 if {[regexp -nocase "^o\[0-9\]*sub" $line]} { 507 puts stdout "[_ "bogus"]:$lno<$theline>" 508 lappend emsg \ 509 "[_ "can not include subroutines within ngcgui subfile"]:$theline" 510 set ay($hdl,parse,msg) $emsg 511 return 0 512 } 513 514 # find subroutine start: 515 if [string match o<*>sub* $line] { 516 if [info exists found_sub_end] { 517 lappend emsg "[_ "Multiple subroutines in file not allowed"]" 518 set ay($hdl,parse,msg) $emsg 519 return 0 520 } 521 set found_sub_start 1 522 set i1 [string first < $theline] 523 set i2 [string first > $theline] 524 set label [string range $theline [expr $i1 + 1] [expr $i2 -1]] 525 if {"$label" != "$ay($hdl,subroutine,name)"} { 526 puts stdout "[_ "bogus"]:$lno<$theline>" 527 lappend emsg \ 528 "[_ "sub label"]: o<$label> [_ "does not match subroutine file name"]" 529 } 530 continue ;# the sub line itself is not saved 531 } 532 533 if {[info exists found_sub_end]} { 534 # allow null lines and comments after endsub 535 if $iscomment { 536 set ::ngc_sub($hdl,$lct) $theline 537 incr lct 538 continue 539 } else { 540 # sometimes there is an m2 after endsub, ignore it 541 if {[string first m2 [string trim [string tolower $theline]]] == 0} { 542 set ::ngc_sub($hdl,$lct) \ 543 "($::ngc(any,app): [_ "ignoring M2 after endsub"]: <$theline>)" 544 puts stdout "[_ "ignoring M2 after endsub"] <$theline>" 545 incr lct 546 continue 547 } else { 548 puts stdout "[_ "bogus"]:$lno<$theline>" 549 lappend emsg "[_ "file contains lines after subend"]" 550 } 551 } 552 } 553 554 if {![info exists found_sub_start]} { 555 # allow null lines and comments before sub 556 if $iscomment { 557 set ::ngc_sub($hdl,$lct) $theline 558 incr lct 559 continue 560 } else { 561 puts stdout "[_ "bogus"]:$lno<$theline>" 562 lappend emsg "[_ "file contains lines before sub"]" 563 } 564 } 565 566 if {$iscomment} { 567 set ::ngc_sub($hdl,$lct) $theline 568 incr lct 569 continue 570 } 571 # processing below for non-comments only 572 573 # find subroutine end: 574 if { [info exists found_sub_start] \ 575 && [string match o<*>endsub* $line] } { 576 set found_sub_end 1 577 set i1 [string first < $theline] 578 set i2 [string first > $theline] 579 set label [string range $theline [expr $i1 + 1] [expr $i2 -1]] 580 if {"$label" != "$ay($hdl,subroutine,name)"} { 581 puts stdout "[_ "bogus"]:$lno<$theline>" 582 lappend emsg \ 583 "[_ "endsub label"]: o<$label> [_ "does not match subroutine file name"]" 584 } 585 continue ;# the endsub line is not saved 586 } 587 588 # find and save labels for name mangling when expanding 589 if { [info exists found_sub_start] \ 590 && ![info exists found_sub_end]} { 591 if {$lct >= 0} { 592 # save label identifiers so they can be made unique when expanding 593 # multiple subroutines 594 # but do not include labels for calls: 595 # match to line but use theline for label to preserve user case 596 if { [string match *o<* $line] \ 597 && ![string match *o<*>*call* $line]} { 598 set i1 [string first < $theline] 599 set i2 [string first > $theline] 600 set label [string range $theline [expr $i1 + 1] [expr $i2 -1]] 601 set ::ngc_sub($hdl,$lct,label) $label 602 set txt [string range $theline [expr $i2+1] end] 603 set ::ngc_sub($hdl,$lct) $txt 604 } elseif { [string match o\[0-9\]* $line] } { 605 set tline [string trimleft $theline] 606 if [regexp -nocase "(^o\[0-9\]*)(.*)" $tline v label txt] { 607 set ::ngc_sub($hdl,$lct,label) $label 608 set ::ngc_sub($hdl,$lct) $txt 609 } 610 } else { 611 set ::ngc_sub($hdl,$lct) $theline 612 set label "" 613 } 614 if {[string length $label] > $ay($hdl,label_maxwidth)} { 615 set ay($hdl,label_maxwidth) [string length $label] 616 } 617 } 618 incr lct 619 } 620 621 # find numbered parameters #1--#30 inclusive 622 # in order to identify the biggest one since all 623 # in this range are considered to be positional parameters 624 # even if some in the range are not explicitly used 625 set l $line 626 while 1 { 627 set i1 [string first # $l] 628 if {$i1 < 0} {break} 629 set i2 [expr 1 + $i1] 630 set i3 [expr 2 + $i1] 631 set i4 [expr 3 + $i1] 632 set char2 [string range $l $i2 $i2] 633 set char3 [string range $l $i3 $i3] 634 635 set v $char2$char3[string range $l $i4 $i4] 636 if { [is_int $v] \ 637 && ($v > 30) } { 638 break ;# ignore #nnn... 639 } 640 if {[is_int $char2] && ![is_int $char3]} { 641 set num_var $char2 642 if {$num_var < $min_num} {set min_num $num_var} 643 if {$num_var > $max_num} {set max_num $num_var} 644 set l [string range $l $i3 end] 645 continue 646 } 647 if {[is_int $char2] && [is_int $char3]} { 648 set num_var $char2$char3 649 if { 0 < $num_var & $num_var <= 30} { 650 if {$num_var < $min_num} {set min_num $num_var} 651 if {$num_var > $max_num} {set max_num $num_var} 652 set l [string range $l [expr 1+$i3] end] 653 continue 654 } 655 } 656 set l [string range $l $i2 end] 657 } 658 659 # find special association lines that match: 660 # for positional parameters, special line is 661 # #<parmname>=#n where 0 <= n <= 30 662 # or #<parmname>=#n (=defaultvalue comment_text) 663 if { [string match *#<*>=#\[1-9\]* $line] \ 664 || [string match *#<*>=#\[1-2\]\[0-9\]* $line] \ 665 || [string match *#<*>=#30* $line] } { 666 667 if { [string match *#<*>=#\[3-9\]\[1-9\]* $line] } { 668 # exclude #31-#99 669 } elseif {[string match *#<*>=#\[1-9\]\[0-9\]\[0-9\]* $line] } { 670 # exclude #nnn... (3 or more digit numbers) 671 } else { 672 set i1 [string first >=# $line] 673 set parmname [string range $line 2 [expr -1+$i1]] 674 set num [string range $line [expr 3+ $i1] end] 675 676 # remove trailing comment: 677 set i1 [string first ( $num] 678 if {$i1 >= 0} { 679 set num [string range $num 0 [expr -1 +$i1]] 680 } 681 set num02 [format %02d $num] 682 set ay($hdl,arg,name,$num02) $parmname 683 set expect_num [expr $last_num +1] 684 # enforce these to appear in order to help prevent user errors 685 if {$num != $expect_num && $num <= 30} { 686 puts stdout "[_ "bogus"]:$lno<$theline>" 687 lappend emsg \ 688 "[_ "out of sequence positional parameter"] $num [_ "expected"]: $expect_num " 689 } else { 690 set last_num $num 691 } 692 693 set i1 [string first ( $theline] 694 set i2 [string last ) $theline] 695 if { $i1 >0 && $i2 > $i1} { 696 set cmt [string range $theline [expr 1 + $i1] [expr -1 + $i2]] 697 if [regexp -nocase "= *(\\+*-*\[0-9.\]*)(.*)" \ 698 $cmt V(match) V(dvalue) V(comment)] { 699 set ay($hdl,arg,dvalue,$num02) $V(dvalue) 700 set ay($hdl,arg,comment,$num02) [string trim $V(comment)] 701 } else { 702 set ay($hdl,arg,comment,$num02) $cmt 703 } 704 } 705 706 # for --vwidth 0, make sure something exists for comment 707 if { $ay(any,width,varname) == 0 \ 708 && ( ![info exists ay($hdl,arg,comment,$num02)] \ 709 || "$ay($hdl,arg,comment,$num02)" == "") 710 } { 711 set ay($hdl,arg,comment,$num02) $ay($hdl,arg,name,$num02) 712 } 713 } 714 } 715 716 } ;# while !eof 717 set ay($hdl,sublines) $lct 718 close $fd 719 720 # for args without a special name association, use #n for name 721 for {set i 1} {$i <= $max_num} {incr i} { 722 set num02 [format %02d $i] 723 if ![info exists ay($hdl,arg,name,$num02)] { 724 set ay($hdl,arg,name,$num02) #$i ;# ensure all intervening parms 725 } 726 } 727 728 set ay($hdl,argct) $max_num 729 730 # remove any notused retained items 731 for {set i [expr $max_num +1]} {$i <= 30} {incr i} { 732 set num02 [format %02d $i] 733 catch {unset ay($hdl,arg,name,$num02)} 734 catch {unset ay($hdl,arg,comment,$num02)} 735 } 736 737 # error checks 738 if {![info exists found_sub_start]} { 739 lappend emsg "[_ "no sub found in file"]" 740 } 741 if {[info exists found_sub_start] && ![info exists found_sub_end]} { 742 lappend emsg "[_ "no endsub found in file"]" 743 } 744 if [info exists emsg] { 745 set ay($hdl,parse,msg) $emsg 746 return 0 747 } 748 return 1 ;# ok 749 } ;# parse 750 751 proc retain_or_unset {hdl ay_name} { 752 upvar $ay_name ay 753 if {$ay($hdl,retainvalues)} { 754 # positional parameters: retain some 755 foreach n [array names ay $hdl,arg,name,*] { 756 # example: 757 # exists arg,name,03 == xloc 758 # arg,value,03 == 999 759 # set arg,byname,xloc == 999 760 set num [string range $n [expr 1+[string last , $n]] end] 761 set name $ay($n) 762 if ![info exists ay($hdl,arg,value,$num)] continue 763 if {[string first # $name] != 0} { 764 set ay($hdl,arg,byname,$name) $ay($hdl,arg,value,$num) 765 } 766 } 767 } else { 768 # retaining none 769 foreach n [array names ay $hdl,arg,value*] {unset ay($n)} 770 foreach n [array names ay $hdl,arg,byname,*] {unset ay($n)} 771 } 772 # always unset these 773 foreach n [array names ay $hdl,arg,name,*] {unset ay($n)} 774 foreach n [array names ay $hdl,arg,comment,*] {unset ay($n)} 775 foreach n [array names ay $hdl,arg,value,*] {unset ay($n)} 776 foreach n [array names ay $hdl,arg,dvalue,*] {unset ay($n)} 777 foreach n [array names ay $hdl,arg,entrywidget,*] {unset ay($n)} 778 779 catch { 780 foreach n [array names ::ngc_sub $hdl,*] { 781 unset ::ngc_sub($n) 782 } 783 } 784 } ;# retain_or_unset 785 #----------------------------------------------------------------------- 786 proc ::ngcgui::find_gcmc {} { 787 if [catch {set found [exec which gcmc]} msg] { 788 puts stdout "find_gcmc:NOTfound:<$msg>" 789 return "" 790 } else { 791 #puts stdout "find_gcmc:found:$found" 792 } 793 return $found 794 } ;# find_gcmc 795 796 proc ::ngcgui::parse_gcmc {hdl ay_name filename args} { 797 # return 1 for ok 798 # return 0 for error and lappend to (parse,msg) 799 upvar $ay_name ay 800 set ay($hdl,parse,msg) "" 801 802 if ![info exists ::ngc(any,gcmc,executable)] { 803 set result [find_gcmc] 804 if {"$result" == ""} { 805 lappend ay($hdl,parse,msg) "[_ "Cannot find gcmc executable"]" 806 lappend ay($hdl,parse,msg) "[_ "Please Install in path"]" 807 return 0 808 } else { 809 set ::ngc(any,gcmc,executable) [find_gcmc] 810 # outdir has to be in path 811 # use first dir in path as dir for temporary ofile 812 if ![info exists ::ngc(any,paths)] { 813 set ::ngc(any,paths) [file normalize [file dirname $filename]] 814 puts "\nngcgui: [_ "not embedded, deriving outdir from:"] $filename\n" 815 } 816 817 set ::ngc(any,gcmc,outdir) [file normalize [lindex $::ngc(any,paths) 0]] 818 set ::ngc(any,gcmc,funcname) tmpgcmc ;# append session id and suffix 819 # clean up prior runs by moving to tmp 820 if ![catch {set flist [glob [file join $::ngc(any,gcmc,outdir) \ 821 $::ngc(any,gcmc,funcname)]*] } msg] { 822 file mkdir /tmp/oldgcmc 823 foreach f $flist { 824 #puts " file rename $f /tmp/[file tail $f]" 825 file rename -force $f [file join /tmp/oldgcmc [file tail $f]] 826 } 827 } 828 } 829 830 set ct 1 831 # catch: early versions of gcmc returns $?=1 832 if [catch {set ans [exec $::ngc(any,gcmc,executable) --version] 833 } msg ] { 834 puts stdout "parse_gcmc: unexpected version:<$msg>" 835 } else { 836 foreach line [split $ans \n] { 837 set ::ngc(any,gcmc,version,line$ct) $line 838 incr ct 839 } 840 puts stdout "gcmc path: $::ngc(any,gcmc,executable)" 841 puts stdout "gcmc version: $::ngc(any,gcmc,version,line1)" 842 } 843 } 844 845 # default info, supersede expected: 846 set ay($hdl,info) "[_ "Current subfile: $filename"]" 847 catch {unset ::ngc($hdl,gcmc,opts)} ;# no retain on reread 848 849 if {"$filename" == ""} { 850 lappend ay($hdl,parse,msg) "[_ "Need non-null file name"]" 851 return 0 852 } 853 if [catch {set fd [open $filename r]} msg] { 854 lappend ay($hdl,parse,msg) $msg 855 return 0 856 } 857 set basename [file tail $filename] 858 set idx [string last . $basename] 859 set ay($hdl,subroutine,name) [string replace $basename $idx end] 860 new_image $hdl $filename 861 862 retain_or_unset $hdl $ay_name 863 864 set min_num 999999; set max_num -1 865 set ay($hdl,label_maxwidth) 0 866 867 set lno 1 868 set num 1 869 set num02 [format %02d $num] 870 set names {} 871 while {![eof $fd]} { 872 gets $fd theline 873 incr lno 874 #remove blanks and tabs 875 set theline [string trim $theline] 876 # consider // comments only 877 if {[string first "//" $theline] != 0} continue 878 # The '*', '+', and '?' qualifiers are all greedy. 879 # Greedy <.*> matches all of <H1>title</H1> 880 # NonGreedy <.*?> matches the only first <H1> 881 882 # // ngcgui : info: describing text 883 set einfo "^ *\\/\\/ *ngcgui *: *info: *\(.*?\)" 884 if {[regexp $einfo $theline match info]} { 885 set ay($hdl,info) $info 886 continue 887 } 888 889 set eopt "^ *\\/\\/ *ngcgui *: *\(-.*\)$" 890 if {[regexp $eopt $theline match opt]} { 891 # remove a trailing comment: 892 set idx [string first '//' $opt] 893 if {$idx >= 0} { set opt [string replace $opt $idx end] } 894 set idx [string first \; $opt] 895 if {$idx >= 0} { set opt [string replace $opt $idx end] } 896 set opt [string trim $opt] 897 898 lappend ::ngc($hdl,gcmc,opts) $opt 899 continue 900 } 901 902 catch {unset name dvalue comment} 903 # // ngcgui : name [= value [,comment]] 904 set e1 "^ *\\/\\/ *ngcgui *: *\(.*?\) *= *\(.*?\) *\, *\(.*?\) *$" 905 set e2 "^ *\\/\\/ *ngcgui *: *\(.*?\) *= *\(.*?\) *$" 906 set e3 "^ *\\/\\/ *ngcgui *: *\(.*?\) *$" 907 if {[regexp $e1 $theline match name dvalue comment]} { 908 #puts "1_____<$name>,<$dvalue>,<$comment>" 909 } elseif {[regexp $e2 $theline match name dvalue]} { 910 #puts "2_____<$name>,<$dvalue>" 911 } elseif {[regexp $e3 $theline match name]} { 912 #puts "3_____<$name>" 913 } else { 914 continue 915 } 916 if {[lsearch $names $name] >= 0} { 917 puts "duplicate name, first one wins <$name>" 918 # could be an error: 919 # lappend emsg "[_ "duplicate name <$name>"]" 920 continue 921 } 922 lappend names $name 923 set ay($hdl,arg,name,$num02) $name 924 if [info exists dvalue] { 925 # this is a convenience to make it simple to edit to 926 # add a var without removing the semicolon 927 # xstart = 10; 928 # //ngcgui: xstart = 10; 929 set dvalue [lindex [split $dvalue ";"] 0] ;# strip after a ";" 930 set ay($hdl,arg,dvalue,$num02) $dvalue 931 } 932 if [info exists comment] { 933 set ay($hdl,arg,comment,$num02) $comment 934 } else { 935 set ay($hdl,arg,comment,$num02) $name 936 } 937 incr num 938 set num02 [format %02d $num] 939 } ;# while !eof 940 941 close $fd 942 set ay($hdl,argct) [llength $names] 943 944 # gcmc files with no args are allowed 945 # if {$ay($hdl,argct) <= 0} { 946 # lappend emsg "[_ "gcmc file with no args"]" 947 # } 948 if {$ay($hdl,argct) > 30} { 949 lappend emsg "[_ "gcmc file with too many args <$::ay($hdl,argct)"]" 950 } 951 952 # error checks 953 if [info exists emsg] { 954 set ay($hdl,parse,msg) $emsg 955 return 0 956 } 957 return 1 ;# ok 958 } ;# parse_gcmc 959 960 proc ::ngcgui::dt {} { 961 return [clock format [clock seconds] -format %y%m%d:%H.%M.%S] 962 } ;# dt 963 964 proc ::ngcgui::is_int {v} { 965 if [catch {format %d $v}] { return 0 } 966 return 1 967 } ;# is_int 968 969 proc ::ngcgui::trimprefix {s {pfx opt,} } { 970 set idx [string first $pfx $s] 971 if {$idx != 0} {return $s} 972 return [string range $s [string length $pfx] end] 973 } ;# trimprefix 974 975 proc ::ngcgui::trimsuffix {s {sfx .ngc} } { 976 set idx [string last $sfx $s] 977 if {$idx <0} {return $s} 978 return [string range $s 0 [expr -1 + $idx]] 979 } ;# trimsuffix 980 981 proc ::ngcgui::qid {} { 982 # unique identifier 983 if ![info exists ::ngc(any,qid)] { set ::ngc(any,qid) 0 } 984 return [incr ::ngc(any,qid)] 985 } ;# qid 986 987 proc ::ngcgui::initgui {hdl} { 988 if ![info exists ::ngc(embed,hdl)] {set ::ngc(embed,hdl) 0} 989 if [info exists ::ngcgui($hdl,afterid)] { return ;# already done } 990 # fixed initializations 991 set ::ngc(any,pentries) 10 ;# number of entries in positional frame 992 ;# 30 max positional parameters 993 ;# 3 frames max so must have pentries >=10 994 set ::ngc(any,pollms) 2000 995 996 set ::ngc(any,color,black) black 997 set ::ngc(any,color,stdbg) #dcdad5 ;# default gray color set 998 set ::ngc(any,color,title) lightsteelblue2 999 set ::ngc(any,color,vdefault) darkseagreen2 ;# value defaults 1000 set ::ngc(any,color,readonly) gray 1001 1002 set ::ngc(any,color,ok) green4 1003 set ::ngc(any,color,single) palegreen 1004 set ::ngc(any,color,multiple) cyan 1005 set ::ngc(any,color,feature) lightslategray 1006 set ::ngc(any,color,prompt) blue3 1007 set ::ngc(any,color,warn) darkorange 1008 set ::ngc(any,color,notice) lightgoldenrodyellow 1009 set ::ngc(any,color,override) blue3 1010 1011 set ::ngc(any,color,error) red 1012 set ::ngc(any,color,filegone) maroon 1013 set ::ngc(any,color,filenew) darkorange 1014 set ::ngc(any,color,filemod) purple 1015 set ::ngc(any,color,custom) ivory2 1016 set ::ngc(any,color,default) blue4 1017 1018 set ::ngc(any,max_msg_len) 500 ;# limit popup msg len (gcmc) 1019 set ::ngc($hdl,afterid) "" 1020 statemap $hdl ;# set up state transitions 1021 } ;# initgui 1022 1023 1024 proc ::ngcgui::preset {hdl ay_name} { 1025 # using apps call this to populate ay_name, 1026 # superseded items as reqd 1027 # all required items with defaults: 1028 upvar $ay_name ay 1029 1030 # per-instance items: 1031 set ay($hdl,fname,subfile) "" 1032 set ay($hdl,fname,preamble) "" 1033 set ay($hdl,fname,postamble) "" 1034 set ay($hdl,fname,outfile) "" 1035 set ay($hdl,auto) 1 1036 set ay($hdl,fname,autosend) "auto.ngc" 1037 set ay($hdl,dir) "" 1038 set ay($hdl,retainvalues) 1 1039 set ay($hdl,expandsubroutine) 0 1040 set ay($hdl,verbose) 1 1041 set ay($hdl,chooser) 0 1042 set ay($hdl,info) "[_ "Choose Files"]" 1043 set ay($hdl,standalone) 0 1044 1045 # common to any instance items: 1046 set ay(any,app) ngcgui 1047 set ay(any,entrykeys,special) {x X y Y z Z a A b B c C u U v V w W d D} 1048 set ay(any,dir,just) "/tmp/ngcgui_bak" ;# set to "" to disable 1049 set ay(any,aspect) horiz 1050 set ay(any,font) {Helvetica -10 normal} 1051 set ay(any,width,comment) 12 1052 set ay(any,width,varname) 12 1053 set ay(any,img,width,max) 320 ;# subsample image to this max size 1054 set ay(any,img,height,max) 240 ;# subsample image to this max size 1055 1056 # options currently available with embed_in_axis only 1057 set ::ngc(opt,nonew) 0 ;# default allows new 1058 set ::ngc(opt,noremove) 0 ;# default allows remove 1059 set ::ngc(opt,noauto) 0 ;# default is autosend 1060 set ::ngc(opt,noinput) 0 ;# default is to show an input frame 1061 set ::ngc(opt,noiframe) 0 ;# default uses a separate toplevel for img 1062 1063 set ::ngc(opt,nom2) 0 ;# default use % at start and end 1064 # instead of m2 at 3end 1065 } ;# preset 1066 1067 proc ::ngcgui::gui {hdl mode args} { 1068 # use ::ngcgui::preset for required ::ngc($hdl,) items and defaults 1069 # standalone invoke: ::ngcgui::gui $hdl standalone wframe 1070 # embedded invoke: ::ngcgui::gui $hdl create wframe 1071 switch $mode { 1072 standalone { 1073 set ::ngc($hdl,standalone) 1 1074 set w [::ngcgui::gui $hdl create $args] 1075 return $w 1076 } 1077 create { 1078 if {"$hdl" == ""} {return -code error "hdl is null"} 1079 # mandatory arg for mode==create is a frame 1080 # caller packs/unpacks wframe which must be a valid name 1081 # but not exist yet 1082 set wframe [lindex $args 0] 1083 initgui $hdl 1084 set ::ngc($hdl,l,width) 10 ;# min lside width, see also tw 1085 if {"$::ngc(any,dir,just)" == ""} { 1086 unset ::ngc(any,dir,just) ;# disable feature: 1087 } else { 1088 if { [file isdirectory $::ngc(any,dir,just)] \ 1089 && [file writable $::ngc(any,dir,just)] \ 1090 } { 1091 # ok 1092 } else { 1093 if [catch {file mkdir $::ngc(any,dir,just)} msg] { 1094 puts stdout $msg ;# no such dir for example 1095 return "" ;# something bad happened 1096 } 1097 } 1098 } 1099 if {"$wframe" == ""} { 1100 return -code error "gui:create no arg for wframe" 1101 } 1102 set wframe [frame $wframe] ;# wframe specifies name, create it here 1103 pack $wframe -anchor nw -fill none -expand 0 ;# NB 1104 set ::ngc($hdl,top) [winfo toplevel $wframe] 1105 set ::ngc($hdl,topf) $wframe ;# ok for embed_in_axis, ok standalone 1106 1107 if {"$::ngc($hdl,dir)" == ""} {set ::ngc($hdl,dir) .} 1108 1109 # defaults: 1110 set ::ngc($hdl,id) 0 1111 set ::ngc($hdl,savect) 0 1112 conf $hdl restart,widget state disabled 1113 set ::ngc($hdl,ftypes,subfile) { {{GCODE,GCMC} {.ngc .gcmc}} } 1114 set ::ngc($hdl,ftypes,other) { {{NGC} {.ngc}} } 1115 # initializations: 1116 set ::ngc($hdl,data,preamble) "" 1117 set ::ngc($hdl,data,postamble) "" 1118 1119 # special frame for embed,axis 1120 set removable 0; set newable 0 1121 if {[info exists ::ngc(embed,axis)] } { 1122 if !$::ngc($hdl,standalone) { 1123 if {!$::ngc(opt,noremove) || $::ngc($hdl,chooser)} { 1124 set removable 1 1125 } 1126 if {!$::ngc(opt,nonew) || $::ngc($hdl,chooser)} { 1127 set newable 1 1128 } 1129 } 1130 tabmanage $::ngc($hdl,axis,page) $wframe \ 1131 "$::ngc(any,app)-$hdl" \ 1132 ::ngc($hdl,info) \ 1133 $removable $newable 1134 } 1135 set wframe [frame $wframe.[qid]] 1136 1137 set bw 8 1138 set tw 10 ;# min text width (default is 20) see also l,width 1139 switch $::ngc(any,aspect) { 1140 vert { 1141 set wI [frame $wframe.input -bd 1 -relief sunken] ;# input frame 1142 set wO [frame $wframe.output -bd 1 -relief sunken] ;# output frame 1143 set wV [frame $wframe.var] ;# variable frame 1144 set wC [frame $wframe.create -bd 1 -relief sunken] ;# create frame 1145 set wE [frame $wframe.exit -bd 1 -relief sunken] ;# exit frame 1146 1147 pack $wI -side top -fill x -expand 1 -anchor n 1148 pack $wE -side bottom -fill x -expand 1 -anchor s 1149 pack $wO -side bottom -fill x -expand 1 -anchor s 1150 pack $wC -side bottom -fill x -expand 1 -anchor n 1151 pack $wV -side top -fill x -expand 1 -anchor n 1152 set ::ngc($hdl,pack,positional) top 1153 } 1154 horiz { 1155 set wL [frame $wframe.left -bd 2 -relief ridge] ;# left frame 1156 set wI [frame $wL.input -bd 0 -relief sunken] ;# input frame 1157 set wO [frame $wL.output -bd 0 -relief sunken] ;# output frame 1158 set wC [frame $wL.create -bd 0 -relief sunken] ;# create frame 1159 set wE [frame $wL.exit -bd 0 -relief sunken] ;# exit frame 1160 set wV [frame $wframe.var -bd 0 -relief flat] ;# variable frame 1161 1162 pack $wL -side left -fill x -expand 1 -anchor nw 1163 pack $wI -side top -fill x -expand 1 -anchor n 1164 pack $wO -side top -fill x -expand 1 -anchor n 1165 pack $wE -side bottom -fill x -expand 1 -anchor s 1166 pack $wC -side bottom -fill x -expand 1 -anchor s 1167 pack $wV -side left -fill x -expand 1 -anchor n 1168 set ::ngc($hdl,pack,positional) left 1169 $wframe config -relief ridge -bd 2 1170 } 1171 default {return -code error ngc::gui:aspect <$aspect>} 1172 } 1173 set ::ngc($hdl,varframe) $wV 1174 set ::ngc($hdl,iframe) $wI 1175 image_init $hdl 1176 1177 set w [frame $wI.[qid]] 1178 pack $w -fill x -expand 1 1179 #pack [label $w.[qid] -anchor w -text "Input Files" \ 1180 # -width $::ngc($hdl,l,width)\ 1181 # -bg $::ngc(any,color,title) -relief groove] -fill x -expand 1 1182 pack [label $w.[qid] -anchor w -text "[_ "Controls"]" \ 1183 -width $::ngc($hdl,l,width)\ 1184 -bg $::ngc(any,color,title) -relief groove] -fill x -expand 1 1185 1186 # wI inputs 1187 set w [frame $wI.[qid]] 1188 pack $w -fill x -expand 1 1189 1190 set b [button $w.[qid] -font $::ngc(any,font) \ 1191 -pady 0 -width $bw -text "[_ "Preamble"]" \ 1192 -command "::ngcgui::gui $hdl getpreamble"] 1193 set ::ngc($hdl,begin,widget) $b 1194 pack $b -side left -expand 0 1195 set e [entry $w.e -width $tw -font $::ngc(any,font) \ 1196 -textvariable ::ngc($hdl,dname,preamble)] 1197 bind $e <Return> [list ::ngcgui::readfile $hdl preamble] 1198 pack $e -side left -fill x -expand 1 1199 set ::ngc($hdl,preamble,widget) $e 1200 1201 set w [frame $wI.[qid]] 1202 pack $w -fill x -expand 1 1203 set b [button $w.[qid] -font $::ngc(any,font) \ 1204 -pady 0 -width $bw -text "[_ "Subfile"]" \ 1205 -command "::ngcgui::gui $hdl getsubfile"] 1206 pack $b -side left -expand 0 1207 set e [entry $w.e -width $tw -font $::ngc(any,font) \ 1208 -textvariable ::ngc($hdl,dname,subfile)] 1209 bind $e <Return> [list ::ngcgui::readfile $hdl subfile] 1210 pack $e -side left -fill x -expand 1 1211 set ::ngc($hdl,subfile,widget) $e 1212 1213 set w [frame $wI.[qid]] 1214 pack $w -fill x -expand 1 1215 set b [button $w.[qid] -font $::ngc(any,font) \ 1216 -pady 0 -width $bw -text "[_ "Postamble"]" \ 1217 -command "::ngcgui::gui $hdl getpostamble"] 1218 pack $b -side left -expand 0 1219 set e [entry $w.e -width $tw -font $::ngc(any,font) \ 1220 -textvariable ::ngc($hdl,dname,postamble)] 1221 bind $e <Return> [list ::ngcgui::readfile $hdl postamble] 1222 pack $e -side left -fill x -expand 1 1223 set ::ngc($hdl,postamble,widget) $e 1224 1225 # set w [frame $wI.[qid]] 1226 # pack $w -fill x -expand 1 1227 # pack [label $w.[qid] -anchor w -text "Options" \ 1228 # -bg $::ngc(any,color,title) -relief groove] -fill x -expand 1 1229 1230 set w [frame $wI.[qid]] 1231 pack $w -fill x -expand 1 1232 set b [checkbutton $w.[qid] -anchor w -font $::ngc(any,font) \ 1233 -text "[_ "Retain values on Subfile read"]" \ 1234 -command [list ::ngcgui::aftertoggle $hdl retainvalues] \ 1235 -variable ::ngc($hdl,retainvalues)] 1236 pack $b -side left -fill x -expand 1 1237 1238 set w [frame $wI.[qid]] 1239 pack $w -fill x -expand 1 1240 set b [checkbutton $w.[qid] -anchor w -font $::ngc(any,font) \ 1241 -text "[_ "Expand subroutine"]" \ 1242 -command [list ::ngcgui::aftertoggle $hdl expandsubroutine] \ 1243 -variable ::ngc($hdl,expandsubroutine)] 1244 pack $b -side left -fill x -expand 1 1245 set ::ngc($hdl,expandsubroutine,widget) $b 1246 1247 if {1} { 1248 set w [frame $wI.[qid]] 1249 pack $w -fill x -expand 1 1250 set b [checkbutton $w.[qid] -anchor w -font $::ngc(any,font) \ 1251 -text "[_ "Autosend"]" \ 1252 -command [list ::ngcgui::aftertoggle $hdl auto] \ 1253 -variable ::ngc($hdl,auto)] 1254 pack $b -side left -fill x -expand 1 1255 } 1256 if {0} { 1257 # take up too much room 1258 set w [frame $wI.[qid]] 1259 pack $w -fill x -expand 1 1260 set b [checkbutton $w.[qid] -anchor w -font $::ngc(any,font) \ 1261 -text "[_ "Verbose ngcfile"]" \ 1262 -command [list ::ngcgui::aftertoggle $hdl verbose] \ 1263 -variable ::ngc($hdl,verbose)] 1264 pack $b -side left -fill x -expand 1 1265 } 1266 1267 # wC create frame 1268 # used fixed widths so buttons stay same when text is changed 1269 set w [frame $wC.[qid]] 1270 pack $w -side top -fill x -expand 1 1271 set b [button $w.[qid] -text "[_ "Create Feature"]" -font $::ngc(any,font) \ 1272 -width 14 -padx 1\ 1273 -command "::ngcgui::gui $hdl savesection"] 1274 pack $b -side left -fill x -expand 1 1275 set ::ngc($hdl,save,widget) $b 1276 1277 set text "[_ "MakeFile"]" 1278 if $::ngc($hdl,auto) {set text "[_ "Finalize"]"} 1279 set b [button $w.[qid] -state disabled -font $::ngc(any,font) \ 1280 -fg $::ngc(any,color,prompt) \ 1281 -width 8 -padx 1\ 1282 -text "$text" -command "::ngcgui::gui $hdl finalize"] 1283 pack $b -side left -fill x -expand 1 1284 set ::ngc($hdl,finalize,widget) $b 1285 1286 set w [frame $wC.[qid]] 1287 pack $w -fill x -expand 1 1288 pack [label $w.[qid] -width 0 -font $::ngc(any,font) \ 1289 -pady 0 -relief flat \ 1290 -textvariable ::ngc($hdl,savect)] -side left -fill x -expand 0 1291 1292 if {!$::ngc(opt,noinput) || $::ngc($hdl,chooser)} { 1293 # reread notapplicable with no controls 1294 set b [button $w.[qid] -width 2 -font $::ngc(any,font) \ 1295 -padx 0 -pady 0 -text "[_ "Reread"]" \ 1296 -state disabled \ 1297 -command [list ::ngcgui::reread $hdl] \ 1298 ] 1299 pack $b -side left -fill x -expand 1 1300 set ::ngc($hdl,reread,widget) $b 1301 } 1302 1303 set b [button $w.[qid] -width 2 -font $::ngc(any,font) \ 1304 -padx 0 -pady 0 -text "[_ "Restart"]" \ 1305 -state disabled \ 1306 -command [list ::ngcgui::message $hdl restart] \ 1307 ] 1308 pack $b -side left -fill x -expand 1 1309 set ::ngc($hdl,restart,widget) $b 1310 # sendfile,widget button is forgettable 1311 # use wC frame avoids problems with ctrl-a resizing app 1312 set b [button $wC.[qid] -state disabled -font $::ngc(any,font) \ 1313 -pady 1 \ 1314 -text "[_ "SendFileToAxis"]" \ 1315 -command [list ::ngcgui::sendfile $hdl]] 1316 pack $b -side bottom -fill x -expand 1 1317 set ::ngc($hdl,sendfile,widget) $b 1318 1319 if $::ngc($hdl,auto) { 1320 pack forget $::ngc($hdl,sendfile,widget) 1321 $::ngc($hdl,finalize,widget) conf -fg $::ngc(any,color,prompt) 1322 } 1323 1324 if $::ngc($hdl,standalone) { 1325 set b [button $w.[qid] -takefocus 0 -font $::ngc(any,font) \ 1326 -pady 0 -text "[_ "Exit"]" \ 1327 -command [list ::ngcgui::bye $hdl]] 1328 pack $b -side left -fill none -expand 0 1329 } 1330 1331 # wO output frame 1332 set w [frame $wO.[qid] -bd 2] 1333 pack $w -side top -fill x -expand 1 1334 1335 set ::ngc($hdl,msg,widget) [label $wE.[qid] \ 1336 -width 20\ 1337 -relief sunken \ 1338 -anchor w] ;# update with config 1339 pack $::ngc($hdl,msg,widget) -side left -fill x -expand 1 1340 1341 # wE exit frame obsoleted 1342 #------------------------------------------------------------------------------ 1343 if {"$::ngc($hdl,fname,preamble)" != ""} { 1344 set ::ngc($hdl,fname,preamble) [string trim $::ngc($hdl,fname,preamble)] 1345 ::ngcgui::gui $hdl readpreamble 1346 } 1347 if {"$::ngc($hdl,fname,subfile)" != ""} { 1348 set ::ngc($hdl,fname,subfile) [string trim $::ngc($hdl,fname,subfile)] 1349 ::ngcgui::gui $hdl readsubfile 1350 } 1351 if {"$::ngc($hdl,fname,postamble)" != ""} { 1352 set ::ngc($hdl,fname,postamble) \ 1353 [string trim $::ngc($hdl,fname,postamble)] 1354 ::ngcgui::gui $hdl readpostamble 1355 } 1356 if [info exists ::ngc($hdl,fail)] { 1357 puts stdout "\n$::ngc(any,app):[_ "Unrecoverable problem"]:\n<$hdl>$::ngc($hdl,fail)" 1358 ::ngcgui::deletepage $::ngc($hdl,axis,page) 1359 return 1360 } 1361 update ;# ensure entry variables are updated before starting checks 1362 periodic_checks $hdl 1363 bindings $hdl init 1364 if ![info exists ::ngc(embed,axis)] [list updownkeys $::ngc($hdl,top)] 1365 after 2000 [list ::ngcgui::showmessage $hdl startup] 1366 return $wframe 1367 # ::ngcgui::gui-create-end 1368 } 1369 getpreamble { 1370 if {$::ngc($hdl,fname,preamble) == ""} { 1371 set idir $::ngc($hdl,dir) 1372 } else { 1373 set idir [file dirname $::ngc($hdl,fname,preamble)] 1374 } 1375 set filename [tk_getOpenFile \ 1376 -title "$::ngc(any,app) Preamble file" \ 1377 -defaultextension .ngc \ 1378 -initialfile [file tail $::ngc($hdl,fname,preamble)] \ 1379 -initialdir $idir \ 1380 -filetypes $::ngc($hdl,ftypes,other) \ 1381 ] 1382 set filename [string trim $filename] 1383 if {"$filename" == ""} return 1384 check_path $filename 1385 set ::ngc($hdl,fname,preamble) $filename 1386 ::ngcgui::gui $hdl readpreamble 1387 return 1388 } 1389 readpreamble { 1390 if { ![string match *.ngc $::ngc($hdl,fname,preamble)]\ 1391 && [file readable "$::ngc($hdl,fname,preamble).ngc"]} { 1392 set ::ngc($hdl,fname,preamble) "$::ngc($hdl,fname,preamble).ngc" 1393 } 1394 set ::ngc($hdl,data,preamble) "" 1395 if {"$::ngc($hdl,fname,preamble)" == ""} { 1396 # message $hdl nullpreamble 1397 return 1398 } else { 1399 if [catch {set fpre [open $::ngc($hdl,fname,preamble) r]} msg] { 1400 lappend emsg $msg 1401 showerr $emsg 1402 message $hdl preambleerror 1403 if {$::ngc(opt,noinput) && !$::ngc($hdl,chooser)} { 1404 set ::ngc($hdl,fail) "preamble:$msg" ;# unrecoverable 1405 } 1406 return 1407 } 1408 set ::ngc($hdl,dname,preamble) [file tail $::ngc($hdl,fname,preamble)] 1409 lappend ::ngc($hdl,data,preamble) \ 1410 "($::ngc(any,app): preamble file: $::ngc($hdl,fname,preamble))" 1411 1412 # dont copy some items to preamble 1413 while {![eof $fpre]} { 1414 gets $fpre line 1415 set l [string map {" " "" " " ""} $line] ;#sp,tab to "" 1416 if {"$l" == ""} continue 1417 if ![string match "(not_a_subfile)" $line] { 1418 lappend ::ngc($hdl,data,preamble) $line 1419 } 1420 } 1421 close $fpre 1422 set ::ngc($hdl,fname,preamble,time) \ 1423 [file mtime $::ngc($hdl,fname,preamble)] 1424 } 1425 message $hdl readpreamble 1426 return 1427 } 1428 getpostamble { 1429 if {$::ngc($hdl,fname,postamble) == ""} { 1430 set idir $::ngc($hdl,dir) 1431 } else { 1432 set idir [file dirname $::ngc($hdl,fname,postamble)] 1433 } 1434 set filename [tk_getOpenFile \ 1435 -title "$::ngc(any,app) [_ "Postamble file"]" \ 1436 -defaultextension .ngc \ 1437 -initialfile [file tail $::ngc($hdl,fname,postamble)] \ 1438 -initialdir $idir \ 1439 -filetypes $::ngc($hdl,ftypes,other) \ 1440 ] 1441 set filename [string trim $filename] 1442 if {"$filename" == ""} return 1443 check_path $filename 1444 set ::ngc($hdl,fname,postamble) $filename 1445 ::ngcgui::gui $hdl readpostamble 1446 return 1447 } 1448 readpostamble { 1449 if { ![string match *.ngc $::ngc($hdl,fname,postamble)]\ 1450 && [file readable "$::ngc($hdl,fname,postamble).ngc"]} { 1451 set ::ngc($hdl,fname,postamble) "$::ngc($hdl,fname,postamble).ngc" 1452 } 1453 set ::ngc($hdl,data,postamble) "" 1454 if {"$::ngc($hdl,fname,postamble)" == ""} { 1455 # message $hdl nullpostamble 1456 return 1457 } else { 1458 if [catch {set fpost [open $::ngc($hdl,fname,postamble) r]} msg] { 1459 lappend emsg $msg 1460 showerr $emsg 1461 message $hdl postambleerror 1462 return 1463 } 1464 set ::ngc($hdl,dname,postamble) [file tail $::ngc($hdl,fname,postamble)] 1465 lappend ::ngc($hdl,data,postamble) \ 1466 "($::ngc(any,app): postamble file: $::ngc($hdl,fname,postamble))" 1467 while {![eof $fpost]} { 1468 gets $fpost line 1469 lappend ::ngc($hdl,data,postamble) "$line" 1470 } 1471 close $fpost 1472 set ::ngc($hdl,fname,postamble,time) \ 1473 [file mtime $::ngc($hdl,fname,postamble)] 1474 } 1475 message $hdl readpostamble 1476 return 1477 } 1478 getsubfile { 1479 if {$::ngc($hdl,fname,subfile) == ""} { 1480 set idir $::ngc($hdl,dir) 1481 } else { 1482 set idir [file dirname $::ngc($hdl,fname,subfile)] 1483 } 1484 set filename [tk_getOpenFile \ 1485 -title "$::ngc(any,app) [_ "Subroutine file"]" \ 1486 -defaultextension .ngc \ 1487 -initialfile [file tail $::ngc($hdl,fname,subfile)] \ 1488 -initialdir $idir \ 1489 -filetypes $::ngc($hdl,ftypes,subfile) \ 1490 ] 1491 set filename [string trim $filename] 1492 if {"$filename" == ""} return 1493 check_path $filename 1494 set ::ngc($hdl,fname,subfile) $filename 1495 ::ngcgui::gui $hdl readsubfile 1496 return 1497 } 1498 readsubfile { 1499 set parsecmd ::ngcgui::parse_ngc 1500 if {[string match *.gcmc $::ngc($hdl,fname,subfile)] } { 1501 set parsecmd ::ngcgui::parse_gcmc 1502 set ::ngc($hdl,gcmc,file) $::ngc($hdl,fname,subfile) 1503 $::ngc($hdl,expandsubroutine,widget) configure -state disable 1504 } else { 1505 # in case earlier an earlier find for gcmc failed; 1506 catch {unset ::ngc($hdl,gcmc,file)} 1507 $::ngc($hdl,expandsubroutine,widget) configure -state normal 1508 } 1509 if { ![string match *.ngc $::ngc($hdl,fname,subfile)] \ 1510 && ![string match *.gcmc $::ngc($hdl,fname,subfile)] \ 1511 } { 1512 set ::ngc($hdl,fname,subfile) "$::ngc($hdl,fname,subfile).ngc" 1513 } 1514 # uses two pack/unpack frames wP 1515 set ew 6; set bw 9 1516 1517 # wP positional parameters 1518 set wP $::ngc($hdl,varframe).positional ;# variable frame positional parms 1519 if [winfo exists $wP] {destroy $wP} 1520 set wP [frame $wP -bd 2 -relief ridge] 1521 1522 pack $wP -side $::ngc($hdl,pack,positional) -fill x -expand 1 -anchor n 1523 1524 if { ![string match *.ngc $::ngc($hdl,fname,subfile)]\ 1525 && [file readable "$::ngc($hdl,fname,subfile).ngc"]} { 1526 set ::ngc($hdl,fname,subfile) "$::ngc($hdl,fname,subfile).ngc" 1527 } 1528 # read and parse the file 1529 set ::ngc($hdl,dname,subfile) [file tail $::ngc($hdl,fname,subfile)] 1530 if ![$parsecmd $hdl ::ngc $::ngc($hdl,fname,subfile)] { 1531 # case where user can't recover 1532 if {$::ngc(opt,noinput) && !$::ngc($hdl,chooser)} { 1533 set ::ngc($hdl,fail) "subfile:$::ngc($hdl,parse,msg)";# unrecoverable 1534 } 1535 showerr $::ngc($hdl,parse,msg) 1536 # try to display name of failed file: 1537 message $hdl parseerror 1538 # 101024:09.13 leave them alone 1539 # set ::ngc($hdl,fname,subfile) "" ;# prevents color change 1540 # set ::ngc($hdl,dname,subfile) "" ;# in periodic_checks 1541 catch {pack forget $wP} 1542 return 1543 } 1544 set ::ngc($hdl,fname,subfile,time) \ 1545 [file mtime $::ngc($hdl,fname,subfile)] 1546 1547 set w [frame $wP.[qid]] 1548 pack $w -side top -fill x -expand 1 1549 pack [label $w.[qid] -text "[_ "Positional Parameters"]" \ 1550 -bg $::ngc(any,color,title) -anchor w -relief groove] \ 1551 -side top -fill x -expand 1 1552 1553 # Positional parameters 1554 # find retained values for numbered parms (#n) with 1555 # a byname association 1556 foreach n [array names ::ngc $hdl,arg,name,*] { 1557 # example: 1558 # if ::ngc($hdl,arg,name,04) == xloc 1559 # and ::ngc($hdl,arg,byname,xloc) == 33 1560 # then set ::ngc($hdl,arg,value,04) 33 1561 # else set ::ngc($hdl,arg,value,04) "" 1562 set name $::ngc($n) 1563 set num [string range $n [expr 1 + [string last , $n]] end] 1564 if {[info exists ::ngc($hdl,arg,byname,$name)]} { 1565 set ::ngc($hdl,arg,value,$num) $::ngc($hdl,arg,byname,$name) 1566 } else { 1567 # use default value if available 1568 if [info exists ::ngc($hdl,arg,dvalue,$num)] { 1569 set ::ngc($hdl,arg,value,$num) $::ngc($hdl,arg,dvalue,$num) 1570 } else { 1571 set ::ngc($hdl,arg,value,$num) "" 1572 } 1573 } 1574 } 1575 1576 # Positional parameters entries, provide two frames 1577 set pnamelist [lsort [array names ::ngc $hdl,arg,name,*]] 1578 set wP1 [frame $wP.[qid] -relief flat] 1579 set wP2 [frame $wP.[qid] -relief flat] 1580 set wP3 [frame $wP.[qid] -relief flat] 1581 set npos [llength $pnamelist] 1582 pack $wP1 -side left -anchor n -fill x -expand 1 1583 # a weird space is left if you dont do these separately: 1584 if {$npos > $::ngc(any,pentries)} { 1585 pack $wP2 -side left -anchor n -fill x -expand 1 1586 if {$npos > [expr 2*$::ngc(any,pentries)]} { 1587 pack $wP3 -side left -anchor n -fill x -expand 1 1588 } 1589 } 1590 set ct 0 1591 1592 foreach v $pnamelist { 1593 incr ct 1594 if {$ct <= $::ngc(any,pentries)} { 1595 set fdata [frame $wP1.[qid]] 1596 } elseif {$ct <= [expr 2* $::ngc(any,pentries)]} { 1597 set fdata [frame $wP2.[qid]] 1598 } else { 1599 set fdata [frame $wP3.[qid]] 1600 } 1601 1602 pack $fdata -side top -fill x -expand 1 1603 1604 set i1 [string last , $v] 1605 set num [string range $v [expr 1+$i1] end] 1606 if [info exists ::ngc($hdl,arg,name,$num)] { 1607 set name $::ngc($hdl,arg,name,$num) 1608 } else { 1609 set name [format %d $num] 1610 } 1611 1612 scan $num %d onum ;# ==>onum avoid octalinterpretation of 08,09 1613 set num02 [format %02d $onum] 1614 1615 set l [label $fdata.[qid] -text [format %#2d $onum] -anchor e \ 1616 -takefocus 0 -relief ridge -width 2] 1617 pack $l -side left -fill x -expand 0 1618 1619 # use entry since it can be expanded by user to see overfill 1620 if {$::ngc(any,width,varname) != 0} { 1621 set l [entry $fdata.[qid] -state readonly -font $::ngc(any,font) \ 1622 -textvariable ::ngc($hdl,arg,name,$num) \ 1623 -takefocus 0 -justify right -relief groove \ 1624 -width $::ngc(any,width,varname)] 1625 pack $l -side left -fill x -expand 0 1626 } 1627 set tvar ::ngc($hdl,arg,value,$num) 1628 set e [entry $fdata.[qid] \ 1629 -width $ew \ 1630 -font $::ngc(any,font) \ 1631 -textvariable $tvar\ 1632 -validate all\ 1633 -validatecommand \ 1634 [list ::ngcgui::validateNumber $hdl $tvar %W %s %P]] 1635 foreach k $::ngc(any,entrykeys,special) { 1636 bind $e <Key-$k> \ 1637 [list ::ngcgui::entrykeybinding %K %W ::ngc($hdl,arg,value,$num)] 1638 } 1639 if [info exists ::ngc(embed,axis)] [list updownkeys $e] 1640 set ::ngc($hdl,arg,entrywidget,$num02) $e 1641 pack $e -side left 1642 1643 set l [entry $fdata.[qid] -state readonly -font $::ngc(any,font) \ 1644 -textvariable ::ngc($hdl,arg,comment,$num02) \ 1645 -takefocus 0 -relief groove \ 1646 -width $::ngc(any,width,comment)\ 1647 ] 1648 pack $l -side left -fill x -expand 1 1649 } 1650 1651 dcheck $hdl 1652 set ::ngc($hdl,dir) [file dirname $::ngc($hdl,fname,subfile)] 1653 message $hdl readsubfile 1654 1655 if [info exists ::ngc(embed,axis)] { 1656 set tabname $::ngc($hdl,dname,subfile) 1657 if {[string match *.ngc $tabname] } { 1658 set idx [string last .ngc $tabname] 1659 set tabname [string replace $tabname $idx end ""] 1660 } elseif {[string match *.gcmc $tabname] } { 1661 set idx [string last .gcmc $tabname] 1662 set tabname [string replace $tabname $idx end ""] 1663 } 1664 # show last subfile used as page name 1665 $::ngc(any,axis,parent) itemconfigure $::ngc($hdl,axis,page) \ 1666 -createcmd "::ngcgui::pagecreate $hdl"\ 1667 -raisecmd "::ngcgui::pageraise $hdl"\ 1668 -leavecmd "::ngcgui::pageleave $hdl"\ 1669 -text "$tabname" 1670 1671 # current tab names for other hdls 1672 set names "" 1673 for {set i 0} {$i <= $::ngc(embed,hdl)} {incr i} { 1674 if {$i == $hdl} continue ;# exclude name for this hdl 1675 if [info exists ::ngc($i,axis,page)] { 1676 lappend names [$::ngc(any,axis,parent) \ 1677 itemcget $::ngc($i,axis,page) -text] 1678 } 1679 } 1680 if {[lsearch $names "$tabname"] >= 0} { 1681 # name exists, make unique name for page 1682 set ct 1 1683 while 1 { 1684 set tryname ${tabname}-$ct 1685 if {[lsearch $names "$tryname"] < 0} break 1686 incr ct 1687 if {$ct>100} {return -code error "readsubfile:problem<$trytabname>"} 1688 } 1689 $::ngc(any,axis,parent) itemconfigure $::ngc($hdl,axis,page) \ 1690 -text "$tryname" 1691 } 1692 } 1693 return ;# readsubfile 1694 } 1695 parmcheck { 1696 if ![info exists ::ngc($hdl,argct)] { 1697 if {"$::ngc($hdl,fname,subfile)" == ""} { 1698 lappend err "[_ "No Subfile specified"]" 1699 } 1700 lappend err "[_ "No parameters yet"]" 1701 } else { 1702 for {set i 1} {$i <= $::ngc($hdl,argct)} {incr i} { 1703 set num02 [format %02d $i] 1704 set token $::ngc($hdl,arg,name,$num02) 1705 # nuisance spaces cause problems: 1706 set ::ngc($hdl,arg,value,$num02) \ 1707 [string trim $::ngc($hdl,arg,value,$num02)] 1708 if {"$::ngc($hdl,arg,value,$num02)" == ""} { 1709 lappend err "[_ "Missing value for parm"] #$i ($token)" 1710 } 1711 } 1712 } 1713 if [info exists err] { 1714 showerr $err 1715 message $hdl parmerr 1716 return 0 ;# error 1717 } 1718 return 1 ;# ok 1719 } 1720 setoutfile { 1721 if {$::ngc($hdl,fname,outfile) == ""} { 1722 set idir $::ngc($hdl,dir) 1723 } else { 1724 set idir [file dirname $::ngc($hdl,fname,outfile)] 1725 } 1726 if {"$::ngc($hdl,fname,outfile)" == "" } { 1727 set ::ngc($hdl,fname,outfile) tmp 1728 } 1729 set filename [tk_getSaveFile \ 1730 -title "$::ngc(any,app) [_ "Output file"]" \ 1731 -defaultextension .ngc \ 1732 -initialfile [file tail $::ngc($hdl,fname,outfile)] \ 1733 -initialdir $idir \ 1734 -filetypes $::ngc($hdl,ftypes,subfile) \ 1735 ] 1736 set filename [string trim $filename] 1737 # sometimes leading blanks get in 1738 set filename [string map {" " "" " " ""} $filename] ;#sp,tab to "" 1739 if {$filename == ""} { 1740 set ::ngc($hdl,fname,outfile) "" ;# canceled 1741 return 1742 } 1743 set ::ngc($hdl,fname,outfile) $filename 1744 message $hdl setoutfile 1745 return 1746 } 1747 savesection { 1748 ::ngcgui::readfile $hdl preamble 1749 ::ngcgui::readfile $hdl postamble 1750 # save,widget has multiple presentations to steer user 1751 1752 if ![::ngcgui::gui $hdl parmcheck] { 1753 return 1754 } 1755 1756 1757 if $::ngc($hdl,verbose) { 1758 lappend ::ngc($hdl,data,section) \ 1759 "($::ngc(any,app): files: <$::ngc($hdl,fname,preamble) $::ngc($hdl,fname,subfile) $::ngc($hdl,fname,postamble)>)" 1760 } 1761 # note: this line will be replaced on file output with a count 1762 # that can include multiple tab pages 1763 lappend ::ngc($hdl,data,section) "#<_feature:> = $::ngc($hdl,savect)" 1764 1765 if {"$::ngc($hdl,fname,preamble)" == "IMMEDIATE"} { 1766 # indicates preamble is interpreted as 1767 # immediate commands separated by semicolons 1768 # example ":t1m6;m1" 1769 set ::ngc($hdl,immediate,preamble) [string range \ 1770 $::ngc($hdl,dname,preamble) 1 end] 1771 if $::ngc($hdl,verbose) { 1772 lappend ::ngc($hdl,data,section) \ 1773 "($::ngc(any,app): IMMEDIATE preamble:)" 1774 } 1775 foreach line [split $::ngc($hdl,immediate,preamble) \;] { 1776 lappend ::ngc($hdl,data,section) [string trim $line] 1777 } 1778 unset ::ngc($hdl,immediate,preamble) 1779 } else { 1780 for {set i 0} {$i < [llength $::ngc($hdl,data,preamble)]} {incr i} { 1781 lappend ::ngc($hdl,data,section) \ 1782 [lindex $::ngc($hdl,data,preamble) $i] 1783 } 1784 } 1785 1786 1787 if [info exists ::ngc($hdl,gcmc,file)] { 1788 if ![savesection_gcmc $hdl] {return} ;# .gcmc file 1789 } else { 1790 if ![savesection_ngc $hdl] {return} ;# conventional .ngc file 1791 } 1792 1793 if {"$::ngc($hdl,fname,postamble)" == "IMMEDIATE"} { 1794 # indicates postamble is interpreted as 1795 # immediate commands separated by semicolons 1796 # example ":t1m6;m1" 1797 set ::ngc($hdl,immediate,postamble) [string range \ 1798 $::ngc($hdl,dname,postamble) 1 end] 1799 if $::ngc($hdl,verbose) { 1800 lappend ::ngc($hdl,data,section) \ 1801 "($::ngc(any,app): IMMEDIATE postamble:)" 1802 } 1803 foreach line [split $::ngc($hdl,immediate,postamble) \;] { 1804 lappend ::ngc($hdl,data,section) [string trim $line] 1805 } 1806 unset ::ngc($hdl,immediate,postamble) 1807 } else { 1808 for {set i 0} {$i < [llength $::ngc($hdl,data,postamble)]} {incr i} { 1809 lappend ::ngc($hdl,data,section) \ 1810 [lindex $::ngc($hdl,data,postamble) $i] 1811 } 1812 } 1813 1814 message $hdl savesection 1815 return 1816 } 1817 finalize { 1818 if {$::ngc($hdl,savect) == 0} { 1819 return ;# silently (may be bound to key) 1820 } 1821 1822 set doall 1 ;# default 1823 if {![info exists ::ngc(embed,axis)]} { 1824 set hdllist $hdl 1825 } else { 1826 # find all tabpages with saved features 1827 # order of tabpage names determines execution order 1828 set tnames "" 1829 foreach p [$::ngc(any,axis,parent) pages] { 1830 set h [pagetohdl $p] 1831 if {$h >= 0} { 1832 if {$::ngc($h,savect) == 0} {continue} 1833 lappend hdllist $h 1834 if [info exists ::ngc($h,axis,page)] { 1835 lappend tnames [$::ngc(any,axis,parent) \ 1836 itemcget $::ngc($h,axis,page) -text] 1837 } 1838 } 1839 } 1840 set thisone [$::ngc(any,axis,parent) \ 1841 itemcget $::ngc($hdl,axis,page) -text] 1842 1843 if {[llength $hdllist] > 1} { 1844 set ans [tk_dialog .foo \ 1845 "[_ "Multiple Tabs with Features"]" \ 1846 "[_ "Finalize all Tabs?"]\n [_ "Order"]:<$tnames>" \ 1847 questhead 0 \ 1848 "[_ "No, just this page"] <$thisone>" Yes Cancel\ 1849 ] 1850 switch $ans { 1851 0 { set hdllist $hdl; set doall 0; #NO} 1852 1 {} 1853 2 {showmessage $hdl cancel; return} 1854 } 1855 } 1856 } 1857 set endhdl [lindex $hdllist end] 1858 1859 if {$::ngc($hdl,auto) && ![sendaxis $hdl ping]} { 1860 set ::ngc($hdl,auto) 0 1861 $::ngc($hdl,finalize,widget) conf -fg $::ngc(any,color,prompt) 1862 lappend msg "[_ "Axis is not responding"]" 1863 lappend msg "[_ "Error: "]$::ngc($hdl,axis,error)" 1864 lappend msg "" 1865 lappend msg "[_ "Autosend disabled, Ctrl-A toggles autosend"]" 1866 lappend msg "" 1867 lappend msg "[_ "File saving enabled -- Finalize to save"]" 1868 showerr $msg nosort 1869 message $hdl senderror 1870 return 1871 } 1872 if $::ngc($hdl,auto) { 1873 set ::ngc($hdl,fname,outfile) $::ngc($hdl,fname,autosend) 1874 } else { 1875 # open and write fname,outfile 1876 title $::ngc($hdl,top) "$::ngc(any,app) <>" 1877 ::ngcgui::gui $hdl setoutfile 1878 if {"$::ngc($hdl,fname,outfile)" == ""} { 1879 message $hdl usercancel 1880 return 1881 } 1882 if {![string match *.ngc $::ngc($hdl,fname,outfile)]} { 1883 lappend msg "[_ "Require .ngc suffix for filename"]" 1884 showerr $msg 1885 message $hdl writeerror 1886 return 1887 } 1888 if { "$::ngc($hdl,fname,outfile)" == "$::ngc($hdl,fname,subfile)" \ 1889 || "$::ngc($hdl,fname,outfile)" == "$::ngc($hdl,fname,preamble)" \ 1890 || "$::ngc($hdl,fname,outfile)" == "$::ngc($hdl,fname,postamble)" \ 1891 } { 1892 set msg "" 1893 lappend msg "[_ "Disallowed overwrite of"] $::ngc($hdl,fname,outfile)" 1894 showerr $msg 1895 message $hdl writeerror 1896 return 1897 } 1898 } 1899 1900 if [catch {set fout [open $::ngc($hdl,fname,outfile) w]} msg] { 1901 lappend emsg $msg 1902 showerr $emsg 1903 message $hdl writeerror 1904 return 1905 } 1906 1907 if {$::ngc(opt,nom2) || [info exists ::ngcgui::control(any,nom2)]} { 1908 puts $fout "%" 1909 puts $fout "($::ngc(any,app): nom2 option)" 1910 } 1911 1912 set featurect 0; 1913 set date [dt] 1914 set features_total 0 1915 foreach thdl $hdllist { 1916 set features_total [expr $features_total + $::ngc($thdl,savect)] 1917 } 1918 foreach thdl $hdllist { 1919 # the string FEATURE is used so files generated by ngcgui can 1920 # be detected and excluded as subfile candidates 1921 puts $fout "($::ngc(any,app): [_ "FEATURE"] $date)" 1922 1923 for {set i 0} {$i < [llength $::ngc($thdl,data,section)]} {incr i} { 1924 set line [lindex $::ngc($thdl,data,section) $i] 1925 if {[string first "#<_feature:>" $line] >= 0} { 1926 # instead of current $line, output feature count (zero referenced) 1927 puts $fout \ 1928 "($::ngc(any,app): [_ "feature line added"]) #<_feature:> = $featurect" 1929 incr featurect 1 1930 set remaining [expr $features_total - $featurect] 1931 puts -nonewline $fout \ 1932 "($::ngc(any,app): [_ "remaining_features line added"]) " 1933 puts $fout "#<_remaining_features:> = [expr $features_total -$featurect]" 1934 } else { 1935 puts $fout $line 1936 } 1937 } 1938 } ;# for hdllist 1939 1940 if {$::ngc(opt,nom2) || [info exists ::ngcgui::control(any,nom2)]} { 1941 puts $fout "%" 1942 } else { 1943 if $::ngc($endhdl,verbose) { 1944 puts $fout "($::ngc(any,app): m2 [_ "line added"]) m2 (g54 [_ "activated"])" 1945 } else { 1946 puts $fout "m2 (m2 [_ "restores"] g54)" 1947 } 1948 } 1949 close $fout 1950 set ::ngc(any,gcmc,id) 0 ;# restart after finalize 1951 1952 set ::ngc($hdl,last,outfile) $::ngc($hdl,fname,outfile) 1953 # just in case you need it later, save a dated copy in /tmp 1954 if [info exists ::ngc(any,dir,just)] { 1955 set base [file tail $::ngc($hdl,fname,outfile)] 1956 set savename [file join $::ngc(any,dir,just) [dt].${base}] 1957 if [catch {file copy $::ngc($hdl,fname,outfile) $savename} msg] { 1958 lappend emsg "<$hdl>$msg" 1959 showerr $emsg 1960 message $hdl writeerror 1961 return 1962 } 1963 } 1964 1965 if {$::ngc($hdl,auto)} { 1966 if ![::ngcgui::sendfile $hdl] { 1967 return ;# send failed, user can start axis or Ctrl-a 1968 } 1969 } 1970 1971 foreach thdl $hdllist { 1972 set ::ngc($thdl,savect) 0 1973 conf $hdl restart,widget state disabled 1974 set ::ngc($thdl,data,section) "" 1975 message $thdl finalize 1976 } ;# for 1977 1978 title $::ngc($thdl,top) "$::ngc(any,app) \ 1979 <[file tail $::ngc($thdl,fname,outfile)]>" 1980 1981 return 1982 } 1983 default {return -code error "::ngcgui::gui: unknown mode <$mode>"} 1984 } 1985 puts stdout "[_ "NOTREACHED mode"]=<$mode>" 1986 } ;# gui 1987 1988 proc ::ngcgui::savesection_ngc {hdl} { 1989 # could check for number here using %f 1990 set pfmt "%12s = %s" ;# positional 1991 set cfmt "(%11s = %12s = %12s)" ;# positional comment form 1992 1993 if {$::ngc($hdl,expandsubroutine)} { 1994 # id for unique label when expanding multiple sub files 1995 set id $::ngc($hdl,id) 1996 set uwidth 3 ;# extra width for unique label 000-999 1997 # $uwdith characters in unique ids 1998 set id [format %0${uwidth}d $::ngc($hdl,id)] 1999 incr ::ngc($hdl,id) 2000 lappend ::ngc($hdl,data,section) \ 2001 "([_ "Positional parameters for"] $::ngc($hdl,fname,subfile):)" 2002 for {set i 1} {$i <= $::ngc($hdl,argct)} {incr i} { 2003 set num02 [format %02d $i] 2004 set name $::ngc($hdl,arg,value,$num02) 2005 lappend ::ngc($hdl,data,section) [format $pfmt #$i $name ] 2006 } 2007 # expand the subroutine in place 2008 lappend ::ngc($hdl,data,section) \ 2009 "([_ "expanded file"]: $::ngc($hdl,fname,subfile))" 2010 for {set i 0} {$i < $::ngc($hdl,sublines)} {incr i} { 2011 if [info exists ::ngc_sub($hdl,$i,label)] { 2012 lappend ::ngc($hdl,data,section) \ 2013 "o<$id$::ngc_sub($hdl,$i,label)> $::ngc_sub($hdl,$i)" 2014 } else { 2015 lappend ::ngc($hdl,data,section) \ 2016 [format %${uwidth}s%s "" " $::ngc_sub($hdl,$i)"] 2017 } 2018 } 2019 } else { 2020 # insert the subroutine call 2021 if $::ngc($hdl,verbose) { 2022 lappend ::ngc($hdl,data,section) \ 2023 "($::ngc(any,app): [_ "call subroutine file"]: $::ngc($hdl,fname,subfile))" 2024 lappend ::ngc($hdl,data,section) "($::ngc(any,app): positional parameters:)" 2025 } 2026 set cline "o<$::ngc($hdl,subroutine,name)> call " 2027 for {set i 1} {$i <= $::ngc($hdl,argct)} {incr i} { 2028 set num02 [format %02d $i] 2029 set name $::ngc($hdl,arg,name,$num02) 2030 if {[string first # $name] == 0} {set name "?"} 2031 # documenting comment 2032 if $::ngc($hdl,verbose) { 2033 lappend ::ngc($hdl,data,section) \ 2034 [format $cfmt #$i $name $::ngc($hdl,arg,value,$num02)] 2035 } 2036 set cline "$cline\[$::ngc($hdl,arg,value,$num02)\]" 2037 } 2038 lappend ::ngc($hdl,data,section) "$cline" 2039 } 2040 return 1 ;# ok 2041 } ;# savesection_ngc 2042 2043 proc ::ngcgui::savesection_gcmc {hdl} { 2044 #puts ===================================== 2045 #parray ::ngc $hdl,arg,* 2046 #parray ::ngc $hdl,gcmc,* 2047 #parray ::ngc any,gcmc,* 2048 #parray ::ngc $hdl,argct 2049 #puts ===================================== 2050 # could check for number here using %f 2051 set cfmt "(%12s = %12s)" ;# positional comment form 2052 2053 # maybe implement later, expand after calling gcmc below 2054 if {$::ngc($hdl,expandsubroutine)} { 2055 set answer [tk_dialog .notdoneyet \ 2056 "Not done yet"\ 2057 "Expand subroutine not supported for gcmc files - continuing"\ 2058 warning -1 \ 2059 "OK"] 2060 } 2061 2062 if ![info exists ::ngc(any,gcmc,id)] { 2063 set ::ngc(any,gcmc,id) 0 2064 } 2065 incr ::ngc(any,gcmc,id) ;# id for any hdl 2066 2067 set funcname $::ngc(any,gcmc,funcname) 2068 # gcmc chars: (allowed: [a-z0-9_-]) 2069 set funcname ${funcname}-[format %02d $::ngc(any,gcmc,id)] 2070 2071 # use first one found in searchpath: 2072 set ifile [file normalize \ 2073 [pathto [file tail $::ngc($hdl,gcmc,file)]]] 2074 if {"$ifile" == ""} { 2075 return 0 ;# fail 2076 } 2077 set ::ngc($hdl,gcmc,realfile) $ifile 2078 2079 set ofile [file join $::ngc(any,gcmc,outdir) $funcname.ngc] 2080 2081 set cmd $::ngc(any,gcmc,executable) 2082 set opts "" 2083 2084 if [info exists ::ngc(any,gcmc_include_path)] { 2085 foreach dir [split $::ngc(any,gcmc_include_path) ":"] { 2086 set opts "$opts --include $dir" 2087 } 2088 } 2089 # note: gcmc adds the current directory 2090 # to the search path as last entry. 2091 # maybe also ?: set opts "$opts --include [file dirname $ifile]" 2092 2093 set opts "$opts --output $ofile" 2094 set opts "$opts --gcode-function $funcname" 2095 if [info exists ::ngc($hdl,gcmc,opts)] { 2096 foreach opt $::ngc($hdl,gcmc,opts) { 2097 set opts "$opts $opt" 2098 } 2099 } 2100 if {$::ngc($hdl,argct) > 0} { 2101 for {set i 1} {$i <= $::ngc($hdl,argct)} {incr i} { 2102 set idx [format %02d $i] 2103 # make all entry box values explicitly floating point 2104 if [catch {set floatvalue [expr 1.0 * $::ngc($hdl,arg,value,$idx)]} msg] { 2105 set answer [tk_dialog .gcmcerror \ 2106 "gcmc input ERROR" \ 2107 "<$::ngc($hdl,arg,value,$idx)> must be a number" \ 2108 error -1 \ 2109 "OK"] 2110 return 0 ;# fail 2111 } 2112 set opts "$opts --define=$::ngc($hdl,arg,name,$idx)=$floatvalue" 2113 } 2114 } 2115 2116 # puts stdout " cmd=$cmd" 2117 # puts stdout " opts=$opts" 2118 # puts stdout " ifile=$ifile" 2119 # puts stdout "funcname=$funcname" 2120 # puts stdout " pwd=[pwd]" 2121 # puts stdout " exists=[file exists $ifile]" 2122 2123 set eline "$cmd $opts $ifile" 2124 if $::ngc($hdl,verbose) { 2125 puts stdout "eline=$eline" 2126 } 2127 2128 #tclsh considers any output on stderr as an error 2129 # -ignorestderr lets it pass so that --precision 2 2130 # would not cause an error but then there are no 2131 # error messages even for hard ($? !=0) errors, just 2132 # "child process exited abnormally" 2133 # so warnings ($?=0) cause abort even though file created 2134 # partial file may be left on error so you cant tell by existence 2135 # so, parse each warning message 2136 2137 # parse messages on stderr from gcmc 2138 set e_message ".*Runtime message\\(\\): *\(.*\)" 2139 set e_warning ".*Runtime warning\\(\\): *\(.*\)" 2140 set e_error ".*Runtime error\\(\\): *\(.*\)" 2141 2142 set m_txt ""; set w_txt ""; set e_txt ""; set compile_txt "" 2143 if [catch {set result [eval exec $eline]} msg] { 2144 if {[string length $msg] > $::ngc(any,max_msg_len)} { 2145 set msg [string range $msg 0 $::ngc(any,max_msg_len)] 2146 set msg "$msg ..." 2147 } 2148 set lmsg [split $msg \n] 2149 foreach line $lmsg { 2150 #puts l=$line 2151 if {[regexp $e_message $line match txt]} { 2152 set m_txt "$m_txt\n$txt" 2153 } elseif { [regexp $e_warning $line match txt]} { 2154 set w_txt "$w_txt\n$txt" 2155 } elseif { [regexp $e_error $line match txt]} { 2156 set e_txt "$e_txt\n$txt" 2157 } else { 2158 if {"$line" != ""} { 2159 set compile_txt "$compile_txt\n$line" 2160 } 2161 } 2162 } 2163 if {"$m_txt" != ""} { 2164 set answer [tk_dialog .gcmcinfor \ 2165 "gcmc INFO"\ 2166 "gcmc file:\n$ifile\n\n$m_txt"\ 2167 info -1 \ 2168 "OK"] 2169 } 2170 if {"$w_txt" != ""} { 2171 set answer [tk_dialog .gcmcwarning \ 2172 "gcmc WARNING"\ 2173 "gcmc file:\n$ifile\n\n$w_txt"\ 2174 warning -1 \ 2175 "OK"] 2176 } 2177 if {"$e_txt" != ""} { 2178 set answer [tk_dialog .gcmcerror \ 2179 "gcmc ERROR"\ 2180 "gcmc file:\n$ifile\n\n$e_txt"\ 2181 error -1 \ 2182 "OK"] 2183 } 2184 if {"$compile_txt" != ""} { 2185 set answer [tk_dialog .gcmcerror \ 2186 "gcmc compile ERROR"\ 2187 "gcmc file:$compile_txt"\ 2188 error -1 \ 2189 "OK"] 2190 } 2191 if {"$e_txt" != ""} { 2192 return 0 ;# fail 2193 } 2194 } else { 2195 #puts "savesection_gcmc OK<$result>" 2196 } 2197 2198 2199 # insert the subroutine call 2200 lappend ::ngc($hdl,data,section) \ 2201 "\n(NOTE: $funcname is provided by a one-time, gcmc-created file:)" 2202 lappend ::ngc($hdl,data,section) \ 2203 "( $ofile)" 2204 lappend ::ngc($hdl,data,section) \ 2205 "(gcmc: File: $::ngc($hdl,gcmc,realfile))" 2206 lappend ::ngc($hdl,data,section) \ 2207 "(gcmc: Options: )" 2208 if [info exists ::ngc($hdl,gcmc,opts)] { 2209 foreach opt $::ngc($hdl,gcmc,opts) { 2210 lappend ::ngc($hdl,data,section) \ 2211 "( $opt)" 2212 } 2213 } 2214 lappend ::ngc($hdl,data,section) \ 2215 "(gcmc: Variable substitions:)" 2216 for {set i 1} {$i <= $::ngc($hdl,argct)} {incr i} { 2217 set num02 [format %02d $i] 2218 set name $::ngc($hdl,arg,name,$num02) 2219 lappend ::ngc($hdl,data,section) \ 2220 [format $cfmt $name $::ngc($hdl,arg,value,$num02)] 2221 } 2222 lappend ::ngc($hdl,data,section) "o<$funcname> call " 2223 2224 return 1 ;# ok 2225 } ;# savesection_gcmc 2226 2227 proc ::ngcgui::conf {hdl wsuffix item value} { 2228 set w $hdl,$wsuffix 2229 if ![info exists ::ngc($w)] return 2230 $::ngc($w) conf -$item $value 2231 } ;# conf 2232 2233 proc ::ngcgui::reread {hdl} { 2234 ::ngcgui::gui $hdl readpreamble 2235 ::ngcgui::gui $hdl readsubfile 2236 ::ngcgui::gui $hdl readpostamble 2237 } ;# reread 2238 2239 proc ::ngcgui::sendfile {hdl} { 2240 if ![sendaxis $hdl ping] { 2241 showerr $::ngc($hdl,axis,error) nosort 2242 message $hdl senderror 2243 return 0 ;# err 2244 } 2245 if ![sendaxis $hdl file] { 2246 showerr $::ngc($hdl,axis,error) nosort 2247 message $hdl senderror 2248 return 0 ;# err 2249 } 2250 $::ngc($hdl,sendfile,widget) conf -state disabled 2251 message $hdl sendfile 2252 return 1 ;# ok 2253 } ;# sendfile 2254 2255 proc ::ngcgui::readfile {hdl item} { 2256 # update fname,$item and readfile 2257 if { ("$item" == "preamble" || "$item" == "postamble") \ 2258 && [string first : $::ngc($hdl,dname,$item)] == 0} { 2259 set ::ngc($hdl,fname,$item) "IMMEDIATE" 2260 set ::ngc($hdl,immediate,$item) [string range \ 2261 $::ngc($hdl,fname,$item) 1 end] 2262 return 2263 } 2264 if {"$::ngc($hdl,dname,$item)" != ""} { 2265 set ptype [file pathtype $::ngc($hdl,dname,$item)] 2266 switch $ptype { 2267 relative { 2268 set fdir [file dirname $::ngc($hdl,fname,$item)] 2269 if {"$fdir" == "." } { 2270 set fdir $::ngc($hdl,dir) ;# -D wins for this case 2271 } 2272 set ::ngc($hdl,fname,$item) [file normalize \ 2273 [file join $fdir $::ngc($hdl,dname,$item)]] 2274 } 2275 absolute {set ::ngc($hdl,fname,$item) \ 2276 [file normalize $::ngc($hdl,dname,$item)] 2277 } 2278 default {return -code error "::ngcgui::readfile <$hdl $ptype>"} 2279 } 2280 # simplify dname,$item to just filename 2281 set ::ngc($hdl,dname,$item) [file tail $::ngc($hdl,fname,$item)] 2282 } else { 2283 #note: ngc(dname,$item) is "", each readproc must init appropriately 2284 set ::ngc($hdl,fname,$item) "" 2285 } 2286 switch $item { 2287 preamble {::ngcgui::gui $hdl readpreamble } 2288 subfile {::ngcgui::gui $hdl readsubfile } 2289 postamble {::ngcgui::gui $hdl readpostamble } 2290 } 2291 } ;# readfile 2292 2293 proc ::ngcgui::debug {hdl} { 2294 set t .debug-$hdl 2295 catch {destroy $t} 2296 set t [toplevel $t] 2297 set lw 20;set ew 12 2298 # hdl,$i 2299 foreach i {standalone auto state lastevent \ 2300 savect dir afterid img,orig,size img,sampled,size} { 2301 set f [frame $t.[qid] ] 2302 pack [label $f.[qid] -relief ridge -anchor e -width $lw\ 2303 -text "$i" \ 2304 -font $::ngc(any,font)\ 2305 ] -fill x -expand 0 -side left 2306 pack [entry $f.[qid] -state readonly -relief ridge -width $ew \ 2307 -textvariable ::ngc($hdl,$i) \ 2308 -font $::ngc(any,font)\ 2309 ] -fill x -expand 1 -side left 2310 pack $f -side top -fill x -expand 1 2311 } 2312 # any,$i 2313 foreach i {any,font any,width,comment any,width,varname any,pollms\ 2314 embed,axis embed,hdl} { 2315 set f [frame $t.[qid] ] 2316 pack [label $f.[qid] -relief ridge -anchor e -width $lw\ 2317 -text "$i" \ 2318 -font $::ngc(any,font)\ 2319 ] -fill x -expand 0 -side left 2320 pack [entry $f.[qid] -state readonly -relief ridge -width $ew \ 2321 -textvariable ::ngc($i) \ 2322 -font $::ngc(any,font)\ 2323 ] -fill x -expand 1 -side left 2324 pack $f -side top -fill x -expand 1 2325 } 2326 wm resizable $t 1 0 2327 } ;# debug 2328 2329 proc ::ngcgui::statemap {hdl} { 2330 # form: (next,state:mode,event) --> nextstate 2331 set ::ngc(any,next,reset:auto,savesection) start 2332 set ::ngc(any,next,reset:noauto,savesection) start 2333 set ::ngc(any,next,reset:auto,restart) reset 2334 set ::ngc(any,next,reset:noauto,restart) reset 2335 2336 set ::ngc(any,next,start:auto,immediate) avail 2337 set ::ngc(any,next,start:noauto,immediate) avail 2338 2339 # have one or more features available: 2340 set ::ngc(any,next,avail:auto,savesection) avail 2341 set ::ngc(any,next,avail:noauto,savesection) avail 2342 set ::ngc(any,next,avail:auto,restart) reset 2343 set ::ngc(any,next,avail:noauto,restart) reset 2344 2345 set ::ngc(any,next,avail:auto,finalize) reset 2346 set ::ngc(any,next,avail:noauto,finalize) reset2 2347 2348 set ::ngc(any,next,reset2:auto,immediate) reset 2349 set ::ngc(any,next,reset2:noauto,immediate) reset 2350 2351 set ::ngc($hdl,state) reset 2352 set ::ngc($hdl,lastevent) notsetyet 2353 2354 } ;# statemap 2355 2356 proc ::ngcgui::message {hdl event} { 2357 # statemachine events (and messages) 2358 # ::ngc(any,next,currentstateandmode,event) specifies next state for event 2359 switch $::ngc($hdl,auto) { 2360 0 {set statemode $::ngc($hdl,state):noauto} 2361 1 {set statemode $::ngc($hdl,state):auto} 2362 } 2363 if ![info exists ::ngc(any,next,$statemode,$event)] { 2364 showmessage $hdl $event 2365 #puts "NOEVENT $::ngc($hdl,state) $event" 2366 return 2367 } 2368 set ::ngc($hdl,lastevent) $event 2369 set ::ngc($hdl,state) $::ngc(any,next,$statemode,$event) 2370 #puts "$event: $statemode ------>$::ngc($hdl,state)" 2371 set mw $::ngc($hdl,msg,widget) 2372 2373 # entry-to-state actions: 2374 # note: execute switch even if state unchanged to update gui 2375 switch $::ngc($hdl,state) { 2376 reset { 2377 if {"$event" == "finalize"} { 2378 showmessage $hdl finalize 2379 update idletasks 2380 if $::ngc($hdl,standalone) { 2381 after 500 ;#pause to see messages 2382 } 2383 } 2384 set ::ngc($hdl,savect) 0 2385 conf $hdl restart,widget state disabled 2386 set ::ngc($hdl,data,section) "" 2387 if [info exists ::ngc(embed,axis)] { 2388 set bcolor $::ngc(any,color,stdbg) 2389 if $::ngc($hdl,chooser) { 2390 set bcolor $::ngc(any,color,custom) 2391 } 2392 $::ngc(any,axis,parent) itemconfigure $::ngc($hdl,axis,page) \ 2393 -foreground $::ngc(any,color,black) \ 2394 -background $bcolor 2395 } 2396 2397 title $::ngc($hdl,top) "$::ngc(any,app)" 2398 walktree $::ngc($hdl,varframe) normal 2399 walktree $::ngc($hdl,iframe) normal 2400 # 101024:19.49 this is better: 2401 focus $::ngc($hdl,topf) 2402 2403 # note: dont disable sendfile,widget (wanted if noauto) 2404 $::ngc($hdl,finalize,widget) conf -state disabled 2405 $::ngc($hdl,save,widget) conf -text "[_ "Create Feature"]" 2406 $mw conf -text "[_ "Enter parms for 1st feature"]" \ 2407 -fg $::ngc(any,color,prompt) 2408 } 2409 uwait { 2410 # alternate behavior: user must select "New Outfile" 2411 walktree $::ngc($hdl,varframe) disabled 2412 walktree $::ngc($hdl,iframe) disabled 2413 $::ngc($hdl,save,widget) conf -text "[_ "New Outfile"]" 2414 $::ngc($hdl,finalize,widget) conf -state disabled 2415 $mw conf -text "[_ "Ready to make New Outfile"]" \ 2416 -fg $::ngc(any,color,prompt) 2417 } 2418 reset2 - uwait2 { 2419 # just make sure sendfile is made available, then go next state 2420 $::ngc($hdl,sendfile,widget) conf -state normal 2421 after 0 [list ::ngcgui::message $hdl immediate] 2422 } 2423 start { 2424 walktree $::ngc($hdl,varframe) normal 2425 walktree $::ngc($hdl,iframe) normal 2426 focus $::ngc($hdl,begin,widget) 2427 2428 $::ngc($hdl,save,widget) conf -text "[_ "Create Feature"]" 2429 $::ngc($hdl,sendfile,widget) conf -state disabled 2430 $::ngc($hdl,finalize,widget) conf -state normal 2431 $mw conf -text "[_ "Enter parms for feature "][expr 1 + $::ngc($hdl,savect)]" \ 2432 -fg $::ngc(any,color,prompt) 2433 after 0 [list ::ngcgui::message $hdl immediate] 2434 } 2435 avail { 2436 incr ::ngc($hdl,savect) 2437 conf $hdl restart,widget state active 2438 2439 if [info exists ::ngc(embed,axis)] { 2440 if {$::ngc($hdl,savect) > 1} { 2441 $::ngc(any,axis,parent) itemconfigure $::ngc($hdl,axis,page) \ 2442 -foreground $::ngc(any,color,multiple) \ 2443 -background $::ngc(any,color,feature) 2444 } else { 2445 $::ngc(any,axis,parent) itemconfigure $::ngc($hdl,axis,page) \ 2446 -foreground $::ngc(any,color,single) \ 2447 -background $::ngc(any,color,feature) 2448 } 2449 } 2450 2451 set t "$::ngc(any,app) $::ngc($hdl,savect) [_ "feature"]" 2452 if {$::ngc($hdl,savect) > 1} { set t ${t}s} 2453 title $::ngc($hdl,top) "$t" ;# plural 2454 $::ngc($hdl,finalize,widget) conf -state normal 2455 if {$::ngc($hdl,savect) > 0} { 2456 $::ngc($hdl,save,widget) conf -text "[_ "Create Next"]" 2457 } else { 2458 $::ngc($hdl,save,widget) conf -text "[_ "Create Feature"]" 2459 } 2460 $::ngc($hdl,sendfile,widget) conf -state disabled 2461 $mw conf -text "[_ "Created feature "]$::ngc($hdl,savect)" \ 2462 -fg $::ngc(any,color,ok) 2463 after 500 [list $::ngc($hdl,msg,widget) conf \ 2464 -text "[_ "Enter parms for feature "][expr 1 + $::ngc($hdl,savect)]" \ 2465 -fg $::ngc(any,color,prompt) 2466 ] 2467 } 2468 } 2469 } ;# message 2470 2471 proc ::ngcgui::title {t txt} { 2472 if ![info exists ::ngc(embed,axis)] { 2473 wm title $t $txt 2474 } 2475 } ;# title 2476 2477 proc ::ngcgui::showmessage {hdl type} { 2478 # if $hdl==opt then just show $type in *,msg,widget 2479 # if no $hdl,msg,widget then do nothing 2480 # if known type then update widgets per $type 2481 # else then just show type in *,msg,widget 2482 if {"$hdl" == "opt"} { 2483 # no message widget since opt is for all instances 2484 foreach w [array names ::ngc *,msg,widget] { 2485 $::ngc($w) conf -text "[_ "option"] :$type $::ngc($hdl,$type)" \ 2486 -fg $::ngc(any,color,ok) 2487 } 2488 return 2489 } 2490 if ![info exists ::ngc($hdl,msg,widget)] return 2491 set ::ngc($hdl,dname,outfile) [file tail $::ngc($hdl,fname,outfile)] ;#shorten 2492 2493 set mw $::ngc($hdl,msg,widget) 2494 switch $type { 2495 parmerr { 2496 $mw conf -text "[_ "Missing parameters"]" \ 2497 -fg $::ngc(any,color,error) 2498 } 2499 parseerror { 2500 $mw conf -text "[_ "Parse Error"]: $::ngc($hdl,dname,subfile)" \ 2501 -fg $::ngc(any,color,error) 2502 $::ngc($hdl,finalize,widget) conf -state disabled 2503 $::ngc($hdl,save,widget) conf -state disabled 2504 } 2505 nullpreamble { 2506 periodic_checks $hdl ;# resync 2507 $mw conf -text "[_ "Null Preamble"]" \ 2508 -fg $::ngc(any,color,ok) 2509 } 2510 readpreamble { 2511 periodic_checks $hdl ;# resync 2512 $mw conf -text "[_ "Read Preamble"]: $::ngc($hdl,dname,preamble)" \ 2513 -fg $::ngc(any,color,ok) 2514 } 2515 preambleerror { 2516 $mw conf -text "[_ "Preamble Error"]: $::ngc($hdl,dname,preamble)" \ 2517 -fg $::ngc(any,color,error) 2518 } 2519 nullpostamble { 2520 periodic_checks $hdl ;# resync 2521 $mw conf -text "[_ "Null Postamble"]" \ 2522 -fg $::ngc(any,color,ok) 2523 } 2524 readpostamble { 2525 periodic_checks $hdl ;# resync 2526 $mw conf -text "[_ "Read Postamble"]: $::ngc($hdl,dname,postamble)" \ 2527 -fg $::ngc(any,color,ok) 2528 } 2529 postambleerror { 2530 $mw conf -text "[_ "Postamble Error"]: $::ngc($hdl,dname,postamble)" \ 2531 -fg $::ngc(any,color,error) 2532 } 2533 readsubfile { 2534 periodic_checks $hdl ;# resync 2535 $mw conf -text "[_ "Read Subfile"]: $::ngc($hdl,dname,subfile)" \ 2536 -fg $::ngc(any,color,ok) 2537 $::ngc($hdl,save,widget) conf -state normal ;# restore after parseerror 2538 } 2539 writeerror { 2540 $mw conf -text "[_ "Write Error"]: $::ngc($hdl,dname,outfile)" \ 2541 -fg $::ngc(any,color,error) 2542 } 2543 setoutfile { 2544 $mw conf -text "[_ "Outfile set"]: $::ngc($hdl,dname,outfile)" \ 2545 -fg $::ngc(any,color,ok) 2546 } 2547 finalize { 2548 $mw conf -text \ 2549 "[_ "Finished"]: ($::ngc($hdl,savect)): $::ngc($hdl,dname,outfile)"\ 2550 -fg $::ngc(any,color,ok) 2551 } 2552 usercancel { 2553 # user canceled output file spec 2554 $mw conf -text "[_ "Canceled"]: $::ngc($hdl,savect) pending "\ 2555 -fg $::ngc(any,color,warn) 2556 walktree $::ngc($hdl,varframe) normal 2557 walktree $::ngc($hdl,iframe) normal 2558 } 2559 sendfile { 2560 $mw conf -text "[_ "Sent"]: $::ngc($hdl,dname,outfile)" \ 2561 -fg $::ngc(any,color,ok) 2562 } 2563 senderror { 2564 $mw conf -text "[_ "SendFileToAxis failed"]" \ 2565 -fg $::ngc(any,color,error) 2566 } 2567 startup { 2568 $mw conf -text "[_ "Ctrl-k for Key bindings"]" \ 2569 -fg $::ngc(any,color,ok) 2570 } 2571 expandsubroutine { 2572 $mw conf -text "[_ "Expand sub"] $::ngc($hdl,expandsubroutine)" \ 2573 -fg $::ngc(any,color,ok) 2574 } 2575 retainvalues { 2576 $mw conf -text "[_ "Retain values"] $::ngc($hdl,retainvalues)" \ 2577 -fg $::ngc(any,color,ok) 2578 } 2579 verbose { 2580 $mw conf -text "[_ "Verbose"] $::ngc($hdl,verbose)" -fg $::ngc(any,color,ok) 2581 } 2582 auto { 2583 $mw conf -text "[_ "Autosend"] $::ngc($hdl,auto)" -fg $::ngc(any,color,ok) 2584 } 2585 cancel { 2586 $mw conf -text "[_ "Finalize Canceled"]" \ 2587 -fg $::ngc(any,color,ok) 2588 } 2589 default { 2590 $mw conf -text "$type" -fg $::ngc(any,color,default) 2591 } 2592 } 2593 } ;# showmessage 2594 2595 proc ::ngcgui::periodic_checks {hdl} { 2596 after cancel $::ngc($hdl,afterid) 2597 if { [info exists ::ngc(embed,axis)] \ 2598 && ([$::ngc(any,axis,parent) raise] != "$::ngc($hdl,axis,page)") } { 2599 # not raised, skip tests 2600 set ::ngc($hdl,afterid) [after $::ngc(any,pollms) \ 2601 [list ::ngcgui::periodic_checks $hdl]] ;#reschedule 2602 return 2603 } 2604 # notify for modified files 2605 foreach i {subfile preamble postamble} { 2606 set f $::ngc($hdl,fname,$i) 2607 if {"$f" == ""} continue 2608 # check for widget because it can go away 2609 if { [info exists ::ngc($hdl,$i,widget)] \ 2610 && [winfo exists $::ngc($hdl,$i,widget)]} { 2611 # check for change in entry widget 2612 if {[file tail $f] != "$::ngc($hdl,dname,$i)"} { 2613 # new file specified in entry box 2614 $::ngc($hdl,$i,widget) conf -fg $::ngc(any,color,filenew) 2615 } else { 2616 $::ngc($hdl,$i,widget) conf -fg $::ngc(any,color,ok) 2617 catch {unset ::ngc($hdl,$i,reread,pending)} 2618 } 2619 # check for file removal 2620 if ![file readable $f] { 2621 # file gone/perm changed notification: 2622 $::ngc($hdl,$i,widget) conf -fg $::ngc(any,color,filegone) 2623 continue 2624 } 2625 set t [file mtime $f] 2626 if { [info exists ::ngc($hdl,fname,$i,time)] \ 2627 && $t > $::ngc($hdl,fname,$i,time)\ 2628 } { 2629 # file modified notification: 2630 conf $hdl $i,widget fg $::ngc(any,color,filemod) 2631 conf $hdl reread,widget state normal 2632 conf $hdl reread,widget fg $::ngc(any,color,filemod) 2633 set ::ngc($hdl,$i,reread,pending) 1 2634 } 2635 } 2636 } 2637 if {[array names ::ngc $hdl,*,reread,pending] == ""} { 2638 conf $hdl reread,widget fg $::ngc(any,color,black) 2639 conf $hdl reread,widget state disabled 2640 } 2641 ::ngcgui::dcheck $hdl 2642 set ::ngc($hdl,afterid) [after $::ngc(any,pollms) \ 2643 [list ::ngcgui::periodic_checks $hdl]] ;#reschedule 2644 return 2645 } ;# periodic_checks 2646 2647 proc ::ngcgui::dcheck {hdl} { 2648 2649 # check display of default values for positional parameters 2650 foreach n [array names ::ngc $hdl,arg,entrywidget,*] { 2651 set i1 [string last , $n] 2652 set num02 [string range $n [expr 1 + $i1] end] 2653 # under some contitions, this entrywidget may be done: 2654 if ![winfo exists $::ngc($hdl,arg,entrywidget,$num02)] continue 2655 if { [info exists ::ngc($hdl,arg,dvalue,$num02)] \ 2656 && "$::ngc($hdl,arg,dvalue,$num02)" \ 2657 == "$::ngc($hdl,arg,value,$num02)"} { 2658 $::ngc($hdl,arg,entrywidget,$num02) conf -bg $::ngc(any,color,vdefault) 2659 } else { 2660 $::ngc($hdl,arg,entrywidget,$num02) conf \ 2661 -bg $::ngc(any,color,stdbg);# restore default 2662 } 2663 } 2664 } ;# dcheck 2665 2666 proc ::ngcgui::updownkeys {w} { 2667 # not compatible with axis key bindings 2668 # make up-arrow, down-arrow behave like tab,shift-tab navigation 2669 bind $w <Key-Down> [bind all <Key-Tab>] 2670 bind $w <Key-Up> [bind all <<PrevWindow>>] 2671 # recursion: 2672 foreach child [winfo children $w] { 2673 if {$child == ""} continue 2674 updownkeys $child 2675 } 2676 } ;# updownkeys 2677 2678 proc ::ngcgui::walktree {w mode} { 2679 # mode == normal|disabled 2680 # puts "w=$w mode=$mode" 2681 switch [winfo class $w] { 2682 Button - 2683 Checkbutton - 2684 Radiobutton - 2685 Entry { 2686 if {[$w cget -state] == "readonly"} { 2687 # skip 2688 } else { 2689 $w config -state $mode 2690 } 2691 } 2692 Toplevel - 2693 Frame { 2694 # recursion: 2695 foreach child [winfo children $w] { 2696 if {$child == ""} continue 2697 walktree $child $mode 2698 } 2699 } 2700 } 2701 } ;# walktree 2702 2703 proc ::ngcgui::showerr {msg "opt sort" "maxerr 10"} { 2704 # msg is a list; default: sort msg 2705 set w .showerr 2706 catch {destroy $w} 2707 set w [toplevel $w] 2708 set l [label $w.l -justify left] 2709 set text "" 2710 if {"$opt" == "sort"} {set msg [lsort $msg]} 2711 set ct 0 2712 foreach item $msg { 2713 if {$ct > $maxerr} { 2714 set text "$text\n..." 2715 break ;# avoid showing too many 2716 } else { 2717 set text "$text\n$item" 2718 } 2719 incr ct 2720 } 2721 $l configure -text $text 2722 pack $l -side top 2723 set b [button $w.b -text "[_ "Dismiss"]" \ 2724 -command "destroy $w"] 2725 pack $b -side top 2726 focus $b 2727 wm withdraw $w 2728 wm title $w "[_ "ngcgui Error"]" 2729 update idletasks 2730 set x [expr [winfo screenwidth $w]/2 \ 2731 - [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]] 2732 set y [expr [winfo screenheight $w]/2 \ 2733 - [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]] 2734 wm geom $w +$x+$y 2735 wm deiconify $w 2736 } ;# showerr 2737 2738 proc ::ngcgui::bye {hdl} { 2739 after cancel $::ngc($hdl,afterid) 2740 catch {destroy $::ngc($hdl,top)} ;# for embedded usage 2741 set ::ngcgui::finis 1 ;# for standalone usage 2742 } ;# bye 2743 2744 proc ::ngcgui::sendaxis {hdl cmd} { 2745 # return 1==>ok 2746 switch $cmd { 2747 ping { 2748 if ![catch {send axis pwd} msg] {return 1 ;#ok} 2749 # tk8.5 send misfeature 2750 if {[string first "X server insecure" $msg] >= 0} { 2751 puts stdout "[_ "Declining support for tk send bug in ngcgui"]" 2752 puts stdout "[_ "You should upgrade linuxcnc to >= linuxcnc2.5"]" 2753 eval exec xhost - SI:localuser:gdm 2754 eval exec xhost - SI:localuser:root 2755 # test if that worked: 2756 if [::ngcgui::sendaxis $hdl ping2] {return 1 ;# ok} 2757 } 2758 } 2759 ping2 { 2760 if ![catch {send axis pwd} msg] {return 1 ;#ok} 2761 } 2762 file { 2763 set f [file normalize $::ngc($hdl,fname,outfile)] 2764 2765 if ![catch {send axis "remote open_file_name $f"} msg] { 2766 if {"$msg" == ""} { 2767 #puts sendaxis:file:ok:<$f>msg=$msg 2768 if [info exists ::ngc(embed,axis)] { 2769 $::ngc(any,axis,parent) raise preview 2770 focus -force . 2771 } 2772 return 1 ;# ok 2773 } else { 2774 # nonnull msg means axis-remote cmd failed, see msg 2775 } 2776 } else { 2777 # axis-ui-remote command not available pre2.4 2778 # try method that may work for axis in linuxcnc2.3.x 2779 return [pre2.4_send_file_to_axis $hdl $f] 2780 } 2781 } 2782 default {return -code error "sendaxis: unknown cmd <$cmd>"} 2783 } 2784 set ::ngc($hdl,axis,error) \{$msg\} ;# brackets needed here 2785 lappend ::ngc($hdl,axis,error) {Note: Ctrl-A toggles autosend} 2786 2787 return 0 ;# fail 2788 } ;# sendaxis 2789 2790 proc ::ngcgui::pre2.4_send_file_to_axis {hdl f} { 2791 # errors may be shown on axisui but NOT detected here with pre2.4 2792 if ![catch {send axis open_file_name $f} msg] { 2793 return 1 ;# ok (expect "None") 2794 } else { 2795 # notreached i suspect 2796 puts "[_ "pre2.4_send_file_to_axis:error"]<$msg>" 2797 set ::ngc($hdl,axis,error) [list $msg] 2798 return 0 ;# error 2799 } 2800 } ;# pre2.4_send_file_to_axis 2801 2802 proc ::ngcgui::entrykeybinding {ax w v} { 2803 # if a global ::entrykeybinding proc exists, use it only: 2804 if {[info proc ::entrykeybinding] != ""} { 2805 after 0 [list ::entrykeybinding $ax $w $v] 2806 return 2807 } 2808 set axis [string toupper $ax] 2809 # these coord values may not work for some configurations: 2810 switch $axis { 2811 X {set coord X} 2812 Y {set coord Y} 2813 Z {set coord Z} 2814 A {set coord A} 2815 B {set coord B} 2816 C {set coord C} 2817 U {set coord U} 2818 V {set coord V} 2819 W {set coord W} 2820 D {set coord X;# for diameter} 2821 } 2822 if {![info exists coord]} return ;# silently 2823 # ignore errors (standalone for example) 2824 if [catch { 2825 set value [emc_rel_act_pos $coord] 2826 switch $axis { 2827 D {set value [expr 2.0*$value] ;# diameter} 2828 default {} 2829 } 2830 set value [format %.4f $value] 2831 after 0 [list set $v $value] 2832 after 0 [list $w configure -fg $::ngc(any,color,override)] 2833 } msg] { 2834 # silently ignore, emc_rel_act_pos will fail in standalone 2835 # puts stdout "entrykeybinding:<$msg>" 2836 } 2837 } ;# entrykeybinding 2838 2839 proc ::ngcgui::text_width_and_length {text wname lname} { 2840 upvar $wname maxwidth ;#pass by ref 2841 upvar $lname lines ;#pass by ref 2842 set linelimit 80 ;# some lines can be real long, ex ::env(LS_COLORS) 2843 set start 0; set end 0; set len 0 2844 set maxwidth 0 2845 set lines 0 2846 while {$end >= 0} { 2847 set end [string first \n $text $start] 2848 set len [expr $end - $start] 2849 #puts "$len $start $end [string range $text $start $end]" 2850 set start [expr $end +1] 2851 if {$len > $maxwidth} { 2852 # dont use len of very long lines 2853 if {$len < $linelimit} { 2854 set maxwidth $len 2855 } 2856 } 2857 incr lines 2858 } 2859 return 2860 } ;# text_width_and_length 2861 2862 proc ::ngcgui::simple_text {top text {title ""} } { 2863 #note: on first cany, top should not exist 2864 set maxheight 20 2865 set tf $top.f 2866 set t $tf.txt 2867 set ysb $tf.ysb 2868 if {![winfo exists $top]} { 2869 toplevel $top 2870 pack [frame $tf] -fill both -expand 1 2871 2872 text_width_and_length "$text" twidth theight 2873 if {$theight > $maxheight} {set theight $maxheight} 2874 set t [text $t \ 2875 -width $twidth -height $theight\ 2876 -yscrollcommand "$ysb set" \ 2877 ] 2878 set ysb [scrollbar $ysb -command "$t yview" -relief sunken] 2879 set db [button $top.b -pady 1 -text "[_ "Dismiss"]" \ 2880 -command "destroy $top"] 2881 focus $db 2882 2883 pack $t -side left -fill both -expand 0 2884 pack $ysb -side right -fill y 2885 pack $db -side top -fill x -expand 0 2886 # fall-thru to insert 2887 } else { 2888 wm deiconify $top 2889 } 2890 if {"$title" != ""} { wm title $top "$title" } 2891 2892 #update 2893 #set geo [wm geometry $top] 2894 #set w [string range $geo 0 [expr [string first x $geo] -1]] 2895 #set h [string range $geo [expr [string first x $geo +1]]\ 2896 # [expr [string first + $geo] -1]] 2897 2898 $t configure -state normal ;# to delete/insert 2899 $t delete 0.0 end 2900 $t insert end $text 2901 $t configure -state disabled ;# leave disabled: insert 2902 wm resizable $top 0 1 2903 wmcenter $top 2904 return $top 2905 } ;# simple_text 2906 2907 proc ::ngcgui::wmcenter w { 2908 # Withdraw the window, then update all the geometry information 2909 # so we know how big it wants to be, then center the window in the 2910 # display and de-iconify it. 2911 wm withdraw $w 2912 update idletasks 2913 set x [expr [winfo screenwidth $w]/2 \ 2914 - [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]] 2915 set y [expr [winfo screenheight $w]/2 \ 2916 - [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]] 2917 wm geom $w +$x+$y 2918 wm deiconify $w 2919 } ;# wmcenter 2920 2921 proc ::ngcgui::entry_mend {w} { 2922 # note: entry_mend is callable by others (ttt) 2923 # axis creates jog bindings for the toplevel (.==dot): 2924 # for <KeyPress-minus> <KeyRelease-minus> <KeyPress-equal> <KeyRelease-equal> 2925 # eg: bind . <KeyPress-minus> ==> {stuff} 2926 # thus, for entries, bindtags are: {$e Entry . all} <-- the . is a problem 2927 # so, limit the bindtags for entries 2928 if {[winfo class $w] == "Entry"} { 2929 bindtags $w [list $w Entry all] ;# remove the . bindtag 2930 bind_for_axis $w 2931 } 2932 foreach child [winfo children $w] { 2933 if {$child == ""} continue 2934 ::ngcgui::entry_mend $child 2935 } 2936 } ;# entry_mend 2937 2938 proc ::ngcgui::recursive_bind_controlkeys {hdl w} { 2939 bind_controlkeys $hdl $w 2940 foreach child [winfo children $w] { 2941 if {$child == ""} continue 2942 ::ngcgui::recursive_bind_controlkeys $hdl $child 2943 } 2944 } ;# recursive_bind_controlkeys 2945 2946 proc ::ngcgui::bind_controlkeys {hdl w} { 2947 set ::ngc(any,kbindlist) {a c d e E f F k n p P r R s S x v t U u} 2948 bind $w <Control-Key-a> [list ::ngcgui::toggle $hdl auto] 2949 bind $w <Control-Key-c> [list ::ngcgui::setentries $hdl clear] 2950 bind $w <Control-Key-d> [list ::ngcgui::setentries $hdl defaults] 2951 bind $w <Control-Key-D> [list ::ngcgui::debug $hdl] 2952 bind $w <Control-Key-e> [list ::ngcgui::editfile $hdl last] 2953 bind $w <Control-Key-E> [list ::ngcgui::toggle $hdl expandsubroutine] 2954 bind $w <Control-Key-f> [list ::ngcgui::gui $hdl savesection] 2955 bind $w <Control-Key-F> [list ::ngcgui::gui $hdl finalize] 2956 bind $w <Control-Key-k> [list ::ngcgui::bindings $hdl show] 2957 bind $w <Control-Key-n> [list ::ngcgui::message $hdl restart] 2958 bind $w <Control-Key-p> [list ::ngcgui::gui $hdl readpreamble] 2959 bind $w <Control-Key-P> [list ::ngcgui::gui $hdl readpostamble] 2960 bind $w <Control-Key-r> [list ::ngcgui::gui $hdl readsubfile] 2961 bind $w <Control-Key-R> [list ::ngcgui::toggle $hdl retainvalues] 2962 bind $w <Control-Key-q> [list ::ngcgui::toggle $hdl verbose] 2963 bind $w <Control-Key-s> [list ::ngcgui::status $hdl] 2964 bind $w <Control-Key-S> [list ::ngcgui::status $hdl full] 2965 bind $w <Control-Key-u> [list ::ngcgui::editfile $hdl source] 2966 bind $w <Control-Key-U> [list ::ngcgui::editfile $hdl preamble] 2967 # for debugging: 2968 bind $w <Control-Key-x> [list parray ::ngc] 2969 bind $w <Control-Key-v> [list parray ::env] 2970 bind $w <Control-Key-t> [list ::ngcgui::test] 2971 } ;# bind_controlkeys 2972 2973 proc ::ngcgui::bind_for_axis {w} { 2974 # Escape and other special bindings for axis embedding 2975 bind $w <Key-Escape> "$::ngc(any,axis,parent) raise preview" ;# allow Escape too 2976 2977 # axis omits return break in estopped_clicked for F1 2978 bind $w <Key-F1> "[bind all <Key-F1>];break" 2979 2980 # Fn keys 2981 foreach i {2 3 4 5 6 7 8 9 10 11 12} { 2982 bind $w <Key-F$i> "[bind . <Key-F$i>];break" 2983 } 2984 } ;# bind_for_axis 2985 2986 proc ::ngcgui::bindings {hdl mode} { 2987 set mode [string tolower $mode] ;# -nocase doesnt work tcl8.4 2988 switch $mode { 2989 show { 2990 set atxt "[_ "OFF"]" 2991 if {$::ngc($hdl,auto)} {set atxt "[_ "ON"]"} 2992 set msg "\ 2993 Ctrl-a [_ "Toggle autosend"]\n\ 2994 Ctrl-c [_ "Clear entries"]\n\ 2995 Ctrl-d [_ "Set entries to default values"]\n\ 2996 Ctrl-e [_ "Open editor specified by"] \$VISUAL\n\ 2997 [_ "on last outfile"]\n\ 2998 Ctrl-E [_ "toggle expand subroutines"]\n\ 2999 Ctrl-f [_ "Create feature"]\n\ 3000 Ctrl-F [_ "Finalize (AUTO send is"] $atxt)\n\ 3001 Ctrl-k [_ "Show key bindings"]\n\ 3002 Ctrl-n [_ "Restart (cancel pending)"]\n\ 3003 Ctrl-p [_ "(re)Read Preamble"]\n\ 3004 Ctrl-P [_ "(re)Read Postamble"]\n\ 3005 Ctrl-r [_ "(re)Read Subfile"]\n\ 3006 Ctrl-R [_ "toggle retain values"]\n\ 3007 Ctrl-q [_ "toggle output file verbosity"]\n\ 3008 Ctrl-s [_ "Show status"]\n\ 3009 Ctrl-S [_ "Show full status (debug info)"]\n\ 3010 Ctrl-u [_ "Open editor specified by"] \$VISUAL\n\ 3011 [_ "on current subfile"]\n\ 3012 Ctrl-U [_ "Open editor specified by"] \$VISUAL\n\ 3013 [_ "on current preamble"]\ 3014 " 3015 if [info exists ::ngc(embed,axis)] { 3016 set msg "[_ " Escape Return to Preview page"]\n$msg" 3017 } 3018 # puts $msg 3019 ::ngcgui::simple_text .ngcguikeys $msg "$::ngc(any,app)-$hdl-keys" 3020 } 3021 init { 3022 # coordinate with bind_controlkeys (x,v,t for debugging) 3023 3024 if [info exists ::ngc(embed,axis)] { 3025 ::ngcgui::bind_for_axis $::ngc($hdl,topf) 3026 } 3027 3028 if [info exists ::ngc(embed,axis)] { 3029 entry_mend $::ngc($hdl,topf) 3030 } 3031 recursive_bind_controlkeys $hdl $::ngc($hdl,topf) 3032 bind $::ngc($hdl,topf) <Enter> [list ::ngcgui::bindings $hdl enter] 3033 bind $::ngc($hdl,topf) <Leave> [list ::ngcgui::bindings $hdl leave] 3034 set ::ngc($hdl,restore,bindtags) [bindtags $::ngc($hdl,topf)] 3035 set ::ngc($hdl,restore,focus) [focus -lastfor $::ngc($hdl,topf)] 3036 } 3037 enter { 3038 set ::ngc($hdl,restore,bindtags) [bindtags $::ngc($hdl,topf)] 3039 bindtags $::ngc($hdl,topf) $::ngc($hdl,topf) 3040 3041 if [info exists ::ngc(embed,axis)] { 3042 entry_mend $::ngc($hdl,topf) 3043 } 3044 recursive_bind_controlkeys $hdl $::ngc($hdl,topf) 3045 set ::ngc($hdl,restore,focus) [focus -lastfor $::ngc($hdl,topf)] 3046 focus $::ngc($hdl,topf) 3047 return 3048 } 3049 leave { 3050 bindtags $::ngc($hdl,topf) $::ngc($hdl,restore,bindtags) 3051 focus -force $::ngc($hdl,restore,focus) 3052 # this seems to be necesarry with notebook pages 3053 foreach key $::ngc(any,kbindlist) { 3054 bind $::ngc($hdl,topf) <Control-Key-$key> {} 3055 } 3056 } 3057 } 3058 } ;# bindings 3059 3060 proc ::ngcgui::aftertoggle {hdl x} { 3061 # hdl: handle (note: opt may be used too) 3062 switch $x { 3063 auto { 3064 if $::ngc($hdl,auto) { 3065 pack forget $::ngc($hdl,sendfile,widget) 3066 $::ngc($hdl,sendfile,widget) conf -state normal 3067 $::ngc($hdl,finalize,widget) config -text "[_ "Finalize"]" 3068 } else { 3069 pack $::ngc($hdl,sendfile,widget) -fill x 3070 $::ngc($hdl,finalize,widget) config -text "[_ "MakeFile"]" 3071 } 3072 } 3073 } 3074 ::ngcgui::showmessage $hdl $x 3075 } ;# aftertoggle 3076 3077 proc ::ngcgui::toggle {hdl x} { 3078 # hdl: handle (note: opt may be used too) 3079 set ::ngc($hdl,$x) [expr $::ngc($hdl,$x)?0:1] 3080 ::ngcgui::aftertoggle $hdl $x 3081 } ;# toggle 3082 3083 proc ::ngcgui::test {} { 3084 set text "Environmental Variables:\n" 3085 foreach v [lsort [array names ::env]] { 3086 set text "$text $v [set ::env($v)]\n" 3087 } 3088 simple_text .test $text 3089 } ;# test 3090 3091 proc ::ngcgui::editfile {hdl {mode last} } { 3092 if ![info exists ::env(VISUAL)] { 3093 simple_text .problem "\n[_ "Editing requires setting for environmental variable VISUAL"] \n 3094 [_ "Trying gedit"]\n"\ 3095 "$::ngc(any,app)-$hdl-problem" 3096 set ::env(VISUAL) gedit 3097 update 3098 after 5000 {destroy .problem} 3099 } 3100 # note: normalize filename to honor tilde (~) 3101 switch $mode { 3102 last { 3103 if { [info exists ::ngc($hdl,last,outfile)] \ 3104 && "$::ngc($hdl,last,outfile)" != ""} { 3105 eval exec $::env(VISUAL) [file normalize $::ngc($hdl,last,outfile)] & 3106 } else { 3107 simple_text .problem "[_ "No file available for editing yet"]\n"\ 3108 "$::ngc(any,app)-$hdl-problem" 3109 return 3110 } 3111 } 3112 source { 3113 if {"$::ngc($hdl,fname,subfile)" != ""} { 3114 eval exec $::env(VISUAL) [file normalize $::ngc($hdl,fname,subfile)] & 3115 } else { 3116 simple_text .problem "[_ "No file available for editing"]\n"\ 3117 "$::ngc(any,app)-$hdl-problem" 3118 return 3119 } 3120 } 3121 preamble { 3122 if {"$::ngc($hdl,fname,preamble)" != ""} { 3123 eval exec $::env(VISUAL) [file normalize $::ngc($hdl,fname,preamble)] & 3124 } else { 3125 simple_text .problem "[_ "No file available for editing"]\n"\ 3126 "$::ngc(any,app)-$hdl-problem" 3127 return 3128 } 3129 } 3130 } 3131 } ;# editfile 3132 3133 proc ::ngcgui::status {hdl args} { 3134 set items {fname,preamble fname,subfile fname,postamble\ 3135 fname,outfile fname,autosend\ 3136 auto dir savect font aspect retainvalues\ 3137 expandsubroutine chooser\ 3138 } 3139 set optitems {noauto nonew noremove noiframe noinput nom2} 3140 set anyitems {app pollms aspect width,comment width,varname qid} 3141 3142 set text "[_ "Status items"]:" 3143 if {"$args" == "full"} { 3144 #parray ::ngc;return 3145 set bitems [lsort [array names ::ngc $hdl,*]] 3146 foreach i $bitems {lappend items [string trim $i $hdl,]} 3147 set text "Status items(all):" 3148 } 3149 set fmt "%s: %s" 3150 foreach i $items { 3151 # catch in case item gets unset 3152 if [catch { set line [format "$fmt" $i $::ngc($hdl,$i)]}] continue 3153 set text "$text\n$line" 3154 } 3155 set text "$text\n\n[_ "All-page opt items"]:" 3156 foreach i $optitems { 3157 # catch in case item gets unset 3158 if [catch { set line [format "$fmt" $i $::ngc(opt,$i)]}] continue 3159 set text "$text\n$line" 3160 } 3161 set text "$text\n\n[_ "any-items"]:" 3162 foreach i $anyitems { 3163 # catch in case item gets unset 3164 if [catch { set line [format "$fmt" $i $::ngc(any,$i)]}] continue 3165 set text "$text\n$line" 3166 } 3167 simple_text .status $text "$::ngc(any,app)-$hdl-status" 3168 focus .status 3169 bind .status <Control-Key-s> [list ::ngcgui::status $hdl $args] 3170 bind .status <Control-Key-S> [list ::ngcgui::status $hdl $args] 3171 } ;# status 3172 3173 proc ::ngcgui::validateNumber {hdl varname widget current new} { 3174 # all entries must be numbers 3175 if ![info exists $varname] {return 1} 3176 if [catch {format %g $new} ] { 3177 $widget configure -fg $::ngc(any,color,error) 3178 return 1 ;# problem but return ok (just change color) 3179 } else { 3180 if {"$current" != "$new"} {} 3181 $widget configure -fg $::ngc(any,color,black) 3182 return 1 ;# 1==>ok 3183 } 3184 } ;# validateNumber 3185 3186 proc ::ngcgui::setentries {hdl opt} { 3187 # set entries per opt == defaults | clear 3188 switch $opt { 3189 defaults { 3190 foreach n [array names ::ngc $hdl,arg,dvalue,*] { 3191 set num02 [string range $n [expr 1+[string last , $n]] end] 3192 set ::ngc($hdl,arg,value,$num02) $::ngc($n) 3193 } 3194 ::ngcgui::showmessage $hdl "[_ "Set defaults"]" 3195 } 3196 clear { 3197 foreach n [array names ::ngc $hdl,arg,value,*] { 3198 set num02 [string range $n [expr 1+[string last , $n]] end] 3199 set ::ngc($hdl,arg,value,$num02) "" 3200 } 3201 ::ngcgui::showmessage $hdl "[_ "Clear entries"]" 3202 } 3203 } 3204 ::ngcgui::dcheck $hdl 3205 } ;# setentries 3206 3207 proc ::ngcgui::wgui {dir} { 3208 # for embedded applications, this proc makes a separate-window gui 3209 # in the current process 3210 # this proc is useful for testing with tkcon: 3211 # to debug using tkcon: source this file then % ::ngcgui::wgui dirname 3212 # to run ngcgui in a frame, use ::ngcgui::gui hdl create frame 3213 # multiple intantiations of ngcgui within the same prcess are not supported 3214 package require Tk 3215 set hdl 0 3216 catch {unset ::ngc} 3217 ::ngcgui::preset $hdl control ;# setup control() with defaults 3218 set control(any,aspect) horiz 3219 set control(any,font) {Helvetica -10 bold} 3220 # set control(any,app) [file tail $::argv0] 3221 set control(any,app) ::ngcgui::wgui ;# with tkcon argv0 not available 3222 set control($hdl,auto) 1 ;# autosend with finalize 3223 set control($hdl,dir) $dir 3224 set control($hdl,topname) .ngcgui 3225 eval ::ngcgui::top $hdl control 3226 wm withdraw . 3227 } ;# wgui 3228 3229 proc ::ngcgui::findkeybinding {w {key k} } { 3230 # utility 3231 set b [bind $w <Control-Key-$key>] 3232 if {"$b" != ""} { 3233 puts "w=$w key=$key binding=<$b>" 3234 } 3235 foreach child [winfo children $w] { 3236 if {$child == ""} continue 3237 find $child $key 3238 } 3239 } ;# findkeybinding 3240 3241 proc ::ngcgui::top {hdl ay_name} { 3242 # make a standalone toplevel 3243 upvar $ay_name ay 3244 3245 foreach n [array names ay $hdl,*] { set ::ngc($n) $ay($n) } 3246 foreach n [array names ay any,*] { set ::ngc($n) $ay($n) } 3247 if ![info exists ::ngc($hdl,topname)] { 3248 set ::ngc($hdl,topname) . 3249 focus $::ngc($hdl,topname) 3250 } else { 3251 catch {destroy $::ngc($hdl,topname)} 3252 toplevel $::ngc($hdl,topname) 3253 } 3254 wm protocol $::ngc($hdl,topname) WM_DELETE_WINDOW [list ::ngcgui::bye $hdl] 3255 3256 # if autosend, make sure file is writable 3257 if $::ngc($hdl,auto) { 3258 if {"$::ngc($hdl,fname,autosend)" == ""} { 3259 set ::ngc($hdl,fname,autosend) auto.ngc 3260 } 3261 if ![string match *.ngc $::ngc($hdl,fname,autosend)] { 3262 set ::ngc($hdl,fname,autosend) $::ngc($hdl,fname,autosend).ngc 3263 } 3264 set fname $::ngc($hdl,fname,autosend) 3265 if [file writable $fname] { 3266 # ok 3267 } else { 3268 if [file exists $fname] { 3269 puts stdout "$fname [_ "not writable"]" 3270 exit 1 3271 } else { 3272 if [catch {set fd [open $fname w]} msg] { 3273 puts stdout $msg 3274 exit 1 3275 } else { 3276 close $fd 3277 file delete $fname 3278 } 3279 } 3280 } 3281 } 3282 3283 if {"$::ngc($hdl,topname)" == "."} { 3284 set w [::ngcgui::gui $hdl standalone .w] 3285 } else { 3286 set w [::ngcgui::gui $hdl standalone $::ngc($hdl,topname).w] 3287 } 3288 3289 if {"$w" == ""} {exit 1} ;# "" indicates something went wrong 3290 pack $w -expand 0 3291 switch $::ngc(any,aspect) { 3292 vert {wm resizable $::ngc($hdl,top) 0 1} 3293 horiz {wm resizable $::ngc($hdl,top) 1 0} 3294 } 3295 3296 } ;# top 3297 3298 proc ::ngcgui::usage {hdl ay_name} { 3299 upvar $ay_name ay 3300 set prog [file tail $::argv0] 3301 set dfont "\"$ay(any,font)\"" ;# avoid messing up vim colors 3302 set aname $ay($hdl,fname,autosend) 3303 puts stdout "Usage: 3304 $prog --help | -? 3305 $prog \[Options\] -D nc_files_directory_name 3306 $prog \[Options\] -i LinuxCNC_inifile_name 3307 $prog \[Options\] 3308 3309 Options: 3310 \[-S subroutine_file\] 3311 \[-p preamble_file\] 3312 \[-P postamble_file\] 3313 \[-o output_file\] 3314 \[-a autosend_file]\ (autosend to axis default:$aname) 3315 \[--noauto]\ (no autosend to axis) 3316 \[-N | --nom2]\ (no m2 terminator (use %)) 3317 \[--font \[big|small|fontspec\]\] (default: $dfont) 3318 \[--horiz|--vert\] (default: --horiz) 3319 \[--cwidth comment_width]\ (width of comment field) 3320 \[--vwidth varname_width]\ (width of varname field) 3321 \[--quiet]\ (fewer comments in outfile) 3322 \[--noiframe]\ (default: frame displays image) 3323 3324 " 3325 exit 0 3326 } ;# usage 3327 3328 proc ::ngcgui::inifind {filename stanza item} { 3329 # find [STANZA]ITEM value from an ini file 3330 set fd [open $filename r] 3331 set state find_stanza 3332 while {![eof $fd]} { 3333 gets $fd theline 3334 # remove blanks and tabs, use lower case 3335 set line [string map {" " "" " " ""} $theline] ;#sp,tab to "" 3336 # remove trailing comment 3337 set i1 [string first # $line] 3338 if {$i1 > 0} { 3339 set line [string range $line 0 [expr $i1 -1]] 3340 } 3341 switch $state { 3342 find_stanza { 3343 if [regexp -nocase "^\\\[$stanza\\\]$" $line] { set state find_item } 3344 } 3345 find_item { 3346 if [regexp -nocase "^\\\[.*" $line] { 3347 break ;# new stanza found before item 3348 } 3349 if [regexp -nocase "^$item=(.*)" $line match value] { 3350 set thevalue $value 3351 # if more than one line like item=value, take the last line 3352 } 3353 } 3354 } 3355 } 3356 close $fd 3357 if [info exists thevalue] { 3358 return $value 3359 } 3360 return "" 3361 } ;# inifind 3362 3363 proc ::ngcgui::movepage {parent lr} { 3364 set pages [$parent pages] 3365 set page [$parent raise] 3366 set idx [lsearch $pages $page] 3367 switch $lr { 3368 left { 3369 if {$idx <= $::ngc(any,axis,min,idx)} { 3370 return 3371 } 3372 incr idx -1 3373 } 3374 right { incr idx +1 } 3375 } 3376 $parent move $page $idx 3377 updatepage 3378 } ;# movepage 3379 3380 proc ::ngcgui::newpage {creatinghdl} { 3381 set subfile "" ;# newpage: user must open file 3382 3383 if $::ngc(opt,noinput) { 3384 # there is no wI input frame, just use current file 3385 # file tail needed to use search path 3386 set subfile [file tail $::ngc($creatinghdl,fname,subfile)] 3387 if {"$subfile" == ""} { 3388 set ::ngc(opt,noinput) 0 ;# need input if no subfile to open page 3389 } 3390 } 3391 if $::ngc($creatinghdl,chooser) { 3392 set subfile "\"\"" ;# chooser starts with no specified subfile 3393 } 3394 3395 set prefile "" 3396 set postfile "" 3397 if {"$::ngc($creatinghdl,dname,preamble)" != ""} { 3398 # file tail needed to use search path 3399 set prefile [file tail $::ngc($creatinghdl,fname,preamble)] 3400 } 3401 if {"$::ngc($creatinghdl,dname,postamble)" != ""} { 3402 # file tail needed to use search path 3403 set postfile [file tail $::ngc($creatinghdl,fname,postamble)] 3404 } 3405 3406 set pageid ngcgui[qid] 3407 set w [$::ngc(any,axis,parent) insert end "$pageid" \ 3408 -text "[_ "new"]" 3409 ] 3410 $w config -borderwidth 0 ;# not sure why this needs to be by itself 3411 set f [frame $w.[qid] -borderwidth 0 -highlightthickness 0] 3412 pack $f -fill both -expand 1 -anchor nw -side top 3413 3414 # note: express font as list here is important fore embedded spaces 3415 set newhdl [embed_in_axis_tab $f \ 3416 subfile=$subfile \ 3417 preamble=$prefile \ 3418 postamble=$postfile \ 3419 font=$::ngc(any,font) \ 3420 options=$::ngc(input,options) \ 3421 gcmc_include_path=$::ngc(input,gcmc_include_path) \ 3422 ] 3423 $::ngc(any,axis,parent) itemconfigure $pageid \ 3424 -createcmd "::ngcgui::pagecreate $newhdl"\ 3425 -raisecmd "::ngcgui::pageraise $newhdl"\ 3426 -leavecmd "::ngcgui::pageleave $newhdl" 3427 3428 # use directory from creating page 3429 set ::ngc($newhdl,dir) [file dir $::ngc($creatinghdl,fname,subfile)] 3430 $::ngc(any,axis,parent) raise $::ngc($newhdl,axis,page) 3431 if {$::ngc(opt,noinput) && ("$::ngc($newhdl,dname,subfile)" != "")} { 3432 set ::ngc($newhdl,info) "$::ngc($newhdl,dname,subfile)" 3433 } else { 3434 set ::ngc($newhdl,info) "[_ "Open a new Subfile"]" 3435 } 3436 updatepage 3437 } ;# newpage 3438 3439 proc ::ngcgui::nextpage {pagename lr} { 3440 # next page to use after this page is deleted 3441 set hdl [pagetohdl $pagename] 3442 if {$hdl <0} {return -code error \ 3443 "nextpage:unexpected pagename <$pagename>" 3444 } 3445 set page $::ngc($hdl,axis,page) 3446 set pages [$::ngc(any,axis,parent) pages] 3447 set lastidx [expr -1 + [llength $pages]] 3448 set idx [lsearch $pages $page] 3449 switch $lr { 3450 left { 3451 if {$idx <= $::ngc(any,axis,min,idx)} { 3452 incr idx +1 ;# since idx page will be deleted 3453 } else { 3454 incr idx -1 3455 } 3456 } 3457 right { 3458 if {$idx >= $lastidx} { 3459 incr idx -1 ;# since idx page will be deleted 3460 } else { 3461 incr idx +1 3462 } 3463 } 3464 } 3465 set newpage [lindex $pages $idx] 3466 return $newpage 3467 } ;# nextpage 3468 3469 proc ::ngcgui::pageexists {hdl} { 3470 if [info exists ::ngc($hdl,axis,page)] {return 1} 3471 return 0 3472 } ;# pageexists 3473 3474 proc ::ngcgui::deletepage {pagename} { 3475 set hdl [pagetohdl $pagename] 3476 if {$hdl <0} {return -code error \ 3477 "deletepage:unexpected pagename <$pagename>" 3478 } 3479 set newpage [nextpage $pagename left] 3480 after cancel $::ngc($hdl,afterid) 3481 $::ngc(any,axis,parent) delete $::ngc($hdl,axis,page) 3482 3483 wm protocol $::ngc($hdl,img,top) WM_DELETE_WINDOW {} 3484 destroy $::ngc($hdl,img,top) 3485 3486 foreach n [array names ::ngc $hdl,*] { 3487 unset ::ngc($n) 3488 } 3489 3490 set idx [lsearch $::ngc(embed,pages) $pagename] 3491 set ::ngc(embed,pages) [lreplace $::ngc(embed,pages) $idx $idx] 3492 $::ngc(any,axis,parent) raise $newpage 3493 updatepage 3494 } ;# deletepage 3495 3496 proc ::ngcgui::updatepage {} { 3497 set parent $::ngc(any,axis,parent) 3498 set allpages [$parent pages] ;# these are in tab order 3499 foreach page [$parent pages] { 3500 if {[lsearch $::ngc(embed,pages) $page] < 0} continue 3501 lappend orderedpages $page 3502 } 3503 if ![info exists orderedpages] return ;# can occur at start 3504 if {[llength $orderedpages] == 1} { 3505 set p $orderedpages 3506 foreach w {,move,l,widget move,r,widget ,remove,widget} { 3507 if [info exists ::ngc($p$w)] { 3508 $::ngc($p$w) config -state disabled 3509 } 3510 } 3511 return 3512 } 3513 foreach p $orderedpages { 3514 set idx [lsearch $orderedpages $p] 3515 if {$idx == 0} { 3516 $::ngc($p,move,l,widget) config -state disabled 3517 $::ngc($p,move,r,widget) config -state active 3518 } elseif {$idx == [expr -1 +[llength $orderedpages]]} { 3519 $::ngc($p,move,l,widget) config -state active 3520 $::ngc($p,move,r,widget) config -state disabled 3521 } else { 3522 $::ngc($p,move,l,widget) config -state active 3523 $::ngc($p,move,r,widget) config -state active 3524 } 3525 # remove,widget not always present 3526 if [info exists ::ngc($p,remove,widget)] { 3527 $::ngc($p,remove,widget) config -state active} 3528 } 3529 3530 # if choosers exist, do not allow removal of last one 3531 set ct 0 3532 foreach name [array names ::ngc *,chooser] { 3533 if $::ngc($name) { 3534 incr ct 3535 lappend chdls [trimsuffix $name ,chooser] 3536 } 3537 } 3538 if {$ct == 1} { 3539 set chdl $chdls 3540 set page $::ngc($chdl,axis,page) 3541 $::ngc($page,remove,widget) configure -state disabled 3542 } elseif {$ct > 1} { 3543 foreach chdl $chdls { 3544 set page $::ngc($chdl,axis,page) 3545 $::ngc($page,remove,widget) configure -state active 3546 } 3547 } 3548 } ;# updatepage 3549 3550 proc ::ngcgui::pagetohdl {pagename} { 3551 foreach name [array names ::ngc *,axis,page] { 3552 if {"$::ngc($name)" == "$pagename"} { 3553 return [trimsuffix $name ,axis,page] 3554 break 3555 } 3556 } 3557 return -1 3558 } ;# pagetohdl 3559 3560 proc ::ngcgui::tabmanage {pagename wframe ident infovar \ 3561 {removable 0} {newable 0} } { 3562 # filler frame to put space below page tabs 3563 pack [frame $wframe.[qid] -relief flat -height 1m\ 3564 ] -anchor n -fill both -expand 0 3565 3566 set af [frame $wframe.[qid] -relief ridge -bd 2] 3567 pack $af -fill x -expand 0 -anchor n ;# always pack to hold space 3568 3569 # another filler frame to put space below page tabs 3570 pack [frame $wframe.[qid] -relief flat -height 1m\ 3571 ] -anchor n -fill both -expand 0 3572 3573 pack [label $wframe.[qid] -relief flat -anchor w \ 3574 -textvariable $infovar \ 3575 -fg $::ngc(any,color,prompt)\ 3576 ] -anchor ne -fill both -expand 0 3577 3578 if $removable { 3579 set hdl [pagetohdl $pagename] 3580 set b [button $af.[qid] -text "[_ "remove"]" \ 3581 -padx 2 -pady 1] 3582 $b configure -command [list ::ngcgui::deletepage $pagename] 3583 pack $b -side left -fill none -expand 0 3584 set ::ngc($pagename,remove,widget) $b 3585 } 3586 3587 if $newable { 3588 set hdl [pagetohdl $pagename] 3589 set b [button $af.[qid] -text "[_ "new"]" \ 3590 -padx 2 -pady 1] 3591 $b configure -command [list ::ngcgui::newpage $hdl] 3592 pack $b -side left -fill none -expand 0 3593 } 3594 3595 set l [label $af.[qid] \ 3596 -text "$ident" \ 3597 -padx 2 -pady 1 -relief ridge\ 3598 ] 3599 pack $l -side left -fill x -expand 1 3600 3601 set parent $::ngc(any,axis,parent) 3602 set b [button $af.[qid] -text "[_ "move"]-->" \ 3603 -padx 2 -pady 1] 3604 $b configure -command [list ::ngcgui::movepage $parent right] 3605 pack $b -side right -fill none -expand 0 3606 set ::ngc($pagename,move,r,widget) $b 3607 3608 set b [button $af.[qid] -text "<--[_ "move"]" \ 3609 -padx 2 -pady 1] 3610 $b configure -command [list ::ngcgui::movepage $parent left] 3611 pack $b -side right -fill none -expand 0 3612 set ::ngc($pagename,move,l,widget) $b 3613 updatepage 3614 } ;# tabmanage 3615 3616 proc ::ngcgui::parent {} {return $::ngc(any,axis,parent)} 3617 3618 proc ::ngcgui::getngcgui_frame {name} { 3619 # utility for applications managed by ngcgui 3620 set wtab [dynamic_tab $name $name] ;# axis function 3621 set w [frame $wtab.[qid] -container 0 -borderwidth 0 -highlightthickness 0] 3622 pack $w -side top -fill both -expand 1 -anchor nw 3623 3624 lappend ::ngc(embed,pages) $name 3625 return $w 3626 } ;# getngcgui_frame 3627 3628 proc ::ngcgui::embed_in_axis_tab {f args} { 3629 # f: frame 3630 # args: "item=value item=value ..." 3631 3632 if ![info exists ::ngc(embed,hdl)] { 3633 set ::ngc(embed,axis) 1 3634 set ::ngc(embed,hdl) 0 3635 set ::ngc(embed,pages) "" 3636 3637 set ::ngc(any,axis,parent) [winfo parent [winfo parent $f]] 3638 3639 # dont allow movement of tab to left of original location: 3640 set idx [lsearch [$::ngc(any,axis,parent) pages] \ 3641 [$::ngc(any,axis,parent) pages end]] 3642 if {$idx < 0} { 3643 set ::ngc(any,axis,min,idx) 10000 3644 } else { 3645 set ::ngc(any,axis,min,idx) $idx 3646 } 3647 } else { 3648 incr ::ngc(embed,hdl) 3649 } 3650 set hdl $::ngc(embed,hdl) ;# local 3651 initgui $hdl 3652 3653 ::ngcgui::preset $hdl ::ngc ;# setup defaults 3654 3655 set equalitems {subfile preamble postamble \ 3656 font \ 3657 startdir \ 3658 gcmc_include_path \ 3659 options \ 3660 } 3661 foreach item $equalitems {set ::ngc(input,$item) ""} 3662 foreach input $args { 3663 set pair [split $input =] 3664 set ::ngc(input,[lindex $pair 0]) [lindex $pair 1] 3665 # ex: input,subfile 3666 } 3667 foreach item $equalitems {set $item $::ngc(input,$item)} 3668 if [info exists ::ngc(input,gcmc_include_path)] { 3669 set ::ngc(any,gcmc_include_path) $::ngc(input,gcmc_include_path) 3670 } 3671 3672 set ::ngc($hdl,dir) $::ngc(input,startdir) 3673 3674 if {[lsearch $options nonew ] >=0} {set ::ngc(opt,nonew) 1} 3675 if {[lsearch $options noremove ] >=0} {set ::ngc(opt,noremove) 1} 3676 if {[lsearch $options noauto ] >=0} {set ::ngc(opt,noauto) 1} 3677 if {[lsearch $options noinput ] >=0} {set ::ngc(opt,noinput) 1} 3678 if {[lsearch $options noiframe ] >=0} {set ::ngc(opt,noiframe) 1} 3679 if {[lsearch $options nom2 ] >=0} {set ::ngc(opt,nom2) 1} 3680 3681 if {[lsearch $options expandsub ] >=0} {set ::ngc($hdl,expandsubroutine) 1} 3682 3683 # special options 3684 if {[lsearch $options nopathcheck ] >=0} {set ::ngc($hdl,nopathcheck) 1} 3685 3686 if $::ngc(opt,noauto) { 3687 set ::ngc($hdl,auto) 0 3688 } else { 3689 set ::ngc($hdl,auto) 1 3690 } 3691 # with image in frame there is not enough room so force noinput 3692 if !$::ngc(opt,noiframe) {set ::ngc(opt,noinput) 1} 3693 3694 set ::ngc(any,width,comment) 0 ;# field can be as long as reqd 3695 3696 set ::ngc($hdl,axis,page) [$::ngc(any,axis,parent) pages end] 3697 set page $::ngc($hdl,axis,page) ;# local 3698 3699 # if font has leading/trailing literal quotes, remove them 3700 if { [string first \" $font] == 0 \ 3701 && [string last \" $font] == [expr [string len $font] -1]} { 3702 set font [string range $font 1 [expr [string len $font] -2]] 3703 } 3704 if {"$font" != ""} {set ::ngc(any,font) $font} 3705 3706 # specific settings for embedding in axis tab: 3707 set ::ngc(any,aspect) horiz 3708 set ::ngc(any,width,varname) 0 3709 if {"$subfile" != ""} { 3710 # detect ini file specified as "" 3711 # this is a chooser page -- user can open new files 3712 if {"$subfile" == "\"\""} { 3713 set ::ngc($hdl,chooser) 1 3714 set ::ngc($hdl,fname,subfile) "" 3715 $::ngc(any,axis,parent) itemconfigure $page \ 3716 -text "[_ "Custom"]" \ 3717 -background $::ngc(any,color,custom) 3718 } else { 3719 if [info exists ::ngc($hdl,nopathcheck)] { 3720 # subfile must be a valid absolute path for this option 3721 # example: ttt uses /tmp directory specified with full path 3722 # to avoid creating persistent files 3723 # relying on purging of /tmp 3724 set ::ngc($hdl,fname,subfile) $subfile 3725 set ::ngc($hdl,dir) [file dirname $subfile] 3726 } else { 3727 set ::ngc($hdl,fname,subfile) [::ngcgui::pathto $subfile] 3728 set ::ngc($hdl,dir) [file dirname $::ngc($hdl,fname,subfile)] 3729 } 3730 } 3731 } 3732 if {"$preamble" != ""} { 3733 set ::ngc($hdl,fname,preamble) [::ngcgui::pathto $preamble] 3734 } 3735 if {"$postamble" != ""} { 3736 set ::ngc($hdl,fname,postamble) [::ngcgui::pathto $postamble] 3737 } 3738 3739 set w [::ngcgui::gui $hdl create $f.ngc_gui] 3740 3741 if {"$w" == ""} { 3742 puts stdout "[_ "Problem creating page"] <$hdl> <$f>" 3743 } else { 3744 pack $w -side top -fill none -expand 1 -anchor nw 3745 } 3746 # package require Linuxcnc ;# needs linuxcnc v2.5.x, segfaults linuxcnc v2.4.x 3747 # just invoking emc_init works with v2.4 and v2.5 3748 if [catch {emc_init} msg] { 3749 puts "embed_in_axis_tab: [_ "entrykeybindings not available"] <$msg>" 3750 } 3751 lappend ::ngc(embed,pages) $page 3752 updatepage 3753 3754 return $hdl 3755 } ;# embed_in_axis_tab 3756 3757 proc ::ngcgui::set_path {} { 3758 # set ::ngc(any,paths) on first use: 3759 if ![info exists ::ngc(any,paths)] { 3760 # expect single item, so take end item in list: 3761 set ::ngc(any,paths) [file normalize \ 3762 [lindex [inifindall DISPLAY PROGRAM_PREFIX] end]] 3763 set tmp [lindex [inifindall RS274NGC SUBROUTINE_PATH] end] 3764 foreach p [split $tmp ":"] {lappend ::ngc(any,paths) "$p"} 3765 } 3766 } ;# get_path 3767 3768 proc ::ngcgui::pathto {fname {mode info}} { 3769 # for embedded usage, find configuration file using a search path 3770 set fname [string trim $fname] 3771 if {"$fname" == ""} {return ""} 3772 3773 set_path ;# if not set, will set 3774 3775 if { [string first "/" $fname] == 0 3776 || [string first "~" $fname] == 0 3777 || [string first "." $fname] == 0 3778 } { 3779 if [file exists $fname] { 3780 # expected usage: spcecify search path [RS274NGC]SUBROUTINE_PATH 3781 # and: specify [DISPLAY]NGCGUI_SUBFILE as a file name only 3782 # 3783 # future: maybe it should be an error to use an absolute path 3784 # since the interpreter may not find the file 3785 # for now: only use a file if it is in search path 3786 set foundabsolute "$fname" 3787 set fname [file tail $fname] ;# to test if it is in search path 3788 } 3789 } 3790 foreach path $::ngc(any,paths) { 3791 set f [file join $path $fname] 3792 if {[info exists foundinpath] && [file exists $f]} { 3793 puts stdout "::ngcgui::pathto: [_ "Found multiple matches for"] <$fname>" 3794 puts stdout "[_ "using path"]: $::ngc(any,paths)" 3795 } 3796 if {![info exists foundinpath] && [file exists $f]} {set foundinpath $f} 3797 } 3798 3799 if [info exists foundinpath] { 3800 if { [info exists foundabsolute] \ 3801 && [file normalize $foundinpath] != [file normalize $foundabsolute] } { 3802 puts "\nngcgui [_ "Warning"]:" 3803 puts "[_ "File absolute path specifier conflicts with searchpath result"]" 3804 puts " [_ "Absolute Specifier"]: $foundabsolute" 3805 puts " [_ "Using Search Result"]: $foundinpath" 3806 puts "" 3807 } 3808 return "$foundinpath" 3809 } else { 3810 set title "[_ "File not in Search Path"]" 3811 3812 set msg "<$fname> [_ "Must be in search path"]\n" 3813 if {[info exists foundabsolute]} { 3814 set msg "$msg\n[_ "(File found -- not in search path)"]" 3815 } 3816 set msg "$msg\n[_ "Current directory"]:\n[pwd]" 3817 set msg "$msg\n\n[_ "Search path"]:\n" 3818 set i 1 3819 foreach p $::ngc(any,paths) { 3820 set msg "$msg\n$i $p" 3821 set fullp [file normalize $p] 3822 if {"$p" != "$fullp"} { 3823 set msg "$msg\n== $fullp" 3824 } 3825 incr i 3826 } 3827 set msg "$msg\n\n[_ "Check setting for"]: \[RS274NGC\]SUBROUTINE_PATH" 3828 set msg "$msg\n[_ "in ini file"]:\n$::emcini" 3829 set msg "$msg\n\n[_ "(Restart required after fixing ini file)"]" 3830 switch $mode { 3831 info { 3832 set answer [tk_dialog .notfound \ 3833 "$title"\ 3834 "$msg"\ 3835 warning -1 \ 3836 "OK"] 3837 set answer 0 ;# continue with warning 3838 } 3839 default { 3840 set answer [tk_dialog .notfound \ 3841 "$title"\ 3842 "$msg" \ 3843 error 0 \ 3844 "[_ "Try to Continue"]" "[_ "Exit"]" 3845 ] 3846 } 3847 } 3848 if $answer {return \ 3849 -code error "[_ "Ngcgui Configuration File Not Found"] <$fname>" 3850 } 3851 if ![info exists foundabsolute] {set foundabsolute ""} 3852 return "$foundabsolute" ;# try to continue 3853 } 3854 } ;# pathto 3855 3856 proc ::ngcgui::check_path filename { 3857 if [info exists ::ngc(embed,axis)] { 3858 pathto [file tail $filename] info 3859 } 3860 return 3861 } ;# check_path 3862 3863 proc ::ngcgui::raiselastpage {} { 3864 $::ngc(any,axis,parent) raise $::ngc($::ngc(embed,hdl),axis,page) 3865 } ;# raiselastpage 3866 3867 proc ::ngcgui::position {top} { 3868 set geo [wm geometry $top] 3869 return [string range $geo [string first + $geo] end] 3870 } ;# position 3871 3872 proc ::ngcgui::pagecreate {hdl} { 3873 #puts "n:pagecreate-$hdl" 3874 return 1 3875 } ;# pagecreate 3876 3877 proc ::ngcgui::pageraise {hdl} { 3878 #puts "n:pageraise-$hdl" 3879 set ::ngc($hdl,img,status) raised 3880 if {"$::ngc($hdl,fname,subfile)" != ""} { 3881 new_image $hdl $::ngc($hdl,fname,subfile) 3882 } 3883 return 1 3884 } ;# pageraise 3885 3886 proc ::ngcgui::pageleave {hdl} { 3887 #puts "n:pageleave-$hdl" 3888 set ::ngc($hdl,img,position) [position $::ngc($hdl,img,top)] 3889 wm withdraw $::ngc($hdl,img,top) 3890 return 1 ;# important: permission to leave 3891 } ;# pageleave 3892 3893 proc ::ngcgui::image_init {hdl} { 3894 set ::ngc($hdl,img,status) new 3895 if [info exists ::ngc(embed,axis)] { 3896 set ::ngc($hdl,img,top) .$::ngc(any,app)-$hdl 3897 } else { 3898 set ::ngc($hdl,img,top) .$::ngc(any,app) 3899 } 3900 if [winfo exists $::ngc($hdl,img,top)] return 3901 wm withdraw [toplevel $::ngc($hdl,img,top)] 3902 wm protocol $::ngc($hdl,img,top) WM_DELETE_WINDOW \ 3903 [list wm withdraw $::ngc($hdl,img,top)] 3904 3905 if {$::ngc(opt,noinput) && !$::ngc($hdl,chooser)} { 3906 pack forget $::ngc($hdl,iframe) ;# wI remove the Input frame 3907 } 3908 if { (!$::ngc(opt,noiframe) && !$::ngc($hdl,chooser) )\ 3909 || (!$::ngc(opt,noiframe) && $::ngc($hdl,standalone) )\ 3910 } { 3911 # use a frame for image 3912 set p [winfo parent $::ngc($hdl,iframe)] 3913 set w $p.[qid] ;# name of frame 3914 set ::ngc($hdl,img,widget) [image_widget $hdl $w] 3915 set ::ngc($hdl,img,type) frame 3916 } else { 3917 # use a toplevel for image 3918 set ::ngc($hdl,img,widget) [image_widget $hdl $::ngc($hdl,img,top).i] 3919 set ::ngc($hdl,img,type) toplevel 3920 } 3921 # note: new_image packs $::ngc($hdl,img,widget) 3922 } ;# image_init 3923 3924 proc ::ngcgui::image_widget {hdl f} { 3925 # f is name of a frame, it should not exist at call, caller packs 3926 # png, pgm,ppm etc support 3927 if [catch {package require Img} msg] { 3928 tk_dialog .img \ 3929 "[_ "Missing Tcl Package Img"] " \ 3930 "[_ "Please install Img"]:\n $ sudo apt-get install libtk-img" \ 3931 "" 0 \ 3932 "ok" 3933 exit 3934 } 3935 if {[winfo exists $f]} {return -code error "image_widget <$w> exists"} 3936 frame $f ;# caller packs 3937 3938 set fimg [frame $f.fimg -relief groove -borderwidth 2] 3939 pack $fimg -side top -expand 1 -fill both 3940 3941 set ::ngc($hdl,img,canvas) [canvas $fimg.canvas -bg darkgray ] 3942 pack $::ngc($hdl,img,canvas) -side left -expand 1 -fill both 3943 return $f 3944 } ;# image_widget 3945 3946 proc ::ngcgui::new_image {hdl ngcfilename} { 3947 set idx [string first .ngc $ngcfilename] 3948 if {$idx < 0} { set idx [string first .gcmc $ngcfilename]} 3949 if {$idx < 0} { return -code error \ 3950 "new_image: unexpected filename: <$ngcfilename>"} 3951 3952 set filestart [string range $ngcfilename 0 $idx] 3953 foreach suffix {png gif jpg pgm} { 3954 set f ${filestart}$suffix 3955 if [file readable $f] { 3956 set ifilename $f 3957 break 3958 } 3959 } 3960 if ![info exists ifilename] { 3961 catch {unset ::ngc($hdl,img,filename)} 3962 catch {pack forget $::ngc($hdl,img,widget)} ;# standalone 3963 catch {wm withdraw $::ngc($hdl,img,top)} ;# needed for standalone 3964 return ;# silently continue 3965 } 3966 3967 set doimage 0 3968 if ![info exists ::ngc($hdl,img,filename)] { 3969 set ::ngc($hdl,img,status) first 3970 set doimage 1 3971 } else { 3972 if {"$::ngc($hdl,img,filename)" != "$ifilename"} { 3973 set ::ngc($hdl,img,position) [position $::ngc($hdl,img,top)] 3974 set ::ngc($hdl,img,status) new 3975 set doimage 1 3976 } 3977 } 3978 3979 if {$doimage} { 3980 # first time for this file for this hdl 3981 set ::ngc($hdl,img,filename) $ifilename 3982 pack forget $::ngc($hdl,img,widget) 3983 set tmpimage [image create photo -file $ifilename] 3984 set ct 0 3985 set sw [expr [image width $tmpimage] / $::ngc(any,img,width,max) + 1] 3986 set sh [expr [image height $tmpimage] / $::ngc(any,img,height,max) + 1] 3987 set subsample $sw 3988 if {$sh > $sw} {set subsample $sh} 3989 set ::ngc($hdl,img,image) [image create photo] 3990 $::ngc($hdl,img,image) copy $tmpimage -subsample $subsample -shrink 3991 3992 set width [image width $::ngc($hdl,img,image)] 3993 set height [image height $::ngc($hdl,img,image)] 3994 # convenience only: 3995 set ::ngc($hdl,img,orig,size) [image width $tmpimage]x[image height $tmpimage] 3996 set ::ngc($hdl,img,sampled,size) ${width}x${height} 3997 3998 $::ngc($hdl,img,canvas) delete all 3999 $::ngc($hdl,img,canvas) configure -width $width -height $height 4000 $::ngc($hdl,img,canvas) create image [expr $width/2] [expr $height/2]\ 4001 -anchor center \ 4002 -image $::ngc($hdl,img,image) 4003 recursive_bind_controlkeys $hdl $::ngc($hdl,img,top) 4004 pack $::ngc($hdl,img,widget) 4005 } 4006 4007 # restore the image widget toplevel if applicable 4008 if {"$::ngc($hdl,img,type)" == "toplevel"} { 4009 switch $::ngc($hdl,img,status) { 4010 first { 4011 if [info exists ::ngc($hdl,img,position)] { 4012 wmrestore $hdl 4013 } else { 4014 wmcenter $::ngc($hdl,img,top) 4015 } 4016 if { ![info exists ::ngc(embed,axis)] \ 4017 || [$::ngc(any,axis,parent) raise] == $::ngc($hdl,axis,page)} { 4018 set ::ngc($hdl,img,status) raised ;# need for standalone 4019 } else { 4020 wm withdraw $::ngc($hdl,img,top) 4021 } 4022 } 4023 new - 4024 raised { wmrestore $hdl } 4025 } 4026 wm resizable $::ngc($hdl,img,top) 0 0 4027 wm title $::ngc($hdl,img,top) [trimsuffix $::ngc($hdl,dname,subfile)] 4028 } 4029 } ;# new_image 4030 4031 proc ::ngcgui::wmrestore {hdl} { 4032 set w $::ngc($hdl,img,top) 4033 wm deiconify $w 4034 if [catch { 4035 if [info exists ::ngc($hdl,img,position)] { 4036 wm geometry $w $::ngc($hdl,img,position) 4037 } 4038 } msg] { 4039 puts stdout "wmrestore: unexpected<$msg>" 4040 } 4041 } ;# wmrestore 4042 4043 # configure standalone usage: 4044 proc ::ngcgui::standalone_ngcgui {args} { 4045 # setup ::ngcgui::control() with defaults 4046 set hdl 0 4047 ::ngcgui::preset $hdl ::ngcgui::control 4048 package require Tk 4049 # configure for standalone usage 4050 # map dot (.) to underline (_) to preclude window naming errors: 4051 set ::ngcgui::control(any,app) [string map {. _} [file tail $::argv0]] 4052 4053 while {[llength $::argv] >0} { 4054 # beware wish handling of reserved cmdline arguments 4055 # to use -h: use -- -h, 4056 # lreplace shifts argv for no. of items for each iteration 4057 switch -- [lindex $::argv 0] { 4058 --noiframe {set ::ngc(opt,noiframe) 1 4059 set ::argv [lreplace $::argv 0 0] 4060 } 4061 -h - -? - 4062 --help {::ngcgui::usage $hdl ::ngcgui::control;exit 0} 4063 --horiz - 4064 -horiz {set ::ngcgui::control(any,aspect) horiz 4065 set ::argv [lreplace $::argv 0 0] 4066 } 4067 --vert - 4068 -vert {set ::ngcgui::control(any,aspect) vert 4069 set ::argv [lreplace $::argv 0 0] 4070 } 4071 -q - 4072 --quiet { 4073 set ::ngcgui::control($hdl,verbose) 0 4074 set ::argv [lreplace $::argv 0 0] 4075 } 4076 --font - 4077 -font {set ::ngcgui::control(any,font) [lindex $::argv 1] 4078 set ::argv [lreplace $::argv 0 1] 4079 } 4080 --vwidth {set ::ngcgui::control(any,width,varname) [lindex $::argv 1] 4081 set ::argv [lreplace $::argv 0 1] 4082 } 4083 --cwidth {set ::ngcgui::control(any,width,comment) [lindex $::argv 1] 4084 set ::argv [lreplace $::argv 0 1] 4085 } 4086 -N - 4087 --nom2 {set ::ngcgui::control(any,nom2) 0 4088 set ::argv [lreplace $::argv 0 0] 4089 } 4090 -S - 4091 --subfile {set ::ngcgui::control($hdl,fname,subfile) [lindex $::argv 1] 4092 set ::argv [lreplace $::argv 0 1] 4093 } 4094 -p - 4095 --preamble {set ::ngcgui::control($hdl,fname,preamble) \ 4096 [lindex $::argv 1] 4097 set ::argv [lreplace $::argv 0 1] 4098 } 4099 -P - 4100 --postamble {set ::ngcgui::control($hdl,fname,postamble) \ 4101 [lindex $::argv 1] 4102 set ::argv [lreplace $::argv 0 1] 4103 } 4104 -o - 4105 --output {set ::ngcgui::control($hdl,fname,outfile) [lindex $::argv 1] 4106 set ::argv [lreplace $::argv 0 1] 4107 } 4108 -D - 4109 --dir { 4110 # -D allows dir specification with no filenames 4111 set ans [lindex $::argv 1] 4112 if [file isdirectory $ans] { 4113 set ::ngcgui::control($hdl,dir) $ans 4114 } else { 4115 set ::ngcgui::control($hdl,dir) [file dirname $ans] 4116 } 4117 set ::argv [lreplace $::argv 0 1] 4118 } 4119 -a - 4120 --autosend {set ::ngcgui::control($hdl,auto) 1 4121 set ::ngcgui::control($hdl,fname,autosend) \ 4122 [lindex $::argv 1] 4123 set ::argv [lreplace $::argv 0 1] 4124 } 4125 --noautosend - 4126 --noauto {set ::ngcgui::control($hdl,auto) 0 4127 set ::argv [lreplace $::argv 0 0] 4128 } 4129 4130 -i - 4131 --ini* { 4132 set filename [lindex $::argv 1] 4133 if ![file readable $filename] { 4134 puts "[_ "ini file"]: <$filename> not readable" 4135 exit 1 4136 } 4137 set ::argv [lreplace $::argv 0 1] 4138 set dir [file normalize [file dirname $filename]] 4139 set pdir [::ngcgui::inifind $filename \ 4140 DISPLAY PROGRAM_PREFIX] 4141 set pdir [file normalize $pdir] 4142 if {"$pdir" == ""} { 4143 puts "\[DISPLAY\]PROGRAM_PREFIX [_ "not found"] <$filename>" 4144 exit 1 4145 } 4146 set ptype [file pathtype $pdir] 4147 switch $ptype { 4148 relative {set inidir [file join $dir $pdir]} 4149 absolute {set inidir [file normalize $pdir]} 4150 default {puts "unhandled pathtype for $pdir <$ptype>" 4151 exit 1 4152 } 4153 } 4154 set ::ngcgui::control($hdl,dir) $inidir 4155 } 4156 default {break} 4157 } 4158 } 4159 if {"$::ngcgui::control(any,font)" == ""} { 4160 set ::ngcgui::control(any,font) small 4161 } 4162 switch -- $::ngcgui::control(any,font) { 4163 small {set ::ngcgui::control(any,font) {Helvetica -10 bold}} 4164 big {set ::ngcgui::control(any,font) {Helvetica -16 bold}} 4165 default {} 4166 } 4167 # ::ngcgui::control() specifies args 4168 eval ::ngcgui::top $hdl ::ngcgui::control 4169 tkwait variable ::ngcgui::finis 4170 exit 0 4171 } ;# standalone_ngcgui 4172 4173 if {[info exists ::argv0] && [info script] == $::argv0} ::ngcgui::standalone_ngcgui 4174