Changeset 138 for trunk/gsascmds.tcl

Timestamp:

Dec 4, 2009 5:01:02 PM (13 years ago)

Author:

toby

Message:

# on 2000/05/17 18:38:55, toby did:
add force to rename
add rundisagl for disagl results in separate window
add pleasewait & donewait

File:

• trunk/gsascmds.tcl (modified) (2 diffs, 3 props)

trunk/gsascmds.tcl

@@ -737 +737 @@
         close $in
         close $out
-        file rename $file $oldname
-        file rename $tmpname $file
+        file rename -force $file $oldname
+        file rename -force $tmpname $file
     } errmsg] {
         tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
@@ -1595 +1595 @@
     afterputontop
 }
+
+# optionally run disagl as a windowless process, w/results in a separate window
+proc rundisagl {} {
+    global expgui txtvw tcl_version tcl_platform
+    if {$expgui(disaglSeparateBox)} {
+        set root [file root $expgui(expfile)] 
+        catch {file delete -force $root.tmp}
+        catch {file rename -force $root.LST $root.OLS}
+        # PSW reports this does not happen right away on windows
+        set i 0
+        while {$i < 5 && [file exists $root.LST]} {
+            # debug code
+            catch {console show}
+            puts "try $i"
+            # end debug code
+            after 100
+            incr i
+        }
+        #run the program
+        pleasewait "Running DISAGL"     
+        # create an empty input file
+        close [open disagl.inp w]
+        catch {exec [file join $expgui(gsasexe) disagl] \
+                [file tail $root] < disagl.inp > disagl.out}
+        catch {file rename -force $root.LST $root.tmp}
+        catch {file delete -force disagl.inp disagl.out}
+        catch {file rename -force $root.OLS $root.LST}
+        donewait
+        # open a new window
+        catch {toplevel .disagl}
+        catch {eval grid forget [grid slaves .disagl]}
+        text .disagl.txt -width 100 -wrap none \
+                -yscrollcommand ".disagl.yscroll set" \
+                -xscrollcommand ".disagl.xscroll set" 
+        scrollbar .disagl.yscroll -command ".disagl.txt yview"
+        scrollbar .disagl.xscroll -command ".disagl.txt xview" -orient horizontal
+        grid .disagl.xscroll -column 0 -row 2 -sticky ew
+        grid .disagl.txt -column 0 -row 1 -sticky nsew
+        grid .disagl.yscroll -column 1 -row 1 -sticky ns
+        grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
+        grid columnconfig .disagl.f 2 -weight 1
+        grid [button .disagl.f.close -text "Close & Delete" \
+                -command "destroy .disagl; file delete $root.tmp"] \
+                -column 3 -row 0 -sticky e
+        grid [button .disagl.f.rename -text "Close & Save as .DIS" \
+                -command "destroy .disagl; file rename -force $root.tmp $root.DIS"] \
+                -column 4 -row 0 -sticky e
+        # allow font changes on the fly
+        if {$tcl_version >= 8.0} {
+            .disagl.txt config -font $txtvw(font)
+            set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
+            grid .disagl.f.font -column 1 -row 0 -sticky w
+            grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
+            $fontbut delete 0 end
+            foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
+                $fontbut add command -label "Courier $f" -font "Courier $f"\
+                        -command "set txtvw(font) \"Courier $f\"; \
+                        .disagl.txt config -font \$txtvw(font)"
+            }
+        }
+        
+        grid columnconfigure .disagl 1 -weight 1
+        grid rowconfigure .disagl 1 -weight 1
+        wm title .disagl "DISAGL results $expgui(expfile)"
+        wm iconname .disagl "DISAGL $root"
+        set in [open $root.tmp r]
+        .disagl.txt insert end [read $in]
+        close $in
+        bind all  {destroy .disagl}
+        bind .disagl  ".disagl.txt yview scroll -1 page"
+        bind .disagl  ".disagl.txt yview scroll 1 page"
+        bind .disagl  ".disagl.txt xview scroll 1 unit"
+        bind .disagl  ".disagl.txt xview scroll -1 unit"
+        bind .disagl  ".disagl.txt yview scroll -1 unit"
+        bind .disagl  ".disagl.txt yview scroll 1 unit"
+        bind .disagl  ".disagl.txt yview 0"
+        bind .disagl  ".disagl.txt yview end"
+        # don't disable in Win as this prevents the highlighting of selected text
+        if {$tcl_platform(platform) != "windows"} {
+            .disagl.txt config -state disabled
+        }
+    } else {
+        runGSASwEXP disagl
+    }
+}
+# tell'em what is happening
+proc pleasewait {{message {}}} {
+    catch {destroy .msg}
+    toplevel .msg
+    wm transient .msg [winfo toplevel .]
+    pack [frame .msg.f -bd 4 -relief groove]
+    pack [message .msg.f.m -text "Please wait $message"]
+    wm withdraw .msg
+    update idletasks
+    # place the message on top of the main window
+    set x [expr [winfo x .] + [winfo width .]/2 - \
+            [winfo reqwidth .msg]/2 - [winfo vrootx .]]
+    if {$x < 0} {set x 0}
+    set y [expr [winfo y .] + [winfo height .]/2 - \
+            [winfo reqheight .msg]/2 - [winfo vrooty .]]
+    if {$y < 0} {set y 0}
+    wm geom .msg +$x+$y
+    wm deiconify .msg
+    focus .msg
+    grab .msg
+    update
+}
+# clear the message
+proc donewait {} {
+    catch {destroy .msg}
+}