source: trunk/gsascmds.tcl @ 910

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

# on 2008/04/15 17:20:39, toby did:
macro recording
implement prompt/no prompt in GSAS window
implement run macros
new proc to run GSAS programs w/o a terminal window

  • Property rcs:author set to toby
  • Property rcs:date set to 2008/04/15 17:20:39
  • Property rcs:lines set to +404 -12
  • Property rcs:rev set to 1.64
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 101.0 KB
Line 
1# $Id: gsascmds.tcl 910 2009-12-04 23:14:10Z 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    # Make the message box transient if the parent is viewable.
136    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
137        wm transient $w $data(-parent)
138    } 
139   
140    catch {
141        if {[string equal [tk windowingsystem] "classic"]
142        || [string equal [tk windowingsystem] "aqua"]} {
143            unsupported::MacWindowStyle style $w dBoxProc
144        }
145    }
146
147    frame $w.bot
148    pack $w.bot -side bottom -fill both
149    frame $w.top
150    pack $w.top -side top -fill both -expand 1
151    if {$data(-helplink) != ""} {
152#       frame $w.help
153#       pack $w.help -side top -fill both
154        pack [button $w.top.1 -text Help -bg yellow \
155                -command "MakeWWWHelp $data(-helplink)"] \
156                -side right -anchor ne
157        bind $w <Key-F1> "MakeWWWHelp $data(-helplink)"
158    }
159    if {[string compare $tcl_platform(platform) "macintosh"]} {
160        $w.bot configure -relief raised -bd 1
161        $w.top configure -relief raised -bd 1
162    }
163
164    # 4. Fill the top part with bitmap and message (use the option
165    # database for -wraplength and -font so that they can be
166    # overridden by the caller).
167
168    option add *Dialog.msg.wrapLength 6i widgetDefault
169
170    if {[string length $data(-message)] > 300} {
171        if {![string compare $tcl_platform(platform) "macintosh"]} {
172            option add *Dialog.msg.t.font system widgetDefault
173        } else {
174            option add *Dialog.msg.t.font {Times 18} widgetDefault
175        }
176        frame $w.msg
177        grid [text  $w.msg.t  \
178                -height 20 -width 55 -relief flat -wrap word \
179                -yscrollcommand "$w.msg.rscr set" \
180                ] -row 1 -column 0 -sticky news
181        grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
182                ] -row 1 -column 1 -sticky ns
183        # give extra space to the text box
184        grid columnconfigure $w.msg 0 -weight 1
185        grid rowconfigure $w.msg 1 -weight 1
186        $w.msg.t insert end $data(-message)
187    } else {
188        if {![string compare $tcl_platform(platform) "macintosh"]} {
189            option add *Dialog.msg.font system widgetDefault
190        } else {
191            option add *Dialog.msg.font {Times 18} widgetDefault
192        }
193        label $w.msg -justify left -text $data(-message)
194    }
195    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
196    if {[string compare $data(-icon) ""]} {
197        label $w.bitmap -bitmap $data(-icon)
198        pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
199    }
200
201    # 5. Create a row of buttons at the bottom of the dialog.
202
203    set i 0
204    foreach but $buttons {
205        set name [lindex $but 0]
206        set opts [lrange $but 1 end]
207      if {![llength $opts]} {
208            # Capitalize the first letter of $name
209          set capName [string toupper \
210                    [string index $name 0]][string range $name 1 end]
211            set opts [list -text $capName]
212        }
213
214      eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
215
216        if {![string compare $name [string tolower $data(-default)]]} {
217            $w.$name configure -default active
218        }
219      pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
220
221        # create the binding for the key accelerator, based on the underline
222        #
223        set underIdx [$w.$name cget -under]
224        if {$underIdx >= 0} {
225            set key [string index [$w.$name cget -text] $underIdx]
226          bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
227          bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
228        }
229        incr i
230    }
231
232    # 6. Create a binding for <Return> on the dialog if there is a
233    # default button.
234
235    if {[string compare $data(-default) ""]} {
236      bind $w <Return> [list $w.[string tolower $data(-default)] invoke]
237    }
238
239    # 7. Withdraw the window, then update all the geometry information
240    # so we know how big it wants to be, then center the window in the
241    # display and de-iconify it.
242
243    wm withdraw $w
244    update idletasks
245    set wp $data(-parent)
246    # center the new window in the middle of the parent
247    set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
248            [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
249    set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
250            [winfo reqheight $w]/2 - [winfo vrooty $wp]]
251    # make sure that we can see the entire window
252    set xborder 10
253    set yborder 25
254    if {$x < 0} {set x 0}
255    if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
256        incr x [expr \
257                [winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
258    }
259    if {$y < 0} {set y 0}
260    if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
261        incr y [expr \
262                [winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
263    }
264    wm geom $w +$x+$y
265    wm deiconify $w
266
267    # 8. Set a grab and claim the focus too.
268
269    catch {set oldFocus [focus]}
270    catch {set oldGrab [grab current $w]}
271    catch {
272        grab $w
273        if {[string compare $data(-default) ""]} {
274            focus $w.[string tolower $data(-default)]
275        } else {
276            focus $w
277        }
278    }
279
280    # 9. Wait for the user to respond, then restore the focus and
281    # return the index of the selected button.  Restore the focus
282    # before deleting the window, since otherwise the window manager
283    # may take the focus away so we can't redirect it.  Finally,
284    # restore any grab that was in effect.
285
286    tkwait variable tkPriv(button)
287    catch {focus $oldFocus}
288    destroy $w
289    catch {grab $oldGrab}
290    return $tkPriv(button)
291}
292
293# tell'em what is happening
294#    message    is a text message to display
295#    statusvar  is a variable name containing a message that gets updated
296#    parent     is the name of the parent window
297#    button     defines a button for the window. Element 0 in $button is the
298#               text for the button and Element 1 is the command to execute.
299proc pleasewait {{message {}} {statusvar {}} {parent .} {button ""}} {
300    catch {destroy .msg}
301    toplevel .msg
302    wm transient .msg [winfo toplevel .]
303    pack [frame .msg.f -bd 4 -relief groove] -padx 5 -pady 5
304    pack [message .msg.f.m -text "Please wait $message"] -side top
305    if {$statusvar != ""} {
306        pack [label .msg.f.status -textvariable $statusvar] -side top
307    }
308    if {$button != ""} {
309        pack [button .msg.f.button -text [lindex $button 0] \
310                -command [lindex $button 1]] -side top
311    }
312    wm withdraw .msg
313    update idletasks
314    # place the message on top of the parent window
315    set x [expr [winfo x $parent] + [winfo width $parent]/2 - \
316            [winfo reqwidth .msg]/2 - [winfo vrootx $parent]]
317    if {$x < 0} {set x 0}
318    set y [expr [winfo y $parent] + [winfo height $parent]/2 - \
319            [winfo reqheight .msg]/2 - [winfo vrooty $parent]]
320    if {$y < 0} {set y 0}
321    wm geom .msg +$x+$y
322    wm deiconify .msg
323    global makenew
324    set makenew(OldGrab) ""
325    set makenew(OldFocus) ""
326    # save focus & grab
327    catch {set makenew(OldFocus) [focus]}
328    catch {set makenew(OldGrab) [grab current .msg]}
329    catch {grab .msg}
330    update
331}
332
333# clear the message
334proc donewait {} {
335    global makenew
336    catch {destroy .msg}
337    # reset focus & grab
338    catch {
339        if {$makenew(OldFocus) != ""} {
340            focus $makenew(OldFocus)
341        }
342    }
343    catch {
344        if {$makenew(OldGrab) != ""} {
345            grab $makenew(OldGrab)
346        }
347    }
348}
349
350proc putontop {w "center 0"} {
351    # center window $w above its parent and make it stay on top
352    set wpt [winfo toplevel [set wp [winfo parent $w]]]
353    if {[winfo viewable $wpt]} {
354        wm transient $w $wpt
355    }
356    wm withdraw $w
357    update idletasks
358    if {$center} {
359        set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
360                - [winfo vrootx $wpt]}]
361        set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
362                - [winfo vrooty $wpt]}]
363    } else {
364        # center the new window in the middle of the parent
365        set x [expr [winfo x $wpt] + [winfo width $wpt]/2 - \
366                [winfo reqwidth $w]/2 - [winfo vrootx $wpt]]
367        if {$x < 0} {set x 0}
368        set xborder 10
369        if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
370            incr x [expr [winfo screenwidth $w] - \
371                    ($x+[winfo reqwidth $w] + $xborder)]
372        }
373        set y [expr [winfo y $wpt] + [winfo height $wpt]/2 - \
374                [winfo reqheight $w]/2 - [winfo vrooty $wpt]]
375        if {$y < 0} {set y 0}
376        set yborder 25
377        if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
378            incr y [expr [winfo screenheight $w] - \
379                    ($y+[winfo reqheight $w] + $yborder)]
380        }
381    }
382    wm geometry $w +$x+$y
383    wm deiconify $w
384
385    global makenew
386    # set grab & focus; use new approach for 8.3 & later
387    if {[info proc ::tk::SetFocusGrab] == ""} {
388        set makenew(OldGrab) ""
389        set makenew(OldFocus) ""
390        catch {set makenew(OldFocus) [focus]}
391        catch {set makenew(OldGrab) [grab current $w]}
392        catch {grab $w}
393    } else {
394        set makenew(OldGrab) $w
395        set makenew(OldFocus) $w
396        ::tk::SetFocusGrab $w $w
397    }
398}
399
400# restore focus after putontop has completed
401proc afterputontop {} {
402    global makenew
403    # reset focus & grab; use new approach for 8.3 & later
404    if {[info proc ::tk::SetFocusGrab] == ""} {
405        if {$makenew(OldFocus) != ""} {
406            catch {focus $makenew(OldFocus)}
407        }
408        if {$makenew(OldGrab) != ""} {
409            catch {grab $makenew(OldGrab)}
410        }
411    } else {
412        catch {::tk::RestoreFocusGrab $makenew(OldGrab) $makenew(OldFocus)}
413    }
414}
415
416proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} {
417    catch {destroy $win}
418    toplevel $win
419
420    pack [label $win.l1 -text $labeltext] -side top
421    if {$err} {$win.l1 config -fg red}
422    pack [frame $win.f1] -side top -expand yes -fill both
423    grid [text  $win.f1.t  \
424            -height 20 -width 55  -wrap none -font Courier \
425            -xscrollcommand "$win.f1.bscr set" \
426            -yscrollcommand "$win.f1.rscr set" \
427            ] -row 1 -column 0 -sticky news
428    grid [scrollbar $win.f1.bscr -orient horizontal \
429            -command "$win.f1.t xview" \
430            ] -row 2 -column 0 -sticky ew
431    grid [scrollbar $win.f1.rscr  -command "$win.f1.t yview" \
432            ] -row 1 -column 1 -sticky ns
433    # give extra space to the text box
434    grid columnconfigure $win.f1 0 -weight 1
435    grid rowconfigure $win.f1 1 -weight 1
436    $win.f1.t insert end $msg
437
438    global makenew
439    set makenew(result) 0
440    bind $win <Return> "destroy $win"
441    bind $win <KeyPress-Prior> "$win.f1.t yview scroll -1 page"
442    bind $win <KeyPress-Next> "$win.f1.t yview scroll 1 page"
443    bind $win <KeyPress-Right> "$win.f1.t xview scroll 1 unit"
444    bind $win <KeyPress-Left> "$win.f1.t xview scroll -1 unit"
445    bind $win <KeyPress-Up> "$win.f1.t yview scroll -1 unit"
446    bind $win <KeyPress-Down> "$win.f1.t yview scroll 1 unit"
447    bind $win <KeyPress-Home> "$win.f1.t yview 0"
448    bind $win <KeyPress-End> "$win.f1.t yview end"
449    set i 0
450    foreach item $optionlist {
451        pack [button $win.q[incr i] \
452                -command "set makenew(result) $i; destroy $win" -text $item] -side left
453    }
454    if {$link != ""} {
455        pack [button $win.help -text Help -bg yellow \
456            -command "MakeWWWHelp $link"] \
457            -side right
458        bind $win <Key-F1> "MakeWWWHelp $link"
459    }
460    putontop $win
461    tkwait window $win
462
463    # fix grab...
464    afterputontop
465    return $makenew(result)
466}
467
468# get a value in a modal dialog
469proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
470    global expgui expmap
471    set w .global
472    catch {destroy $w}
473    toplevel $w -bg beige
474    bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
475    wm title $w "Input $what"
476    set expgui(temp) {}
477    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
478            -side top -expand yes -fill both
479    grid [label $w.0.a -text "Input a value for the $what" \
480            -bg beige] \
481            -row 0 -column 0 -columnspan 10
482    grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
483            -row 1 -column 0 
484
485    set expgui(temp) $initvalue
486    pack [frame $w.b -bg beige] -side top -fill x -expand yes
487    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
488    if $quit {
489        pack [button $w.b.3 -text Quit \
490                -command "set expgui(temp) {}; destroy $w"] -side left
491    }
492    bind $w <Return> "destroy $w"
493    pack [button $w.b.help -text Help -bg yellow \
494            -command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
495            -side right
496
497    # force the window to stay on top
498    putontop $w
499
500    focus $w.b.2
501    tkwait window $w
502    afterputontop
503
504    return $expgui(temp)
505}
506
507#------------------------------------------------------------------------------
508# profile/symmetry routines
509#------------------------------------------------------------------------------
510# profile terms
511array set expgui {
512    prof-T-names {"Von Dreele-Jorgensen-Windsor" \
513                      "David-Ikeda-Carpenter" "Exponential pseudo-Voigt" \
514                      "Exponential p-V+Stephens aniso strain" \
515                      "Exponential p-V+macro strain"
516    }
517    prof-T-1 {alp-0 alp-1 bet-0 bet-1 sig-0 sig-1 sig-2 rstr rsta \
518            rsca s1ec s2ec }
519    prof-T-2 {alp-0 alp-1 beta switch sig-0 sig-1 sig-2 gam-0 gam-1 \
520            gam-2 ptec stec difc difa zero }
521    prof-T-3 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
522            gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
523    prof-T-4 {alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
524            rstr rsta rsca eta}
525    prof-T-5 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
526            gam-2 gsf g1ec g2ec rstr rsta rsca D1 D2 D3 D4 D5 D6 }
527    prof-C-names {"Gaussian only" "Pseudo-Voigt" \
528                      "pseudo-Voigt/FCJ Asym" "p-V/FCJ+Stephens aniso strain" \
529                      "p-V/FCJ+macro strain"
530    }
531    prof-C-1 {GU GV GW asym F1 F2 }
532    prof-C-2 {GU GV GW LX LY trns asym shft GP stec ptec sfec \
533            L11 L22 L33 L12 L13 L23 }
534    prof-C-3 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
535            L11 L22 L33 L12 L13 L23 }
536    prof-C-4 {GU GV GW GP LX ptec trns shft sfec S/L H/L eta} 
537    prof-C-5 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
538            D1 D2 D3 D4 D5 D6 }
539    prof-E-names {Gaussian "Otto pseudo-Voigt"}
540    prof-E-1 {A B C ds cds}
541    prof-E-2 {A B C ds cds LX LY ptec stec}
542}
543
544# number of profile terms depends on the histogram type
545# the LAUE symmetry and the profile number
546proc GetProfileTerms {phase hist ptype} {
547    global expmap expgui
548    if {$hist == "C" || $hist == "T" || $hist == "E"} {
549        set htype $hist
550    } else {
551        set htype [string range $expmap(htype_$hist) 2 2]
552    }
553    # get the cached copy of the profile term labels, when possible
554    set lbls {}
555    catch {
556        set lbls $expmap(ProfileTerms${phase}_${ptype}_${htype})
557    }
558    if {$lbls != ""} {return $lbls}
559
560    catch {set lbls $expgui(prof-$htype-$ptype)}
561    if {$lbls == ""} {return}
562    # add terms based on the Laue symmetry
563    if {($htype == "C" || $htype == "T") && $ptype == 4} {
564        set laueaxis [GetLaue [phaseinfo $phase spacegroup]]
565        eval lappend lbls [Profile4Terms $laueaxis]
566    }
567    set expmap(ProfileTerms${phase}_${ptype}_${htype}) $lbls
568    return $lbls
569}
570
571proc Profile4Terms {laueaxis} {
572# GSAS Laue classes by number vs spacegrp labeling
573#   1    2    3    4     5      6     7       8     9      10     11     12   13  14
574# 1bar, 2/m, mmm, 4/m, 4/mmm, 3bar, 3bar m, 3bar, 3barm1, 3bar1m, 6/m, 6/mmm, m 3, m3m
575#                              R      R      H      H       H
576# (R=Rhombohedral setting; H=Hexagonal setting)
577    switch -exact $laueaxis {
578        1bar {return \
579                "S400 S040 S004 S220 S202 S022 S310 S103 S031 \
580                S130 S301 S013 S211 S121 S112"}
581        2/ma {return "S400 S040 S004 S220 S202 S022 S013 S031 S211"}
582        2/mb {return "S400 S040 S004 S220 S202 S022 S301 S103 S121"}
583        2/mc {return "S400 S040 S004 S220 S202 S022 S130 S310 S112"}
584        mmm  {return "S400 S040 S004 S220 S202 S022"}
585        4/{return "S400 S004 S220 S202 S310"}
586        4/mmm {return "S400 S004 S220 S202"}
587        3barR     {return "S400 S220 S310 S301 S211"}
588        "3bar mR" {return "S400 S220 S310 S211"}
589        3bar    {return "S400 S004 S202 S310 S211"}
590        3barm1 {return "S400 S004 S202 S301"}
591        3bar1m  {return "S400 S004 S202 S211"}
592        6/m    {return "S400 S004 S202"}
593        6/mmm  {return "S400 S004 S202"}
594        "m 3"  {return "S400 S220"}
595        m3m    {return "S400 S220"}
596        default {return ""}
597    }
598}
599
600proc GetLaue {spg} {
601    global tcl_platform expgui
602    # check the space group
603    set fp [open spg.in w]
604    puts $fp "N"
605    puts $fp "N"
606    puts $fp $spg
607    puts $fp "Q"
608    close $fp
609    catch {
610        if {$tcl_platform(platform) == "windows"} {
611            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
612        } else {
613            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
614        }
615    }
616    set fp [open spg.out r]
617    set laue {}
618    set uniqueaxis {}
619    while {[gets $fp line] >= 0} {
620        regexp {Laue symmetry (.*)} $line junk laue
621        regexp {The unique axis is (.*)} $line junk uniqueaxis
622    }
623    close $fp
624    catch {file delete -force spg.in spg.out}
625    set laue [string trim $laue]
626    # add a R suffix for rhombohedral settings
627    if {[string range [string trim $spg] end end] == "R"} {
628        return "${laue}${uniqueaxis}R"
629    }
630    return "${laue}$uniqueaxis"
631}
632
633# set up to change the profile type for a series of histogram/phase entries
634# (histlist & phaselist should be lists of the same length)
635#
636proc ChangeProfileType {histlist phaselist} {
637    global expgui expmap
638    set w .profile
639    catch {destroy $w}
640    toplevel $w -bg beige
641    wm title $w "Change Profile Function"
642   
643    # all histogram/phases better be the same type, so we can just use the 1st
644    set hist [lindex $histlist 0]
645    set phase [lindex $phaselist 0]
646    set ptype [string trim [hapinfo $hist $phase proftype]]
647
648    # get list of allowed profile terms for the current histogram type
649    set i 1
650    while {[set lbls [GetProfileTerms $phase $hist $i]] != ""} {
651        lappend lbllist $lbls
652        incr i
653    }
654    # labels for the current type
655    set i $ptype
656    set oldlbls [lindex $lbllist [incr i -1]]
657   
658    if {[llength $histlist] == 1} {
659        pack [label $w.a -bg beige \
660                -text "Change profile function for Histogram #$hist Phase #$phase" \
661                ] -side top
662    } else {
663        # make a list of histograms by phase
664        foreach h $histlist p $phaselist {
665            lappend phlist($p) $h
666        }
667        set num 0
668        pack [frame $w.a -bg beige] -side top
669        pack [label $w.a.$num -bg beige \
670                -text "Change profile function for:" \
671                ] -side top -anchor w
672        foreach i [lsort [array names phlist]] {
673            incr num
674            pack [label $w.a.$num -bg beige -text \
675                    "\tPhase #$i, Histograms [CompressList $phlist($i)]" \
676                    ] -side top -anchor w
677        }
678    }
679    pack [label $w.e1 \
680            -text "Current function is type $ptype." \
681            -bg beige] -side top -anchor w
682    pack [frame $w.e -bg beige] -side top -expand yes -fill both
683    pack [label $w.e.1 \
684            -text "Set function to type" \
685            -bg beige] -side left
686    set menu [tk_optionMenu $w.e.2 expgui(newpeaktype) junk]
687    pack $w.e.2 -side left -anchor w
688
689    pack [radiobutton $w.e.4 -bg beige -variable expgui(DefaultPeakType) \
690            -command "set expgui(newpeaktype) $ptype; \
691            FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
692            -value 1 -text "Current value overrides"] -side right
693    pack [radiobutton $w.e.3 -bg beige -variable expgui(DefaultPeakType) \
694            -command \
695            "set expgui(newpeaktype) $ptype; \
696            FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
697            -value 0 -text "Default value overrides"] -side right
698
699    $w.e.2 config -bg beige
700    pack [frame $w.c -bg beige] -side top -expand yes -fill both
701    pack [frame $w.d -bg beige] -side top -expand yes -fill both
702    pack [button $w.d.2 -text Set  \
703              -command "SaveChangeProfileType $w.c [list $histlist] [list $phaselist]; destroy $w"\
704            ] -side left
705    pack [button $w.d.3 -text Quit \
706            -command "destroy $w"] -side left
707    pack [button $w.d.help -text Help -bg yellow \
708            -command "MakeWWWHelp expgui5.html ChangeType"] \
709            -side right
710    bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
711    bind $w <Return> "destroy $w"
712
713    $menu delete 0 end
714    set i 0
715    foreach lbls $lbllist {
716        incr i
717        $menu add command -label $i -command \
718                "set expgui(newpeaktype) $i; \
719                FillChangeProfileType $w.c $hist $phase $i [list $lbls] [list $oldlbls]"
720    }
721    set expgui(newpeaktype) $ptype
722    FillChangeProfileType $w.c $hist $phase $ptype $oldlbls $oldlbls
723
724    # force the window to stay on top
725    putontop $w
726    focus $w.e.2
727    tkwait window $w
728    afterputontop
729    sethistlist
730}
731
732# save the changes to the profile
733proc SaveChangeProfileType {w histlist phaselist} {
734    global expgui
735    foreach phase $phaselist hist $histlist {
736        hapinfo $hist $phase proftype set $expgui(newpeaktype)
737        RecordMacroEntry "hapinfo $hist $phase proftype set $expgui(newpeaktype)" 0
738        hapinfo $hist $phase profterms set $expgui(newProfileTerms)
739        RecordMacroEntry "hapinfo $hist $phase profterms set $expgui(newProfileTerms)" 0
740        for {set i 1} {$i <=  $expgui(newProfileTerms)} {incr i} {
741            hapinfo $hist $phase pterm$i set [$w.ent${i} get]
742            RecordMacroEntry "hapinfo $hist $phase pterm$i set [$w.ent${i} get]" 0
743            hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
744            RecordMacroEntry "hapinfo $hist $phase pref$i set $expgui(ProfRef$i)" 0
745        }
746        set i [expr 1+$expgui(newProfileTerms)]
747        hapinfo $hist $phase pcut set [$w.ent$i get]
748        RecordMacroEntry "hapinfo $hist $phase pcut set [$w.ent$i get]" 0
749        incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
750        RecordMacroEntry "incr expgui(changed)" 0
751    }
752}
753
754# file the contents of the "Change Profile Type" Menu
755proc FillChangeProfileType {w hist phase newtype lbls oldlbls} {
756    global expgui expmap
757    set ptype [string trim [hapinfo $hist $phase proftype]]
758    catch {unset oldval}
759    # loop through the old terms and set up an array of starting values
760    set num 0
761    foreach term $oldlbls {
762        incr num
763        set oldval($term) [hapinfo $hist $phase pterm$num]
764    }
765    set oldval(Peak\nCutoff) [hapinfo $hist $phase pcut]
766
767    # is the new type the same as the current?
768    if {$ptype == $newtype} {
769        set nterms [hapinfo $hist $phase profterms]
770    } else {
771        set nterms [llength $lbls]
772    }
773    set expgui(newProfileTerms) $nterms
774    set expgui(CurrentProfileTerms) $nterms
775    # which default profile set matches the new type
776    set setnum {}
777    foreach j {" " 1 2 3 4 5 6 7 8 9} {
778        set i [profdefinfo $hist $j proftype]
779        if {$i == ""} continue
780        if {$i == $newtype} {
781            set setnum $j
782            break
783        }
784    }
785
786    eval destroy [winfo children $w]
787
788    set colstr 0
789    set row 2
790    set maxrow [expr $row + $nterms/2]
791    for { set num 1 } { $num <= $nterms + 1} { incr num } {
792        # get the default value (originally from the in .INS file)
793        set val {}
794        if {$setnum != ""} {
795            set val 0.0
796            catch {
797                set val [profdefinfo $hist $setnum pterm$num]
798                # pretty up the number
799                if {$val == 0.0} {
800                    set val 0.0
801                } elseif {abs($val) < 1e-2 || abs($val) > 1e6} {
802                    set val [format %.3e $val]
803                } elseif {abs($val) > 1e-2 && abs($val) < 10} {
804                    set val [format %.5f $val]
805                } elseif {abs($val) < 9999} {
806                    set val [format %.2f $val]
807                } elseif {abs($val) < 1e6} {
808                    set val [format %.0f $val]
809                }
810            }
811        }
812        # heading
813        if {$row == 2} {
814            set col $colstr
815            grid [label $w.h0${num} -text "lbl" -bg beige] \
816                -row $row -column $col
817            grid [label $w.h2${num} -text "ref" -bg beige] \
818                -row $row -column [incr col]
819            grid [label $w.h3${num} -text "next value" -bg beige] \
820                -row $row -column [incr col]
821            grid [label $w.h4${num} -text "default" -bg beige] \
822                -row $row -column [incr col]
823            grid [label $w.h5${num} -text "current" -bg beige] \
824                -row $row -column [incr col]
825        }
826        set col $colstr
827        incr row
828        set term {}
829        catch {set term [lindex $lbls [expr $num-1]]}
830        if {$term == ""} {set term $num}
831        if {$num == $nterms + 1} {
832            set term "Peak\nCutoff"
833            set val {}
834            if {$setnum != ""} {
835                set val 0.0
836                catch {set val [profdefinfo $hist $setnum pcut]}
837            }
838        }
839
840        grid [label $w.l${num} -text "$term" -bg beige] \
841                -row $row -column $col
842        grid [checkbutton $w.chk${num} -variable expgui(ProfRef$num) \
843                -bg beige -activebackground beige] -row $row -column [incr col]
844        grid [entry $w.ent${num} \
845                -width 12] -row $row -column [incr col]
846        if {$val != ""} {
847            grid [button $w.def${num} -text $val -command \
848                    "$w.ent${num} delete 0 end; $w.ent${num} insert end $val" \
849                    ] -row $row -column [incr col] -sticky ew
850        } else {
851            grid [label $w.def${num} -text (none) \
852                    ] -row $row -column [incr col]
853        }
854        set curval {}
855        catch {
856            set curval [expr $oldval($term)]
857            # pretty up the number
858            if {$curval == 0.0} {
859                set curval 0.0
860            } elseif {abs($curval) < 1e-2 || abs($curval) > 1e6} {
861                set curval [format %.3e $curval]
862            } elseif {abs($curval) > 1e-2 && abs($curval) < 10} {
863                set curval [format %.5f $curval]
864            } elseif {abs($curval) < 9999} {
865                set curval [format %.2f $curval]
866            } elseif {abs($curval) < 1e6} {
867                set curval [format %.0f $curval]
868            }
869            grid [button $w.cur${num} -text $curval -command  \
870                    "$w.ent${num} delete 0 end; $w.ent${num} insert end $curval" \
871                    ] -row $row -column [incr col] -sticky ew
872        }
873        # set default values for flag and value
874        set ref 0
875        if {$setnum != ""} {
876            catch {
877                if {[profdefinfo $hist $setnum pref$num] == "Y"} {set ref 1}
878            }
879        }
880        set expgui(ProfRef$num) $ref
881       
882        $w.ent${num} delete 0 end
883        if {!$expgui(DefaultPeakType) && $val != ""} {
884            $w.ent${num} insert end $val
885        } elseif {$curval != ""} {
886            $w.ent${num} insert end $curval
887        } elseif {$val != ""} {
888            $w.ent${num} insert end $val
889        } else {
890            $w.ent${num} insert end 0.0
891        }
892        if {$row > $maxrow} {
893            set row 2
894            incr colstr 5
895        }
896    }
897    if {$::tcl_platform(os) == "Darwin"} {
898        # on OS X force a window resize
899        wm geometry [winfo toplevel $w] {}
900    }
901}
902
903#------------------------------------------------------------------------------
904# WWW/help routines
905#------------------------------------------------------------------------------
906# browse a WWW page with URL. The URL may contain a #anchor
907# On UNIX assume netscape or mozilla is in the path or env(BROWSER) is loaded.
908# On Windows search the registry for a browser. Mac branch not tested.
909# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
910# to the contributers
911proc urlOpen {url} {
912    global env tcl_platform
913    if {$tcl_platform(os) == "Darwin"} {
914        # if this is an external URL or does not contain an anchor, take the
915        # easy approach
916        if {[string range $url 0 4] == "http:" || \
917                [string first "#" $url] == -1} {
918            if {![catch {exec open $url}]} {
919                return
920            }
921        }
922        # so sorry, have to use Internet Explorer
923        set url [file nativename $url]; # replace ~/ if present
924        if {[file pathtype $url] == "relative"} {
925            set url [file join [pwd] $url]
926        }
927        exec osascript -e "tell application \"Internet Explorer\"\rGetURL \"file://$url\"\rend tell"
928    } elseif {$tcl_platform(platform) == "unix"} {
929        set browserlist {}
930        if {[info exists env(BROWSER)]} {
931            set browserlist $env(BROWSER)
932        }
933        lappend browserlist netscape mozilla
934        foreach p $browserlist {
935            set progs [auto_execok $p]
936            if {[llength $progs]} {
937                if {[catch {exec $progs -remote openURL($url)}]} {
938                    # perhaps browser doesn't understand -remote flag
939                    if {[catch {exec $env(BROWSER) $url &} emsg]} {
940                        error "Error displaying $url in browser\n$emsg"
941                    }
942                }
943                return
944            }
945        }
946        MyMessageBox -parent . -title "No Browser" \
947            -message "Could not find a browser. Netscape & Mozilla not found. Define environment variable BROWSER to be full path name of browser." \
948            -icon warning
949    } elseif {$tcl_platform(platform) == "windows"} {
950        package require registry
951        # Look for the application under
952        # HKEY_CLASSES_ROOT
953        set root HKEY_CLASSES_ROOT
954       
955        # Get the application key for HTML files
956        set appKey [registry get $root\\.html ""]
957       
958        # Get the command for opening HTML files
959        set appCmd [registry get \
960                        $root\\$appKey\\shell\\open\\command ""]
961
962        # Substitute the HTML filename into the command for %1
963        # or stick it on the end
964        if {[string first %1 $appCmd] != -1} {
965            regsub %1 $appCmd $url appCmd
966        } else {
967            append appCmd " " $url
968        }
969       
970        # Double up the backslashes for eval (below)
971        regsub -all {\\} $appCmd  {\\\\} appCmd
972       
973        # Invoke the command
974        eval exec $appCmd &
975    } elseif {$tcl_platform(platform) == "macintosh"} {
976        # preOSX -- this is not used
977        if {0 == [info exists env(BROWSER)]} {
978            set env(BROWSER) "Browse the Internet"
979        }
980        if {[catch {
981            AppleScript execute\
982                "tell application \"$env(BROWSER)\"
983                         open url \"$url\"
984                     end tell
985                "} emsg]
986        } then {
987            error "Error displaying $url in browser\n$emsg"
988        }
989    }
990}
991
992proc NetHelp {file anchor localloc netloc} {
993    # use the file on-line, if it exists
994    if {[file exists [file join $localloc $file]]} {
995        set url "[file join $localloc $file]"
996    } else {
997        set url "http://$netloc/$file"
998    }
999    catch {
1000        pleasewait "Starting web browser..."
1001        after 2000 donewait
1002    }
1003    if {$anchor != ""} {
1004        append url # $anchor
1005    }
1006    urlOpen $url
1007}
1008
1009proc MakeWWWHelp {"topic {}" "anchor {}"} {
1010    global expgui
1011    if {$topic == ""} {
1012        foreach item $expgui(notebookpagelist) {
1013            if {[lindex $item 0] == $expgui(pagenow)} {
1014                NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) $expgui(website)
1015                return
1016            }
1017        }
1018        # this should not happen
1019        NetHelp expgui.html "" $expgui(docdir) $expgui(website)
1020    } elseif {$topic == "menu"} {
1021        NetHelp expguic.html "" $expgui(docdir) $expgui(website)
1022    } else {
1023        NetHelp $topic $anchor $expgui(docdir) $expgui(website)
1024    }
1025}
1026
1027# show help information
1028proc showhelp {} {
1029    global expgui_helplist helpmsg
1030    set helpmsg {}
1031    set frm .help
1032    catch {destroy $frm}
1033    toplevel $frm
1034    wm title $frm "Help Summary"
1035    grid [label $frm.0 -text \
1036            "Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
1037        -column 0 -columnspan 4 -row 0
1038#    grid [message $frm.help -textvariable helpmsg -relief groove] \
1039#          -column 0 -columnspan 4 -row 2 -sticky nsew
1040    grid [text $frm.help -relief groove -bg beige -width 0\
1041            -height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
1042           -column 0 -columnspan 3 -row 2 -sticky nsew
1043    grid [scrollbar $frm.escroll -command "$frm.help yview"] \
1044            -column 4 -row 2 -sticky nsew
1045    grid rowconfig $frm 1 -weight 1 -minsize 50
1046    grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
1047    grid columnconfig $frm 0 -weight 1
1048    grid columnconfig $frm 2 -weight 1
1049    set lst [array names expgui_helplist]
1050    grid [listbox $frm.cmds -relief raised -bd 2 \
1051            -yscrollcommand "$frm.scroll set" \
1052            -height 8 -width 0 -exportselection 0 ] \
1053            -column 0 -row 1 -sticky nse
1054    grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
1055            -column 1 -row 1 -sticky nsew
1056    foreach item [lsort -dictionary $lst] {
1057        $frm.cmds insert end $item 
1058    }
1059    if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
1060    grid [button $frm.done -text Done -command "destroy $frm"] \
1061            -column 2 -row 1
1062#    bind $frm.cmds <ButtonRelease-1> \
1063#           "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
1064    bind $frm.cmds <ButtonRelease-1> \
1065            "+$frm.help config -state normal; $frm.help delete 0.0 end; \
1066             $frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
1067             $frm.help config -state disabled"
1068
1069    # get the size of the window and expand the message boxes to match
1070#    update
1071#    $frm.help config -width [winfo width $frm.help ]
1072}
1073
1074
1075#------------------------------------------------------------------------------
1076# utilities
1077#------------------------------------------------------------------------------
1078# run liveplot
1079proc liveplot {} {
1080    global expgui liveplot wishshell expmap
1081    set expnam [file root [file tail $expgui(expfile)]]
1082    # which histograms are ready for use?
1083    set validlist {}
1084    foreach ihist $expmap(powderlist) {
1085        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1086                [string range $expmap(htype_$ihist) 3 3] == "D"} {
1087            lappend validlist $ihist
1088        }
1089    }
1090    if {[llength $validlist] == 0} {
1091        MyMessageBox -parent . -title "No Valid Histograms" \
1092                -message "No histograms are ready to plot. Run GENLES and try again" \
1093                -icon warning -helplink "expguierr.html NoValidHist"
1094        return
1095    }
1096    # use $liveplot(hst) if valid, the 1st entry otherwise
1097    if {[lsearch $validlist $liveplot(hst)] != -1} {
1098        exec $wishshell [file join $expgui(scriptdir) liveplot] \
1099                $expnam $liveplot(hst) $liveplot(legend) &
1100    } else {
1101        exec $wishshell [file join $expgui(scriptdir) liveplot] \
1102                $expnam [lindex $validlist 0] $liveplot(legend) &
1103    }
1104}
1105
1106# run lstview
1107proc lstview {} {
1108    global expgui wishshell
1109    set expnam [file root [file tail $expgui(expfile)]]
1110    exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
1111}
1112
1113# run widplt
1114proc widplt {"prog widplt"} {
1115    global expgui wishshell
1116    exec $wishshell [file join $expgui(scriptdir) $prog] \
1117            $expgui(expfile) &
1118}
1119
1120# run bkgedit
1121proc bkgedit {"hst {}"} {
1122    global expgui liveplot wishshell expmap
1123    set expnam [file root [file tail $expgui(expfile)]]
1124    if {$hst == ""} {
1125        # which histograms are ready for use?
1126        set validlist {}
1127        foreach ihist $expmap(powderlist) {
1128            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1129                    [string range $expmap(htype_$ihist) 3 3] == "*"} {
1130                lappend validlist $ihist
1131            }
1132        }
1133        if {[llength $validlist] == 0} {
1134            MyMessageBox -parent . -title "No Valid Histograms" \
1135                    -message "No histograms are ready to plot. Run POWPREF and try again" \
1136                    -icon warning -helplink "expguierr.html NoValidHist"
1137            return
1138        }
1139        # use $liveplot(hst) if valid, the 1st entry otherwise
1140        if {[lsearch $validlist $liveplot(hst)] != -1} {
1141            set hst $liveplot(hst)
1142        } else {
1143            set hst [lindex $validlist 0]
1144        }
1145    }
1146    # Save the current exp file
1147    savearchiveexp
1148    CantRecordMacroEntry "bkgedit"
1149    # disable the file change monitor if we will reload the .EXP file automatically
1150    if {$expgui(autoexpload)} {set expgui(expModifiedLast) 0}
1151    if {$expgui(autoiconify)} {wm iconify .}
1152    exec $wishshell [file join $expgui(scriptdir) bkgedit] \
1153            $expnam $hst $liveplot(legend)
1154    if {$expgui(autoiconify)} {wm deiconify .}
1155    # load the changed .EXP file automatically?
1156    if {$expgui(autoexpload)} {
1157        # load the revised exp file
1158        loadexp $expgui(expfile)
1159    } else {
1160        # check for changes in the .EXP file immediately
1161        whenidle
1162    }
1163}
1164
1165# run excledt
1166proc excledit {} {
1167    global expgui liveplot expmap
1168    set expnam [file root [file tail $expgui(expfile)]]
1169    # which histograms are ready for use?
1170    set validlist {}
1171    foreach ihist $expmap(powderlist) {
1172        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1173                [string range $expmap(htype_$ihist) 3 3] == "*" || \
1174                [string range $expmap(htype_$ihist) 3 3] == "D"} {
1175            lappend validlist $ihist
1176        }
1177    }
1178    if {[llength $validlist] == 0} {
1179        MyMessageBox -parent . -title "No Valid Histograms" \
1180                -message "No histograms are ready to plot. Run POWPREF and try again" \
1181                -icon warning -helplink "expguierr.html NoValidHist"
1182        return
1183    }
1184    #if {$expgui(autoiconify)} {wm iconify .}
1185    StartExcl 
1186    #if {$expgui(autoiconify)} {wm deiconify .}
1187}
1188
1189# compute the composition for each phase and display in a dialog
1190proc composition {} {
1191    global expmap expgui
1192    set Z 1
1193    foreach phase $expmap(phaselist) type $expmap(phasetype) {
1194        if {$type == 4} continue
1195        ResetMultiplicities $phase {}
1196        catch {unset total}
1197        foreach atom $expmap(atomlist_$phase) {
1198            set type [atominfo $phase $atom type]
1199            set mult [atominfo $phase $atom mult]
1200            if [catch {set total($type)}] {
1201                set total($type) [expr \
1202                        $mult * [atominfo $phase $atom frac]]
1203            } else {
1204                set total($type) [expr $total($type) + \
1205                        $mult * [atominfo $phase $atom frac]]
1206            }
1207            if {$mult > $Z} {set Z $mult}
1208        }
1209        append text "\nPhase $phase\n"
1210        append text "  Unit cell contents\n"
1211        foreach type [lsort [array names total]] {
1212            append text "   $type[format %8.3f $total($type)]"
1213        }
1214        append text "\n\n"
1215       
1216        append text "  Asymmetric Unit contents (Z=$Z)\n"
1217        foreach type [lsort [array names total]] {
1218            append text "   $type[format %8.3f [expr $total($type)/$Z]]"
1219        }
1220        append text "\n"
1221    }
1222   
1223    catch {destroy .comp}
1224    toplevel .comp -class MonoSpc
1225    bind .comp <Key-F1> "MakeWWWHelp expgui.html Composition"
1226    wm title .comp Composition
1227    pack [label .comp.results -text $text \
1228            -justify left] -side top
1229    pack [frame .comp.box]  -side top -expand y -fill x
1230    pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
1231
1232    set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
1233    pack [button .comp.box.2 -text "Save to $lstnam file" \
1234            -command "writelst [list $text] ; destroy .comp"] -side left
1235    pack [button .comp.box.help -text Help -bg yellow \
1236            -command "MakeWWWHelp expgui.html Composition"] \
1237            -side right
1238}
1239
1240# Delete History Records
1241proc DeleteHistoryRecords {{msg ""}} {
1242    global expgui
1243    set frm .history
1244    catch {destroy $frm}
1245    toplevel $frm
1246    bind $frm <Key-F1> "MakeWWWHelp expgui.html DeleteHistoryRecords"
1247    if {[string trim $msg] == ""} {
1248        set msg "There are [CountHistory] history records"
1249    }
1250    pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
1251    pack [label $frm.1.0 -text $msg] -side top
1252    pack [frame $frm.1.1] -side top
1253    pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
1254    pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
1255            ] -side left
1256    set expgui(historyKeep) 10
1257    pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
1258    set expgui(renumber) 1
1259    pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
1260    pack [button $frm.2.help -text Help -bg yellow \
1261            -command "MakeWWWHelp expgui.html DeleteHistoryRecords"] -side top
1262    pack [button $frm.2.4 -text Quit \
1263            -command {destroy .history}] -side bottom
1264    pack [button $frm.2.3 -text OK \
1265            -command { 
1266        if ![catch {expr $expgui(historyKeep)}] {
1267            DeleteHistory $expgui(historyKeep) $expgui(renumber)
1268            set expgui(changed) 1
1269            destroy .history
1270        }
1271    }] -side bottom
1272    bind $frm <Return> "$frm.2.3 invoke"
1273   
1274    # force the window to stay on top
1275    putontop $frm 
1276    focus $frm.2.3
1277    tkwait window $frm
1278    afterputontop
1279}
1280
1281proc archiveexp {} {
1282    global expgui tcl_platform
1283    # is there a file to archive?
1284    if {![file exists $expgui(expfile)]} return
1285    set expnam [file rootname $expgui(expfile)]
1286    # get the last archived version
1287    set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
1288    if {$lastf == ""} {
1289        set num 01
1290    } else {
1291        regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
1292        scan $num %x num
1293        if {$num >= 255} {
1294            set num FF
1295        } else {
1296            set num [string toupper [format %.2x [incr num]]]
1297        }
1298    }
1299    catch {
1300        set file $expnam.O$num
1301        file copy -force $expgui(expfile) $file
1302        set fp [open $expnam.LST a+]
1303        puts $fp "\n----------------------------------------------"
1304        puts $fp "     Archiving [file tail $expnam.EXP] as [file tail $file]"
1305        puts $fp "----------------------------------------------\n"
1306        close $fp
1307    } errmsg
1308    if {$errmsg != ""} {
1309        tk_dialog .warn Confirm "Error archiving the current .EXP file: $errmsg" warning 0 OK
1310    }
1311}
1312
1313# save and optionally archive the expfile
1314proc savearchiveexp {} {
1315    global expgui expmap
1316    if {$expgui(expfile) == ""} {
1317        SaveAsFile
1318        return
1319    }
1320    if !$expgui(changed) return
1321    if {$expgui(archive)} archiveexp
1322    # add a history record
1323    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds] -format {%D %T}]"
1324    # now save the file
1325    expwrite $expgui(expfile)
1326    # change the icon and assign an app to this .EXP file
1327    global tcl_platform
1328    if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
1329        MacSetResourceFork $expgui(expfile)
1330    }
1331    set expgui(changed) 0
1332    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
1333    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
1334    wm title . $expgui(expfile)
1335    set expgui(titleunchanged) 1
1336    # set convergence criterion
1337    InitLSvars
1338}
1339
1340#------------------------------------------------------------------------------
1341# GSAS interface routines
1342#------------------------------------------------------------------------------
1343# run a GSAS program that does not require an experiment file
1344proc runGSASprog {proglist "concurrent 1"} {
1345    # save call to Macro file
1346    RecordMacroEntry "runGSASprog [list $proglist] $concurrent" 0
1347    # if concurrent is 0, EXPGUI runs the GSAS program in background
1348    # -- this is not currently needed anywhere where the .EXP file is not.
1349    global expgui tcl_platform
1350    set cmd {}
1351    foreach prog $proglist {
1352        StartGRWND $prog
1353        if {$tcl_platform(platform) == "windows"} {
1354            append cmd " \"$expgui(gsasexe)/${prog}.exe \" "
1355        } else {
1356            if {$cmd != ""} {append cmd "\;"}
1357            append cmd "[file join $expgui(gsasexe) $prog]"
1358        }
1359    }
1360    forknewterm $prog $cmd [expr !$concurrent] 1
1361}
1362
1363# dummy routine, overridden if needed
1364proc StartGRWND {prog} {
1365}
1366
1367# run a GSAS program that requires an experiment file for input/output
1368proc runGSASwEXP {proglist "concurrent 0"} {
1369    # save call to Macro file
1370    RecordMacroEntry "runGSASwEXP [list $proglist] $concurrent" 0
1371    # most programs that require the .EXP file change it and
1372    # cannot be run concurrently
1373    global expgui tcl_platform
1374    # Save the current exp file
1375    savearchiveexp
1376    # load the changed .EXP file automatically?
1377    if {$expgui(autoexpload)} {
1378        # disable the file changed monitor
1379        set expgui(expModifiedLast) 0
1380    }
1381    set cmd {}
1382    set expnam [file root [file tail $expgui(expfile)]]
1383    foreach prog $proglist {
1384        if {$prog == "powpref"} {
1385            set expgui(needpowpref) 0
1386            set expgui(needpowpref_why) ""
1387        } elseif {$prog == "genles" && $expgui(needpowpref) != 0} {
1388            set msg "You are attempting to run GENLES, after making changes that require POWPREF:\n\n$expgui(needpowpref_why) \nRun POWPREF first?"
1389            set ans [MyMessageBox -parent . -title "Run POWPREF" \
1390                    -message $msg -icon warning -type "Yes No" -default yes \
1391                    -helplink "expguierr.html RunPowpref"]
1392            if {$ans == "yes"} {
1393                set expgui(needpowpref) 0
1394                set expgui(needpowpref_why) ""
1395                if {$tcl_platform(platform) == "windows"} {
1396                    append cmd " \"$expgui(gsasexe)/powpref.exe $expnam \" "
1397                } else {
1398                    if {$cmd != ""} {append cmd "\;"}
1399                    append cmd "[file join $expgui(gsasexe) powpref] $expnam"
1400                }
1401            }
1402        }
1403        StartGRWND $prog
1404        if {$tcl_platform(platform) == "windows"} {
1405            append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
1406        } elseif {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1407            append cmd " \" [file join $expgui(gsasexe) $prog] $expnam \" "
1408        } else {
1409            if {$cmd != ""} {append cmd "\;"}
1410            append cmd "[file join $expgui(gsasexe) $prog] $expnam"
1411        }
1412    }
1413    if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1414        set outfile ${expnam}_macout.LST
1415        runnoterm $cmd $outfile
1416    } else {
1417        forknewterm "$prog -- $expnam" $cmd [expr !$concurrent] 1
1418    }
1419    # load the changed .EXP file automatically?
1420    if {$expgui(autoexpload)} {
1421        # load the revised exp file
1422        loadexp $expgui(expfile)
1423    }
1424    if {$expgui(MacroRunning)} {
1425        if {[file exists  abort_${expnam}_macro.flag]} {
1426            file delete abort_${expnam}_macro.flag
1427            error "User requested to abort the macro"
1428        }
1429        update idletasks
1430    }
1431}
1432
1433# write text to the .LST file
1434proc writelst {text} {
1435    global expgui
1436    set lstnam [file rootname $expgui(expfile)].LST
1437    set fp [open $lstnam a]
1438    puts $fp "\n-----------------------------------------------------------------"
1439    puts $fp $text
1440    puts $fp "-----------------------------------------------------------------\n"
1441    close $fp
1442}
1443
1444
1445# rename file current to suggested,
1446#   delete window if supplied
1447#   use parent, if supplied or .
1448proc RenameAsFile {current suggested "window {}" "parent {}"} {
1449    if {$parent == "" && $window != ""} {set parent $window}
1450    if {$parent == ""} {set parent .}
1451    set newfile [tk_getSaveFile -initialfile $suggested -parent $parent]
1452    if {$newfile == ""} return
1453    if {[catch {
1454        file rename -force $current $newfile
1455    }]} {
1456        file copy -force $current $newfile
1457        file delete -force $current
1458    }
1459    if {$window != ""} {destroy $window}
1460}
1461
1462# optionally run disagl as a windowless process, w/results in a separate window
1463proc rundisagl {} {
1464    global expgui txtvw tcl_version tcl_platform
1465    if {$expgui(disaglSeparateBox)} {
1466        set root [file root $expgui(expfile)] 
1467        catch {file delete -force $root.tmp}
1468        if {[catch {file rename -force $root.LST $root.OLS}]} {
1469            file copy -force $root.LST $root.OLS
1470            file delete -force $root.OLS
1471        }
1472        # PSW reports this does not happen right away on windows
1473        set i 0
1474        while {$i < 10 && [file exists $root.LST]} {
1475            # debug code
1476            #catch {console show}
1477            #puts "try $i"
1478            # end debug code
1479            after 100
1480            incr i
1481        }
1482        if {[file exists $root.LST]} {
1483            # it was not possible to rename the file
1484            MyMessageBox -parent . -title "Rename Problem" \
1485                -message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
1486                -icon warning -helplink "expguierr.html NoRename"
1487            return
1488        }
1489
1490        #run the program
1491        pleasewait "Running DISAGL"     
1492        # create an empty input file
1493        close [open disagl.inp w]
1494        catch {exec [file join $expgui(gsasexe) disagl] \
1495                [file tail $root] < disagl.inp > disagl.out}
1496        if {[catch {file rename -force $root.LST $root.tmp}]} {
1497            file copy -force $root.LST $root.tmp
1498            file delete -force $root.LST
1499        }
1500        catch {file delete -force disagl.inp disagl.out}
1501        if {[catch {file rename -force $root.OLS $root.LST}]} {
1502            file copy -force $root.OLS $root.LST
1503            file delete -force $root.OLS
1504        }
1505        donewait
1506        # open a new window
1507        catch {toplevel .disagl}
1508        catch {eval grid forget [grid slaves .disagl]}
1509        text .disagl.txt -width 100 -wrap none \
1510                -yscrollcommand ".disagl.yscroll set" \
1511                -xscrollcommand ".disagl.xscroll set" 
1512        scrollbar .disagl.yscroll -command ".disagl.txt yview"
1513        scrollbar .disagl.xscroll -command ".disagl.txt xview" -orient horizontal
1514        grid .disagl.xscroll -column 0 -row 2 -sticky ew
1515        grid .disagl.txt -column 0 -row 1 -sticky nsew
1516        grid .disagl.yscroll -column 1 -row 1 -sticky ns
1517        grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
1518        grid columnconfig .disagl.f 2 -weight 1
1519        grid [button .disagl.f.close -text "Close & Delete" \
1520                -command "destroy .disagl; file delete $root.tmp"] \
1521                -column 3 -row 0 -sticky e
1522        grid [button .disagl.f.rename \
1523                -command "RenameAsFile $root.tmp $root.DIS .disagl" \
1524                -text "Close & Save as..."] \
1525                -column 4 -row 0 -sticky e
1526        # allow font changes on the fly
1527        if {$tcl_version >= 8.0} {
1528            .disagl.txt config -font $txtvw(font)
1529            set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
1530            grid .disagl.f.font -column 1 -row 0 -sticky w
1531            grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
1532            $fontbut delete 0 end
1533            foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
1534                $fontbut add command -label "Courier $f" -font "Courier $f"\
1535                        -command "set txtvw(font) \"Courier $f\"; \
1536                        .disagl.txt config -font \$txtvw(font)"
1537            }
1538        }
1539       
1540        grid columnconfigure .disagl 0 -weight 1
1541        grid rowconfigure .disagl 1 -weight 1
1542        wm title .disagl "DISAGL results $expgui(expfile)"
1543        wm iconname .disagl "DISAGL $root"
1544        set in [open $root.tmp r]
1545        .disagl.txt insert end [read $in]
1546        close $in
1547        bind all  {destroy .disagl}
1548        bind .disagl  ".disagl.txt yview scroll -1 page"
1549        bind .disagl  ".disagl.txt yview scroll 1 page"
1550        bind .disagl  ".disagl.txt xview scroll 1 unit"
1551        bind .disagl  ".disagl.txt xview scroll -1 unit"
1552        bind .disagl  ".disagl.txt yview scroll -1 unit"
1553        bind .disagl  ".disagl.txt yview scroll 1 unit"
1554        bind .disagl  ".disagl.txt yview 0"
1555        bind .disagl  ".disagl.txt yview end"
1556        # don't disable in Win as this prevents the highlighting of selected text
1557        if {$tcl_platform(platform) != "windows"} {
1558            .disagl.txt config -state disabled
1559        }
1560    } else {
1561        runGSASwEXP disagl
1562    }
1563}
1564
1565#------------------------------------------------------------------------------
1566# file conversions
1567#------------------------------------------------------------------------------
1568proc convfile {} {
1569    global expgui
1570    set frm .file
1571    catch {destroy $frm}
1572    toplevel $frm
1573    wm title $frm "Convert File"
1574    bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
1575    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1576    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
1577            -side left -fill y -expand yes
1578    pack [button $frmC.help -text Help -bg yellow \
1579            -command "MakeWWWHelp expgui.html ConvertWin"] -side top
1580    pack [button $frmC.q -text Quit -command "destroy $frm"] -side bottom
1581    pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
1582            -side bottom
1583    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
1584    winfilebox $frm
1585    bind $frm <Return> "ValidWinCnv $frm"
1586
1587    # force the window to stay on top
1588    putontop $frm
1589    focus $frmC.q 
1590    tkwait window $frm
1591    afterputontop
1592}
1593
1594# validate the files and make the conversion
1595proc ValidWinCnv {frm} {
1596    global expgui
1597    # change backslashes to something sensible
1598    regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
1599    # allow entry of D: for D:/ and D:TEST for d:/TEST
1600    if {[string first : $expgui(FileMenuCnvName)] != -1 && \
1601            [string first :/ $expgui(FileMenuCnvName)] == -1} {
1602        regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
1603    }
1604    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1605        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1606        ChooseWinCnv $frm
1607        return
1608    } elseif [file isdirectory \
1609            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
1610        if {$expgui(FileMenuCnvName) != "."} {
1611            set expgui(FileMenuDir) \
1612                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1613        }
1614        ChooseWinCnv $frm
1615        return
1616    }
1617 
1618    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1619    if ![file exists $file] {
1620        MyMessageBox -parent $frm -title "Convert Error" \
1621                -message "File $file does not exist" -icon error
1622        return
1623    }
1624
1625    set tmpname "[file join [file dirname $file] tempfile.xxx]"
1626    set oldname "[file rootname $file].org"
1627    if [file exists $oldname] {
1628        set ans [MyMessageBox -parent . -title "Overwrite?" \
1629                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
1630                -icon warning -type {Overwrite Cancel} -default Overwrite \
1631                -helplink "expguierr.html OverwriteCnv"]
1632        if {[string tolower $ans] == "cancel"} return
1633        catch {file delete $oldname}
1634    }
1635
1636    if [catch {
1637        set in [open $file r]
1638        set out [open $tmpname w]
1639        fconfigure $out -translation crlf -encoding ascii
1640        set len [gets $in line]
1641        if {$len > 160} {
1642            # this is a UNIX file. Hope there are no control characters
1643            set i 0
1644            set j 79
1645            while {$j < $len} {
1646                puts $out [string range $line $i $j]
1647                incr i 80
1648                incr j 80
1649            }
1650        } else {
1651            while {$len >= 0} {
1652                append line "                                        "
1653                append line "                                        "
1654                set line [string range $line 0 79]
1655                puts $out $line
1656                set len [gets $in line]
1657            }
1658        }
1659        close $in
1660        close $out
1661        file rename -force $file $oldname
1662        file rename -force $tmpname $file
1663    } errmsg] {
1664        MyMessageBox -parent $frm -title "Conversion error" \
1665                -message "Error in conversion:\n$errmsg" -icon warning
1666    } else {
1667        set ans [MyMessageBox -parent $frm -title "More?" \
1668                -message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
1669                -type yesno -default no]
1670        if {$ans == "no"} {destroy $frm}
1671    }
1672}
1673
1674# create a file box
1675proc winfilebox {frm} {
1676    global expgui
1677    set bx $frm.1
1678    pack [frame $bx.top] -side top
1679    pack [label $bx.top.a -text "Directory" ] -side left
1680    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1681    pack $bx.top.d -side left
1682    set expgui(FileMenuDir) [pwd]
1683    # the icon below is from tk8.0/tkfbox.tcl
1684    set upfolder [image create bitmap -data {
1685#define updir_width 28
1686#define updir_height 16
1687static char updir_bits[] = {
1688   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1689   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1690   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1691   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1692   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1693   0xf0, 0xff, 0xff, 0x01};}]
1694
1695    pack [button $bx.top.b -image $upfolder \
1696            -command "updir; ChooseWinCnv $frm" ]
1697    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1698    listbox $bx.a.files -relief raised -bd 2 \
1699            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1700            -height 15 -width 0 -exportselection 0 
1701    listbox $bx.a.dates -relief raised -bd 2 \
1702            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1703            -height 15 -width 0 -takefocus 0 -exportselection 0 
1704    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1705    ChooseWinCnv $frm
1706    bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
1707    bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
1708    bind $bx.a.files <Double-1> "SelectWinCnv $frm"
1709    bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
1710    pack $bx.a.scroll -side left -fill y
1711    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1712    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
1713}
1714
1715# set the box or file in the selection window
1716proc ReleaseWinCnv {frm} {
1717    global expgui
1718    set files $frm.1.a.files
1719    set dates $frm.1.a.dates
1720    set select [$files curselection]
1721    if {$select == ""} {
1722        set select [$dates curselection]
1723    }
1724    if {$select == ""} {
1725        set expgui(FileMenuCnvName) ""
1726    } else {
1727        set expgui(FileMenuCnvName) [string trim [$files get $select]]
1728    }
1729    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1730        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1731        ChooseWinCnv $frm
1732    } elseif [file isdirectory \
1733            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
1734        if {$expgui(FileMenuCnvName) != "."} {
1735            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1736            ChooseWinCnv $frm
1737        }
1738    }
1739    return
1740}
1741
1742# select a file or directory -- called on double click
1743proc SelectWinCnv {frm} {
1744    global expgui
1745    set files $frm.1.a.files
1746    set dates $frm.1.a.dates
1747    set select [$files curselection]
1748    if {$select == ""} {
1749        set select [$dates curselection]
1750    }
1751    if {$select == ""} {
1752        set file .
1753    } else {
1754        set file [string trim [$files get $select]]
1755    }
1756    if {$file == "<Parent>"} {
1757        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1758        ChooseWinCnv $frm
1759    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1760        if {$file != "."} {
1761            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1762            ChooseWinCnv $frm
1763        }
1764    } else {
1765        set expgui(FileMenuCnvName) [file tail $file]
1766        ValidWinCnv $frm
1767    }
1768}
1769
1770# fill the files & dates & Directory selection box with current directory,
1771# also called when box is created to fill it
1772proc ChooseWinCnv {frm} {
1773    global expgui
1774    set files $frm.1.a.files
1775    set dates $frm.1.a.dates
1776    set expgui(FileMenuCnvName) {}
1777    $files delete 0 end
1778    $dates delete 0 end
1779    $files insert end {<Parent>}
1780    $dates insert end {(Directory)}
1781    set filelist [glob -nocomplain \
1782            [file join [set expgui(FileMenuDir)] *] ]
1783    foreach file [lsort -dictionary $filelist] {
1784        if {[file isdirectory $file]} {
1785            $files insert end [file tail $file]
1786            $dates insert end {(Directory)}
1787        }
1788    }
1789    foreach file [lsort -dictionary $filelist] {
1790        if {![file isdirectory $file]} {
1791            set modified [clock format [file mtime $file] -format "%T %D"]
1792            $files insert end [file tail $file]
1793            $dates insert end $modified
1794        }
1795    }
1796    $expgui(FileDirButtonMenu)  delete 0 end
1797    set list ""
1798    global tcl_version
1799    if {$tcl_version > 8.0} {
1800        catch {set list [string tolower [file volume]]}
1801    }
1802    set dir ""
1803    foreach subdir [file split [set expgui(FileMenuDir)]] {
1804        set dir [string tolower [file join $dir $subdir]]
1805        if {[lsearch $list $dir] == -1} {lappend list $dir}
1806    }
1807    foreach path $list {
1808        $expgui(FileDirButtonMenu) add command -label $path \
1809                -command "[list set expgui(FileMenuDir) $path]; \
1810                ChooseWinCnv $frm"
1811    }
1812    return
1813}
1814
1815#------------------------------------------------------------------------------
1816# set options for liveplot
1817proc liveplotopt {} {
1818    global liveplot expmap
1819    set frm .file
1820    catch {destroy $frm}
1821    toplevel $frm
1822    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1823    set last [lindex [lsort -integer $expmap(powderlist)] end]
1824    if {$last == ""} {set last 1}
1825    pack [scale  $frmA.1 -label "Histogram number" -from 1 -to $last \
1826            -length  150 -orient horizontal -variable liveplot(hst)] -side top
1827    pack [checkbutton $frmA.2 -text {include plot legend}\
1828            -variable liveplot(legend)] -side top
1829    pack [button $frm.2 -text OK \
1830            -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
1831            ] -side top
1832    bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
1833   
1834    # force the window to stay on top
1835    putontop $frm 
1836    focus $frm.2
1837    tkwait window $frm
1838    afterputontop
1839}
1840
1841#------------------------------------------------------------------------------
1842# get an experiment file name
1843#------------------------------------------------------------------------------
1844proc getExpFileName {mode} {
1845    global expgui tcl_platform
1846    set frm .file
1847    catch {destroy $frm}
1848    toplevel $frm
1849    wm title $frm "Experiment file"
1850    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
1851    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1852    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
1853            -fill y -expand yes
1854    pack [button $frmC.help -text Help -bg yellow \
1855            -command "MakeWWWHelp expguierr.html open"] \
1856            -side top -anchor e
1857    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
1858    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
1859            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1860    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
1861            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1862
1863    set expgui(includearchived) 0
1864    set expgui(FileInfoBox) $frmC.info
1865    if {$mode == "old"} {
1866        pack [checkbutton $frmC.ar -text "Include Archived Files" \
1867                -variable expgui(includearchived) \
1868                -command "ChooseExpFil $frmA"] -side top -pady 10
1869        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
1870                -class SmallFont] \
1871                -side top -fill both -expand yes -pady 5
1872    } elseif {$mode != "new"} {
1873        # for initial read, don't access archived files
1874        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
1875                -class SmallFont] \
1876                -side top -fill both -expand yes -pady 5
1877        set mode "old"
1878    }
1879    pack [button $frmC.b -text Read \
1880            -command "valid_exp_file $frmA $mode"] -side bottom
1881    if {$mode == "new"} {
1882        $frmC.b config -text Save
1883    }
1884    pack [button $frmC.q -text Quit \
1885            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
1886    bind $frm <Return> "$frmC.b invoke"
1887
1888    if {$mode == "new"} {
1889        pack [label $frmA.0 -text "Enter an experiment file to create"] \
1890                -side top -anchor center
1891    } else {
1892        pack [label $frmA.0 -text "Select an experiment file to read"] \
1893                -side top -anchor center
1894    }
1895    expfilebox $frmA $mode
1896    # force the window to stay on top
1897    putontop $frm
1898    focus $frmC.b
1899    tkwait window $frm
1900    afterputontop
1901    if {$expgui(FileMenuEXPNAM) == ""} return
1902    # is there a space in the EXP name?
1903    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
1904        update
1905        MyMessageBox -parent . -title "File Name Error" \
1906            -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
1907            -icon warning -type Continue -default continue
1908#               -helplink "expguierr.html OpenErr"
1909        return
1910    }
1911    if {[string first " " $expgui(FileMenuDir)] != -1} {
1912        update
1913        MyMessageBox -parent . -title "Good luck..." \
1914            -message "You are using a directory with a space in the name ([file dirname $expgui(FileMenuDir)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@NIST.gov so they can be fixed." \
1915            -icon warning -type Continue -default continue
1916#               -helplink "expguierr.html OpenErr"
1917    }
1918    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1919}
1920
1921# validation routine
1922proc valid_exp_file {frm mode} {
1923    global expgui tcl_platform
1924    # windows fixes
1925    if {$tcl_platform(platform) == "windows"} {
1926        # change backslashes to something sensible
1927        regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
1928        # allow entry of D: for D:/ and D:TEST for d:/TEST
1929        if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
1930                [string first :/ $expgui(FileMenuEXPNAM)] == -1} {
1931            regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
1932        }
1933    }
1934    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
1935        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1936        ChooseExpFil $frm
1937        return
1938    } elseif [file isdirectory \
1939            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
1940        if {$expgui(FileMenuEXPNAM) != "."} {
1941            set expgui(FileMenuDir) \
1942                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1943        }
1944        ChooseExpFil $frm
1945        return
1946    }
1947    # append a .EXP if not present
1948    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
1949        append expgui(FileMenuEXPNAM) ".EXP"
1950    }
1951    # is there a space in the name?
1952    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
1953        MyMessageBox -parent . -title "File Name Error" \
1954                -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
1955                -icon warning -type Continue -default continue
1956#               -helplink "expguierr.html OpenErr"
1957        return
1958    }
1959    # check for archive files
1960    if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
1961            $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
1962        destroy .file
1963        return
1964    } elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
1965        # check for files that end in something other than .EXP .exp or .Exp...
1966        MyMessageBox -parent . -title "File Open Error" \
1967                -message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
1968                -icon error
1969        return
1970    }
1971    # check on the file status
1972    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1973    if {$mode == "new" && [file exists $file]} {
1974        set ans [
1975        MyMessageBox -parent . -title "File Open Error" \
1976                -message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
1977                -icon question -type {"Select other" "Overwrite"} -default "select other" \
1978                -helplink "expguierr.html OverwriteErr"
1979        ]
1980        if {[string tolower $ans] == "overwrite"} {destroy .file}
1981        return
1982    }
1983    # if file does not exist in case provided, set the name to all
1984    # upper case letters, since that is the best choice.
1985    # if it does exist, read from it as is. For UNIX we will force uppercase later.
1986    if {![file exists $file]} {
1987        set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
1988        set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1989    }
1990    if {$mode == "old" && ![file exists $file]} {
1991        set ans [
1992        MyMessageBox -parent . -title "File Open Error" \
1993                -message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
1994                -icon question -type {"Select other" "Create"} -default "select other" \
1995                -helplink "expguierr.html OpenErr"
1996        ]
1997        if {[string tolower $ans] == "create"} {destroy .file}
1998        return
1999    }
2000    destroy .file
2001}
2002
2003proc updir {} {
2004    global expgui
2005    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
2006}
2007
2008# create a file box
2009proc expfilebox {bx mode} {
2010    global expgui
2011    pack [frame $bx.top] -side top
2012    pack [label $bx.top.a -text "Directory" ] -side left
2013    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2014    pack $bx.top.d -side left
2015    set expgui(FileMenuDir) [pwd]
2016    # the icon below is from tk8.0/tkfbox.tcl
2017    set upfolder [image create bitmap -data {
2018#define updir_width 28
2019#define updir_height 16
2020static char updir_bits[] = {
2021   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
2022   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
2023   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
2024   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
2025   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
2026   0xf0, 0xff, 0xff, 0x01};}]
2027
2028    pack [button $bx.top.b -image $upfolder \
2029            -command "updir; ChooseExpFil $bx" ]
2030    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2031    listbox $bx.a.files -relief raised -bd 2 \
2032            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2033            -height 15 -width 0 -exportselection 0 
2034    listbox $bx.a.dates -relief raised -bd 2 \
2035            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2036            -height 15 -width 0 -takefocus 0 -exportselection 0 
2037    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2038    ChooseExpFil $bx
2039    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2040    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2041    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
2042    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
2043    pack $bx.a.scroll -side left -fill y
2044    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2045    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2046}
2047proc sync2boxesX {master slave scroll args} {
2048    $slave xview moveto [lindex [$master xview] 0]
2049    eval $scroll set $args
2050}
2051proc move2boxesX {boxlist args} {
2052    foreach listbox $boxlist { 
2053        eval $listbox xview $args
2054    }
2055}
2056proc sync2boxesY {master slave scroll args} {
2057    $slave yview moveto [lindex [$master yview] 0]
2058    eval $scroll set $args
2059}
2060proc move2boxesY {boxlist args} {
2061    foreach listbox $boxlist { 
2062        eval $listbox yview $args
2063    }
2064}
2065
2066# creates a table that is scrollable in both x and y, use ResizeScrollTable
2067# to set sizes after gridding the boxes
2068proc MakeScrollTable {box} {
2069    grid [label $box.0] -column 0 -row 0
2070    grid [set tbox [canvas $box.top \
2071            -scrollregion {0 0 10 10} \
2072            -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
2073            -width 10 -height 10]] \
2074            -sticky sew -row 0 -column 1
2075    grid [set sbox [canvas $box.side \
2076            -scrollregion {0 0 10 10} \
2077            -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
2078            -width 10 -height 10]] \
2079            -sticky nes -row 1 -column 0
2080    grid [set bbox [canvas $box.can \
2081            -scrollregion {0 0 10 10} \
2082            -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
2083            -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
2084            -width 200 -height 200 -bg lightgrey]] \
2085            -sticky news -row 1 -column 1
2086    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
2087            -command "move2boxesX \" $box.can $box.top \" "]] \
2088            -sticky ew -row 2 -column 1
2089    grid [set sybox [scrollbar $box.yscroll \
2090            -command "move2boxesY \" $box.can $box.side \" "]] \
2091            -sticky ns -row 1 -column 2
2092    frame $tbox.f -bd 0
2093    $tbox create window 0 0 -anchor nw  -window $tbox.f
2094    frame $bbox.f -bd 2
2095    $bbox create window 0 0 -anchor nw  -window $bbox.f
2096    frame $sbox.f -bd 2 -relief raised
2097    $sbox create window 0 0 -anchor nw  -window $sbox.f
2098    grid columnconfig $box 1 -weight 1
2099    grid rowconfig $box 1 -weight 1
2100    return [list  $tbox.f  $bbox.f $sbox.f $box.0]
2101}
2102
2103proc ResizeScrollTable {box} {
2104    update idletasks
2105    for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
2106        set x1 [lindex [grid bbox $box.can.f $i 0] 2]
2107        set x2 [lindex [grid bbox $box.top.f $i 0] 2]
2108        if {$x2 > $x1} {set x1 $x2}
2109        grid columnconfigure $box.top.f $i -minsize $x1
2110        grid columnconfigure $box.can.f $i -minsize $x1
2111    }
2112    for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
2113        set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
2114        set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
2115        if {$x2 > $x1} {set x1 $x2}
2116        grid rowconfigure $box.can.f $i -minsize $x1
2117        grid rowconfigure $box.side.f $i -minsize $x1
2118    }
2119    update idletasks
2120    set sizes [grid bbox $box.can.f]
2121    $box.can config -scrollregion $sizes
2122    $box.side config -scrollregion $sizes
2123    $box.top config -scrollregion $sizes
2124    $box.top config -height [lindex [grid bbox $box.top.f] 3]
2125    $box.side config -width [lindex [grid bbox $box.side.f] 2]
2126}
2127proc ExpandScrollTable {box} {
2128    # set height & width of central box
2129    $box.can config -width \
2130            [expr [winfo width [winfo toplevel $box]] \
2131            - [winfo width $box.side] - [winfo width $box.yscroll]-20]
2132    $box.can config -height \
2133            [expr [winfo height [winfo toplevel $box]] \
2134            - [winfo height $box.top] - [winfo height $box.scroll]-25]
2135}
2136
2137
2138# support routine for SetHistUseFlags
2139proc InitHistUseFlags {} {
2140    global expmap expgui
2141    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2142#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2143            set expgui(useflag_$i) [histinfo $i use]
2144#       }
2145    }
2146}
2147
2148# show all Powder histograms; set use/do not use flags
2149proc SetHistUseFlags {} {
2150    set box .test
2151    catch {toplevel $box}
2152    eval destroy [winfo children $box]
2153    grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
2154    grid [frame $box.a] -row 1 -column 0 -columnspan 2
2155    grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
2156    grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
2157    grid columnconfig $box 0 -weight 1
2158    grid columnconfig $box 1 -weight 1
2159    foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
2160    $cbox config -text "Use\nFlag"
2161    [winfo parent $bbox] config -height 250 -width 400
2162    global expmap expgui
2163    set px 5
2164    set row -1
2165    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2166        if {[string range $expmap(htype_$i) 2 2] == "T"} {
2167            set det [format %8.2f [histinfo $i tofangle]]
2168        } elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
2169            set det [format %8.5f [histinfo $i lam1]]
2170        } elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
2171            set det [format %8.2f [histinfo $i lam1]]
2172        } else {
2173            set det {}
2174        }
2175        incr row
2176#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2177            grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0 
2178            set expgui(useflag_$i) [histinfo $i use]
2179#       }
2180        grid [label $bbox.0$i \
2181                -text [string range $expmap(htype_$i) 0 3] \
2182                ] -row $row -column 0 -padx $px
2183        grid [label $bbox.1$i -text [histinfo $i bank] \
2184                ] -row $row -column 1 -padx $px
2185        grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
2186        grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
2187                ] -row $row -column 3 -padx $px -sticky ew
2188    }
2189    grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
2190    grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
2191    grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
2192    grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
2193    ResizeScrollTable $box.a
2194    InitHistUseFlags
2195    putontop $box
2196    tkwait window $box
2197    afterputontop
2198    set prevchages $expgui(changed)
2199    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2200#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2201            if {$expgui(useflag_$i) != [histinfo $i use]} {
2202                histinfo $i use set $expgui(useflag_$i)
2203                RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
2204                incr expgui(changed)
2205                RecordMacroEntry "incr expgui(changed)" 0
2206            }
2207#       }
2208    }
2209    if {$prevchages != $expgui(changed)} {
2210        set msg "You have changed [expr $expgui(changed)-$prevchages] "
2211        append msg "histogram flag(s). You must run POWPREF "
2212        append msg "to include/remove these histograms. Do you want to "
2213        append msg "run POWPREF?"
2214        set ans [MyMessageBox -parent . -message $msg \
2215                -title "Process changes?"\
2216                -helplink "expguierr.html ProcessUse" \
2217                -default {Run POWPREF} \
2218                -type {{Run POWPREF} Skip}]
2219       
2220        if {$ans == "skip"} {
2221            # save and reload the experiment file
2222            savearchiveexp
2223            loadexp $expgui(expfile)
2224        } else {
2225            # run powpref and force a reload
2226            set saveautoload $expgui(autoexpload)
2227            set expgui(autoexpload) 1
2228            runGSASwEXP powpref
2229            set expgui(autoexpload) $saveautoload
2230        }
2231    }
2232}
2233
2234# set the box or file in the selection window
2235proc ReleaseExpFil {frm} {
2236    global expgui
2237    set files $frm.a.files
2238    set dates $frm.a.dates
2239    set select [$files curselection]
2240    if {$select == ""} {
2241        set select [$dates curselection]
2242    }
2243    if {$select == ""} {
2244        set expgui(FileMenuEXPNAM) ""
2245    } else {
2246        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
2247        after idle UpdateInfoBox
2248    }
2249    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2250        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
2251        ChooseExpFil $frm
2252    } elseif [file isdirectory \
2253            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
2254        if {$expgui(FileMenuEXPNAM) != "."} {
2255            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2256            ChooseExpFil $frm
2257        }
2258    }
2259    return
2260}
2261proc UpdateInfoBox {} {
2262    global expgui
2263    if {![winfo exists $expgui(FileInfoBox)]} return
2264    eval destroy [winfo children $expgui(FileInfoBox)]
2265    set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
2266    if [file isdirectory $file] return
2267    if [file exists $file] {
2268        pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
2269                -side top
2270        catch {
2271            set fp [open $file r]
2272            global testline
2273            set testline [read $fp]
2274            close $fp
2275            update
2276            regexp {GNLS  RUN on (.*) +Total.*run *([0-9]+) } \
2277                    $testline a last cycles
2278            pack [label $expgui(FileInfoBox).2 -justify left \
2279                    -text "last GENLES run:\n  $last\n  total cycles: $cycles"] \
2280                -side top -anchor w
2281            regexp {REFN GDNFT.*= *([0-9]*\.[0-9]*) +for *([0-9]+) variables} \
2282                    $testline a chi2 vars
2283            pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
2284                    -side top -anchor w
2285            pack [label $expgui(FileInfoBox).3.a -justify left \
2286                    -text "c" -font symbol] \
2287                    -side left -anchor w
2288            pack [label $expgui(FileInfoBox).3.b -justify left \
2289                    -text "2: $chi2, $vars vars"] \
2290                    -side top -anchor w
2291            # check first 9 histograms
2292            set lbl "h  Rwp     R(F2)"
2293            set n 0
2294            foreach k {1 2 3 4 5 6 7 8 9} {
2295                set key "HST  $k"
2296                append key { RPOWD +([0-9]*\.[0-9]*) }
2297                set i [regexp $key $testline a Rwp]
2298                set key "HST  $k"
2299                append key { R-FAC +[0-9]+ +([0-9]*\.[0-9]*) }
2300                set j [regexp $key $testline a Rb]
2301                if {$i || $j} {
2302                    incr n
2303                    append lbl "\n$k  "
2304                    if {$i} {
2305                        append lbl [string range $Rwp 0 5]
2306                    } else {
2307                        append lbl "    "
2308                    }
2309                }
2310                if {$j} {
2311                    append lbl " [string range $Rb 0 5]"
2312                }
2313                # stick 1st 3 entries in box
2314                if {$n >= 3} break
2315            }
2316            pack [label $expgui(FileInfoBox).4 -justify left \
2317                    -text $lbl] \
2318                    -side top -anchor w     
2319        }
2320    }
2321}
2322
2323# select a file or directory -- called on double click
2324proc SelectExpFil {frm mode} {
2325    global expgui
2326    set files $frm.a.files
2327    set dates $frm.a.dates
2328    set select [$files curselection]
2329    if {$select == ""} {
2330        set select [$dates curselection]
2331    }
2332    if {$select == ""} {
2333        set file .
2334    } else {
2335        set file [string trim [$files get $select]]
2336    }
2337    if {$file == "<Parent>"} {
2338        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2339        ChooseExpFil $frm
2340    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
2341        if {$file != "."} {
2342            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
2343            ChooseExpFil $frm
2344        }
2345    } else {
2346        set expgui(FileMenuEXPNAM) [file tail $file]
2347        valid_exp_file $frm $mode
2348    }
2349}
2350
2351# fill the files & dates & Directory selection box with current directory,
2352# also called when box is created to fill it
2353proc ChooseExpFil {frm} {
2354    global expgui
2355    set files $frm.a.files
2356    set dates $frm.a.dates
2357    set expgui(FileMenuEXPNAM) {}
2358    $files delete 0 end
2359    $dates delete 0 end
2360    $files insert end {<Parent>}
2361    $dates insert end {(Directory)}
2362    set filelist [glob -nocomplain \
2363            [file join [set expgui(FileMenuDir)] *] ]
2364    foreach file [lsort -dictionary $filelist] {
2365        if {[file isdirectory $file]} {
2366            $files insert end [file tail $file]
2367            $dates insert end {(Directory)}
2368        }
2369    }
2370    set pairlist {}
2371    foreach file [lsort -dictionary $filelist] {
2372        if {![file isdirectory $file]  && \
2373                [string toupper [file extension $file]] == ".EXP"} {
2374            set modified [file mtime $file]
2375            lappend pairlist [list $file $modified]
2376        } elseif {![file isdirectory $file] && $expgui(includearchived) && \
2377                [string match {*.O[0-9A-F][0-9A-F]} $file]} {
2378            set modified [file mtime $file]
2379            lappend pairlist [list $file $modified]
2380        }
2381    }
2382    if {$expgui(filesort) == 0} {
2383        foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
2384            set file [lindex $pair 0]
2385            set modified [clock format [lindex $pair 1] -format "%T %D"]
2386            $files insert end [file tail $file]
2387            $dates insert end $modified
2388        }
2389    } else {
2390        foreach pair [lsort -dictionary -index 0 $pairlist] {
2391            set file [lindex $pair 0]
2392            set modified [clock format [lindex $pair 1] -format "%T %D"]
2393            $files insert end [file tail $file]
2394            $dates insert end $modified
2395        }
2396    }
2397    $expgui(FileDirButtonMenu)  delete 0 end
2398    set list ""
2399    global tcl_platform tcl_version
2400    if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
2401        catch {set list [string tolower [file volume]]}
2402    }
2403    set dir ""
2404    foreach subdir [file split [set expgui(FileMenuDir)]] {
2405        set dir [file join $dir $subdir]
2406        if {$tcl_platform(platform) == "windows"} {
2407            set dir [string tolower $dir]
2408            if {[lsearch $list $dir] == -1} {lappend list $dir}
2409        } else {
2410            lappend list $dir
2411        }
2412    }
2413    foreach path $list {
2414        $expgui(FileDirButtonMenu) add command -label $path \
2415                -command "[list set expgui(FileMenuDir) $path]; \
2416                ChooseExpFil $frm"
2417    }
2418    # highlight the current experiment -- if present
2419    for {set i 0} {$i < [$files size]} {incr i} {
2420        set file [$files get $i]
2421        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
2422            $files selection set $i
2423        }
2424    }
2425    return
2426}
2427
2428
2429#------------------------------------------------------------------------------
2430# platform-specific definitions
2431if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
2432    # windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
2433    # DOS box synchronously, so we create a "lock" file that is deleted
2434    # at the end of the DOS run so we can tell when the run is done.
2435    # We create a window to force the deleting of the file so that if
2436    # the DOS process crashes, the user can continue anyway.
2437    #
2438    # procedure to check if the lock file is still there (Win-9x/me only)
2439    proc checklockfile {file window} {
2440        if [file exists $file] {
2441            after 500 checklockfile $file $window
2442        } else {
2443            catch {destroy $window}
2444        }
2445    }
2446    # this procedure starts the GRWND program, if needed for program $prog
2447    proc StartGRWND {prog} {
2448        global expgui
2449        if {!$expgui(autoGRWND)} return
2450        # at some point we might want to have a real list
2451        if {$prog != "genles" && $prog != "powpref"} {
2452            # get a list of running jobs
2453            exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
2454            set fp [open tlist.tlist r]
2455            set text [read $fp]
2456            close $fp
2457            file delete -force tlist.tlist
2458            # if GRWND.EXE is not currently running, start it
2459            if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
2460                exec [file join $expgui(gsasexe) grwnd.exe] &
2461                # give grwnd a 1 second head start
2462                after 1000
2463            }
2464        }
2465    }
2466    # this creates a DOS box to run a program in
2467    proc forknewterm {title command "wait 1" "scrollbar 1"} {
2468        global env expgui
2469        # Windows environment variables
2470        set env(GSAS) [file nativename $expgui(gsasdir)]
2471        # PGPLOT_FONT is needed by PGPLOT
2472        set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) pgl grfont.dat]]
2473        # this is the number of lines/page in the .LST (etc.) file
2474        set env(LENPAGE) 60
2475        set pwd [file nativename [pwd]]
2476       
2477        # check the .EXP path -- can DOS use it?
2478        if {[string first // [pwd]] != -1} {
2479            MyMessageBox -parent . -title "Invalid Path" \
2480                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2481                    -icon error -type ok -default ok \
2482                    -helplink "expgui_Win_readme.html NetPath"
2483            return
2484        }
2485        if {[info command winutils::shell] == "" && \
2486                [info command winexec] == ""} {
2487            MyMessageBox -parent . -title "Setup error" \
2488                -message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
2489                -icon error -type darn -default darn \
2490                -helplink "expgui_Win_readme.html Winexec"
2491            return
2492        }
2493        # loop over multiple commands
2494        foreach cmd $command {
2495            # simulate the wait with a lock file
2496            if {$wait} {
2497                if {$expgui(autoiconify)} {wm iconify .}
2498                # create a blank lock file and a message window
2499                close [open expgui.lck w]
2500                toplevel .lock
2501                grid [button .lock.0 -text Help -bg yellow \
2502                        -command "MakeWWWHelp expguierr.html lock"] \
2503                        -column 1 -row 0
2504                grid [label .lock.1 \
2505                        -text "Please wait while the GSAS program finishes."] \
2506                        -column 0 -row 0
2507                grid [label .lock.2 -text \
2508                        "In case a problem occurs, close the DOS box"] \
2509                        -column 0 -columnspan 2 -row 1
2510                grid [label .lock.3 -text \
2511                        "and press the \"Continue\" button (below)"] \
2512                        -column 0 -columnspan 2 -row 2
2513                grid [button .lock.b -text "Continue" \
2514                        -command "destroy .lock; wm deiconify ."] \
2515                        -column 0 -columnspan 2 -row 3
2516                putontop .lock
2517                update
2518                checklockfile expgui.lck .lock
2519            }
2520
2521            # pause is hard coded in the GSASTCL.BAT file
2522            if {$expgui(execprompt)} {
2523                set script gsastcl.bat
2524            } else {
2525                set script gsasnowt.bat
2526            }
2527
2528            # replace the forward slashes with backward
2529            regsub -all / $cmd \\ cmd
2530            if {[info command winutils::shell] != ""} {
2531                winutils::shell [file join $expgui(scriptdir) $script] $cmd
2532            } else {
2533                winexec -d [file nativename [pwd]] \
2534                    [file join $expgui(scriptdir) $script] $cmd
2535            }
2536            if {$expgui(MacroRunning)} {
2537                update 
2538                update idletasks
2539            }
2540            if {$wait} {
2541                tkwait window .lock
2542                file delete -force expgui.lck
2543            }
2544        }
2545        if {$expgui(autoiconify) && $wait} {wm deiconify .}
2546        # check for changes in the .EXP file immediately
2547        whenidle
2548    }
2549} elseif {$tcl_platform(platform) == "windows"} {
2550    # now for Windows-NT, where we can run synchronously
2551    #
2552    # this creates a DOS box to run a program in
2553    proc forknewterm {title command  "wait 1" "scrollbar 1"} {
2554        global env expgui
2555        # Windows environment variables
2556        set env(GSAS) [file nativename $expgui(gsasdir)]
2557        # PGPLOT_FONT is needed by PGPLOT
2558        set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) pgl grfont.dat]]
2559        # this is the number of lines/page in the .LST (etc.) file
2560        set env(LENPAGE) 60
2561        set pwd [file nativename [pwd]]
2562        # check the path -- can DOS use it?
2563        if {[string first // [pwd]] != -1} {
2564            MyMessageBox -parent . -title "Invalid Path" \
2565                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2566                    -icon error -type ok -default ok \
2567                    -helplink "expgui_Win_readme.html NetPath"
2568            return
2569        }
2570        # pause is hard coded in the .BAT file
2571        if {$expgui(execprompt)} {
2572            set script gsastcl.bat
2573        } else {
2574            set script gsasnowt.bat
2575        }
2576
2577        if {$wait} {
2578            if {$expgui(autoiconify)} {wm iconify .}
2579            # create a blank lock file (keep liveplot from running)
2580            close [open expgui.lck w]
2581            # loop over commands
2582            foreach cmd $command {
2583                # replace the forward slashes with backward
2584                regsub -all / $cmd \\ cmd
2585                exec $env(COMSPEC) /c \
2586                        "start [file join $expgui(scriptdir) $script] $cmd"
2587            }
2588            file delete -force expgui.lck
2589            if {$expgui(autoiconify)} {wm deiconify .}
2590            # check for changes in the .EXP file immediately
2591            whenidle
2592        } else {
2593            # loop over commands
2594            foreach cmd $command {
2595                # replace the forward slashes with backward
2596                regsub -all / $cmd \\ cmd
2597                # run in background
2598                exec $env(COMSPEC) /c \
2599                        "start [file join $expgui(scriptdir) $script] $cmd" &
2600                if {$expgui(MacroRunning)} {
2601                    update 
2602                    update idletasks
2603                }
2604            }
2605        }
2606    }
2607} else {
2608    # this creates a xterm window to run a program in
2609    proc forknewterm {title command "wait 1" "scrollbar 1"} {
2610        global env expgui
2611        # UNIX environment variables
2612        set env(GSAS) [file nativename $expgui(gsasdir)]
2613        set env(gsas) [file nativename $expgui(gsasdir)]
2614        set env(GSASEXE) $expgui(gsasexe)
2615        set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2616        set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2617        # PGPLOT_DIR is needed by PGPLOT
2618        set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl]
2619        # this is the number of lines/page in the .LST (etc.) file
2620        set env(LENPAGE) 60
2621        set termopts {}
2622        if $env(GSASBACKSPACE) {
2623            append termopts \
2624                    {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
2625        }
2626        if $scrollbar {
2627            append termopts " -sb"
2628        } else {
2629            append termopts " +sb"
2630        }
2631        if {$wait} {
2632            set suffix {}
2633        } else {
2634            set suffix {&}
2635        }
2636
2637        # hold window open after commands finish
2638        if {$expgui(execprompt)} {
2639            append command "\; echo -n Press Enter to continue \; read x"
2640        }
2641        if {$wait && $expgui(autoiconify)} {wm iconify .}
2642        catch {eval exec xterm $termopts -title [list $title] \
2643                -e /bin/sh -c [list $command] $suffix} errmsg
2644        if $expgui(debug) {puts "xterm result = $errmsg"}
2645        if {$expgui(MacroRunning)} {
2646            update 
2647            update idletasks
2648        }
2649        if {$wait} {
2650            if {$expgui(autoiconify)} {wm deiconify .}
2651            # check for changes in the .EXP file immediately
2652            whenidle
2653        }
2654    }
2655}
2656
2657# run commands without a terminal window
2658proc runnoterm {command outfile} {
2659    global env expgui tcl_platform
2660    if {$tcl_platform(platform) == "windows"} {
2661        # Windows environment variables
2662        set env(GSAS) [file nativename $expgui(gsasdir)]
2663        # PGPLOT_FONT is needed by PGPLOT
2664        set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) pgl grfont.dat]]
2665        # this is the number of lines/page in the .LST (etc.) file
2666        set env(LENPAGE) 60
2667        set pwd [file nativename [pwd]]
2668        # loop over multiple commands
2669        foreach cmd $command {
2670            # replace the forward slashes with backward
2671            regsub -all / $cmd \\ cmd
2672            exec $cmd >>& $outfile
2673            update
2674            update idletasks
2675        }
2676    } else { 
2677        # UNIX environment variables
2678        set env(GSAS) [file nativename $expgui(gsasdir)]
2679        set env(gsas) [file nativename $expgui(gsasdir)]
2680        set env(GSASEXE) $expgui(gsasexe)
2681        set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2682        set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2683        # PGPLOT_DIR is needed by PGPLOT
2684        set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl]
2685        # this is the number of lines/page in the .LST (etc.) file
2686        set env(LENPAGE) 60
2687        foreach cmd $command {
2688            catch {eval exec $cmd >>& $outfile} errmsg
2689        }
2690        update
2691        update idletasks
2692    }
2693    # check for changes in the .EXP file immediately
2694    #whenidle
2695}
2696
2697# modify resource fork info for a .EXP file on the Mac
2698proc MacSetResourceFork {expfile} {
2699    global expgui tcl_platform
2700    if {$tcl_platform(os) != "Darwin"} {return}
2701    set expnative [file nativename $expfile]
2702    #
2703    # assign an app to the data file, if the app and the
2704    # required tool (Rez) are installed
2705    set app [file join $expgui(gsasdir) expgui.app]
2706    if {[file exists /Developer/Tools/Rez]} {
2707        set RezApp /Developer/Tools/Rez
2708    } elseif {[file exists [file join $expgui(gsasdir) Rez]]} {
2709        set RezApp [file join $expgui(gsasdir) Rez]
2710    } else {
2711        set RezApp {}
2712    }
2713    if {[file exists /Developer/Tools/SetFile]} {
2714        set SetFileApp /Developer/Tools/SetFile
2715    } elseif {[file exists [file join $expgui(gsasdir) SetFile]]} {
2716        set SetFileApp [file join $expgui(gsasdir) SetFile]
2717    } else {
2718        set SetFileApp {}
2719    }
2720    if {[file exists $app] && $RezApp != ""} {
2721        # make a resource file
2722        set l [string length $app]; incr l
2723        set str "data 'usro' (0) {\n"
2724        append str {  $"}
2725        append str [format %.8X $l]
2726        foreach char [split $app {}] {
2727           append str [format %.2X [scan $char %c]]   
2728        }
2729        append str {00"}
2730        append str " \t/* ....$app. */\n};"
2731        set fp [open setapp.r w]
2732        puts $fp $str
2733        close $fp
2734        exec $RezApp setapp.r -o $expnative -a
2735        file delete -force setapp.r
2736    }
2737
2738    # assign an icon to the data file, if it and the required tools exist
2739    set icon [file join $expgui(gsasdir) gsasicon.r]
2740    if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
2741        exec $RezApp [file nativename $icon] -o $expnative -a
2742        exec $SetFileApp -a C $expnative
2743    }
2744}
2745
2746#-------------------------------------------------------------------------------
2747# Macro Recording
2748#-------------------------------------------------------------------------------
2749set expgui(MacroBufferedCommand) ""
2750set expgui(fpMacroFile) ""
2751set expgui(MacroFile) ""
2752# Turn on/off mode to save commands in MacroFile
2753proc SetRecordMacroOnOff {args} {
2754    global expgui
2755    if {$expgui(RecordMacro)} {
2756        set expgui(fpMacroFile) ""
2757        set expgui(MacroBufferedCommand) ""
2758        while {$expgui(fpMacroFile) == ""} {
2759            set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
2760                                       -parent . \
2761                                       -filetypes {{"EXPGUI Macro file" .expmac}} \
2762                                       -defaultextension .expmac  \
2763                                       -initialfile EXPGUI.expmac \
2764                                       -title "Choose location to save macro"]
2765            if {$expgui(MacroFile) == ""} {
2766                # respond to cancel
2767                set expgui(fpMacroFile) ""
2768                set expgui(MacroFile) ""
2769                set expgui(RecordMacro) 0
2770                return
2771            }
2772            if {[catch {
2773                set expgui(fpMacroFile) [open $expgui(MacroFile) w]
2774                puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
2775            } errmsg]} {
2776                MyMessageBox -parent . -title "Error opening selected file" \
2777                    -message "Error opening macro file:\n$errmsg" \
2778                    -icon warning -type TryAgain -default tryagain
2779                catch {close $expgui(fpMacroFile)}
2780                set expgui(fpMacroFile) ""
2781                set expgui(MacroFile) ""
2782                set expgui(RecordMacro) 0
2783            }
2784        }
2785    } else {
2786        if {[string trim $expgui(MacroBufferedCommand)] != ""} {
2787            puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
2788        }
2789        catch {close $expgui(fpMacroFile)}
2790        set expgui(fpMacroFile) ""
2791        set expgui(MacroFile) ""
2792        set expgui(MacroBufferedCommand) ""
2793    }
2794}
2795
2796# record a command in the Macro File
2797proc RecordMacroEntry {command buffer} {
2798    global expgui
2799    if {! $expgui(RecordMacro)} return
2800    # in buffered mode: hold the last command in memory and compare to the
2801    # next. If two commands differ only in the final argument, then the
2802    # second command makes the previous redundant so only the latter version
2803    # is retained (This will happen when a user types a string into a box).
2804    # When the commands differ, then the previous is written to file
2805    # and the next is retained in memory.
2806    if {$buffer} {
2807        if {[string trim $expgui(MacroBufferedCommand)] == ""} {
2808            set expgui(MacroBufferedCommand) $command
2809            return
2810        }
2811        set diff 0
2812        # is command a repeat of previous?
2813        foreach a $command b $expgui(MacroBufferedCommand) {
2814            if {$diff} {
2815                # found a difference, other than in the last arg
2816                puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
2817                break
2818            }
2819            if {$a != $b} {set diff 1}
2820        }
2821        set expgui(MacroBufferedCommand) $command
2822    } else {
2823        # no buffering on current command; write the old and new to file.
2824        if {[string trim $expgui(MacroBufferedCommand)] != ""} {
2825            puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
2826        }
2827        puts $expgui(fpMacroFile) $command
2828        set expgui(MacroBufferedCommand) ""
2829    }
2830}
2831
2832proc CantRecordMacroEntry {comment} {
2833    global expgui
2834    if {! $expgui(RecordMacro)} return
2835
2836    # no buffering on current command; write the old and new to file.
2837    if {[string trim $expgui(MacroBufferedCommand)] != ""} {
2838        puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
2839    }
2840    puts $expgui(fpMacroFile) "# unrecorded: $comment"
2841    set expgui(MacroBufferedCommand) ""
2842    MyMessageBox -parent . -title "No command record" \
2843        -message "EXPGUI is not able to record this action in the macro file: $comment" \
2844        -icon warning
2845}
2846
2847
2848# Play back commands in Macro File
2849proc ReplayMacroFile {"lineatatime 0"} {
2850    global expgui
2851    set expnam [file root [file tail $expgui(expfile)]]
2852    file delete abort_${expnam}_macro.flag
2853    set expgui(MacroRunning) 0
2854    set MacroFile [tk_getOpenFile -initialdir [pwd] \
2855                       -parent . \
2856                       -filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
2857                       -defaultextension .expmac  \
2858                       -title "Choose location to read macro"]
2859    if {$MacroFile == ""} return
2860    set expgui(MacroRunning) 1
2861    if {$lineatatime} {
2862        set expgui(MacroChanged) 0
2863        set top1 .macro
2864        catch {destroy $top1}
2865        toplevel $top1
2866        set txt $top1.t
2867        grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
2868            -column 0 -row 0 -sticky news
2869        wm title $top1 "File $MacroFile"
2870        grid [scrollbar $top1.s -command "$txt yview"] \
2871            -column 1 -row 0 -sticky ns
2872        grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
2873        grid columnconfig $top1 0 -weight 1
2874        grid rowconfig $top1 0 -weight 1
2875        grid [button $top1.b.e -text "Execute line" \
2876                  -command "MacroExecuteCurrentLine $txt"] \
2877            -column 0 -row 0 -sticky w
2878        grid columnconfig $top1.b 1 -weight 1
2879        grid [button $top1.b.s -text "Save As" -state disabled \
2880                  -command "MacroResave $txt"] -column 1 -row 0
2881        set expgui(MacroSaveButton) $top1.b.s 
2882        grid [button $top1.b.c -text "Close " \
2883                  -command "MacroCloseWindow $txt"] -column 2 -row 0
2884        $txt delete 0.0 end
2885        set fp [open $MacroFile r]
2886        $txt insert 0.0 [read $fp]
2887        close $fp
2888        MacroHighlightText $txt 1
2889        # deal with editing in the box
2890        $txt configure -undo 1
2891        $txt edit modified 0
2892        bind $txt <<Modified>> {
2893            $expgui(MacroSaveButton) configure -state normal
2894            set expgui(MacroChanged) 1
2895        }
2896    } else {
2897        close [open running_${expnam}_macro.flag w]
2898        set saveprompt $expgui(execprompt)
2899        set saveautold $expgui(autoexpload)
2900        set expgui(execprompt) 0
2901        set expgui(autoexpload) 1
2902        set expnam [file root [file tail $expgui(expfile)]]
2903        if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
2904            set outfile ${expnam}_macout.LST
2905            # create an empty file
2906            catch {file delete $outfile}
2907            close [open $outfile w]
2908            # view it with LSTVIEW
2909            set outfile ${expnam}_macout
2910            exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
2911        } else {
2912            # show status, offer abort with MACROMON
2913            exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
2914        }
2915
2916        set  expgui(MacroStatus) "starting script"
2917        pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus) 
2918
2919        if {[catch {
2920            source $MacroFile
2921        } errmsg]} {
2922            set txt $::errorInfo
2923            catch {
2924                set fp [open error.txt a]
2925                puts $fp "#  [clock format [clock seconds] -format %Y-%m-%dT%T]"
2926                puts $fp $txt
2927                close $fp
2928            }
2929            donewait
2930            MyMessageBox -parent . -title "Error running Macro file" \
2931                -message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
2932                -icon error -type OK -default ok
2933        } else {
2934            donewait
2935        }
2936        file delete running_${expnam}_macro.flag
2937        set expgui(execprompt) $saveprompt
2938        set expgui(autoexpload) $saveautold
2939        set expgui(MacroRunning) 0
2940        # show changes
2941        PaintEXPGUIpages
2942        # put comment in output file
2943        if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
2944            set outfile ${expnam}_macout.LST
2945            set fp [open $outfile a]
2946            puts $fp "\n**** Macro ended ****" 
2947            close $fp
2948        }
2949    }
2950}
2951
2952# highlight a line in the Macro file display
2953proc MacroHighlightText {txt line} {
2954    $txt tag delete next
2955    $txt tag add next $line.0 $line.end
2956    $txt see $line.0
2957    $txt tag configure next -background yellow
2958    # tag all text
2959    $txt tag delete all
2960    $txt tag add all 0.0 end
2961    # double-click moves the current line
2962    $txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
2963}
2964
2965# respond to a double click by moving the next line to be executed to
2966# the line where the double click occurred
2967proc MacroDoubleClick {txt} {
2968    set line [lindex [split [$txt tag ranges sel] "."] 0]
2969    MacroHighlightText $txt $line
2970}
2971
2972# respond to Execute button: execute the current line
2973# close window after last command
2974proc MacroExecuteCurrentLine {txt} {
2975    global expgui
2976    set linenum [lindex [split [$txt tag ranges next] "."] 0]
2977    if {$linenum == ""} {return}
2978    set line [$txt get $linenum.0 $linenum.end]
2979    # is this continued (ends with \)?
2980    while {[string range $line end end] == "\\" } {
2981        incr linenum
2982        # get rid of trailing backslash
2983        set line [string range $line 0 end-1]
2984        #append next line
2985        append line [$txt get $linenum.0 $linenum.end]
2986    }
2987     if {[catch $line errmsg]} {
2988        MyMessageBox -parent $txt -title "Error on line" \
2989            -message "Error on line $linenum:\n$errmsg" \
2990            -icon warning -type Continue -default continue
2991    }
2992    # show changes
2993    PaintEXPGUIpages
2994    # move forward in macrofile
2995    incr linenum
2996    MacroHighlightText $txt $linenum
2997    set linenum [lindex [split [$txt tag ranges next] "."] 0]
2998    # at end?
2999    if {$linenum == ""} {MacroCloseWindow $txt}
3000}
3001
3002# Save a modified macro file
3003proc MacroResave {txt} {
3004    global expgui
3005    set MacroFile [tk_getSaveFile -initialdir [pwd] \
3006                       -parent $txt \
3007                       -filetypes {{"EXPGUI Macro file" .expmac}} \
3008                       -defaultextension .expmac  \
3009                       -initialfile $expgui(MacroFile) \
3010                       -title "Choose location to save macro"]
3011    if {[string trim $MacroFile] == ""} {return}
3012    if {[catch {
3013        set fp [open $MacroFile w]
3014        puts $fp [string trim [$txt get 0.0 end]]
3015        close $fp
3016    } errmsg]} {
3017        MyMessageBox -parent $txt -title "Error writing to file" \
3018            -message "Error writing macro file:\n$errmsg" \
3019            -icon warning -type TryAgain -default tryagain
3020        return
3021    }
3022    set expgui(MacroChanged) 0
3023    # gray out the button
3024    $expgui(MacroSaveButton) configure -state disabled
3025}
3026
3027# close the window, but provide a chance to save the file first, if modified
3028proc MacroCloseWindow {txt} {
3029    global expgui
3030    if {$expgui(MacroChanged)} {
3031        set ans [MyMessageBox -parent $txt -title "Save macro file?" \
3032                     -message "Macro file has been changed, do you want to save it?" \
3033                     -icon warning -type "Yes No" -default no]
3034        if {$ans != "no"} {MacroResave $txt}
3035    }
3036    set expgui(MacroRunning) 0
3037    destroy [winfo toplevel $txt]
3038}
3039
3040# Add a comment to a macro file
3041proc AddCommentMacroFile {} {
3042    global expgui
3043    if {! $expgui(RecordMacro)} return
3044    RecordMacroEntry "# [getstring "comment for macro file"]" 0
3045}
Note: See TracBrowser for help on using the repository browser.