source: trunk/gsascmds.tcl @ 633

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

# on 2002/07/18 20:51:26, toby did:
remove iconify from excledt -- seems to work better on Windows

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