Changeset 138


Ignore:
Timestamp:
Dec 4, 2009 5:01:02 PM (11 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gsascmds.tcl

    • Property rcs:date changed from 2000/05/16 21:57:44 to 2000/05/17 18:38:55
    • Property rcs:lines changed from +301 -18 to +114 -3
    • Property rcs:rev changed from 1.16 to 1.17
    r130 r138  
    737737        close $in
    738738        close $out
    739         file rename $file $oldname
    740         file rename $tmpname $file
     739        file rename -force $file $oldname
     740        file rename -force $tmpname $file
    741741    } errmsg] {
    742742        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
     
    15951595    afterputontop
    15961596}
     1597
     1598# optionally run disagl as a windowless process, w/results in a separate window
     1599proc rundisagl {} {
     1600    global expgui txtvw tcl_version tcl_platform
     1601    if {$expgui(disaglSeparateBox)} {
     1602        set root [file root $expgui(expfile)]
     1603        catch {file delete -force $root.tmp}
     1604        catch {file rename -force $root.LST $root.OLS}
     1605        # PSW reports this does not happen right away on windows
     1606        set i 0
     1607        while {$i < 5 && [file exists $root.LST]} {
     1608            # debug code
     1609            catch {console show}
     1610            puts "try $i"
     1611            # end debug code
     1612            after 100
     1613            incr i
     1614        }
     1615        #run the program
     1616        pleasewait "Running DISAGL"     
     1617        # create an empty input file
     1618        close [open disagl.inp w]
     1619        catch {exec [file join $expgui(gsasexe) disagl] \
     1620                [file tail $root] < disagl.inp > disagl.out}
     1621        catch {file rename -force $root.LST $root.tmp}
     1622        catch {file delete -force disagl.inp disagl.out}
     1623        catch {file rename -force $root.OLS $root.LST}
     1624        donewait
     1625        # open a new window
     1626        catch {toplevel .disagl}
     1627        catch {eval grid forget [grid slaves .disagl]}
     1628        text .disagl.txt -width 100 -wrap none \
     1629                -yscrollcommand ".disagl.yscroll set" \
     1630                -xscrollcommand ".disagl.xscroll set"
     1631        scrollbar .disagl.yscroll -command ".disagl.txt yview"
     1632        scrollbar .disagl.xscroll -command ".disagl.txt xview" -orient horizontal
     1633        grid .disagl.xscroll -column 0 -row 2 -sticky ew
     1634        grid .disagl.txt -column 0 -row 1 -sticky nsew
     1635        grid .disagl.yscroll -column 1 -row 1 -sticky ns
     1636        grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
     1637        grid columnconfig .disagl.f 2 -weight 1
     1638        grid [button .disagl.f.close -text "Close & Delete" \
     1639                -command "destroy .disagl; file delete $root.tmp"] \
     1640                -column 3 -row 0 -sticky e
     1641        grid [button .disagl.f.rename -text "Close & Save as .DIS" \
     1642                -command "destroy .disagl; file rename -force $root.tmp $root.DIS"] \
     1643                -column 4 -row 0 -sticky e
     1644        # allow font changes on the fly
     1645        if {$tcl_version >= 8.0} {
     1646            .disagl.txt config -font $txtvw(font)
     1647            set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
     1648            grid .disagl.f.font -column 1 -row 0 -sticky w
     1649            grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
     1650            $fontbut delete 0 end
     1651            foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
     1652                $fontbut add command -label "Courier $f" -font "Courier $f"\
     1653                        -command "set txtvw(font) \"Courier $f\"; \
     1654                        .disagl.txt config -font \$txtvw(font)"
     1655            }
     1656        }
     1657       
     1658        grid columnconfigure .disagl 1 -weight 1
     1659        grid rowconfigure .disagl 1 -weight 1
     1660        wm title .disagl "DISAGL results $expgui(expfile)"
     1661        wm iconname .disagl "DISAGL $root"
     1662        set in [open $root.tmp r]
     1663        .disagl.txt insert end [read $in]
     1664        close $in
     1665        bind all  {destroy .disagl}
     1666        bind .disagl  ".disagl.txt yview scroll -1 page"
     1667        bind .disagl  ".disagl.txt yview scroll 1 page"
     1668        bind .disagl  ".disagl.txt xview scroll 1 unit"
     1669        bind .disagl  ".disagl.txt xview scroll -1 unit"
     1670        bind .disagl  ".disagl.txt yview scroll -1 unit"
     1671        bind .disagl  ".disagl.txt yview scroll 1 unit"
     1672        bind .disagl  ".disagl.txt yview 0"
     1673        bind .disagl  ".disagl.txt yview end"
     1674        # don't disable in Win as this prevents the highlighting of selected text
     1675        if {$tcl_platform(platform) != "windows"} {
     1676            .disagl.txt config -state disabled
     1677        }
     1678    } else {
     1679        runGSASwEXP disagl
     1680    }
     1681}
     1682# tell'em what is happening
     1683proc pleasewait {{message {}}} {
     1684    catch {destroy .msg}
     1685    toplevel .msg
     1686    wm transient .msg [winfo toplevel .]
     1687    pack [frame .msg.f -bd 4 -relief groove]
     1688    pack [message .msg.f.m -text "Please wait $message"]
     1689    wm withdraw .msg
     1690    update idletasks
     1691    # place the message on top of the main window
     1692    set x [expr [winfo x .] + [winfo width .]/2 - \
     1693            [winfo reqwidth .msg]/2 - [winfo vrootx .]]
     1694    if {$x < 0} {set x 0}
     1695    set y [expr [winfo y .] + [winfo height .]/2 - \
     1696            [winfo reqheight .msg]/2 - [winfo vrooty .]]
     1697    if {$y < 0} {set y 0}
     1698    wm geom .msg +$x+$y
     1699    wm deiconify .msg
     1700    focus .msg
     1701    grab .msg
     1702    update
     1703}
     1704# clear the message
     1705proc donewait {} {
     1706    catch {destroy .msg}
     1707}
Note: See TracChangeset for help on using the changeset viewer.