2 #----- get startup directory and name -----------------------------------------
3 set cmd_name
[file tail
$argv0]
4 set cmd_dir
[file dirname
$argv0]
5 if {![file exists
$argv0] ||
[file isdirectory
$argv0]} {
6 if {$tcl_platform(platform
) == "windows"} {
11 foreach i
[split $env(PATH
) $sep] {
13 set i
[join [split $i \\] /]
15 if {[file exists
$i/$cmd_name] && ![file isdirectory
$i/$cmd_name]} {
22 if ![catch {cd $cmd_dir}] {
26 if {$tcl_platform(platform
) == "windows"} {
27 set cmd_dir
[file attributes
$cmd_dir -shortname]
31 #----- set path to tcl scripts ------------------------------------------------
32 if {[info exists env
(GSS_DIR
)]} {
33 set auto_path
"$env(GSS_DIR)/lib/gui_script $cmd_dir $cmd_dir/../lib/gui_script . $auto_path"
40 proc error_exit
{msg
} {
42 tk_dialog .
error Error
$msg error 0 Exit
46 if [catch {do_config
-win} msg
] {error_exit
$msg}
49 #---- set global data structure -----------------------------------------------
58 #----- create main window -----------------------------------------------------
59 wm title .
"GSS UI 0.1"
61 wm protocol . WM_DELETE_WINDOW save_quit
68 #----- create menu -------------------------------------------------------------
69 menubar_create
{File Edit Run Help
}
71 #----- file menu ---------------------------------------------------------------
72 set m
[menubar_get File
]
73 $m add command
-label "New" -command new_cmd_file
74 $m add command
-label "Open ..." -command open_cmd_file
76 $m add command
-label "Save ..." -command save_cmd_file
77 $m add command
-label "Save As..." -command saveas_cmd_file
79 $m add command
-label "Quit" -command save_quit
82 proc new_cmd_file
{} {
86 $editor delete
1.0 end
87 $output delete
1.0 end
88 set ProgData
(cmd_file_name
) ""
89 $editor edit modified
0
90 set ProgData
(change
) 0
94 proc open_cmd_file
{} {
97 $editor delete
1.0 end
99 {{GSS Input Files
} {.inp .txt
}}
103 set ProgData
(cmd_file_name
) [FileOpen
"Open GSS Input File" "" .
$FileList]
105 if {![catch {open $ProgData(cmd_file_name
) r
} fd
]} {
106 $editor fastinsert end
[read $fd]
109 $editor highlight
1.0 end
110 $editor edit modified
0
111 set ProgData
(change
) 0
112 cd [file dirname
$ProgData(cmd_file_name
)]
115 proc save_cmd_file
{} {
118 if {$ProgData(cmd_file_name
) == ""} {
119 set ProgData
(cmd_file_name
) [FileSave
"Save GSS Input File" "" .
\
120 {{{GSS Input Files
} {.inp
}} {{All Files
} {*}}} inp
]
121 if {$ProgData(cmd_file_name
) == ""} return
123 set fd
[open $ProgData(cmd_file_name
) w
+]
124 puts $fd [string trimright
[$editor get
1.0 end
]]
126 $editor edit modified
0
127 set ProgData
(change
) 0
128 cd [file dirname
$ProgData(cmd_file_name
)]
131 proc saveas_cmd_file
{} {
134 set ProgData
(cmd_file_name
) [FileSave
"Save As GSS Input File" "" .
\
135 {{{GSS Input Files
} {.inp
}} {{All Files
} {*}}} inp
]
136 if {$ProgData(cmd_file_name
) == ""} return
137 set fd
[open $ProgData(cmd_file_name
) w
+]
138 puts $fd [string trimright
[$editor get
1.0 end
]]
140 $editor edit modified
0
141 set ProgData
(change
) 0
142 cd [file dirname
$ProgData(cmd_file_name
)]
148 if {[$editor edit modified
]} then
{
149 set save
[dialog .quitsave
-1 -1 Quit
\
150 "Save the command file?" question
0 Yes No Cancel
]
151 if {$save == 2} {return 0}
152 if {$save == 0} {save_cmd_file
}
158 #----- edit menu ---------------------------------------------------------------
159 set m
[menubar_get Edit
]
160 $m add command
-label "Undo" -underline 0 -accelerator {Ctrl-z
} -command edit_undo
161 $m add command
-label "Redo" -underline 0 -accelerator {Ctrl-y
} -command edit_redo
163 $m add command
-label "Cut" -underline 0 -accelerator {Ctrl-x
} -command edit_cut
164 $m add command
-label "Copy" -underline 0 -accelerator {Ctrl-c
} -command edit_copy
165 $m add command
-label "Paste" -underline 0 -accelerator {Ctrl-v
} -command edit_paste
166 $m add command
-label "Select All" -underline 0 -command edit_select_all
168 #$m add command -label "Find/Replace" -underline 0 -command edit_find
173 catch {$editor edit undo
} msg
175 set ProgData
(change
) [$editor edit modified
]
176 $editor highlight
1.0 end
182 catch {$editor edit redo
} msg
184 set ProgData
(change
) [$editor edit modified
]
185 $editor highlight
1.0 end
192 set ProgData
(change
) [$editor edit modified
]
193 $editor highlight
1.0 end
205 set ProgData
(change
) [$editor edit modified
]
206 $editor highlight
1.0 end
209 proc edit_select_all
{} {
211 $editor tag add sel
1.0 end
215 #----- run menu ---------------------------------------------------------------
216 set m
[menubar_get Run
]
217 $m add command
-label "Start" -underline 0 -command exe_cmd_file
218 $m add command
-label "Stop" -underline 0 -state disabled
-command exe_kill
220 proc tk_exec_fileevent
{id
} {
226 if {[eof $tk_exec_pipe($id)]} {
227 fileevent $tk_exec_pipe($id) readable
""
228 set tk_exec_cond
($id) 1
231 #append tk_exec_data($id) [gets $tk_exec_pipe($id)]
232 #append tk_exec_data($id) "\n"
233 set data
[gets $tk_exec_pipe($id)]
235 $output insert end
$data
239 proc tk_exec
{prog
} {
247 if {![info exists tk_exec_id
]} {
255 for {set i
0} {$i < [llength $prog]} {incr i
} {
256 set arg
[lindex $prog $i]
257 switch -glob -- $arg {
266 error "unknown option: $arg"
269 # the glob should be on *, but the wiki reformats
277 set prog
[lrange $prog $i end
]
280 if {$tcl_platform(platform
) == "windows" && \
281 [info exists env
(COMSPEC
)]} {
282 set prog
[linsert $prog 0 $env(COMSPEC
) "/c"]
286 #set pipe [open "| $prog" r]
287 if { [catch {open "| $prog 2>@stdout"} FILEHANDLE
] } {
288 return "Can't open pipe for '$args'"
292 set tk_exec_pipe
($tk_exec_id) $pipe
293 set tk_exec_data
($tk_exec_id) ""
294 set tk_exec_cond
($tk_exec_id) 0
296 fconfigure $pipe -blocking 0 -buffering none
298 fileevent $pipe readable
"tk_exec_fileevent $tk_exec_id"
300 vwait tk_exec_cond
($tk_exec_id)
303 set data
$tk_exec_data($tk_exec_id)
305 set data
[string trimright
$tk_exec_data($tk_exec_id) \n]
308 unset tk_exec_pipe
($tk_exec_id)
309 unset tk_exec_data
($tk_exec_id)
310 unset tk_exec_cond
($tk_exec_id)
312 if {[catch {close $pipe} err
]} {
313 error "pipe error: $err"
318 proc bgExec
{prog readHandler pCount
{timeout
0} {toExit
""}} {
320 upvar #0 $pCount myCount
321 if {![string length
[auto_execok [lindex $prog 0]]]} {
322 # perhaps additional checking with [file executable]
323 return -code error "error: could not locate '$prog'"
325 set myCount
[expr {[info exists myCount
]?
[incr myCount
]:1}]
326 set redir
[expr {[info patchlevel
] >= "8.4.7"?
{2>@1}:{2>@stdout
}}]
327 if [catch {open "| $prog $redir" r
} pH
] {
328 return -code error "error: could not start '$prog' ($pH)"
330 set exe_pid
[pid $pH]
331 fconfigure $pH -blocking 0; # -buffering line (does it really matter?!)
332 set tID
[expr {$timeout?
[after $timeout [list bgExecTimeout
$pH $pCount $toExit]]:{}}]
333 fileevent $pH readable
[list bgExecGenericHandler
$pH $pCount $readHandler $tID]
337 proc bgExecGenericHandler
{chan pCount readHandler tID
} {
338 upvar #0 $pCount myCount
340 after cancel
$tID; # empty tID is ignored
341 catch {close $chan}; # automatically deregisters the fileevent handler
342 # (see Practical Programming in Tcl an Tk, page 229)
344 } elseif
{[gets $chan line
] != -1} {
345 # we are not blocked (manpage gets, Practical... page.233)
346 lappend readHandler
$line
347 if {[catch {uplevel $readHandler} rc
]} {
348 # user-readHandler ended with error -> terminate the processing
356 proc bgExecTimeout
{chan pCount toExit
} {
357 upvar #0 $pCount myCount
358 if {[string length
$toExit]} {
359 catch {uplevel [list $toExit [pid $chan]]}
365 proc exe_cmd_record
{data
} {
368 $output insert end
$data
372 proc exe_cmd_file
{} {
377 global .toolbar.but.kill
379 .toolbar.but.run.kill configure
-state normal
382 menubar_state Run normal
$i
384 if {[$editor edit modified
]==1} then
{
385 set save
[dialog .runsave
-1 -1 Quit
\
386 "Save the command file?" question
0 Yes No Cancel
]
387 if {$save == 2} {return 0}
388 if {$save == 0} {save_cmd_file
}
390 if {$tcl_platform(platform
) == "windows" } {
391 set cmd
[file nativename
"$::env(GSS_DIR)\\bin\\gss"]
392 set arg
[file tail
$ProgData(cmd_file_name
)]
394 set cmd
"$::env(GSS_DIR)/bin/gss"
395 set arg
[file tail
$ProgData(cmd_file_name
)]
397 $output delete
1.0 end
398 bgExec
"gss $arg " exe_cmd_record pCount
400 # if {$tcl_platform(platform) == "windows" } {
401 # tk_exec "gss $ProgData(cmd_file_name)"
403 # bgExec "gss $ProgData(cmd_file_name) " exe_cmd_record pCount
412 exec kill
-s SIGINT
$exe_pid
413 $output insert end
"Terminated by signal SIGINT \n"
414 # disable kill buttom
415 .toolbar.but.run.kill configure
-state disabled
417 menubar_state Run disabled
$i
423 #----- help menu --------------------------------------------------------------
424 set m
[menubar_get Help
]
425 $m add command
-label "About..." -underline 0 -command do_about
429 dialog .about
-1 -1 "About GSS GUI" \
431 A GUI shell
for GSS code.
434 Email
: gdiso
@ustc.edu
} \
440 #---------- toolbar ------------------------------------------------------------
442 pack .toolbar
-side top
-pady 2 -fill x
444 set tbbut
[frame .toolbar.but
]
445 pack $tbbut -side left
447 set b
[frame $tbbut.
file]
448 pack $b -side left
-padx 5
450 image create
photo img_new
-data {\
451 R0lGODlhEAAQAIMAAPwCBFRShPz6
/PT2
/Oz2
/OTu
/MzK
/OTy
/Nzu
/NTq
/NTm
/Mzm
/Mzi
/MTi
/Lze
/Lza
/C
\
452 H5BAEAAAAALAAAAAAQABAAAARcEMhJKw04YyuDGCBBbFYQikVgBKV4HEUqrFVwEDCCaHVxIAVEQqGgXYK6
\
453 hHJhnAR0iuFiwWh2hokptWEFBBRaRqPh6Aa044ejzLqIG4
+x42E22O
/3tlPD13P
+fhEAIf5oQ3JlYXRlZC
\
454 BieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRz
\
455 IHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw
==}
457 image create
photo img_open
-data {\
458 R0lGODlhEAAQAIMAAPwCBASCBMyaBPzynPz6nJxmBPzunPz2nPz
+nPzSBPzqnPzmnPzinPzenAAAAAAAAC
\
459 H5BAEAAAAALAAAAAAQABAAAARTEMhJq724hp1n8MDXeaJgYtsnDANhvkJRCcZxEEiOJDIlKLWDbtebCBaG
\
460 GmwZEzCQKxxCSgQ4Gb
/BbciTCBpOoFbX9X6fChYhUZYU3vB4cXTxRwAAIf5oQ3JlYXRlZCBieSBCTVBUb0
\
461 dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVk
\
462 Lg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw
==}
464 image create
photo img_save
-data {\
465 R0lGODlhEAAQAIQAAPwCBFRShGRmzPT6
/Oz2
/OTy
/Nzu
/NTm
/AQCBMTi
/Lze
/Mzm
/KzW
/NTq
/LTa
/AQCxO
\
466 Ti5Nze3Nza3MzOzLy
+xNTS1MTGxMzKzAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQ
\
467 ABAAAAVkICCOZCkGaKqqpxAMRFEYRx0gQfvGRZ0oKZ2MdlgogC6doVc8MgJJADRQaxidU13t8HMwnlGoa4
\
468 UShM2PtFp9fkAikomcQnm0IebKxGKp3
/MTF3R2OVICboB7foVSZGQmkCR
+IQAh
/mhDcmVhdGVkIGJ5IEJN
\
469 UFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZX
\
470 J2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
}
474 button $b.new
-relief flat
-image img_new
-takefocus 0 -command new_cmd_file
475 set_balloon
$b.new
"New File..."
477 button $b.
open -relief flat
-image img_open
-takefocus 0 -command open_cmd_file
478 set_balloon
$b.
open "Open File..."
480 button $b.save
-relief flat
-image img_save
-takefocus 0 -command save_cmd_file
481 set_balloon
$b.save
"Save File ..."
483 pack $b.new
$b.
open $b.save
-side left
486 set b
[frame $tbbut.run
]
487 pack $b -side left
-padx 5
489 image create
photo img_run
-data {\
490 R0lGODlhEAAQAIEAAAT
+BPz
+/ASCBAAAACH5BAEAAAAALAAAAAAQABAAAAIrRI6ZFuIPHYr0HXpjhpM3vAmh94m
\
491 fokgn2o3W5pqlCc60Zt8VnoMMqwD4CwAh
/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqS
\
492 BEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
}
494 image create
photo img_stop
-data {\
495 R0lGODlhEAAQAIUAAASC
/PR6fPyChPyGjPyOjPyKjPxydPy6vPzGzPzCxPy2vPymrLxOVPyurPyanPyOlPx6
\
496 fNRmZPwSFPyepPx2fPyipPx
+hPxaXPxSVLQyNPw2NPySlPz
+/Pz2
/Pze3PxCROQiJEQCBPweJPyytPzm7Pz6
/\
497 Pw2PPwuNMQGDEwCBPwaHPwmJPwOFPwmLPwCBPze5PwKDPzy9PyenPwGBKwCBPQCBLQCBFQGBJQGBLwKDLwGDA
\
498 AAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAabQIBwSCwWA4IBYVAwGIWCwwGBSCgWDKOi4SgUHgV
\
499 IwBAhSiYCSkUwLlgumMxQU7hsOAiMoePBfEAhQiJ
+GAkcIyQlFCYnKClCKissLSsTHB0YKhIuKIEALJsuKi8d
\
500 JQMuqJ1CMDAuGiQxGgIcMjMuNJ41qCsJH6gyBbaqQjSouqjIjkU2yM0oN084OTo6KDQ20E8AIdzd2t9EfkEAI
\
501 f5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGw
\
502 gcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw
==}
504 button $b.run
-relief flat
-image img_run
-takefocus 0 -command exe_cmd_file
505 set_balloon
$b.run
"Run GSS"
507 button $b.kill
-relief flat
-image img_stop
-takefocus 0 -command exe_kill
-state disabled
508 set_balloon
$b.kill
"Kill process"
510 pack $b.run
$b.kill
-side left
513 #---------- color text editor -------------------------------------------------
514 pack [frame .f_ctex
] -fill both
-expand 1
515 pack [scrollbar .f_ctex.s
-command {.f_ctex.t yview
}] -side right
-fill y
516 set editor
[ctext .f_ctex.t
-bg white
-fg black
-insertbackground red
-undo 1 \
517 -yscrollcommand {.f_ctex.s
set}]
518 pack $editor -pady 2 -fill both
-expand 1
521 #ctext::addHighlightClassForRegexp .f_ctex.t string black {=[ \t]*([a-zA-Z0-9\_][a-zA-Z0-9\.\_]*|\"[a-zA-Z0-9\.\_\ \-]*\")}
522 ctext
::addHighlightClassForRegexp .f_ctex.t number red
{=[ \t]*([+-]?
\d
+\.
\d
*([EeDd
][+-]?
\d
+)?|
[+-]?
\d
*\.
\d
+([EeDd
][+-]?
\d
+)?|
[+-]?
\d
+([EeDd
][+-]?
\d
+)|
[+-]?
\d
+)}
523 ctext
::addHighlightClassForRegexp .f_ctex.t bool DeepPink
{=[ \t]*(TRUE|FALSE|On|Off
)}
524 ctext
::addHighlightClassForRegexp .f_ctex.t equ black
{\=}
525 ctext
::addHighlightClassForRegexp .f_ctex.t keyword blue
\
526 {^
[ \t]*(SET|MESH|XMESH|YMESH|ELIMINATE|SPREAD|REGION|SEGMENT|REFINE|PROFILE|
\
527 ISOURCE|VSOURCE|BOUNDARY|CONTACT|PMIS|ATTACH|METHOD|SOLVE|IMPORT|EXPORT|
\
528 PLOTVTK|PLOT|PLOTMESH|PROBE|PHOTOGEN|END
)}
529 ctext
::addHighlightClassForRegexp .f_ctex.t comment
#007f7f {#[^\n\r]*}
531 bindtags $editor "Ctext $editor all ."
533 bind $editor <KeyRelease
> key_release
534 bind $editor <ButtonRelease
> button_release
537 bind Text
<<Copy
>> {}
538 bind Text
<<Paste
>> {}
539 bind Text
<<Undo
>> {}
540 bind Text
<<Redo
>> {}
542 bind $editor <Control-x
> {edit_cut
}
543 bind $editor <Control-c
> {edit_copy
}
544 bind $editor <Control-v
> {edit_paste
}
545 bind $editor <Control-z
> {edit_undo
}
546 bind $editor <Control-y
> {edit_redo
}
548 proc button_release
{} {
551 set ProgData
(pos
) [$editor index insert
]
554 proc key_release
{} {
557 set ProgData
(change
) [$editor edit modified
]
558 set ProgData
(pos
) [$editor index insert
]
561 bind $editor <Button-3
> {tk_popup [menubar_get Edit
] [winfo pointerx .
] [winfo pointery .
]}
563 #---------- text window for log -----------------------------------------------
564 FrameCreate .f_out
-text "GSS Log Message" -font $Font(bold
) -pady 0
565 pack .f_out
-pady 2 -fill both
-expand 1
566 set outwin
[FrameGet .f_out
]
568 pack [frame $outwin.f
] -fill both
-expand 1
569 pack [scrollbar $outwin.f.s
-command {$outwin.f.t yview
}] -side right
-fill y
570 set output
[text $outwin.f.t
-bg white
-fg black
-height 4 \
571 -yscrollcommand {$outwin.f.s
set}]
572 pack $output -pady 2 -fill both
-expand 1
576 #---------- status bar ----------------------------------------------
577 frame .status
-borderwidth 1 -relief flat
578 pack .status
-padx 1 -side bottom
-fill x
579 label .status.l1
-text "" -relief sunken
-borderwidth 1 -width 10
580 label .status.l2
-text "" -relief sunken
-borderwidth 1
581 label .status.filler
-text "" -relief sunken
-borderwidth 1
582 label .status.l3
-text "" -relief sunken
-borderwidth 1 -width 13
584 canvas .status.c
-relief sunken
-borderwidth 0 -width 20 -height 16 -cursor bottom_right_corner
586 pack .status.l1 .status.l3 .status.l2
-side left
-padx 1
587 pack .status.filler
-side left
-fill x
-expand yes
-padx 1
588 pack .status.c
-padx 1 -side left
591 .status.c create line
19 0 1 18 -fill white
592 .status.c create line
19 1 2 18 -fill gray70
593 .status.c create line
19 2 3 18 -fill gray70
594 .status.c create line
19 6 7 18 -fill white
595 .status.c create line
19 7 8 18 -fill gray70
596 .status.c create line
19 8 9 18 -fill gray70
597 .status.c create line
19 12 13 18 -fill white
598 .status.c create line
19 13 14 18 -fill gray70
600 proc status_change
{args
} {
605 .status.l2 configure
-text " Filename: $ProgData(cmd_file_name) "
607 if {$ProgData(change
) == 0} {
608 .status.l1 configure
-foreground blue
-text "Unchanged"
610 .status.l1 configure
-foreground red
-text "Changed"
613 .status.l3 configure
-text "Line: $ProgData(pos)"
616 trace variable ProgData w status_change
618 #---------- produce cmd line arg ----------------------------------------------
620 set file [lindex $argv [expr $argc - 1]]
621 if {[string index
$file 0] != "-" && [file exists
$file]} {
622 set ProgData
(cmd_file_name
) $file
623 if {![catch {open $ProgData(cmd_file_name
) r
} fd
]} {
624 $editor fastinsert end
[read $fd]
627 $editor highlight
1.0 end
628 $editor edit modified
0
629 set ProgData
(change
) 0
630 cd [file dirname
$ProgData(cmd_file_name
)]
638 #---------- images ------------------------------------------------------------
639 image create
photo img_about
-file $env(GSS_DIR
)/lib
/gss.logo.gif