source: trunk/gsascmds.tcl @ 731

Last change on this file since 731 was 731, checked in by toby, 11 years ago

# on 2003/08/11 19:28:54, toby did:
code cleanup -col -> -column

  • Property rcs:author set to toby
  • Property rcs:date set to 2003/08/11 19:28:54
  • Property rcs:lines set to +11 -11
  • Property rcs:rev set to 1.51
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 83.1 KB
Line 
1# $Id: gsascmds.tcl 731 2009-12-04 23:11:04Z toby $
2#------------------------------------------------------------------------------
3# display routines
4#------------------------------------------------------------------------------
5#       Message box code that centers the message box over the parent.
6#          or along the edge, if too close,
7#          but leave a border along +x & +y for reasons I don't remember
8#       It also allows the button names to be defined using
9#            -type $list  -- where $list has a list of button names
10#       larger messages are placed in a scrolled text widget
11#       capitalization is now ignored for -default
12#       The command returns the name button in all lower case letters
13#       otherwise see  tk_messageBox for a description
14#
15#       This is a modification of tkMessageBox (msgbox.tcl v1.5)
16#
17proc MyMessageBox {args} {
18    global tkPriv tcl_platform
19
20    set w tkPrivMsgBox
21    upvar #0 $w data
22
23    #
24    # The default value of the title is space (" ") not the empty string
25    # because for some window managers, a
26    #           wm title .foo ""
27    # causes the window title to be "foo" instead of the empty string.
28    #
29    set specs {
30        {-default "" "" ""}
31        {-icon "" "" "info"}
32        {-message "" "" ""}
33        {-parent "" "" .}
34        {-title "" "" " "}
35        {-type "" "" "ok"}
36        {-helplink "" "" ""}
37    }
38
39    tclParseConfigSpec $w $specs "" $args
40
41    if {[lsearch {info warning error question} $data(-icon)] == -1} {
42        error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
43    }
44    if {![string compare $tcl_platform(platform) "macintosh"]} {
45      switch -- $data(-icon) {
46          "error"     {set data(-icon) "stop"}
47          "warning"   {set data(-icon) "caution"}
48          "info"      {set data(-icon) "note"}
49        }
50    }
51
52    if {![winfo exists $data(-parent)]} {
53        error "bad window path name \"$data(-parent)\""
54    }
55
56    switch -- $data(-type) {
57        abortretryignore {
58            set buttons {
59                {abort  -width 6 -text Abort -under 0}
60                {retry  -width 6 -text Retry -under 0}
61                {ignore -width 6 -text Ignore -under 0}
62            }
63        }
64        ok {
65            set buttons {
66                {ok -width 6 -text OK -under 0}
67            }
68          if {![string compare $data(-default) ""]} {
69                set data(-default) "ok"
70            }
71        }
72        okcancel {
73            set buttons {
74                {ok     -width 6 -text OK     -under 0}
75                {cancel -width 6 -text Cancel -under 0}
76            }
77        }
78        retrycancel {
79            set buttons {
80                {retry  -width 6 -text Retry  -under 0}
81                {cancel -width 6 -text Cancel -under 0}
82            }
83        }
84        yesno {
85            set buttons {
86                {yes    -width 6 -text Yes -under 0}
87                {no     -width 6 -text No  -under 0}
88            }
89        }
90        yesnocancel {
91            set buttons {
92                {yes    -width 6 -text Yes -under 0}
93                {no     -width 6 -text No  -under 0}
94                {cancel -width 6 -text Cancel -under 0}
95            }
96        }
97        default {
98#           error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
99            foreach item $data(-type) {
100                lappend buttons [list [string tolower $item] -text $item -under 0]
101            }
102        }
103    }
104
105    if {[string compare $data(-default) ""]} {
106        set valid 0
107        foreach btn $buttons {
108            if {![string compare [lindex $btn 0] [string tolower $data(-default)]]} {
109                set valid 1
110                break
111            }
112        }
113        if {!$valid} {
114            error "invalid default button \"$data(-default)\""
115        }
116    }
117
118    # 2. Set the dialog to be a child window of $parent
119    #
120    #
121    if {[string compare $data(-parent) .]} {
122        set w $data(-parent).__tk__messagebox
123    } else {
124        set w .__tk__messagebox
125    }
126
127    # 3. Create the top-level window and divide it into top
128    # and bottom parts.
129
130    catch {destroy $w}
131    toplevel $w -class Dialog
132    wm title $w $data(-title)
133    wm iconname $w Dialog
134    wm protocol $w WM_DELETE_WINDOW { }
135    wm transient $w $data(-parent)
136    if {![string compare $tcl_platform(platform) "macintosh"]} {
137        unsupported1 style $w dBoxProc
138    }
139
140    frame $w.bot
141    pack $w.bot -side bottom -fill both
142    frame $w.top
143    pack $w.top -side top -fill both -expand 1
144    if {$data(-helplink) != ""} {
145#       frame $w.help
146#       pack $w.help -side top -fill both
147        pack [button $w.top.1 -text Help -bg yellow \
148                -command "MakeWWWHelp $data(-helplink)"] \
149                -side right -anchor ne
150        bind $w <Key-F1> "MakeWWWHelp $data(-helplink)"
151    }
152    if {[string compare $tcl_platform(platform) "macintosh"]} {
153        $w.bot configure -relief raised -bd 1
154        $w.top configure -relief raised -bd 1
155    }
156
157    # 4. Fill the top part with bitmap and message (use the option
158    # database for -wraplength and -font so that they can be
159    # overridden by the caller).
160
161    option add *Dialog.msg.wrapLength 6i widgetDefault
162
163    if {[string length $data(-message)] > 300} {
164        if {![string compare $tcl_platform(platform) "macintosh"]} {
165            option add *Dialog.msg.t.font system widgetDefault
166        } else {
167            option add *Dialog.msg.t.font {Times 18} widgetDefault
168        }
169        frame $w.msg
170        grid [text  $w.msg.t  \
171                -height 20 -width 55 -relief flat -wrap word \
172                -yscrollcommand "$w.msg.rscr set" \
173                ] -row 1 -column 0 -sticky news
174        grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
175                ] -row 1 -column 1 -sticky ns
176        # give extra space to the text box
177        grid columnconfigure $w.msg 0 -weight 1
178        grid rowconfigure $w.msg 1 -weight 1
179        $w.msg.t insert end $data(-message)
180    } else {
181        if {![string compare $tcl_platform(platform) "macintosh"]} {
182            option add *Dialog.msg.font system widgetDefault
183        } else {
184            option add *Dialog.msg.font {Times 18} widgetDefault
185        }
186        label $w.msg -justify left -text $data(-message)
187    }
188    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
189    if {[string compare $data(-icon) ""]} {
190        label $w.bitmap -bitmap $data(-icon)
191        pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
192    }
193
194    # 5. Create a row of buttons at the bottom of the dialog.
195
196    set i 0
197    foreach but $buttons {
198        set name [lindex $but 0]
199        set opts [lrange $but 1 end]
200      if {![llength $opts]} {
201            # Capitalize the first letter of $name
202          set capName [string toupper \
203                    [string index $name 0]][string range $name 1 end]
204            set opts [list -text $capName]
205        }
206
207      eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
208
209        if {![string compare $name [string tolower $data(-default)]]} {
210            $w.$name configure -default active
211        }
212      pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
213
214        # create the binding for the key accelerator, based on the underline
215        #
216        set underIdx [$w.$name cget -under]
217        if {$underIdx >= 0} {
218            set key [string index [$w.$name cget -text] $underIdx]
219          bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
220          bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
221        }
222        incr i
223    }
224
225    # 6. Create a binding for <Return> on the dialog if there is a
226    # default button.
227
228    if {[string compare $data(-default) ""]} {
229      bind $w <Return> [list tkButtonInvoke $w.[string tolower $data(-default)]]
230    }
231
232    # 7. Withdraw the window, then update all the geometry information
233    # so we know how big it wants to be, then center the window in the
234    # display and de-iconify it.
235
236    wm withdraw $w
237    update idletasks
238    set wp $data(-parent)
239    # center the new window in the middle of the parent
240    set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
241            [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
242    set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
243            [winfo reqheight $w]/2 - [winfo vrooty $wp]]
244    # make sure that we can see the entire window
245    set xborder 10
246    set yborder 25
247    if {$x < 0} {set x 0}
248    if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
249        incr x [expr \
250                [winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
251    }
252    if {$y < 0} {set y 0}
253    if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
254        incr y [expr \
255                [winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
256    }
257    wm geom $w +$x+$y
258    wm deiconify $w
259
260    # 8. Set a grab and claim the focus too.
261
262    catch {set oldFocus [focus]}
263    catch {set oldGrab [grab current $w]}
264    catch {
265        grab $w
266        if {[string compare $data(-default) ""]} {
267            focus $w.[string tolower $data(-default)]
268        } else {
269            focus $w
270        }
271    }
272
273    # 9. Wait for the user to respond, then restore the focus and
274    # return the index of the selected button.  Restore the focus
275    # before deleting the window, since otherwise the window manager
276    # may take the focus away so we can't redirect it.  Finally,
277    # restore any grab that was in effect.
278
279    tkwait variable tkPriv(button)
280    catch {focus $oldFocus}
281    destroy $w
282    catch {grab $oldGrab}
283    return $tkPriv(button)
284}
285
286# tell'em what is happening
287#    message    is a text message to display
288#    statusvar  is a variable name containing a message that gets updated
289#    parent     is the name of the parent window
290#    button     defines a button for the window. Element 0 in $button is the
291#               text for the button and Element 1 is the command to execute.
292proc pleasewait {{message {}} {statusvar {}} {parent .} {button ""}} {
293    catch {destroy .msg}
294    toplevel .msg
295    wm transient .msg [winfo toplevel .]
296    pack [frame .msg.f -bd 4 -relief groove] -padx 5 -pady 5
297    pack [message .msg.f.m -text "Please wait $message"] -side top
298    if {$statusvar != ""} {
299        pack [label .msg.f.status -textvariable $statusvar] -side top
300    }
301    if {$button != ""} {
302        pack [button .msg.f.button -text [lindex $button 0] \
303                -command [lindex $button 1]] -side top
304    }
305    wm withdraw .msg
306    update idletasks
307    # place the message on top of the parent window
308    set x [expr [winfo x $parent] + [winfo width $parent]/2 - \
309            [winfo reqwidth .msg]/2 - [winfo vrootx $parent]]
310    if {$x < 0} {set x 0}
311    set y [expr [winfo y $parent] + [winfo height $parent]/2 - \
312            [winfo reqheight .msg]/2 - [winfo vrooty $parent]]
313    if {$y < 0} {set y 0}
314    wm geom .msg +$x+$y
315    wm deiconify .msg
316    global makenew
317    set makenew(OldGrab) ""
318    set makenew(OldFocus) ""
319    # save focus & grab
320    catch {set makenew(OldFocus) [focus]}
321    catch {set makenew(OldGrab) [grab current .msg]}
322    catch {grab .msg}
323    update
324}
325
326# clear the message
327proc donewait {} {
328    global makenew
329    catch {destroy .msg}
330    # reset focus & grab
331    catch {
332        if {$makenew(OldFocus) != ""} {
333            focus $makenew(OldFocus)
334        }
335    }
336    catch {
337        if {$makenew(OldGrab) != ""} {
338            grab $makenew(OldGrab)
339        }
340    }
341}
342
343proc putontop {w} {
344    # center window $w above its parent and make it stay on top
345    set wp [winfo parent $w]
346    wm transient $w [winfo toplevel $wp]
347    wm withdraw $w
348    update idletasks
349    # center the new window in the middle of the parent
350    set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
351            [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
352    if {$x < 0} {set x 0}
353    set xborder 10
354    if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
355        incr x [expr \
356                [winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
357    }
358    set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
359            [winfo reqheight $w]/2 - [winfo vrooty $wp]]
360    if {$y < 0} {set y 0}
361    set yborder 25
362    if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
363        incr y [expr \
364                [winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
365    }
366    wm geom $w +$x+$y
367    wm deiconify $w
368
369    global makenew
370    set makenew(OldGrab) ""
371    set makenew(OldFocus) ""
372    catch {set makenew(OldFocus) [focus]}
373    catch {set makenew(OldGrab) [grab current $w]}
374    catch {grab $w}
375}
376
377proc afterputontop {} {
378    # restore focus
379    global makenew
380    # reset focus & grab
381    catch {
382        if {$makenew(OldFocus) != ""} {
383            focus $makenew(OldFocus)
384        }
385    }
386    catch {
387        if {$makenew(OldGrab) != ""} {
388            grab $makenew(OldGrab)
389        }
390    }
391}
392
393proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} {
394    catch {destroy $win}
395    toplevel $win
396
397    pack [label $win.l1 -text $labeltext] -side top
398    if {$err} {$win.l1 config -fg red}
399    pack [frame $win.f1] -side top -expand yes -fill both
400    grid [text  $win.f1.t  \
401            -height 20 -width 55  -wrap none -font Courier \
402            -xscrollcommand "$win.f1.bscr set" \
403            -yscrollcommand "$win.f1.rscr set" \
404            ] -row 1 -column 0 -sticky news
405    grid [scrollbar $win.f1.bscr -orient horizontal \
406            -command "$win.f1.t xview" \
407            ] -row 2 -column 0 -sticky ew
408    grid [scrollbar $win.f1.rscr  -command "$win.f1.t yview" \
409            ] -row 1 -column 1 -sticky ns
410    # give extra space to the text box
411    grid columnconfigure $win.f1 0 -weight 1
412    grid rowconfigure $win.f1 1 -weight 1
413    $win.f1.t insert end $msg
414
415    global makenew
416    set makenew(result) 0
417    bind $win <Return> "destroy $win"
418    bind $win <KeyPress-Prior> "$win.f1.t yview scroll -1 page"
419    bind $win <KeyPress-Next> "$win.f1.t yview scroll 1 page"
420    bind $win <KeyPress-Right> "$win.f1.t xview scroll 1 unit"
421    bind $win <KeyPress-Left> "$win.f1.t xview scroll -1 unit"
422    bind $win <KeyPress-Up> "$win.f1.t yview scroll -1 unit"
423    bind $win <KeyPress-Down> "$win.f1.t yview scroll 1 unit"
424    bind $win <KeyPress-Home> "$win.f1.t yview 0"
425    bind $win <KeyPress-End> "$win.f1.t yview end"
426    set i 0
427    foreach item $optionlist {
428        pack [button $win.q[incr i] \
429                -command "set makenew(result) $i; destroy $win" -text $item] -side left
430    }
431    if {$link != ""} {
432        pack [button $win.help -text Help -bg yellow \
433            -command "MakeWWWHelp $link"] \
434            -side right
435        bind $win <Key-F1> "MakeWWWHelp $link"
436    }
437    putontop $win
438    tkwait window $win
439
440    # fix grab...
441    afterputontop
442    return $makenew(result)
443}
444
445# get a value in a modal dialog
446proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
447    global expgui expmap
448    set w .global
449    catch {destroy $w}
450    toplevel $w -bg beige
451    bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
452    wm title $w "Input $what"
453    set expgui(temp) {}
454    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
455            -side top -expand yes -fill both
456    grid [label $w.0.a -text "Input a value for the $what" \
457            -bg beige] \
458            -row 0 -column 0 -columnspan 10
459    grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
460            -row 1 -column 0 
461
462    set expgui(temp) $initvalue
463    pack [frame $w.b -bg beige] -side top -fill x -expand yes
464    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
465    if $quit {
466        pack [button $w.b.3 -text Quit \
467                -command "set expgui(temp) {}; destroy $w"] -side left
468    }
469    bind $w <Return> "destroy $w"
470    pack [button $w.b.help -text Help -bg yellow \
471            -command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
472            -side right
473
474    # force the window to stay on top
475    putontop $w
476
477    focus $w.b.2
478    tkwait window $w
479    afterputontop
480
481    return $expgui(temp)
482}
483
484#------------------------------------------------------------------------------
485# profile/symmetry routines
486#------------------------------------------------------------------------------
487# profile terms
488array set expgui {
489    prof-T-1 {alp-0 alp-1 bet-0 bet-1 sig-0 sig-1 sig-2 rstr rsta \
490            rsca s1ec s2ec }
491    prof-T-2 {alp-0 alp-1 beta switch sig-0 sig-1 sig-2 gam-0 gam-1 \
492            gam-2 ptec stec difc difa zero }
493    prof-T-3 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
494            gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
495    prof-T-4 {alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
496            rstr rsta rsca eta}
497    prof-C-1 {GU GV GW asym F1 F2 }
498    prof-C-2 {GU GV GW LX LY trns asym shft GP stec ptec sfec \
499            L11 L22 L33 L12 L13 L23 }
500    prof-C-3 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
501            L11 L22 L33 L12 L13 L23 }
502    prof-C-4 {GU GV GW GP LX ptec trns shft sfec S/L H/L eta} 
503    prof-E-1 {A B C ds cds}
504}
505
506# number of profile terms depends on the histogram type
507# the LAUE symmetry and the profile number
508proc GetProfileTerms {phase hist ptype} {
509    global expmap expgui
510    if {$hist == "C" || $hist == "T" || $hist == "E"} {
511        set htype $hist
512    } else {
513        set htype [string range $expmap(htype_$hist) 2 2]
514    }
515    # get the cached copy of the profile term labels, when possible
516    set lbls {}
517    catch {
518        set lbls $expmap(ProfileTerms${phase}_${ptype}_${htype})
519    }
520    if {$lbls != ""} {return $lbls}
521
522    catch {set lbls $expgui(prof-$htype-$ptype)}
523    if {$lbls == ""} {return}
524    # add terms based on the Laue symmetry
525    if {($htype == "C" || $htype == "T") && $ptype == 4} {
526        set laueaxis [GetLaue [phaseinfo $phase spacegroup]]
527        eval lappend lbls [Profile4Terms $laueaxis]
528    }
529    set expmap(ProfileTerms${phase}_${ptype}_${htype}) $lbls
530    return $lbls
531}
532
533proc Profile4Terms {laueaxis} {
534    switch -exact $laueaxis {
535        1bar {return \
536                "S400 S040 S004 S220 S202 S022 S310 S103 S031 \
537                S130 S301 S013 S211 S121 S112"}
538        2/ma {return "S400 S040 S004 S220 S202 S022 S013 S031 S211"}
539        2/mb {return "S400 S040 S004 S220 S202 S022 S301 S103 S121"}
540        2/mc {return "S400 S040 S004 S220 S202 S022 S130 S310 S112"}
541        mmm  {return "S400 S040 S004 S220 S202 S022"}
542        4/{return "S400 S004 S220 S202"}
543        4/mmm {return "S400 S004 S220 S202"}
544        3barR     {return "S400 S220 S310 S211"}
545        "3bar mR" {return "S400 S220 S310 S211"}
546        3bar    {return "S400 S004 S202 S211"}
547        3barm1 {return "S400 S004 S202"}
548        3bar1m  {return "S400 S004 S202 S211"}
549        6/m    {return "S400 S004 S202"}
550        6/mmm  {return "S400 S004 S202"}
551        "m 3"  {return "S400 S220"}
552        m3m    {return "S400 S220"}
553        default {return ""}
554    }
555}
556
557proc GetLaue {spg} {
558    global tcl_platform expgui
559    # check the space group
560    set fp [open spg.in w]
561    puts $fp "N"
562    puts $fp "N"
563    puts $fp $spg
564    puts $fp "Q"
565    close $fp
566    catch {
567        if {$tcl_platform(platform) == "windows"} {
568            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
569        } else {
570            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
571        }
572    }
573    set fp [open spg.out r]
574    set laue {}
575    set uniqueaxis {}
576    while {[gets $fp line] >= 0} {
577        regexp {Laue symmetry (.*)} $line junk laue
578        regexp {The unique axis is (.*)} $line junk uniqueaxis
579    }
580    close $fp
581    catch {file delete -force spg.in spg.out}
582    set laue [string trim $laue]
583    # add a R suffix for rhombohedral settings
584    if {[string range [string trim $spg] end end] == "R"} {
585        return "${laue}${uniqueaxis}R"
586    }
587    return "${laue}$uniqueaxis"
588}
589
590# set up to change the profile type for a series of histogram/phase entries
591# (histlist & phaselist should be lists of the same length)
592#
593proc ChangeProfileType {histlist phaselist} {
594    global expgui expmap
595    set w .profile
596    catch {destroy $w}
597    toplevel $w -bg beige
598    wm title $w "Change Profile Function"
599   
600    # all histogram/phases better be the same type, so we can just use the 1st
601    set hist [lindex $histlist 0]
602    set phase [lindex $phaselist 0]
603    set ptype [string trim [hapinfo $hist $phase proftype]]
604
605    # get list of allowed profile terms for the current histogram type
606    set i 1
607    while {[set lbls [GetProfileTerms $phase $hist $i]] != ""} {
608        lappend lbllist $lbls
609        incr i
610    }
611    # labels for the current type
612    set i $ptype
613    set oldlbls [lindex $lbllist [incr i -1]]
614   
615    if {[llength $histlist] == 1} {
616        pack [label $w.a -bg beige \
617                -text "Change profile function for Histogram #$hist Phase #$phase" \
618                ] -side top
619    } else {
620        # make a list of histograms by phase
621        foreach h $histlist p $phaselist {
622            lappend phlist($p) $h
623        }
624        set num 0
625        pack [frame $w.a -bg beige] -side top
626        pack [label $w.a.$num -bg beige \
627                -text "Change profile function for:" \
628                ] -side top -anchor w
629        foreach i [lsort [array names phlist]] {
630            incr num
631            pack [label $w.a.$num -bg beige -text \
632                    "\tPhase #$i, Histograms [CompressList $phlist($i)]" \
633                    ] -side top -anchor w
634        }
635    }
636    pack [label $w.e1 \
637            -text "Current function is type $ptype." \
638            -bg beige] -side top -anchor w
639    pack [frame $w.e -bg beige] -side top -expand yes -fill both
640    pack [label $w.e.1 \
641            -text "Set function to type" \
642            -bg beige] -side left
643    set menu [tk_optionMenu $w.e.2 expgui(newpeaktype) junk]
644    pack $w.e.2 -side left -anchor w
645
646    pack [radiobutton $w.e.4 -bg beige -variable expgui(DefaultPeakType) \
647            -command "set expgui(newpeaktype) $ptype; \
648            FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
649            -value 1 -text "Current value overrides"] -side right
650    pack [radiobutton $w.e.3 -bg beige -variable expgui(DefaultPeakType) \
651            -command \
652            "set expgui(newpeaktype) $ptype; \
653            FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
654            -value 0 -text "Default value overrides"] -side right
655
656    $w.e.2 config -bg beige
657    pack [frame $w.c -bg beige] -side top -expand yes -fill both
658    pack [frame $w.d -bg beige] -side top -expand yes -fill both
659    pack [button $w.d.2 -text Set  \
660            -command "SaveChangeProfileType $w.c $histlist $phaselist; destroy $w"\
661            ] -side left
662    pack [button $w.d.3 -text Quit \
663            -command "destroy $w"] -side left
664    pack [button $w.d.help -text Help -bg yellow \
665            -command "MakeWWWHelp expgui5.html ChangeType"] \
666            -side right
667    bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
668    bind $w <Return> "destroy $w"
669
670    $menu delete 0 end
671    set i 0
672    foreach lbls $lbllist {
673        incr i
674        $menu add command -label $i -command \
675                "set expgui(newpeaktype) $i; \
676                FillChangeProfileType $w.c $hist $phase $i [list $lbls] [list $oldlbls]"
677    }
678    set expgui(newpeaktype) $ptype
679    FillChangeProfileType $w.c $hist $phase $ptype $oldlbls $oldlbls
680
681    # force the window to stay on top
682    putontop $w
683    focus $w.e.2
684    tkwait window $w
685    afterputontop
686    sethistlist
687}
688
689# save the changes to the profile
690proc SaveChangeProfileType {w histlist phaselist} {
691    global expgui
692    foreach phase $phaselist hist $histlist {
693        hapinfo $hist $phase proftype set $expgui(newpeaktype)
694        hapinfo $hist $phase profterms set $expgui(newProfileTerms)
695        for {set i 1} {$i <=  $expgui(newProfileTerms)} {incr i} {
696            hapinfo $hist $phase pterm$i set [$w.ent${i} get]
697            hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
698        }
699        set i [expr 1+$expgui(newProfileTerms)]
700        hapinfo $hist $phase pcut set [$w.ent$i get]
701        incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
702    }
703}
704
705# file the contents of the "Change Profile Type" Menu
706proc FillChangeProfileType {w hist phase newtype lbls oldlbls} {
707    global expgui expmap
708    set ptype [string trim [hapinfo $hist $phase proftype]]
709    catch {unset oldval}
710    # loop through the old terms and set up an array of starting values
711    set num 0
712    foreach term $oldlbls {
713        incr num
714        set oldval($term) [hapinfo $hist $phase pterm$num]
715    }
716    set oldval(Peak\nCutoff) [hapinfo $hist $phase pcut]
717
718    # is the new type the same as the current?
719    if {$ptype == $newtype} {
720        set nterms [hapinfo $hist $phase profterms]
721    } else {
722        set nterms [llength $lbls]
723    }
724    set expgui(newProfileTerms) $nterms
725    set expgui(CurrentProfileTerms) $nterms
726    # which default profile set matches the new type
727    set setnum {}
728    foreach j {" " 1 2 3 4 5 6 7 8 9} {
729        set i [profdefinfo $hist $j proftype]
730        if {$i == ""} continue
731        if {$i == $newtype} {
732            set setnum $j
733            break
734        }
735    }
736
737    eval destroy [winfo children $w]
738
739    set colstr 0
740    set row 2
741    set maxrow [expr $row + $nterms/2]
742    for { set num 1 } { $num <= $nterms + 1} { incr num } {
743        # get the default value (originally from the in .INS file)
744        set val {}
745        if {$setnum != ""} {
746            set val 0.0
747            catch {
748                set val [profdefinfo $hist $setnum pterm$num]
749                # pretty up the number
750                if {$val == 0.0} {
751                    set val 0.0
752                } elseif {abs($val) < 1e-2 || abs($val) > 1e6} {
753                    set val [format %.3e $val]
754                } elseif {abs($val) > 1e-2 && abs($val) < 10} {
755                    set val [format %.5f $val]
756                } elseif {abs($val) < 9999} {
757                    set val [format %.2f $val]
758                } elseif {abs($val) < 1e6} {
759                    set val [format %.0f $val]
760                }
761            }
762        }
763        # heading
764        if {$row == 2} {
765            set col $colstr
766            grid [label $w.h0${num} -text "lbl" -bg beige] \
767                -row $row -column $col
768            grid [label $w.h2${num} -text "ref" -bg beige] \
769                -row $row -column [incr col]
770            grid [label $w.h3${num} -text "next value" -bg beige] \
771                -row $row -column [incr col]
772            grid [label $w.h4${num} -text "default" -bg beige] \
773                -row $row -column [incr col]
774            grid [label $w.h5${num} -text "current" -bg beige] \
775                -row $row -column [incr col]
776        }
777        set col $colstr
778        incr row
779        set term {}
780        catch {set term [lindex $lbls [expr $num-1]]}
781        if {$term == ""} {set term $num}
782        if {$num == $nterms + 1} {
783            set term "Peak\nCutoff"
784            set val {}
785            if {$setnum != ""} {
786                set val 0.0
787                catch {set val [profdefinfo $hist $setnum pcut]}
788            }
789        }
790
791        grid [label $w.l${num} -text "$term" -bg beige] \
792                -row $row -column $col
793        grid [checkbutton $w.chk${num} -variable expgui(ProfRef$num) \
794                -bg beige -activebackground beige] -row $row -column [incr col]
795        grid [entry $w.ent${num} \
796                -width 12] -row $row -column [incr col]
797        if {$val != ""} {
798            grid [button $w.def${num} -text $val -command \
799                    "$w.ent${num} delete 0 end; $w.ent${num} insert end $val" \
800                    ] -row $row -column [incr col] -sticky ew
801        } else {
802            grid [label $w.def${num} -text (none) \
803                    ] -row $row -column [incr col]
804        }
805        set curval {}
806        catch {
807            set curval [expr $oldval($term)]
808            # pretty up the number
809            if {$curval == 0.0} {
810                set curval 0.0
811            } elseif {abs($curval) < 1e-2 || abs($curval) > 1e6} {
812                set curval [format %.3e $curval]
813            } elseif {abs($curval) > 1e-2 && abs($curval) < 10} {
814                set curval [format %.5f $curval]
815            } elseif {abs($curval) < 9999} {
816                set curval [format %.2f $curval]
817            } elseif {abs($curval) < 1e6} {
818                set curval [format %.0f $curval]
819            }
820            grid [button $w.cur${num} -text $curval -command  \
821                    "$w.ent${num} delete 0 end; $w.ent${num} insert end $curval" \
822                    ] -row $row -column [incr col] -sticky ew
823        }
824        # set default values for flag and value
825        set ref 0
826        if {$setnum != ""} {
827            catch {
828                if {[profdefinfo $hist $setnum pref$num] == "Y"} {set ref 1}
829            }
830        }
831        set expgui(ProfRef$num) $ref
832       
833        $w.ent${num} delete 0 end
834        if {!$expgui(DefaultPeakType) && $val != ""} {
835            $w.ent${num} insert end $val
836        } elseif {$curval != ""} {
837            $w.ent${num} insert end $curval
838        } elseif {$val != ""} {
839            $w.ent${num} insert end $val
840        } else {
841            $w.ent${num} insert end 0.0
842        }
843        if {$row > $maxrow} {
844            set row 2
845            incr colstr 5
846        }
847    }
848}
849
850#------------------------------------------------------------------------------
851# WWW/help routines
852#------------------------------------------------------------------------------
853# browse a WWW page with URL. The URL may contain a #anchor
854# On UNIX assume netscape is in the path or env(BROWSER) is loaded.
855# On Windows search the registry for a browser. Mac branch not tested.
856# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
857# to the contributers
858proc urlOpen {url} {
859    global env tcl_platform
860    switch $tcl_platform(platform) {
861        "unix" {
862            if {![info exists env(BROWSER)]} {
863                set progs [auto_execok netscape]
864                if {[llength $progs]} {
865                    set env(BROWSER) [list $progs]
866                }
867            }
868            if {[info exists env(BROWSER)]} {
869                if {[catch {exec $env(BROWSER) -remote openURL($url)}]} {
870                    # perhaps browser doesn't understand -remote flag
871                    if {[catch {exec $env(BROWSER) $url &} emsg]} {
872                        error "Error displaying $url in browser\n$emsg"
873                    }
874                }
875            } else {
876                MyMessageBox -parent . -title "No Browser" \
877                        -message "Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
878                        -icon warn
879            }
880        }
881        "windows" {
882            package require registry
883            # Look for the application under
884            # HKEY_CLASSES_ROOT
885            set root HKEY_CLASSES_ROOT
886
887            # Get the application key for HTML files
888            set appKey [registry get $root\\.html ""]
889
890            # Get the command for opening HTML files
891            set appCmd [registry get \
892                    $root\\$appKey\\shell\\open\\command ""]
893
894            # Substitute the HTML filename into the command for %1
895            # or stick it on the end
896            if {[string first %1 $appCmd] != -1} {
897                regsub %1 $appCmd $url appCmd
898            } else {
899                append appCmd " " $url
900            }
901           
902            # Double up the backslashes for eval (below)
903            regsub -all {\\} $appCmd  {\\\\} appCmd
904           
905            # Invoke the command
906            eval exec $appCmd &
907        }
908        "macintosh" {
909            if {0 == [info exists env(BROWSER)]} {
910                set env(BROWSER) "Browse the Internet"
911            }
912            if {[catch {
913                AppleScript execute\
914                    "tell application \"$env(BROWSER)\"
915                         open url \"$url\"
916                     end tell
917                "} emsg]
918            } then {
919                error "Error displaying $url in browser\n$emsg"
920            }
921        }
922    }
923}
924
925proc NetHelp {file anchor localloc netloc} {
926    if {[file exists [file join $localloc $file]]} {
927        set url "[file join $localloc $file]"
928    } else {
929        set url "http://$netloc/$file"
930    }
931    catch {
932        pleasewait "Starting web browser..."
933        after 2000 donewait
934    }
935    if {$anchor != ""} {
936        append url # $anchor
937    }
938    urlOpen $url
939}
940
941proc MakeWWWHelp {"topic {}" "anchor {}"} {
942    global expgui
943    if {$topic == ""} {
944        foreach item $expgui(notebookpagelist) {
945            if {[lindex $item 0] == $expgui(pagenow)} {
946                NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) $expgui(website)
947                return
948            }
949        }
950        # this should not happen
951        NetHelp expgui.html "" $expgui(docdir) $expgui(website)
952    } elseif {$topic == "menu"} {
953        NetHelp expguic.html "" $expgui(docdir) $expgui(website)
954    } else {
955        NetHelp $topic $anchor $expgui(docdir) $expgui(website)
956    }
957}
958
959# show help information
960proc showhelp {} {
961    global expgui_helplist helpmsg
962    set helpmsg {}
963    set frm .help
964    catch {destroy $frm}
965    toplevel $frm
966    wm title $frm "Help Summary"
967    grid [label $frm.0 -text \
968            "Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
969        -column 0 -columnspan 4 -row 0
970#    grid [message $frm.help -textvariable helpmsg -relief groove] \
971#          -column 0 -columnspan 4 -row 2 -sticky nsew
972    grid [text $frm.help -relief groove -bg beige -width 0\
973            -height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
974           -column 0 -columnspan 3 -row 2 -sticky nsew
975    grid [scrollbar $frm.escroll -command "$frm.help yview"] \
976            -column 4 -row 2 -sticky nsew
977    grid rowconfig $frm 1 -weight 1 -minsize 50
978    grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
979    grid columnconfig $frm 0 -weight 1
980    grid columnconfig $frm 2 -weight 1
981    set lst [array names expgui_helplist]
982    grid [listbox $frm.cmds -relief raised -bd 2 \
983            -yscrollcommand "$frm.scroll set" \
984            -height 8 -width 0 -exportselection 0 ] \
985            -column 0 -row 1 -sticky nse
986    grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
987            -column 1 -row 1 -sticky nsew
988    foreach item [lsort -dictionary $lst] {
989        $frm.cmds insert end $item 
990    }
991    if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
992    grid [button $frm.done -text Done -command "destroy $frm"] \
993            -column 2 -row 1
994#    bind $frm.cmds <ButtonRelease-1> \
995#           "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
996    bind $frm.cmds <ButtonRelease-1> \
997            "+$frm.help config -state normal; $frm.help delete 0.0 end; \
998             $frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
999             $frm.help config -state disabled"
1000
1001    # get the size of the window and expand the message boxes to match
1002#    update
1003#    $frm.help config -width [winfo width $frm.help ]
1004}
1005
1006
1007#------------------------------------------------------------------------------
1008# utilities
1009#------------------------------------------------------------------------------
1010# run liveplot
1011proc liveplot {} {
1012    global expgui liveplot wishshell expmap
1013    set expnam [file root [file tail $expgui(expfile)]]
1014    # which histograms are ready for use?
1015    set validlist {}
1016    foreach ihist $expmap(powderlist) {
1017        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1018                [string range $expmap(htype_$ihist) 3 3] == "D"} {
1019            lappend validlist $ihist
1020        }
1021    }
1022    if {[llength $validlist] == 0} {
1023        MyMessageBox -parent . -title "No Valid Histograms" \
1024                -message "No histograms are ready to plot. Run GENLES and try again" \
1025                -icon warning -helplink "expguierr.html NoValidHist"
1026        return
1027    }
1028    # use $liveplot(hst) if valid, the 1st entry otherwise
1029    if {[lsearch $validlist $liveplot(hst)] != -1} {
1030        exec $wishshell [file join $expgui(scriptdir) liveplot] \
1031                $expnam $liveplot(hst) $liveplot(legend) &
1032    } else {
1033        exec $wishshell [file join $expgui(scriptdir) liveplot] \
1034                $expnam [lindex $validlist 0] $liveplot(legend) &
1035    }
1036}
1037
1038# run lstview
1039proc lstview {} {
1040    global expgui wishshell
1041    set expnam [file root [file tail $expgui(expfile)]]
1042    exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
1043}
1044
1045# run widplt
1046proc widplt {"prog widplt"} {
1047    global expgui wishshell
1048    exec $wishshell [file join $expgui(scriptdir) $prog] \
1049            $expgui(expfile) &
1050}
1051
1052# run bkgedit
1053proc bkgedit {"hst {}"} {
1054    global expgui liveplot wishshell expmap
1055    set expnam [file root [file tail $expgui(expfile)]]
1056    if {$hst == ""} {
1057        # which histograms are ready for use?
1058        set validlist {}
1059        foreach ihist $expmap(powderlist) {
1060            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1061                    [string range $expmap(htype_$ihist) 3 3] == "*"} {
1062                lappend validlist $ihist
1063            }
1064        }
1065        if {[llength $validlist] == 0} {
1066            MyMessageBox -parent . -title "No Valid Histograms" \
1067                    -message "No histograms are ready to plot. Run POWPREF and try again" \
1068                    -icon warning -helplink "expguierr.html NoValidHist"
1069            return
1070        }
1071        # use $liveplot(hst) if valid, the 1st entry otherwise
1072        if {[lsearch $validlist $liveplot(hst)] != -1} {
1073            set hst $liveplot(hst)
1074        } else {
1075            set hst [lindex $validlist 0]
1076        }
1077    }
1078    if {$expgui(autoiconify)} {wm iconify .}
1079    exec $wishshell [file join $expgui(scriptdir) bkgedit] \
1080            $expnam $hst $liveplot(legend)
1081    if {$expgui(autoiconify)} {wm deiconify .}
1082    # check for changes in the .EXP file immediately
1083    whenidle
1084}
1085
1086# run excledt
1087proc excledit {} {
1088    global expgui liveplot wishshell expmap
1089    set expnam [file root [file tail $expgui(expfile)]]
1090    # which histograms are ready for use?
1091    set validlist {}
1092    foreach ihist $expmap(powderlist) {
1093        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1094                [string range $expmap(htype_$ihist) 3 3] == "*" || \
1095                [string range $expmap(htype_$ihist) 3 3] == "D"} {
1096            lappend validlist $ihist
1097        }
1098    }
1099    if {[llength $validlist] == 0} {
1100        MyMessageBox -parent . -title "No Valid Histograms" \
1101                -message "No histograms are ready to plot. Run POWPREF and try again" \
1102                -icon warning -helplink "expguierr.html NoValidHist"
1103        return
1104    }
1105    #if {$expgui(autoiconify)} {wm iconify .}
1106    StartExcl 
1107    #if {$expgui(autoiconify)} {wm deiconify .}
1108}
1109
1110# compute the composition for each phase and display in a dialog
1111proc composition {} {
1112    global expmap expgui
1113    set Z 1
1114    foreach phase $expmap(phaselist) type $expmap(phasetype) {
1115        if {$type > 2} continue
1116        catch {unset total}
1117        foreach atom $expmap(atomlist_$phase) {
1118            set type [atominfo $phase $atom type]
1119            set mult [atominfo $phase $atom mult]
1120            if [catch {set total($type)}] {
1121                set total($type) [expr \
1122                        $mult * [atominfo $phase $atom frac]]
1123            } else {
1124                set total($type) [expr $total($type) + \
1125                        $mult * [atominfo $phase $atom frac]]
1126            }
1127            if {$mult > $Z} {set Z $mult}
1128        }
1129        append text "\nPhase $phase\n"
1130        append text "  Unit cell contents\n"
1131        foreach type [lsort [array names total]] {
1132            append text "   $type[format %8.3f $total($type)]"
1133        }
1134        append text "\n\n"
1135       
1136        append text "  Asymmetric Unit contents (Z=$Z)\n"
1137        foreach type [lsort [array names total]] {
1138            append text "   $type[format %8.3f [expr $total($type)/$Z]]"
1139        }
1140        append text "\n"
1141    }
1142   
1143    catch {destroy .comp}
1144    toplevel .comp -class MonoSpc
1145    bind .comp <Key-F1> "MakeWWWHelp expgui.html Composition"
1146    wm title .comp Composition
1147    pack [label .comp.results -text $text \
1148            -justify left] -side top
1149    pack [frame .comp.box]  -side top -expand y -fill x
1150    pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
1151
1152    set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
1153    pack [button .comp.box.2 -text "Save to $lstnam file" \
1154            -command "writelst [list $text] ; destroy .comp"] -side left
1155    pack [button .comp.box.help -text Help -bg yellow \
1156            -command "MakeWWWHelp expgui.html Composition"] \
1157            -side right
1158}
1159
1160# Delete History Records
1161proc DeleteHistoryRecords {{msg ""}} {
1162    global expgui
1163    set frm .history
1164    catch {destroy $frm}
1165    toplevel $frm
1166    bind $frm <Key-F1> "MakeWWWHelp expgui.html DeleteHistoryRecords"
1167    if {[string trim $msg] == ""} {
1168        set msg "There are [CountHistory] history records"
1169    }
1170    pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
1171    pack [label $frm.1.0 -text $msg] -side top
1172    pack [frame $frm.1.1] -side top
1173    pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
1174    pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
1175            ] -side left
1176    set expgui(historyKeep) 10
1177    pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
1178    set expgui(renumber) 1
1179    pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
1180    pack [button $frm.2.help -text Help -bg yellow \
1181            -command "MakeWWWHelp expgui.html DeleteHistoryRecords"] -side top
1182    pack [button $frm.2.4 -text Quit \
1183            -command {destroy .history}] -side bottom
1184    pack [button $frm.2.3 -text OK \
1185            -command { 
1186        if ![catch {expr $expgui(historyKeep)}] {
1187            DeleteHistory $expgui(historyKeep) $expgui(renumber)
1188            set expgui(changed) 1
1189            destroy .history
1190        }
1191    }] -side bottom
1192    bind $frm <Return> "$frm.2.3 invoke"
1193   
1194    # force the window to stay on top
1195    putontop $frm 
1196    focus $frm.2.3
1197    tkwait window $frm
1198    afterputontop
1199}
1200
1201proc archiveexp {} {
1202    global expgui tcl_platform
1203    # is there a file to archive?
1204    if {![file exists $expgui(expfile)]} return
1205    set expnam [file rootname $expgui(expfile)]
1206    # get the last archived version
1207    set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
1208    if {$lastf == ""} {
1209        set num 01
1210    } else {
1211        regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
1212        scan $num %x num
1213        if {$num >= 255} {
1214            set num FF
1215        } else {
1216            set num [string toupper [format %.2x [incr num]]]
1217        }
1218    }
1219    catch {
1220        set file $expnam.O$num
1221        file copy -force $expgui(expfile) $file
1222        set fp [open $expnam.LST a+]
1223        puts $fp "\n----------------------------------------------"
1224        puts $fp "     Archiving [file tail $expnam.EXP] as [file tail $file]"
1225        puts $fp "----------------------------------------------\n"
1226        close $fp
1227    } errmsg
1228    if {$errmsg != ""} {
1229        tk_dialog .warn Confirm "Error archiving the current .EXP file: $errmsg" warning 0 OK
1230    }
1231}
1232
1233# save and optionally archive the expfile
1234proc savearchiveexp {} {
1235    global expgui expmap
1236    if {$expgui(expfile) == ""} {
1237        SaveAsFile
1238        return
1239    }
1240    if !$expgui(changed) return
1241    if {$expgui(archive)} archiveexp
1242    # add a history record
1243    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
1244    # now save the file
1245    expwrite $expgui(expfile)
1246    set expgui(changed) 0
1247    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
1248    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
1249    wm title . $expgui(expfile)
1250    set expgui(titleunchanged) 1
1251    # set convergence criterion
1252    InitLSvars
1253}
1254
1255#------------------------------------------------------------------------------
1256# GSAS interface routines
1257#------------------------------------------------------------------------------
1258# run a GSAS program that does not require an experiment file
1259proc runGSASprog {proglist "concurrent 1"} {
1260    # if concurrent is 0, EXPGUI runs the GSAS program in background
1261    # -- this is not currently needed anywhere where the .EXP file is not.
1262    global expgui tcl_platform
1263    set cmd {}
1264    foreach prog $proglist {
1265        StartGRWND $prog
1266        if {$tcl_platform(platform) == "windows"} {
1267            append cmd " \"$expgui(gsasexe)/${prog}.exe \" "
1268        } else {
1269            if {$cmd != ""} {append cmd "\;"}
1270            append cmd "[file join $expgui(gsasexe) $prog]"
1271        }
1272    }
1273    forknewterm $prog $cmd [expr !$concurrent] 1
1274}
1275
1276# dummy routine, overridden if needed
1277proc StartGRWND {prog} {
1278}
1279
1280# run a GSAS program that requires an experiment file for input/output
1281proc runGSASwEXP {proglist "concurrent 0"} {
1282    # most programs that require the .EXP file change it and
1283    # cannot be run concurrently
1284    global expgui tcl_platform
1285    # Save the current exp file
1286    savearchiveexp
1287    # load the changed .EXP file automatically?
1288    if {$expgui(autoexpload)} {
1289        # disable the file changed monitor
1290        set expgui(expModifiedLast) 0
1291    }
1292    set cmd {}
1293    set expnam [file root [file tail $expgui(expfile)]]
1294    foreach prog $proglist {
1295        if {$prog == "powpref"} {
1296            set expgui(needpowpref) 0
1297            set expgui(needpowpref_why) ""
1298        } elseif {$prog == "genles" && $expgui(needpowpref) != 0} {
1299            set msg "You are attempting to run GENLES, after making changes that require POWPREF:\n\n$expgui(needpowpref_why) \nRun POWPREF first?"
1300            set ans [MyMessageBox -parent . -title "Run POWPREF" \
1301                    -message $msg -icon warning -type "Yes No" -default yes \
1302                    -helplink "expguierr.html RunPowpref"]
1303            if {$ans == "yes"} {
1304                set expgui(needpowpref) 0
1305                set expgui(needpowpref_why) ""
1306                if {$tcl_platform(platform) == "windows"} {
1307                    append cmd " \"$expgui(gsasexe)/powpref.exe $expnam \" "
1308                } else {
1309                    if {$cmd != ""} {append cmd "\;"}
1310                    append cmd "[file join $expgui(gsasexe) powpref] $expnam"
1311                }
1312            }
1313        }
1314        StartGRWND $prog
1315        if {$tcl_platform(platform) == "windows"} {
1316            append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
1317        } else {
1318            if {$cmd != ""} {append cmd "\;"}
1319            append cmd "[file join $expgui(gsasexe) $prog] $expnam"
1320        }
1321    }
1322    forknewterm "$prog -- $expnam" $cmd [expr !$concurrent] 1
1323    # load the changed .EXP file automatically?
1324    if {$expgui(autoexpload)} {
1325        # load the revised exp file
1326        loadexp $expgui(expfile)
1327    }
1328}
1329
1330# write text to the .LST file
1331proc writelst {text} {
1332    global expgui
1333    set lstnam [file rootname $expgui(expfile)].LST
1334    set fp [open $lstnam a]
1335    puts $fp "\n-----------------------------------------------------------------"
1336    puts $fp $text
1337    puts $fp "-----------------------------------------------------------------\n"
1338    close $fp
1339}
1340
1341
1342# rename file current to suggested,
1343#   delete window if supplied
1344#   use parent, if supplied or .
1345proc RenameAsFile {current suggested "window {}" "parent {}"} {
1346    if {$parent == "" && $window != ""} {set parent $window}
1347    if {$parent == ""} {set parent .}
1348    set newfile [tk_getSaveFile -initialfile $suggested -parent $parent]
1349    if {$newfile == ""} return
1350    if {[catch {
1351        file rename -force $current $newfile
1352    }]} {
1353        file copy -force $current $newfile
1354        file delete -force $current
1355    }
1356    if {$window != ""} {destroy $window}
1357}
1358
1359# optionally run disagl as a windowless process, w/results in a separate window
1360proc rundisagl {} {
1361    global expgui txtvw tcl_version tcl_platform
1362    if {$expgui(disaglSeparateBox)} {
1363        set root [file root $expgui(expfile)] 
1364        catch {file delete -force $root.tmp}
1365        if {[catch {file rename -force $root.LST $root.OLS}]} {
1366            file copy -force $root.LST $root.OLS
1367            file delete -force $root.OLS
1368        }
1369        # PSW reports this does not happen right away on windows
1370        set i 0
1371        while {$i < 10 && [file exists $root.LST]} {
1372            # debug code
1373            #catch {console show}
1374            #puts "try $i"
1375            # end debug code
1376            after 100
1377            incr i
1378        }
1379        if {[file exists $root.LST]} {
1380            # it was not possible to rename the file
1381            MyMessageBox -parent . -title "Rename Problem" \
1382                -message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
1383                -icon warning -helplink "expguierr.html NoRename"
1384            return
1385        }
1386
1387        #run the program
1388        pleasewait "Running DISAGL"     
1389        # create an empty input file
1390        close [open disagl.inp w]
1391        catch {exec [file join $expgui(gsasexe) disagl] \
1392                [file tail $root] < disagl.inp > disagl.out}
1393        if {[catch {file rename -force $root.LST $root.tmp}]} {
1394            file copy -force $root.LST $root.tmp
1395            file delete -force $root.LST
1396        }
1397        catch {file delete -force disagl.inp disagl.out}
1398        if {[catch {file rename -force $root.OLS $root.LST}]} {
1399            file copy -force $root.OLS $root.LST
1400            file delete -force $root.OLS
1401        }
1402        donewait
1403        # open a new window
1404        catch {toplevel .disagl}
1405        catch {eval grid forget [grid slaves .disagl]}
1406        text .disagl.txt -width 100 -wrap none \
1407                -yscrollcommand ".disagl.yscroll set" \
1408                -xscrollcommand ".disagl.xscroll set" 
1409        scrollbar .disagl.yscroll -command ".disagl.txt yview"
1410        scrollbar .disagl.xscroll -command ".disagl.txt xview" -orient horizontal
1411        grid .disagl.xscroll -column 0 -row 2 -sticky ew
1412        grid .disagl.txt -column 0 -row 1 -sticky nsew
1413        grid .disagl.yscroll -column 1 -row 1 -sticky ns
1414        grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
1415        grid columnconfig .disagl.f 2 -weight 1
1416        grid [button .disagl.f.close -text "Close & Delete" \
1417                -command "destroy .disagl; file delete $root.tmp"] \
1418                -column 3 -row 0 -sticky e
1419        grid [button .disagl.f.rename \
1420                -command "RenameAsFile $root.tmp $root.DIS .disagl" \
1421                -text "Close & Save as..."] \
1422                -column 4 -row 0 -sticky e
1423        # allow font changes on the fly
1424        if {$tcl_version >= 8.0} {
1425            .disagl.txt config -font $txtvw(font)
1426            set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
1427            grid .disagl.f.font -column 1 -row 0 -sticky w
1428            grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
1429            $fontbut delete 0 end
1430            foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
1431                $fontbut add command -label "Courier $f" -font "Courier $f"\
1432                        -command "set txtvw(font) \"Courier $f\"; \
1433                        .disagl.txt config -font \$txtvw(font)"
1434            }
1435        }
1436       
1437        grid columnconfigure .disagl 0 -weight 1
1438        grid rowconfigure .disagl 1 -weight 1
1439        wm title .disagl "DISAGL results $expgui(expfile)"
1440        wm iconname .disagl "DISAGL $root"
1441        set in [open $root.tmp r]
1442        .disagl.txt insert end [read $in]
1443        close $in
1444        bind all  {destroy .disagl}
1445        bind .disagl  ".disagl.txt yview scroll -1 page"
1446        bind .disagl  ".disagl.txt yview scroll 1 page"
1447        bind .disagl  ".disagl.txt xview scroll 1 unit"
1448        bind .disagl  ".disagl.txt xview scroll -1 unit"
1449        bind .disagl  ".disagl.txt yview scroll -1 unit"
1450        bind .disagl  ".disagl.txt yview scroll 1 unit"
1451        bind .disagl  ".disagl.txt yview 0"
1452        bind .disagl  ".disagl.txt yview end"
1453        # don't disable in Win as this prevents the highlighting of selected text
1454        if {$tcl_platform(platform) != "windows"} {
1455            .disagl.txt config -state disabled
1456        }
1457    } else {
1458        runGSASwEXP disagl
1459    }
1460}
1461
1462#------------------------------------------------------------------------------
1463# file conversions
1464#------------------------------------------------------------------------------
1465proc convfile {} {
1466    global expgui
1467    set frm .file
1468    catch {destroy $frm}
1469    toplevel $frm
1470    wm title $frm "Convert File"
1471    bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
1472    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1473    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
1474            -side left -fill y -expand yes
1475    pack [button $frmC.help -text Help -bg yellow \
1476            -command "MakeWWWHelp expgui.html ConvertWin"] -side top
1477    pack [button $frmC.q -text Quit -command "destroy $frm"] -side bottom
1478    pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
1479            -side bottom
1480    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
1481    winfilebox $frm
1482    bind $frm <Return> "ValidWinCnv $frm"
1483
1484    # force the window to stay on top
1485    putontop $frm
1486    focus $frmC.q 
1487    tkwait window $frm
1488    afterputontop
1489}
1490
1491# validate the files and make the conversion
1492proc ValidWinCnv {frm} {
1493    global expgui
1494    # change backslashes to something sensible
1495    regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
1496    # allow entry of D: for D:/ and D:TEST for d:/TEST
1497    if {[string first : $expgui(FileMenuCnvName)] != -1 && \
1498            [string first :/ $expgui(FileMenuCnvName)] == -1} {
1499        regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
1500    }
1501    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1502        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1503        ChooseWinCnv $frm
1504        return
1505    } elseif [file isdirectory \
1506            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
1507        if {$expgui(FileMenuCnvName) != "."} {
1508            set expgui(FileMenuDir) \
1509                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1510        }
1511        ChooseWinCnv $frm
1512        return
1513    }
1514 
1515    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1516    if ![file exists $file] {
1517        MyMessageBox -parent $frm -title "Convert Error" \
1518                -message "File $file does not exist" -icon error
1519        return
1520    }
1521
1522    set tmpname "[file join [file dirname $file] tempfile.xxx]"
1523    set oldname "[file rootname $file].org"
1524    if [file exists $oldname] {
1525        set ans [MyMessageBox -parent . -title "Overwrite?" \
1526                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
1527                -icon warning -type {Overwrite Cancel} -default Overwrite \
1528                -helplink "expguierr.html OverwriteCnv"]
1529        if {[string tolower $ans] == "cancel"} return
1530        catch {file delete $oldname}
1531    }
1532
1533    if [catch {
1534        set in [open $file r]
1535        set out [open $tmpname w]
1536        fconfigure $out -translation crlf
1537        set len [gets $in line]
1538        if {$len > 160} {
1539            # this is a UNIX file. Hope there are no control characters
1540            set i 0
1541            set j 79
1542            while {$j < $len} {
1543                puts $out [string range $line $i $j]
1544                incr i 80
1545                incr j 80
1546            }
1547        } else {
1548            while {$len >= 0} {
1549                append line "                                        "
1550                append line "                                        "
1551                set line [string range $line 0 79]
1552                puts $out $line
1553                set len [gets $in line]
1554            }
1555        }
1556        close $in
1557        close $out
1558        file rename -force $file $oldname
1559        file rename -force $tmpname $file
1560    } errmsg] {
1561        MyMessageBox -parent $frm -title "Conversion error" \
1562                -message "Error in conversion:\n$errmsg" -icon warning
1563    } else {
1564        set ans [MyMessageBox -parent $frm -title "More?" \
1565                -message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
1566                -type yesno -default no]
1567        if {$ans == "no"} {destroy $frm}
1568    }
1569}
1570
1571# create a file box
1572proc winfilebox {frm} {
1573    global expgui
1574    set bx $frm.1
1575    pack [frame $bx.top] -side top
1576    pack [label $bx.top.a -text "Directory" ] -side left
1577    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1578    pack $bx.top.d -side left
1579    set expgui(FileMenuDir) [pwd]
1580    # the icon below is from tk8.0/tkfbox.tcl
1581    set upfolder [image create bitmap -data {
1582#define updir_width 28
1583#define updir_height 16
1584static char updir_bits[] = {
1585   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1586   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1587   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1588   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1589   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1590   0xf0, 0xff, 0xff, 0x01};}]
1591
1592    pack [button $bx.top.b -image $upfolder \
1593            -command "updir; ChooseWinCnv $frm" ]
1594    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1595    listbox $bx.a.files -relief raised -bd 2 \
1596            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1597            -height 15 -width 0 -exportselection 0 
1598    listbox $bx.a.dates -relief raised -bd 2 \
1599            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1600            -height 15 -width 0 -takefocus 0 -exportselection 0 
1601    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1602    ChooseWinCnv $frm
1603    bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
1604    bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
1605    bind $bx.a.files <Double-1> "SelectWinCnv $frm"
1606    bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
1607    pack $bx.a.scroll -side left -fill y
1608    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1609    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
1610}
1611
1612# set the box or file in the selection window
1613proc ReleaseWinCnv {frm} {
1614    global expgui
1615    set files $frm.1.a.files
1616    set dates $frm.1.a.dates
1617    set select [$files curselection]
1618    if {$select == ""} {
1619        set select [$dates curselection]
1620    }
1621    if {$select == ""} {
1622        set expgui(FileMenuCnvName) ""
1623    } else {
1624        set expgui(FileMenuCnvName) [string trim [$files get $select]]
1625    }
1626    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1627        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1628        ChooseWinCnv $frm
1629    } elseif [file isdirectory \
1630            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
1631        if {$expgui(FileMenuCnvName) != "."} {
1632            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1633            ChooseWinCnv $frm
1634        }
1635    }
1636    return
1637}
1638
1639# select a file or directory -- called on double click
1640proc SelectWinCnv {frm} {
1641    global expgui
1642    set files $frm.1.a.files
1643    set dates $frm.1.a.dates
1644    set select [$files curselection]
1645    if {$select == ""} {
1646        set select [$dates curselection]
1647    }
1648    if {$select == ""} {
1649        set file .
1650    } else {
1651        set file [string trim [$files get $select]]
1652    }
1653    if {$file == "<Parent>"} {
1654        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1655        ChooseWinCnv $frm
1656    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1657        if {$file != "."} {
1658            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1659            ChooseWinCnv $frm
1660        }
1661    } else {
1662        set expgui(FileMenuCnvName) [file tail $file]
1663        ValidWinCnv $frm
1664    }
1665}
1666
1667# fill the files & dates & Directory selection box with current directory,
1668# also called when box is created to fill it
1669proc ChooseWinCnv {frm} {
1670    global expgui
1671    set files $frm.1.a.files
1672    set dates $frm.1.a.dates
1673    set expgui(FileMenuCnvName) {}
1674    $files delete 0 end
1675    $dates delete 0 end
1676    $files insert end {<Parent>}
1677    $dates insert end {(Directory)}
1678    set filelist [glob -nocomplain \
1679            [file join [set expgui(FileMenuDir)] *] ]
1680    foreach file [lsort -dictionary $filelist] {
1681        if {[file isdirectory $file]} {
1682            $files insert end [file tail $file]
1683            $dates insert end {(Directory)}
1684        }
1685    }
1686    foreach file [lsort -dictionary $filelist] {
1687        if {![file isdirectory $file]} {
1688            set modified [clock format [file mtime $file] -format "%T %D"]
1689            $files insert end [file tail $file]
1690            $dates insert end $modified
1691        }
1692    }
1693    $expgui(FileDirButtonMenu)  delete 0 end
1694    set list ""
1695    global tcl_version
1696    if {$tcl_version > 8.0} {
1697        catch {set list [string tolower [file volume]]}
1698    }
1699    set dir ""
1700    foreach subdir [file split [set expgui(FileMenuDir)]] {
1701        set dir [string tolower [file join $dir $subdir]]
1702        if {[lsearch $list $dir] == -1} {lappend list $dir}
1703    }
1704    foreach path $list {
1705        $expgui(FileDirButtonMenu) add command -label $path \
1706                -command "[list set expgui(FileMenuDir) $path]; \
1707                ChooseWinCnv $frm"
1708    }
1709    return
1710}
1711
1712#------------------------------------------------------------------------------
1713# set options for liveplot
1714proc liveplotopt {} {
1715    global liveplot expmap
1716    set frm .file
1717    catch {destroy $frm}
1718    toplevel $frm
1719    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1720    set last [lindex [lsort -integer $expmap(powderlist)] end]
1721    if {$last == ""} {set last 1}
1722    pack [scale  $frmA.1 -label "Histogram number" -from 1 -to $last \
1723            -length  150 -orient horizontal -variable liveplot(hst)] -side top
1724    pack [checkbutton $frmA.2 -text {include plot legend}\
1725            -variable liveplot(legend)] -side top
1726    pack [button $frm.2 -text OK \
1727            -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
1728            ] -side top
1729    bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
1730   
1731    # force the window to stay on top
1732    putontop $frm 
1733    focus $frm.2
1734    tkwait window $frm
1735    afterputontop
1736}
1737
1738#------------------------------------------------------------------------------
1739# get an experiment file name
1740#------------------------------------------------------------------------------
1741proc getExpFileName {mode} {
1742    global expgui tcl_platform
1743    set frm .file
1744    catch {destroy $frm}
1745    toplevel $frm
1746    wm title $frm "Experiment file"
1747    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
1748    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1749    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
1750            -fill y -expand yes
1751    pack [button $frmC.help -text Help -bg yellow \
1752            -command "MakeWWWHelp expguierr.html open"] \
1753            -side top -anchor e
1754    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
1755    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
1756            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1757    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
1758            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1759
1760    set expgui(includearchived) 0
1761    set expgui(FileInfoBox) $frmC.info
1762    if {$mode == "old"} {
1763        pack [checkbutton $frmC.ar -text "Include Archived Files" \
1764                -variable expgui(includearchived) \
1765                -command "ChooseExpFil $frmA"] -side top -pady 10
1766        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
1767                -class SmallFont] \
1768                -side top -fill both -expand yes -pady 5
1769    }
1770    pack [button $frmC.b -text Read \
1771            -command "valid_exp_file $frmA $mode"] -side bottom
1772    if {$mode == "new"} {
1773        $frmC.b config -text Save
1774    }
1775    pack [button $frmC.q -text Quit \
1776            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
1777    bind $frm <Return> "$frmC.b invoke"
1778
1779    if {$mode == "new"} {
1780        pack [label $frmA.0 -text "Enter an experiment file to create"] \
1781                -side top -anchor center
1782    } else {
1783        pack [label $frmA.0 -text "Select an experiment file to read"] \
1784                -side top -anchor center
1785    }
1786    expfilebox $frmA $mode
1787    # force the window to stay on top
1788    putontop $frm
1789    focus $frmC.b
1790    tkwait window $frm
1791    afterputontop
1792    if {$expgui(FileMenuEXPNAM) == ""} return
1793    # is there a space in the EXP name?
1794    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
1795        update
1796        MyMessageBox -parent . -title "File Name Error" \
1797            -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
1798            -icon warning -type Continue -default continue
1799#               -helplink "expguierr.html OpenErr"
1800        return
1801    }
1802    if {[string first " " $expgui(FileMenuDir)] != -1} {
1803        update
1804        MyMessageBox -parent . -title "Good luck..." \
1805            -message "You are using a directory with a space in the name ([file dirname $expgui(FileMenuDir)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@NIST.gov so they can be fixed." \
1806            -icon warning -type Continue -default continue
1807#               -helplink "expguierr.html OpenErr"
1808    }
1809    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1810}
1811
1812# validation routine
1813proc valid_exp_file {frm mode} {
1814    global expgui tcl_platform
1815    # windows fixes
1816    if {$tcl_platform(platform) == "windows"} {
1817        # change backslashes to something sensible
1818        regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
1819        # allow entry of D: for D:/ and D:TEST for d:/TEST
1820        if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
1821                [string first :/ $expgui(FileMenuEXPNAM)] == -1} {
1822            regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
1823        }
1824    }
1825    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
1826        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1827        ChooseExpFil $frm
1828        return
1829    } elseif [file isdirectory \
1830            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
1831        if {$expgui(FileMenuEXPNAM) != "."} {
1832            set expgui(FileMenuDir) \
1833                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1834        }
1835        ChooseExpFil $frm
1836        return
1837    }
1838    # append a .EXP if not present
1839    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
1840        append expgui(FileMenuEXPNAM) ".EXP"
1841    }
1842    # is there a space in the name?
1843    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
1844        MyMessageBox -parent . -title "File Name Error" \
1845                -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
1846                -icon warning -type Continue -default continue
1847#               -helplink "expguierr.html OpenErr"
1848        return
1849    }
1850    # check for archive files
1851    if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
1852            $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
1853        destroy .file
1854        return
1855    } elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
1856        # check for files that end in something other than .EXP .exp or .Exp...
1857        MyMessageBox -parent . -title "File Open Error" \
1858                -message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
1859                -icon error
1860        return
1861    }
1862    # check on the file status
1863    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1864    if {$mode == "new" && [file exists $file]} {
1865        set ans [
1866        MyMessageBox -parent . -title "File Open Error" \
1867                -message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
1868                -icon question -type {"Select other" "Overwrite"} -default "select other" \
1869                -helplink "expguierr.html OverwriteErr"
1870        ]
1871        if {[string tolower $ans] == "overwrite"} {destroy .file}
1872        return
1873    }
1874    # if file does not exist in case provided, set the name to all
1875    # upper case letters, since that is the best choice.
1876    # if it does exist, read from it as is. For UNIX we will force uppercase later.
1877    if {![file exists $file]} {
1878        set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
1879        set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1880    }
1881    if {$mode == "old" && ![file exists $file]} {
1882        set ans [
1883        MyMessageBox -parent . -title "File Open Error" \
1884                -message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
1885                -icon question -type {"Select other" "Create"} -default "select other" \
1886                -helplink "expguierr.html OpenErr"
1887        ]
1888        if {[string tolower $ans] == "create"} {destroy .file}
1889        return
1890    }
1891    destroy .file
1892}
1893
1894proc updir {} {
1895    global expgui
1896    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
1897}
1898
1899# create a file box
1900proc expfilebox {bx mode} {
1901    global expgui
1902    pack [frame $bx.top] -side top
1903    pack [label $bx.top.a -text "Directory" ] -side left
1904    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1905    pack $bx.top.d -side left
1906    set expgui(FileMenuDir) [pwd]
1907    # the icon below is from tk8.0/tkfbox.tcl
1908    set upfolder [image create bitmap -data {
1909#define updir_width 28
1910#define updir_height 16
1911static char updir_bits[] = {
1912   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1913   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1914   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1915   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1916   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1917   0xf0, 0xff, 0xff, 0x01};}]
1918
1919    pack [button $bx.top.b -image $upfolder \
1920            -command "updir; ChooseExpFil $bx" ]
1921    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1922    listbox $bx.a.files -relief raised -bd 2 \
1923            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1924            -height 15 -width 0 -exportselection 0 
1925    listbox $bx.a.dates -relief raised -bd 2 \
1926            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1927            -height 15 -width 0 -takefocus 0 -exportselection 0 
1928    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1929    ChooseExpFil $bx
1930    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
1931    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
1932    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
1933    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
1934    pack $bx.a.scroll -side left -fill y
1935    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1936    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
1937}
1938proc sync2boxesX {master slave scroll args} {
1939    $slave xview moveto [lindex [$master xview] 0]
1940    eval $scroll set $args
1941}
1942proc move2boxesX {boxlist args} {
1943    foreach listbox $boxlist { 
1944        eval $listbox xview $args
1945    }
1946}
1947proc sync2boxesY {master slave scroll args} {
1948    $slave yview moveto [lindex [$master yview] 0]
1949    eval $scroll set $args
1950}
1951proc move2boxesY {boxlist args} {
1952    foreach listbox $boxlist { 
1953        eval $listbox yview $args
1954    }
1955}
1956
1957# creates a table that is scrollable in both x and y, use ResizeScrollTable
1958# to set sizes after gridding the boxes
1959proc MakeScrollTable {box} {
1960    grid [label $box.0] -column 0 -row 0
1961    grid [set tbox [canvas $box.top \
1962            -scrollregion {0 0 10 10} \
1963            -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
1964            -width 10 -height 10]] \
1965            -sticky sew -row 0 -column 1
1966    grid [set sbox [canvas $box.side \
1967            -scrollregion {0 0 10 10} \
1968            -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
1969            -width 10 -height 10]] \
1970            -sticky nes -row 1 -column 0
1971    grid [set bbox [canvas $box.can \
1972            -scrollregion {0 0 10 10} \
1973            -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
1974            -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
1975            -width 200 -height 200 -bg lightgrey]] \
1976            -sticky news -row 1 -column 1
1977    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
1978            -command "move2boxesX \" $box.can $box.top \" "]] \
1979            -sticky ew -row 2 -column 1
1980    grid [set sybox [scrollbar $box.yscroll \
1981            -command "move2boxesY \" $box.can $box.side \" "]] \
1982            -sticky ns -row 1 -column 2
1983    frame $tbox.f -bd 0
1984    $tbox create window 0 0 -anchor nw  -window $tbox.f
1985    frame $bbox.f -bd 2
1986    $bbox create window 0 0 -anchor nw  -window $bbox.f
1987    frame $sbox.f -bd 2 -relief raised
1988    $sbox create window 0 0 -anchor nw  -window $sbox.f
1989    grid columnconfig $box 1 -weight 1
1990    grid rowconfig $box 1 -weight 1
1991    return [list  $tbox.f  $bbox.f $sbox.f $box.0]
1992}
1993
1994proc ResizeScrollTable {box} {
1995    update idletasks
1996    for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
1997        set x1 [lindex [grid bbox $box.can.f $i 0] 2]
1998        set x2 [lindex [grid bbox $box.top.f $i 0] 2]
1999        if {$x2 > $x1} {set x1 $x2}
2000        grid columnconfigure $box.top.f $i -minsize $x1
2001        grid columnconfigure $box.can.f $i -minsize $x1
2002    }
2003    for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
2004        set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
2005        set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
2006        if {$x2 > $x1} {set x1 $x2}
2007        grid rowconfigure $box.can.f $i -minsize $x1
2008        grid rowconfigure $box.side.f $i -minsize $x1
2009    }
2010    update idletasks
2011    set sizes [grid bbox $box.can.f]
2012    $box.can config -scrollregion $sizes
2013    $box.side config -scrollregion $sizes
2014    $box.top config -scrollregion $sizes
2015    $box.top config -height [lindex [grid bbox $box.top.f] 3]
2016    $box.side config -width [lindex [grid bbox $box.side.f] 2]
2017}
2018proc ExpandScrollTable {box} {
2019    # set height & width of central box
2020    $box.can config -width \
2021            [expr [winfo width [winfo toplevel $box]] \
2022            - [winfo width $box.side] - [winfo width $box.yscroll]-20]
2023    $box.can config -height \
2024            [expr [winfo height [winfo toplevel $box]] \
2025            - [winfo height $box.top] - [winfo height $box.scroll]-25]
2026}
2027
2028
2029# support routine for SetHistUseFlags
2030proc InitHistUseFlags {} {
2031    global expmap expgui
2032    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2033#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2034            set expgui(useflag_$i) [histinfo $i use]
2035#       }
2036    }
2037}
2038
2039# show all Powder histograms; set use/do not use flags
2040proc SetHistUseFlags {} {
2041    set box .test
2042    catch {toplevel $box}
2043    eval destroy [winfo children $box]
2044    grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
2045    grid [frame $box.a] -row 1 -column 0 -columnspan 2
2046    grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
2047    grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
2048    grid columnconfig $box 0 -weight 1
2049    grid columnconfig $box 1 -weight 1
2050    foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
2051    $cbox config -text "Use\nFlag"
2052    [winfo parent $bbox] config -height 250 -width 400
2053    global expmap expgui
2054    set px 5
2055    set row -1
2056    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2057        if {[string range $expmap(htype_$i) 2 2] == "T"} {
2058            set det [format %8.2f [histinfo $i tofangle]]
2059        } elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
2060            set det [format %8.5f [histinfo $i lam1]]
2061        } elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
2062            set det [format %8.2f [histinfo $i lam1]]
2063        } else {
2064            set det {}
2065        }
2066        incr row
2067#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2068            grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0 
2069            set expgui(useflag_$i) [histinfo $i use]
2070#       }
2071        grid [label $bbox.0$i \
2072                -text [string range $expmap(htype_$i) 0 3] \
2073                ] -row $row -column 0 -padx $px
2074        grid [label $bbox.1$i -text [histinfo $i bank] \
2075                ] -row $row -column 1 -padx $px
2076        grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
2077        grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
2078                ] -row $row -column 3 -padx $px -sticky ew
2079    }
2080    grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
2081    grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
2082    grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
2083    grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
2084    ResizeScrollTable $box.a
2085    InitHistUseFlags
2086    putontop $box
2087    tkwait window $box
2088    afterputontop
2089    set prevchages $expgui(changed)
2090    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2091#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2092            if {$expgui(useflag_$i) != [histinfo $i use]} {
2093                histinfo $i use set $expgui(useflag_$i)
2094                incr expgui(changed)
2095            }
2096#       }
2097    }
2098    if {$prevchages != $expgui(changed)} {
2099        set msg "You have changed [expr $expgui(changed)-$prevchages] "
2100        append msg "histogram flag(s). You must run POWPREF "
2101        append msg "to include/remove these histograms. Do you want to "
2102        append msg "run POWPREF?"
2103        set ans [MyMessageBox -parent . -message $msg \
2104                -title "Process changes?"\
2105                -helplink "expguierr.html ProcessUse" \
2106                -default {Run POWPREF} \
2107                -type {{Run POWPREF} Skip}]
2108       
2109        if {$ans == "skip"} {
2110            # save and reload the experiment file
2111            savearchiveexp
2112            loadexp $expgui(expfile)
2113        } else {
2114            # run powpref and force a reload
2115            set saveautoload $expgui(autoexpload)
2116            set expgui(autoexpload) 1
2117            runGSASwEXP powpref
2118            set expgui(autoexpload) $saveautoload
2119        }
2120    }
2121}
2122
2123# set the box or file in the selection window
2124proc ReleaseExpFil {frm} {
2125    global expgui
2126    set files $frm.a.files
2127    set dates $frm.a.dates
2128    set select [$files curselection]
2129    if {$select == ""} {
2130        set select [$dates curselection]
2131    }
2132    if {$select == ""} {
2133        set expgui(FileMenuEXPNAM) ""
2134    } else {
2135        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
2136        after idle UpdateInfoBox
2137    }
2138    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2139        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
2140        ChooseExpFil $frm
2141    } elseif [file isdirectory \
2142            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
2143        if {$expgui(FileMenuEXPNAM) != "."} {
2144            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2145            ChooseExpFil $frm
2146        }
2147    }
2148    return
2149}
2150proc UpdateInfoBox {} {
2151    global expgui
2152    if {![winfo exists $expgui(FileInfoBox)]} return
2153    eval destroy [winfo children $expgui(FileInfoBox)]
2154    set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
2155    if [file isdirectory $file] return
2156    if [file exists $file] {
2157        pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
2158                -side top
2159        catch {
2160            set fp [open $file r]
2161            global testline
2162            set testline [read $fp]
2163            close $fp
2164            update
2165            regexp {GNLS  RUN on (.*) +Total.*run +([0-9]+) } \
2166                    $testline a last cycles
2167            pack [label $expgui(FileInfoBox).2 -justify left \
2168                    -text "last GENLES run:\n  $last\n  total cycles: $cycles"] \
2169                -side top -anchor w
2170            regexp {REFN GDNFT.*= *([0-9]*\.[0-9]*) +for *([0-9]+) variables} \
2171                    $testline a chi2 vars
2172            pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
2173                    -side top -anchor w
2174            pack [label $expgui(FileInfoBox).3.a -justify left \
2175                    -text "c" -font symbol] \
2176                    -side left -anchor w
2177            pack [label $expgui(FileInfoBox).3.b -justify left \
2178                    -text "2: $chi2, $vars vars"] \
2179                    -side top -anchor w
2180            # check first 9 histograms
2181            set lbl "h  Rwp     R(F2)"
2182            set n 0
2183            foreach k {1 2 3 4 5 6 7 8 9} {
2184                set key "HST  $k"
2185                append key { RPOWD +([0-9]*\.[0-9]*) }
2186                set i [regexp $key $testline a Rwp]
2187                set key "HST  $k"
2188                append key { R-FAC +[0-9]+ +([0-9]*\.[0-9]*) }
2189                set j [regexp $key $testline a Rb]
2190                if {$i || $j} {
2191                    incr n
2192                    append lbl "\n$k  "
2193                    if {$i} {
2194                        append lbl [string range $Rwp 0 5]
2195                    } else {
2196                        append lbl "    "
2197                    }
2198                }
2199                if {$j} {
2200                    append lbl " [string range $Rb 0 5]"
2201                }
2202                # stick 1st 3 entries in box
2203                if {$n >= 3} break
2204            }
2205            pack [label $expgui(FileInfoBox).4 -justify left \
2206                    -text $lbl] \
2207                    -side top -anchor w     
2208        }
2209    }
2210}
2211
2212# select a file or directory -- called on double click
2213proc SelectExpFil {frm mode} {
2214    global expgui
2215    set files $frm.a.files
2216    set dates $frm.a.dates
2217    set select [$files curselection]
2218    if {$select == ""} {
2219        set select [$dates curselection]
2220    }
2221    if {$select == ""} {
2222        set file .
2223    } else {
2224        set file [string trim [$files get $select]]
2225    }
2226    if {$file == "<Parent>"} {
2227        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2228        ChooseExpFil $frm
2229    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
2230        if {$file != "."} {
2231            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
2232            ChooseExpFil $frm
2233        }
2234    } else {
2235        set expgui(FileMenuEXPNAM) [file tail $file]
2236        valid_exp_file $frm $mode
2237    }
2238}
2239
2240# fill the files & dates & Directory selection box with current directory,
2241# also called when box is created to fill it
2242proc ChooseExpFil {frm} {
2243    global expgui
2244    set files $frm.a.files
2245    set dates $frm.a.dates
2246    set expgui(FileMenuEXPNAM) {}
2247    $files delete 0 end
2248    $dates delete 0 end
2249    $files insert end {<Parent>}
2250    $dates insert end {(Directory)}
2251    set filelist [glob -nocomplain \
2252            [file join [set expgui(FileMenuDir)] *] ]
2253    foreach file [lsort -dictionary $filelist] {
2254        if {[file isdirectory $file]} {
2255            $files insert end [file tail $file]
2256            $dates insert end {(Directory)}
2257        }
2258    }
2259    set pairlist {}
2260    foreach file [lsort -dictionary $filelist] {
2261        if {![file isdirectory $file]  && \
2262                [string toupper [file extension $file]] == ".EXP"} {
2263            set modified [file mtime $file]
2264            lappend pairlist [list $file $modified]
2265        } elseif {![file isdirectory $file] && $expgui(includearchived) && \
2266                [string match {*.O[0-9A-F][0-9A-F]} $file]} {
2267            set modified [file mtime $file]
2268            lappend pairlist [list $file $modified]
2269        }
2270    }
2271    if {$expgui(filesort) == 0} {
2272        foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
2273            set file [lindex $pair 0]
2274            set modified [clock format [lindex $pair 1] -format "%T %D"]
2275            $files insert end [file tail $file]
2276            $dates insert end $modified
2277        }
2278    } else {
2279        foreach pair [lsort -dictionary -index 0 $pairlist] {
2280            set file [lindex $pair 0]
2281            set modified [clock format [lindex $pair 1] -format "%T %D"]
2282            $files insert end [file tail $file]
2283            $dates insert end $modified
2284        }
2285    }
2286    $expgui(FileDirButtonMenu)  delete 0 end
2287    set list ""
2288    global tcl_platform tcl_version
2289    if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
2290        catch {set list [string tolower [file volume]]}
2291    }
2292    set dir ""
2293    foreach subdir [file split [set expgui(FileMenuDir)]] {
2294        set dir [file join $dir $subdir]
2295        if {$tcl_platform(platform) == "windows"} {
2296            set dir [string tolower $dir]
2297            if {[lsearch $list $dir] == -1} {lappend list $dir}
2298        } else {
2299            lappend list $dir
2300        }
2301    }
2302    foreach path $list {
2303        $expgui(FileDirButtonMenu) add command -label $path \
2304                -command "[list set expgui(FileMenuDir) $path]; \
2305                ChooseExpFil $frm"
2306    }
2307    # highlight the current experiment -- if present
2308    for {set i 0} {$i < [$files size]} {incr i} {
2309        set file [$files get $i]
2310        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
2311            $files selection set $i
2312        }
2313    }
2314    return
2315}
2316
2317
2318#------------------------------------------------------------------------------
2319# platform-specific definitions
2320if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
2321    # windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
2322    # DOS box synchronously, so we create a "lock" file that is deleted
2323    # at the end of the DOS run so we can tell when the run is done.
2324    # We create a window to force the deleting of the file so that if
2325    # the DOS process crashes, the user can continue anyway.
2326    #
2327    # procedure to check if the lock file is still there (Win-9x/me only)
2328    proc checklockfile {file window} {
2329        if [file exists $file] {
2330            after 500 checklockfile $file $window
2331        } else {
2332            catch {destroy $window}
2333        }
2334    }
2335    # this procedure starts the GRWND program, if needed for program $prog
2336    proc StartGRWND {prog} {
2337        global expgui
2338        if {!$expgui(autoGRWND)} return
2339        # at some point we might want to have a real list
2340        if {$prog != "genles" && $prog != "powpref"} {
2341            # get a list of running jobs
2342            exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
2343            set fp [open tlist.tlist r]
2344            set text [read $fp]
2345            close $fp
2346            file delete -force tlist.tlist
2347            # if GRWND.EXE is not currently running, start it
2348            if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
2349                exec [file join $expgui(gsasexe) grwnd.exe] &
2350                # give grwnd a 1 second head start
2351                after 1000
2352            }
2353        }
2354    }
2355    # this creates a DOS box to run a program in
2356    proc forknewterm {title command "wait 1" "scrollbar 1"} {
2357        global env expgui
2358        # Windows environment variables
2359        set env(GSAS) [file nativename $expgui(gsasdir)]
2360        # PGPLOT_FONT is needed by PGPLOT
2361        set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) pgl grfont.dat]]
2362        # this is the number of lines/page in the .LST (etc.) file
2363        set env(LENPAGE) 60
2364        set pwd [file nativename [pwd]]
2365       
2366        # check the .EXP path -- can DOS use it?
2367        if {[string first // [pwd]] != -1} {
2368            MyMessageBox -parent . -title "Invalid Path" \
2369                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2370                    -icon error -type ok -default ok \
2371                    -helplink "expgui_Win_readme.html NetPath"
2372            return
2373        }
2374        # pause is hard coded in the .BAT file
2375        #
2376        # loop over multiple commands
2377        foreach cmd $command {
2378            # simulate the wait with a lock file
2379            if {$wait} {
2380                if {$expgui(autoiconify)} {wm iconify .}
2381                # create a blank lock file and a message window
2382                close [open expgui.lck w]
2383                toplevel .lock
2384                grid [button .lock.0 -text Help -bg yellow \
2385                        -command "MakeWWWHelp expguierr.html lock"] \
2386                        -column 1 -row 0
2387                grid [label .lock.1 \
2388                        -text "Please wait while the GSAS program finishes."] \
2389                        -column 0 -row 0
2390                grid [label .lock.2 -text \
2391                        "In case a problem occurs, close the DOS box"] \
2392                        -column 0 -columnspan 2 -row 1
2393                grid [label .lock.3 -text \
2394                        "and press the \"Continue\" button (below)"] \
2395                        -column 0 -columnspan 2 -row 2
2396                grid [button .lock.b -text "Continue" \
2397                        -command "destroy .lock; wm deiconify ."] \
2398                        -column 0 -columnspan 2 -row 3
2399                putontop .lock
2400                update
2401                checklockfile expgui.lck .lock
2402            }
2403            # replace the forward slashes with backward
2404            regsub -all / $cmd \\ cmd
2405            winexec -d [file nativename [pwd]] \
2406                    [file join $expgui(scriptdir) gsastcl.bat] $cmd
2407            if {$wait} {
2408                tkwait window .lock
2409                file delete -force expgui.lck
2410            }
2411        }
2412        if {$expgui(autoiconify) && $wait} {wm deiconify .}
2413        # check for changes in the .EXP file immediately
2414        whenidle
2415    }
2416} elseif {$tcl_platform(platform) == "windows"} {
2417    # now for Windows-NT, where we can run synchronously
2418    #
2419    # this creates a DOS box to run a program in
2420    proc forknewterm {title command  "wait 1" "scrollbar 1"} {
2421        global env expgui
2422        # Windows environment variables
2423        set env(GSAS) [file nativename $expgui(gsasdir)]
2424        # PGPLOT_FONT is needed by PGPLOT
2425        set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) pgl grfont.dat]]
2426        # this is the number of lines/page in the .LST (etc.) file
2427        set env(LENPAGE) 60
2428        set pwd [file nativename [pwd]]
2429        # check the path -- can DOS use it?
2430        if {[string first // [pwd]] != -1} {
2431            MyMessageBox -parent . -title "Invalid Path" \
2432                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2433                    -icon error -type ok -default ok \
2434                    -helplink "expgui_Win_readme.html NetPath"
2435            return
2436        }
2437        # pause is hard coded in the .BAT file
2438
2439        if {$wait} {
2440            if {$expgui(autoiconify)} {wm iconify .}
2441            # create a blank lock file (keep liveplot from running)
2442            close [open expgui.lck w]
2443            # loop over commands
2444            foreach cmd $command {
2445                # replace the forward slashes with backward
2446                regsub -all / $cmd \\ cmd
2447                exec $env(COMSPEC) /c \
2448                        "start [file join $expgui(scriptdir) gsastcl.bat] $cmd"
2449            }
2450            file delete -force expgui.lck
2451            if {$expgui(autoiconify)} {wm deiconify .}
2452            # check for changes in the .EXP file immediately
2453            whenidle
2454        } else {
2455            # loop over commands
2456            foreach cmd $command {
2457                # replace the forward slashes with backward
2458                regsub -all / $cmd \\ cmd
2459                # run in background
2460                exec $env(COMSPEC) /c \
2461                        "start [file join $expgui(scriptdir) gsastcl.bat] $cmd" &
2462            }
2463        }
2464    }
2465} else {
2466    # this creates a xterm window to run a program in
2467    proc forknewterm {title command "wait 1" "scrollbar 1"} {
2468        global env expgui
2469        # UNIX environment variables
2470        set env(GSAS) [file nativename $expgui(gsasdir)]
2471        set env(gsas) [file nativename $expgui(gsasdir)]
2472        set env(GSASEXE) $expgui(gsasexe)
2473        set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2474        set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2475        # PGPLOT_DIR is needed by PGPLOT
2476        set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl]
2477        # this is the number of lines/page in the .LST (etc.) file
2478        set env(LENPAGE) 60
2479        set termopts {}
2480        if $env(GSASBACKSPACE) {
2481            append termopts \
2482                    {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
2483        }
2484        if $scrollbar {
2485            append termopts " -sb"
2486        } else {
2487            append termopts " +sb"
2488        }
2489        if {$wait} {
2490            set suffix {}
2491        } else {
2492            set suffix {&}
2493        }
2494        #
2495        #if $wait {
2496            append command "\; echo -n Press Enter to continue \; read x"
2497        #}
2498        if {$wait && $expgui(autoiconify)} {wm iconify .}
2499        catch {eval exec xterm $termopts -title [list $title] \
2500                -e /bin/sh -c [list $command] $suffix} errmsg
2501        if $expgui(debug) {puts "xterm result = $errmsg"}
2502        if {$wait} {
2503            if {$expgui(autoiconify)} {wm deiconify .}
2504            # check for changes in the .EXP file immediately
2505            whenidle
2506        }
2507    }
2508}
Note: See TracBrowser for help on using the repository browser.