source: trunk/gsascmds.tcl @ 1225

Last change on this file since 1225 was 1225, checked in by toby, 8 years ago

update to latest, with Fourier & f'/f

  • Property svn:keywords set to Author Date Revision Id
File size: 141.6 KB
Line 
1# $Id: gsascmds.tcl 1225 2012-11-08 19:42:25Z 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# format numbers & errors in crystallographic notation
469proc formatSU {num err} {
470    # errors less or equal to t are expressed as 2 digits
471    set T 19
472    set lnT [expr { log10($T) }] 
473    # error is zero
474    if {$err == 0} {
475        # is this an integer?
476        if {int($num) == $num} {
477            return [format %d [expr int($num)]]
478        }
479        # allow six sig figs with a zero error (except for 0.0)
480        set dec [expr int(5.999999-log10( abs($num) ))]
481        if {$dec < -2 || $dec > 9} {
482            return [format %.5E $num]
483        } elseif {$dec <= 0} {
484            return [format %d [expr int($num)]]
485        } else {
486            return [format %.${dec}f $num]
487        }
488    } else {
489        #set sigfigs [expr log10( abs(10) / abs(.012/$T) ) + 1]
490        # should the number be expressed in scientific notation?
491        if {$err > $T || abs($num) < 0.0001} {
492            # get the exponent
493            set exp [lindex [split [format %E $num] E] end]
494            # strip leading zeros
495            regsub {([-\+])0+} $exp {\1} exp
496            # number of decimals in exponetial notation
497            set dec [expr int($lnT - log10( abs($err) ) + $exp)]
498            # should the error be displayed?
499            if {$err < 0} {
500                return [format "%.${dec}E" $num]
501            } else {
502                # scale the error into a decimal number
503                set serr [expr int(0.5 + $err * pow(10,$dec-$exp))]
504                return [format "%.${dec}E(%d)" $num $serr]
505            }
506        } else {
507            # number of digits
508            set dec [expr int($lnT - log10( abs($err) ))]
509            # should the error be displayed?
510            if {$err < 0} {
511                return [format "%.${dec}f" $num]
512            } else {
513                set serr [expr int(0.5 + $err * pow(10,$dec))]
514                return [format "%.${dec}f(%d)" $num $serr]
515            }
516        }
517    }
518}
519
520# place a window on a selected part of the screen
521# xfrac specifies the hozontal position with 0 to the left and 100 to the right
522# yfrac specifies the vertical position with 0 to the top and 100 to the bottom
523# loc chooses the part of the window to place at that location: N: upper, S: lower, W: left, E: right
524# use NSEW for center
525proc LocateWindow {win {xfrac 50} {yfrac 50} {loc c}} {
526    wm withdraw $win
527    set maxx [winfo screenwidth $win]
528    set maxy [winfo screenheight $win]
529    set reqx [winfo reqwidth $win]
530    set reqy [winfo reqheight $win]
531    set x [expr {$maxx*$xfrac/100.}]
532    set y [expr {$maxy*$yfrac/100.}]
533    if {[string match -nocase "*e*" $loc] && [string match -nocase "*w*" $loc]} {
534        # EW: center
535        set x [expr {$x - $reqx/2. }]
536    } elseif {[string match -nocase "*e*" $loc]} {
537        # right corner
538        set x [expr {$x - $reqx}]
539    } elseif {[string match -nocase "*w*" $loc]} {     
540        # left corner -- do nothing
541    } else {
542        # center
543        set x [expr {$x - $reqx/2. }]
544    }
545    if {[string match -nocase "*n*" $loc] && [string match -nocase "*s*" $loc]} {
546        # NS: center
547        set y [expr {$y - $reqy/2 }]
548    } elseif {[string match -nocase "*n*" $loc]} {
549        # upper corner -- do nothing
550    } elseif {[string match -nocase "*s*" $loc]} {
551        # lower corner
552        set y [expr {$y - $reqy}]
553    } else {
554        # center
555        set y [expr {$y - $reqy/2 }]
556    }
557    set x [expr {int($x + 0.5)}]
558    set y [expr {int($y + 0.5)}]
559    if {$x < 0} {set x 0}
560    if {$x > $maxx-$reqx} {set x [expr {$maxx-$reqx}]}
561    if {$y < 0} {set y 0}
562    if {$y > $maxy-$reqy} {set y [expr {$maxy-$reqy}]}
563    wm geom $win +$x+$y
564    wm deiconify $win
565}
566
567# get a value in a modal dialog
568proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
569    global expgui expmap
570    set w .global
571    catch {destroy $w}
572    toplevel $w -bg beige
573    bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
574    wm title $w "Input $what"
575    set expgui(temp) {}
576    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
577            -side top -expand yes -fill both
578    grid [label $w.0.a -text "Input a value for the $what" \
579            -bg beige] \
580            -row 0 -column 0 -columnspan 10
581    grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
582            -row 1 -column 0 
583
584    set expgui(temp) $initvalue
585    pack [frame $w.b -bg beige] -side top -fill x -expand yes
586    pack [button $w.b.2 -text Continue -command "destroy $w"] -side left
587    if $quit {
588        pack [button $w.b.3 -text Cancel \
589                -command "set expgui(temp) {}; destroy $w"] -side left
590    }
591    bind $w <Return> "destroy $w"
592    pack [button $w.b.help -text Help -bg yellow \
593            -command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
594            -side right
595
596    # force the window to stay on top
597    putontop $w
598
599    focus $w.b.2
600    tkwait window $w
601    afterputontop
602
603    return $expgui(temp)
604}
605
606# for use in debugging -- how did I get here!
607proc ShowCallStack {} {
608    puts "\n================== ShowCallStack ==============="
609    set n [info level]
610    incr n -1
611    while {$n > 0} {
612        puts "level $n: [info level $n]"
613        incr n -1
614    }
615}
616#------------------------------------------------------------------------------
617# profile/symmetry routines
618#------------------------------------------------------------------------------
619# profile terms
620array set expgui {
621    prof-T-names {"Von Dreele-Jorgensen-Windsor" \
622                      "David-Ikeda-Carpenter" "Exponential pseudo-Voigt" \
623                      "Exponential p-V+Stephens aniso strain" \
624                      "Exponential p-V+macro strain"
625    }
626    prof-T-1 {alp-0 alp-1 bet-0 bet-1 sig-0 sig-1 sig-2 rstr rsta \
627            rsca s1ec s2ec }
628    prof-T-2 {alp-0 alp-1 beta switch sig-0 sig-1 sig-2 gam-0 gam-1 \
629            gam-2 ptec stec difc difa zero }
630    prof-T-3 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
631            gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
632    prof-T-4 {alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
633            rstr rsta rsca eta}
634    prof-T-5 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
635            gam-2 gsf g1ec g2ec rstr rsta rsca D1 D2 D3 D4 D5 D6 }
636    prof-C-names {"Gaussian only" "Pseudo-Voigt" \
637                      "pseudo-Voigt/FCJ Asym" "p-V/FCJ+Stephens aniso strain" \
638                      "p-V/FCJ+macro strain"
639    }
640    prof-C-1 {GU GV GW asym F1 F2 }
641    prof-C-2 {GU GV GW LX LY trns asym shft GP stec ptec sfec \
642            L11 L22 L33 L12 L13 L23 }
643    prof-C-3 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
644            L11 L22 L33 L12 L13 L23 }
645    prof-C-4 {GU GV GW GP LX ptec trns shft sfec S/L H/L eta} 
646    prof-C-5 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
647            D1 D2 D3 D4 D5 D6 }
648    prof-E-names {Gaussian "Otto pseudo-Voigt"}
649    prof-E-1 {A B C ds cds}
650    prof-E-2 {A B C ds cds LX LY ptec stec}
651}
652
653# number of profile terms depends on the histogram type
654# the LAUE symmetry and the profile number
655proc GetProfileTerms {phase hist ptype} {
656    global expmap expgui
657    if {$hist == "C" || $hist == "T" || $hist == "E"} {
658        set htype $hist
659    } else {
660        set htype [string range $expmap(htype_$hist) 2 2]
661    }
662    # get the cached copy of the profile term labels, when possible
663    set lbls {}
664    catch {
665        set lbls $expmap(ProfileTerms${phase}_${ptype}_${htype})
666    }
667    if {$lbls != ""} {return $lbls}
668
669    catch {set lbls $expgui(prof-$htype-$ptype)}
670    if {$lbls == ""} {return}
671    # add terms based on the Laue symmetry
672    if {($htype == "C" || $htype == "T") && $ptype == 4} {
673        set laueaxis [GetLaue [phaseinfo $phase spacegroup]]
674        eval lappend lbls [Profile4Terms $laueaxis]
675    }
676    set expmap(ProfileTerms${phase}_${ptype}_${htype}) $lbls
677    return $lbls
678}
679
680proc Profile4Terms {laueaxis} {
681# GSAS Laue classes by number vs spacegrp labeling
682#   1    2    3    4     5      6     7       8     9      10     11     12   13  14
683# 1bar, 2/m, mmm, 4/m, 4/mmm, 3bar, 3bar m, 3bar, 3barm1, 3bar1m, 6/m, 6/mmm, m 3, m3m
684#                              R      R      H      H       H
685# (R=Rhombohedral setting; H=Hexagonal setting)
686    switch -exact $laueaxis {
687        1bar {return \
688                "S400 S040 S004 S220 S202 S022 S310 S103 S031 \
689                S130 S301 S013 S211 S121 S112"}
690        2/ma {return "S400 S040 S004 S220 S202 S022 S013 S031 S211"}
691        2/mb {return "S400 S040 S004 S220 S202 S022 S301 S103 S121"}
692        2/mc {return "S400 S040 S004 S220 S202 S022 S130 S310 S112"}
693        mmm  {return "S400 S040 S004 S220 S202 S022"}
694        4/{return "S400 S004 S220 S202 S310"}
695        4/mmm {return "S400 S004 S220 S202"}
696        3barR     {return "S400 S220 S310 S301 S211"}
697        "3bar mR" {return "S400 S220 S310 S211"}
698        3bar    {return "S400 S004 S202 S310 S211"}
699        3barm1 {return "S400 S004 S202 S301"}
700        3bar1m  {return "S400 S004 S202 S211"}
701        6/m    {return "S400 S004 S202"}
702        6/mmm  {return "S400 S004 S202"}
703        "m 3"  {return "S400 S220"}
704        m3m    {return "S400 S220"}
705        default {return ""}
706    }
707}
708
709proc GetLaue {spg} {
710    global tcl_platform expgui
711    # check the space group
712    set fp [open spg.in w]
713    puts $fp "N"
714    puts $fp "N"
715    puts $fp $spg
716    puts $fp "Q"
717    close $fp
718    catch {
719        if {$tcl_platform(platform) == "windows"} {
720            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
721        } else {
722            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
723        }
724    }
725    set fp [open spg.out r]
726    set laue {}
727    set uniqueaxis {}
728    while {[gets $fp line] >= 0} {
729        regexp {Laue symmetry (.*)} $line junk laue
730        regexp {The unique axis is (.*)} $line junk uniqueaxis
731    }
732    close $fp
733    catch {file delete -force spg.in spg.out}
734    set laue [string trim $laue]
735    # add a R suffix for rhombohedral settings
736    if {[string range [string trim $spg] end end] == "R"} {
737        return "${laue}${uniqueaxis}R"
738    }
739    return "${laue}$uniqueaxis"
740}
741
742# set up to change the profile type for a series of histogram/phase entries
743# (histlist & phaselist should be lists of the same length)
744#
745proc ChangeProfileType {histlist phaselist} {
746    global expgui expmap
747    set w .profile
748    catch {destroy $w}
749    toplevel $w -bg beige
750    wm title $w "Change Profile Function"
751   
752    # all histogram/phases better be the same type, so we can just use the 1st
753    set hist [lindex $histlist 0]
754    set phase [lindex $phaselist 0]
755    set ptype [string trim [hapinfo $hist $phase proftype]]
756
757    # get list of allowed profile terms for the current histogram type
758    set i 1
759    while {[set lbls [GetProfileTerms $phase $hist $i]] != ""} {
760        lappend lbllist $lbls
761        incr i
762    }
763    # labels for the current type
764    set i $ptype
765    set oldlbls [lindex $lbllist [incr i -1]]
766   
767    if {[llength $histlist] == 1} {
768        pack [label $w.a -bg beige \
769                -text "Change profile function for Histogram #$hist Phase #$phase" \
770                ] -side top
771    } else {
772        # make a list of histograms by phase
773        foreach h $histlist p $phaselist {
774            lappend phlist($p) $h
775        }
776        set num 0
777        pack [frame $w.a -bg beige] -side top
778        pack [label $w.a.$num -bg beige \
779                -text "Change profile function for:" \
780                ] -side top -anchor w
781        foreach i [lsort [array names phlist]] {
782            incr num
783            pack [label $w.a.$num -bg beige -text \
784                    "\tPhase #$i, Histograms [CompressList $phlist($i)]" \
785                    ] -side top -anchor w
786        }
787    }
788    pack [label $w.e1 \
789            -text "Current function is type $ptype." \
790            -bg beige] -side top -anchor w
791    pack [frame $w.e -bg beige] -side top -expand yes -fill both
792    pack [label $w.e.1 \
793            -text "Set function to type" \
794            -bg beige] -side left
795    set menu [tk_optionMenu $w.e.2 expgui(newpeaktype) junk]
796    pack $w.e.2 -side left -anchor w
797
798    pack [radiobutton $w.e.4 -bg beige -variable expgui(DefaultPeakType) \
799            -command "set expgui(newpeaktype) $ptype; \
800            FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
801            -value 1 -text "Current value overrides"] -side right
802    pack [radiobutton $w.e.3 -bg beige -variable expgui(DefaultPeakType) \
803            -command \
804            "set expgui(newpeaktype) $ptype; \
805            FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
806            -value 0 -text "Default value overrides"] -side right
807
808    $w.e.2 config -bg beige
809    pack [frame $w.c -bg beige] -side top -expand yes -fill both
810    pack [frame $w.d -bg beige] -side top -expand yes -fill both
811    pack [button $w.d.2 -text Continue  \
812              -command "SaveChangeProfileType $w.c [list $histlist] [list $phaselist]; destroy $w"\
813            ] -side left
814    pack [button $w.d.3 -text Cancel \
815            -command "destroy $w"] -side left
816    pack [button $w.d.help -text Help -bg yellow \
817            -command "MakeWWWHelp expgui5.html ChangeType"] \
818            -side right
819    bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
820    bind $w <Return> "destroy $w"
821
822    $menu delete 0 end
823    set i 0
824    foreach lbls $lbllist {
825        incr i
826        set j $i
827        # determine if negative profiles are allowed
828        if {[string range $expmap(htype_$hist) 2 2] == "T"} {
829            if {[histinfo $hist proftbl] > 0 && $i > 2} {
830                set j -$i
831            }
832        }
833        $menu add command -label $j -command \
834                "set expgui(newpeaktype) $j; \
835                FillChangeProfileType $w.c $hist $phase $j [list $lbls] [list $oldlbls]"
836    }
837    set expgui(newpeaktype) $ptype
838    FillChangeProfileType $w.c $hist $phase $ptype $oldlbls $oldlbls
839
840    # force the window to stay on top
841    putontop $w
842    focus $w.e.2
843    tkwait window $w
844    afterputontop
845    sethistlist
846}
847
848# save the changes to the profile
849proc SaveChangeProfileType {w histlist phaselist} {
850    global expgui
851    foreach phase $phaselist hist $histlist {
852        hapinfo $hist $phase proftype set $expgui(newpeaktype)
853        RecordMacroEntry "hapinfo $hist $phase proftype set $expgui(newpeaktype)" 0
854        hapinfo $hist $phase profterms set $expgui(newProfileTerms)
855        RecordMacroEntry "hapinfo $hist $phase profterms set $expgui(newProfileTerms)" 0
856        for {set i 1} {$i <=  $expgui(newProfileTerms)} {incr i} {
857            hapinfo $hist $phase pterm$i set [$w.ent${i} get]
858            RecordMacroEntry "hapinfo $hist $phase pterm$i set [$w.ent${i} get]" 0
859            hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
860            RecordMacroEntry "hapinfo $hist $phase pref$i set $expgui(ProfRef$i)" 0
861        }
862        set i [expr 1+$expgui(newProfileTerms)]
863        hapinfo $hist $phase pcut set [$w.ent$i get]
864        RecordMacroEntry "hapinfo $hist $phase pcut set [$w.ent$i get]" 0
865        incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
866        RecordMacroEntry "incr expgui(changed)" 0
867    }
868}
869
870# file the contents of the "Change Profile Type" Menu
871proc FillChangeProfileType {w hist phase newtype lbls oldlbls} {
872    global expgui expmap
873    set ptype [string trim [hapinfo $hist $phase proftype]]
874    catch {unset oldval}
875    # loop through the old terms and set up an array of starting values
876    set num 0
877    foreach term $oldlbls {
878        incr num
879        set oldval($term) [hapinfo $hist $phase pterm$num]
880    }
881    set oldval(Peak\nCutoff) [hapinfo $hist $phase pcut]
882
883    # is the new type the same as the current?
884    if {$ptype == $newtype} {
885        set nterms [hapinfo $hist $phase profterms]
886    } else {
887        set nterms [llength $lbls]
888    }
889    set expgui(newProfileTerms) $nterms
890    set expgui(CurrentProfileTerms) $nterms
891    # which default profile set matches the new type
892    set setnum {}
893    foreach j {" " 1 2 3 4 5 6 7 8 9} {
894        set i [profdefinfo $hist $j proftype]
895        if {$i == ""} continue
896        if {$i == $newtype} {
897            set setnum $j
898            break
899        }
900    }
901
902    eval destroy [winfo children $w]
903
904    set colstr 0
905    set row 2
906    set maxrow [expr $row + $nterms/2]
907    for { set num 1 } { $num <= $nterms + 1} { incr num } {
908        # get the default value (originally from the in .INS file)
909        set val {}
910        if {$setnum != ""} {
911            set val 0.0
912            catch {
913                set val [profdefinfo $hist $setnum pterm$num]
914                # pretty up the number
915                if {$val == 0.0} {
916                    set val 0.0
917                } elseif {abs($val) < 1e-2 || abs($val) > 1e6} {
918                    set val [format %.3e $val]
919                } elseif {abs($val) > 1e-2 && abs($val) < 10} {
920                    set val [format %.5f $val]
921                } elseif {abs($val) < 9999} {
922                    set val [format %.2f $val]
923                } elseif {abs($val) < 1e6} {
924                    set val [format %.0f $val]
925                }
926            }
927        }
928        # heading
929        if {$row == 2} {
930            set col $colstr
931            grid [label $w.h0${num} -text "lbl" -bg beige] \
932                -row $row -column $col
933            grid [label $w.h2${num} -text "ref" -bg beige] \
934                -row $row -column [incr col]
935            grid [label $w.h3${num} -text "next value" -bg beige] \
936                -row $row -column [incr col]
937            grid [label $w.h4${num} -text "default" -bg beige] \
938                -row $row -column [incr col]
939            grid [label $w.h5${num} -text "current" -bg beige] \
940                -row $row -column [incr col]
941        }
942        set col $colstr
943        incr row
944        set term {}
945        catch {set term [lindex $lbls [expr $num-1]]}
946        if {$term == ""} {set term $num}
947        if {$num == $nterms + 1} {
948            set term "Peak\nCutoff"
949            set val {}
950            if {$setnum != ""} {
951                set val 0.0
952                catch {set val [profdefinfo $hist $setnum pcut]}
953            }
954        }
955
956        grid [label $w.l${num} -text "$term" -bg beige] \
957                -row $row -column $col
958        grid [checkbutton $w.chk${num} -variable expgui(ProfRef$num) \
959                -bg beige -activebackground beige] -row $row -column [incr col]
960        grid [entry $w.ent${num} \
961                -width 12] -row $row -column [incr col]
962        if {$val != ""} {
963            grid [button $w.def${num} -text $val -command \
964                    "$w.ent${num} delete 0 end; $w.ent${num} insert end $val" \
965                    ] -row $row -column [incr col] -sticky ew
966        } else {
967            grid [label $w.def${num} -text (none) \
968                    ] -row $row -column [incr col]
969        }
970        set curval {}
971        catch {
972            set curval [expr $oldval($term)]
973            # pretty up the number
974            if {$curval == 0.0} {
975                set curval 0.0
976            } elseif {abs($curval) < 1e-2 || abs($curval) > 1e6} {
977                set curval [format %.3e $curval]
978            } elseif {abs($curval) > 1e-2 && abs($curval) < 10} {
979                set curval [format %.5f $curval]
980            } elseif {abs($curval) < 9999} {
981                set curval [format %.2f $curval]
982            } elseif {abs($curval) < 1e6} {
983                set curval [format %.0f $curval]
984            }
985            grid [button $w.cur${num} -text $curval -command  \
986                    "$w.ent${num} delete 0 end; $w.ent${num} insert end $curval" \
987                    ] -row $row -column [incr col] -sticky ew
988        }
989        # set default values for flag and value
990        set ref 0
991        if {$setnum != ""} {
992            catch {
993                if {[profdefinfo $hist $setnum pref$num] == "Y"} {set ref 1}
994            }
995        }
996        set expgui(ProfRef$num) $ref
997       
998        $w.ent${num} delete 0 end
999        if {!$expgui(DefaultPeakType) && $val != ""} {
1000            $w.ent${num} insert end $val
1001        } elseif {$curval != ""} {
1002            $w.ent${num} insert end $curval
1003        } elseif {$val != ""} {
1004            $w.ent${num} insert end $val
1005        } else {
1006            $w.ent${num} insert end 0.0
1007        }
1008        if {$row > $maxrow} {
1009            set row 2
1010            incr colstr 5
1011        }
1012    }
1013    if {$::tcl_platform(os) == "Darwin"} {
1014        # on OS X force a window resize
1015        wm geometry [winfo toplevel $w] {}
1016    }
1017}
1018
1019#------------------------------------------------------------------------------
1020# WWW/help routines
1021#------------------------------------------------------------------------------
1022# browse a WWW page with URL. The URL may contain a #anchor
1023# On UNIX assume netscape or mozilla is in the path or env(BROWSER) is loaded.
1024# On Windows search the registry for a browser. Mac branch not tested.
1025# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
1026# to the contributers
1027proc urlOpen {url} {
1028    global env tcl_platform
1029    if {$tcl_platform(os) == "Darwin"} {
1030        # if this is an external URL or does not contain an anchor, take the
1031        # easy approach
1032        if {[string range $url 0 4] == "http:" || \
1033                [string first "#" $url] == -1} {
1034            if {![catch {exec open $url}]} {
1035                return
1036            }
1037        }
1038        # so sorry, have to use Safari, even if not default
1039        set url [file nativename $url]; # replace ~/ if present
1040        if {[file pathtype $url] == "relative"} {
1041            set url [file join [pwd] $url]
1042        }
1043        exec osascript -e "tell application \"Safari\" to open location \"file://$url\""
1044    } elseif {$tcl_platform(platform) == "unix"} {
1045        set browserlist {}
1046        if {[info exists env(BROWSER)]} {
1047            set browserlist $env(BROWSER)
1048        }
1049        lappend browserlist netscape mozilla
1050        foreach p $browserlist {
1051            set progs [auto_execok $p]
1052            if {[llength $progs]} {
1053                if {[catch {exec $progs -remote openURL($url)}]} {
1054                    # perhaps browser doesn't understand -remote flag
1055                    if {[catch {exec $env(BROWSER) $url &} emsg]} {
1056                        error "Error displaying $url in browser\n$emsg"
1057                    }
1058                }
1059                return
1060            }
1061        }
1062        MyMessageBox -parent . -title "No Browser" \
1063            -message "Could not find a browser. Netscape & Mozilla not found. Define environment variable BROWSER to be full path name of browser." \
1064            -icon warning
1065    } elseif {$tcl_platform(platform) == "windows"} {
1066        package require registry
1067        # Look for the application under
1068        # HKEY_CLASSES_ROOT
1069        set root HKEY_CLASSES_ROOT
1070       
1071        # Get the application key for HTML files
1072        set appKey [registry get $root\\.html ""]
1073       
1074        # Get the command for opening HTML files
1075        set appCmd [registry get \
1076                        $root\\$appKey\\shell\\open\\command ""]
1077
1078        # Substitute the HTML filename into the command for %1
1079        # or stick it on the end
1080        if {[string first %1 $appCmd] != -1} {
1081            regsub %1 $appCmd $url appCmd
1082        } else {
1083            append appCmd " " $url
1084        }
1085       
1086        # Double up the backslashes for eval (below)
1087        regsub -all {\\} $appCmd  {\\\\} appCmd
1088       
1089        # Invoke the command
1090        eval exec $appCmd &
1091    } elseif {$tcl_platform(platform) == "macintosh"} {
1092        # preOSX -- this is not used
1093        if {0 == [info exists env(BROWSER)]} {
1094            set env(BROWSER) "Browse the Internet"
1095        }
1096        if {[catch {
1097            AppleScript execute\
1098                "tell application \"$env(BROWSER)\"
1099                         open url \"$url\"
1100                     end tell
1101                "} emsg]
1102        } then {
1103            error "Error displaying $url in browser\n$emsg"
1104        }
1105    }
1106}
1107
1108proc NetHelp {file anchor localloc netloc} {
1109    # use the file on-line, if it exists
1110    if {[file exists [file join $localloc $file]]} {
1111        set url "[file join $localloc $file]"
1112    } else {
1113        set url "http://$netloc/$file"
1114    }
1115    catch {
1116        pleasewait "Starting web browser..."
1117        after 2000 donewait
1118    }
1119    if {$anchor != ""} {
1120        append url # $anchor
1121    }
1122    urlOpen $url
1123}
1124
1125proc MakeWWWHelp {"topic {}" "anchor {}"} {
1126    global expgui
1127    if {$topic == ""} {
1128        foreach item $expgui(notebookpagelist) {
1129            if {[lindex $item 0] == $expgui(pagenow)} {
1130                NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) $expgui(website)
1131                return
1132            }
1133        }
1134        # this should not happen
1135        NetHelp expgui.html "" $expgui(docdir) $expgui(website)
1136    } elseif {$topic == "menu"} {
1137        NetHelp expguic.html "" $expgui(docdir) $expgui(website)
1138    } else {
1139        NetHelp $topic $anchor $expgui(docdir) $expgui(website)
1140    }
1141}
1142
1143# show help information
1144proc showhelp {} {
1145    global expgui_helplist helpmsg
1146    set helpmsg {}
1147    set frm .help
1148    catch {destroy $frm}
1149    toplevel $frm
1150    wm title $frm "Help Summary"
1151    grid [label $frm.0 -text \
1152            "Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
1153        -column 0 -columnspan 4 -row 0
1154#    grid [message $frm.help -textvariable helpmsg -relief groove] \
1155#          -column 0 -columnspan 4 -row 2 -sticky nsew
1156    grid [text $frm.help -relief groove -bg beige -width 0\
1157            -height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
1158           -column 0 -columnspan 3 -row 2 -sticky nsew
1159    grid [scrollbar $frm.escroll -command "$frm.help yview"] \
1160            -column 4 -row 2 -sticky nsew
1161    grid rowconfig $frm 1 -weight 1 -minsize 50
1162    grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
1163    grid columnconfig $frm 0 -weight 1
1164    grid columnconfig $frm 2 -weight 1
1165    set lst [array names expgui_helplist]
1166    grid [listbox $frm.cmds -relief raised -bd 2 \
1167            -yscrollcommand "$frm.scroll set" \
1168            -height 8 -width 0 -exportselection 0 ] \
1169            -column 0 -row 1 -sticky nse
1170    grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
1171            -column 1 -row 1 -sticky nsew
1172    foreach item [lsort -dictionary $lst] {
1173        $frm.cmds insert end $item 
1174    }
1175    if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
1176    grid [button $frm.done -text Done -command "destroy $frm"] \
1177            -column 2 -row 1
1178#    bind $frm.cmds <ButtonRelease-1> \
1179#           "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
1180    bind $frm.cmds <ButtonRelease-1> \
1181            "+$frm.help config -state normal; $frm.help delete 0.0 end; \
1182             $frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
1183             $frm.help config -state disabled"
1184
1185    # get the size of the window and expand the message boxes to match
1186#    update
1187#    $frm.help config -width [winfo width $frm.help ]
1188}
1189
1190
1191#------------------------------------------------------------------------------
1192# utilities
1193#------------------------------------------------------------------------------
1194# run liveplot
1195proc liveplot {} {
1196    global expgui liveplot wishshell expmap
1197    set expnam [file root [file tail $expgui(expfile)]]
1198    # which histograms are ready for use?
1199    set validlist {}
1200    foreach ihist $expmap(powderlist) {
1201        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1202                [string range $expmap(htype_$ihist) 3 3] == "D"} {
1203            lappend validlist $ihist
1204        }
1205    }
1206    if {[llength $validlist] == 0} {
1207        MyMessageBox -parent . -title "No Valid Histograms" \
1208                -message "No histograms are ready to plot. Run GENLES and try again" \
1209                -icon warning -helplink "expguierr.html NoValidHist"
1210        return
1211    }
1212    # use $liveplot(hst) if valid, the 1st entry otherwise
1213    if {[lsearch $validlist $liveplot(hst)] != -1} {
1214        exec $wishshell [file join $expgui(scriptdir) liveplot] \
1215                $expnam $liveplot(hst) $liveplot(legend) &
1216    } else {
1217        exec $wishshell [file join $expgui(scriptdir) liveplot] \
1218                $expnam [lindex $validlist 0] $liveplot(legend) &
1219    }
1220}
1221
1222# run lstview
1223proc lstview {} {
1224    global expgui wishshell
1225    set expnam [file root [file tail $expgui(expfile)]]
1226    exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
1227}
1228
1229# run widplt
1230proc widplt {"prog widplt"} {
1231    global expgui wishshell
1232    exec $wishshell [file join $expgui(scriptdir) $prog] \
1233            $expgui(expfile) &
1234}
1235
1236# run bkgedit
1237proc bkgedit {"hst {}"} {
1238    global expgui liveplot wishshell expmap
1239    set expnam [file root [file tail $expgui(expfile)]]
1240    if {$hst == ""} {
1241        # which histograms are ready for use?
1242        set validlist {}
1243        foreach ihist $expmap(powderlist) {
1244            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1245                    [string range $expmap(htype_$ihist) 3 3] == "*"} {
1246                lappend validlist $ihist
1247            }
1248        }
1249        if {[llength $validlist] == 0} {
1250            MyMessageBox -parent . -title "No Valid Histograms" \
1251                    -message "No histograms are ready to plot. Run POWPREF and try again" \
1252                    -icon warning -helplink "expguierr.html NoValidHist"
1253            return
1254        }
1255        # use $liveplot(hst) if valid, the 1st entry otherwise
1256        if {[lsearch $validlist $liveplot(hst)] != -1} {
1257            set hst $liveplot(hst)
1258        } else {
1259            set hst [lindex $validlist 0]
1260        }
1261    }
1262    # Save the current exp file
1263    savearchiveexp
1264    CantRecordMacroEntry "bkgedit"
1265    # disable the file change monitor if we will reload the .EXP file automatically
1266    if {$expgui(autoexpload)} {set expgui(expModifiedLast) 0}
1267    if {$expgui(autoiconify)} {wm iconify .}
1268    exec $wishshell [file join $expgui(scriptdir) bkgedit] \
1269            $expnam $hst $liveplot(legend)
1270    if {$expgui(autoiconify)} {wm deiconify .}
1271    # load the changed .EXP file automatically?
1272    if {$expgui(autoexpload)} {
1273        # load the revised exp file
1274        loadexp $expgui(expfile)
1275    } else {
1276        # check for changes in the .EXP file immediately
1277        whenidle
1278    }
1279}
1280
1281# run excledt
1282proc excledit {} {
1283    global expgui liveplot expmap
1284    set expnam [file root [file tail $expgui(expfile)]]
1285    # which histograms are ready for use?
1286    set validlist {}
1287    foreach ihist $expmap(powderlist) {
1288        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
1289                [string range $expmap(htype_$ihist) 3 3] == "*" || \
1290                [string range $expmap(htype_$ihist) 3 3] == "D"} {
1291            lappend validlist $ihist
1292        }
1293    }
1294    if {[llength $validlist] == 0} {
1295        MyMessageBox -parent . -title "No Valid Histograms" \
1296                -message "No histograms are ready to plot. Run POWPREF and try again" \
1297                -icon warning -helplink "expguierr.html NoValidHist"
1298        return
1299    }
1300    #if {$expgui(autoiconify)} {wm iconify .}
1301    StartExcl 
1302    #if {$expgui(autoiconify)} {wm deiconify .}
1303}
1304
1305# compute the composition for each phase and display in a dialog
1306proc composition {} {
1307    global expmap expgui
1308    set Z 1
1309    foreach phase $expmap(phaselist) type $expmap(phasetype) {
1310        if {$type == 4} continue
1311        ResetMultiplicities $phase {}
1312        catch {unset total}
1313        foreach atom $expmap(atomlist_$phase) {
1314            set type [atominfo $phase $atom type]
1315            set mult [atominfo $phase $atom mult]
1316            if [catch {set total($type)}] {
1317                set total($type) [expr \
1318                        $mult * [atominfo $phase $atom frac]]
1319            } else {
1320                set total($type) [expr $total($type) + \
1321                        $mult * [atominfo $phase $atom frac]]
1322            }
1323            if {$mult > $Z} {set Z $mult}
1324        }
1325        append text "\nPhase $phase\n"
1326        append text "  Unit cell contents\n"
1327        foreach type [lsort [array names total]] {
1328            append text "   $type[format %8.3f $total($type)]"
1329        }
1330        append text "\n\n"
1331       
1332        append text "  Asymmetric Unit contents (Z=$Z)\n"
1333        foreach type [lsort [array names total]] {
1334            append text "   $type[format %8.3f [expr $total($type)/$Z]]"
1335        }
1336        append text "\n"
1337    }
1338   
1339    catch {destroy .comp}
1340    toplevel .comp -class MonoSpc
1341    bind .comp <Key-F1> "MakeWWWHelp expgui.html Composition"
1342    wm title .comp Composition
1343    pack [label .comp.results -text $text \
1344            -justify left] -side top
1345    pack [frame .comp.box]  -side top -expand y -fill x
1346    pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
1347
1348    set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
1349    pack [button .comp.box.2 -text "Save to $lstnam file" \
1350            -command "writelst [list $text] ; destroy .comp"] -side left
1351    pack [button .comp.box.help -text Help -bg yellow \
1352            -command "MakeWWWHelp expgui.html Composition"] \
1353            -side right
1354}
1355
1356# Delete History Records
1357proc DeleteHistoryRecords {{msg ""}} {
1358    global expgui
1359    set frm .history
1360    catch {destroy $frm}
1361    toplevel $frm
1362    bind $frm <Key-F1> "MakeWWWHelp expgui.html DeleteHistoryRecords"
1363    if {[string trim $msg] == ""} {
1364        set msg "There are [CountHistory] history records"
1365    }
1366    pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
1367    pack [label $frm.1.0 -text $msg] -side top
1368    pack [frame $frm.1.1] -side top
1369    pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
1370    pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
1371            ] -side left
1372    set expgui(historyKeep) 10
1373    pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
1374    set expgui(renumber) 1
1375    pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
1376    pack [button $frm.2.help -text Help -bg yellow \
1377            -command "MakeWWWHelp expgui.html DeleteHistoryRecords"] -side top
1378    pack [button $frm.2.4 -text Cancel \
1379            -command {destroy .history}] -side bottom
1380    pack [button $frm.2.3 -text OK \
1381            -command { 
1382        if ![catch {expr $expgui(historyKeep)}] {
1383            DeleteHistory $expgui(historyKeep) $expgui(renumber)
1384            set expgui(changed) 1
1385            destroy .history
1386        }
1387    }] -side bottom
1388    bind $frm <Return> "$frm.2.3 invoke"
1389   
1390    # force the window to stay on top
1391    putontop $frm 
1392    focus $frm.2.3
1393    tkwait window $frm
1394    afterputontop
1395}
1396
1397proc archiveexp {} {
1398    global expgui tcl_platform
1399    # is there a file to archive?
1400    if {![file exists $expgui(expfile)]} return
1401    set expnam [file rootname $expgui(expfile)]
1402    # get the last archived version
1403    set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
1404    if {$lastf == ""} {
1405        set num 01
1406    } else {
1407        regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
1408        scan $num %x num
1409        if {$num >= 255} {
1410            set num FF
1411        } else {
1412            set num [string toupper [format %.2x [incr num]]]
1413        }
1414    }
1415    catch {
1416        set file $expnam.O$num
1417        file copy -force $expgui(expfile) $file
1418        set fp [open $expnam.LST a+]
1419        puts $fp "\n----------------------------------------------"
1420        puts $fp "     Archiving [file tail $expnam.EXP] as [file tail $file]"
1421        puts $fp "----------------------------------------------\n"
1422        close $fp
1423    } errmsg
1424    if {$errmsg != ""} {
1425        tk_dialog .warn Confirm "Error archiving the current .EXP file: $errmsg" warning 0 OK
1426    }
1427}
1428
1429# save and optionally archive the expfile
1430proc savearchiveexp {} {
1431    global expgui expmap
1432    if {$expgui(expfile) == ""} {
1433        SaveAsFile
1434        return
1435    }
1436    if !$expgui(changed) return
1437    if {$expgui(archive)} archiveexp
1438    # add a history record
1439    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds] -format {%D %T}]"
1440    # now save the file
1441    expwrite $expgui(expfile)
1442    # change the icon and assign an app to this .EXP file
1443    global tcl_platform
1444    if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
1445        MacSetResourceFork $expgui(expfile)
1446    }
1447    set expgui(changed) 0
1448    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
1449    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
1450    wm title . $expgui(expfile)
1451    set expgui(titleunchanged) 1
1452    # set convergence criterion
1453    InitLSvars
1454}
1455
1456#------------------------------------------------------------------------------
1457# GSAS interface routines
1458#------------------------------------------------------------------------------
1459# run a GSAS program that does not require an experiment file
1460proc runGSASprog {proglist "concurrent 1"} {
1461    # save call to Macro file
1462    RecordMacroEntry "runGSASprog [list $proglist] $concurrent" 0
1463    # if concurrent is 0, EXPGUI runs the GSAS program in background
1464    # -- this is not currently needed anywhere where the .EXP file is not.
1465    global expgui tcl_platform
1466    set cmd {}
1467    foreach prog $proglist {
1468        StartGRWND $prog
1469        if {$tcl_platform(platform) == "windows"} {
1470            append cmd " \"[file attributes $expgui(gsasexe)/${prog}.exe -shortname]\" "
1471        } else {
1472            if {$cmd != ""} {append cmd "\;"}
1473            append cmd "[file join $expgui(gsasexe) $prog]"
1474        }
1475    }
1476    forknewterm $prog $cmd [expr !$concurrent] 1
1477}
1478
1479# dummy routine, overridden if needed
1480proc StartGRWND {prog} {
1481}
1482
1483# run a GSAS program that requires an experiment file for input/output
1484proc runGSASwEXP {proglist "concurrent 0"} {
1485    # save call to Macro file
1486    RecordMacroEntry "runGSASwEXP [list $proglist] $concurrent" 0
1487    # most programs that require the .EXP file change it and
1488    # cannot be run concurrently
1489    global expgui tcl_platform
1490    # Save the current exp file
1491    savearchiveexp
1492    # load the changed .EXP file automatically?
1493    if {$expgui(autoexpload)} {
1494        # disable the file changed monitor
1495        set expgui(expModifiedLast) 0
1496    }
1497    set cmd {}
1498    set expnam [file root [file tail $expgui(expfile)]]
1499    foreach prog $proglist {
1500        if {$prog == "powpref"} {
1501            set expgui(needpowpref) 0
1502            set expgui(needpowpref_why) ""
1503        } elseif {$prog == "genles" && $expgui(needpowpref) != 0} {
1504            set msg "You are attempting to run GENLES, after making changes that require POWPREF:\n\n$expgui(needpowpref_why) \nRun POWPREF first?"
1505            set ans [MyMessageBox -parent . -title "Run POWPREF" \
1506                    -message $msg -icon warning -type "Yes No" -default yes \
1507                    -helplink "expguierr.html RunPowpref"]
1508            if {$ans == "yes"} {
1509                set expgui(needpowpref) 0
1510                set expgui(needpowpref_why) ""
1511                if {$tcl_platform(platform) == "windows"} {
1512                    append cmd " \"[file attributes $expgui(gsasexe)/powpref.exe -shortname] $expnam \" "
1513                } else {
1514                    if {$cmd != ""} {append cmd "\;"}
1515                    append cmd "[file join $expgui(gsasexe) powpref] $expnam"
1516                }
1517            }
1518        }
1519        StartGRWND $prog
1520        if {$tcl_platform(platform) == "windows"} {
1521            append cmd " \"[file attributes $expgui(gsasexe)/${prog}.exe -shortname] $expnam \" "
1522        } elseif {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1523            append cmd " \" [file join $expgui(gsasexe) $prog] $expnam \" "
1524        } else {
1525            if {$cmd != ""} {append cmd "\;"}
1526            append cmd "[file join $expgui(gsasexe) $prog] $expnam"
1527        }
1528    }
1529    if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1530        set outfile ${expnam}_macout.LST
1531        runnoterm $cmd $outfile
1532    } else {
1533        forknewterm "$prog -- $expnam" $cmd [expr !$concurrent] 1
1534    }
1535    # load the changed .EXP file automatically?
1536    if {$expgui(autoexpload)} {
1537        # load the revised exp file
1538        loadexp $expgui(expfile)
1539    }
1540    if {$expgui(MacroRunning)} {
1541        if {[file exists  abort_${expnam}_macro.flag]} {
1542            file delete abort_${expnam}_macro.flag
1543            error "User requested to abort the macro"
1544        }
1545        update idletasks
1546    }
1547}
1548
1549# write text to the .LST file
1550proc writelst {text} {
1551    global expgui
1552    set lstnam [file rootname $expgui(expfile)].LST
1553    set fp [open $lstnam a]
1554    puts $fp "\n-----------------------------------------------------------------"
1555    puts $fp $text
1556    puts $fp "-----------------------------------------------------------------\n"
1557    close $fp
1558}
1559
1560
1561# rename file current to suggested,
1562#   delete window if supplied
1563#   use parent, if supplied or .
1564proc RenameAsFile {current suggested "window {}" "parent {}"} {
1565    if {$parent == "" && $window != ""} {set parent $window}
1566    if {$parent == ""} {set parent .}
1567    set newfile [tk_getSaveFile -initialfile $suggested -parent $parent]
1568    if {$newfile == ""} return
1569    if {[catch {
1570        file rename -force $current $newfile
1571    }]} {
1572        file copy -force $current $newfile
1573        file delete -force $current
1574    }
1575    if {$window != ""} {destroy $window}
1576}
1577
1578# optionally run disagl as a windowless process, w/results in a separate window
1579proc rundisagl {} {
1580    global expgui txtvw tcl_version tcl_platform
1581    # call up new DISAGL parm edit box
1582    if {[DA_Control_Panel 1]} {return}
1583    # Save the current exp file if needed
1584    savearchiveexp
1585    if {$expgui(disaglSeparateBox)} {
1586        set root [file root $expgui(expfile)] 
1587        catch {file delete -force $root.tmp}
1588        if {[catch {file rename -force $root.LST $root.OLS}]} {
1589            file copy -force $root.LST $root.OLS
1590            file delete -force $root.OLS
1591        }
1592        # PSW reports this does not happen right away on windows
1593        set i 0
1594        while {$i < 10 && [file exists $root.LST]} {
1595            # debug code
1596            #catch {console show}
1597            #puts "try $i"
1598            # end debug code
1599            after 100
1600            incr i
1601        }
1602        if {[file exists $root.LST]} {
1603            # it was not possible to rename the file
1604            MyMessageBox -parent . -title "Rename Problem" \
1605                -message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
1606                -icon warning -helplink "expguierr.html NoRename"
1607            return
1608        }
1609
1610        #run the program
1611        pleasewait "Running DISAGL"     
1612        # create an empty input file
1613        close [open disagl.inp w]
1614        catch {exec [file join $expgui(gsasexe) disagl] \
1615                [file tail $root] < disagl.inp > disagl.out}
1616        if {[catch {file rename -force $root.LST $root.tmp}]} {
1617            file copy -force $root.LST $root.tmp
1618            file delete -force $root.LST
1619        }
1620        catch {file delete -force disagl.inp disagl.out}
1621        if {[catch {file rename -force $root.OLS $root.LST}]} {
1622            file copy -force $root.OLS $root.LST
1623            file delete -force $root.OLS
1624        }
1625        donewait
1626        # open a new window
1627        catch {toplevel .disagl}
1628        eval destroy [winfo child .disagl]
1629        set txt .disagl.txt
1630        catch {eval grid forget [grid slaves .disagl]}
1631        text $txt -width 100 -wrap none \
1632                -yscrollcommand ".disagl.yscroll set" \
1633                -xscrollcommand ".disagl.xscroll set" 
1634        scrollbar .disagl.yscroll -command "$txt yview"
1635        scrollbar .disagl.xscroll -command "$txt xview" -orient horizontal
1636        grid .disagl.xscroll -column 0 -row 2 -sticky ew
1637        grid $txt -column 0 -row 1 -sticky nsew
1638        grid .disagl.yscroll -column 1 -row 1 -sticky ns
1639        grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
1640        grid columnconfig .disagl.f 2 -weight 1
1641        grid [button .disagl.f.close -text "Close & Delete" \
1642                  -command "destroy .disagl; file delete \[list $root.tmp\]"] \
1643                -column 3 -row 0 -sticky e
1644        grid [button .disagl.f.rename \
1645                  -command "RenameAsFile \[list $root.tmp\] \[list $root.DIS\] .disagl" \
1646                -text "Close & Save as..."] \
1647                -column 4 -row 0 -sticky e
1648        # allow font changes on the fly
1649        if {$tcl_version >= 8.0} {
1650            $txt config -font $txtvw(font)
1651            set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
1652            grid .disagl.f.font -column 1 -row 0 -sticky w
1653            grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
1654            $fontbut delete 0 end
1655            foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
1656                $fontbut add command -label "Courier $f" -font "Courier $f"\
1657                        -command "set txtvw(font) \"Courier $f\"; \
1658                        $txt config -font \$txtvw(font)"
1659            }
1660        }
1661       
1662        grid columnconfigure .disagl 0 -weight 1
1663        grid rowconfigure .disagl 1 -weight 1
1664        wm title .disagl "DISAGL results $expgui(expfile)"
1665        wm iconname .disagl "DISAGL $root"
1666        set in [open $root.tmp r]
1667        $txt insert end [read $in]
1668        close $in
1669        bind all  {destroy .disagl}
1670        bind .disagl  "$txt yview scroll -1 page"
1671        bind .disagl  "$txt yview scroll 1 page"
1672        bind .disagl  "$txt xview scroll 1 unit"
1673        bind .disagl  "$txt xview scroll -1 unit"
1674        bind .disagl  "$txt yview scroll -1 unit"
1675        bind .disagl  "$txt yview scroll 1 unit"
1676        bind .disagl  "$txt yview 0"
1677        bind .disagl  "$txt yview end"
1678        # don't disable in Win as this prevents the highlighting of selected text
1679        if {$tcl_platform(platform) != "windows"} {
1680            $txt config -state disabled
1681        }
1682        # find the beginning of the disagl text
1683
1684        set pos 1.0
1685        set nph 0
1686        while {[set loc [$txt search "Program DISAGL Version" $pos end]] != ""} {
1687            set pos [expr {$loc + 1}]
1688            incr nph
1689        }
1690        #puts "Found $nph DISAGL run(s)"
1691        # count phases
1692        set l {}
1693        while {[set loc [$txt search "Lattice constants are" $pos end]] != ""} {
1694            lappend l $loc
1695            set pos [expr {$loc + 1}]
1696}
1697        catch {unset phaseloc}
1698       
1699        set j 0
1700        foreach pos $l {
1701            if {$j == 0} {
1702                set prev $pos
1703                incr j
1704                continue
1705            }
1706            set phaseloc($j) [list $prev $pos]
1707            incr j
1708        }
1709        set phaseloc($j) [list $pos end]
1710        if {$nph >= 1 && $j >= 2} {
1711            grid [menubutton .disagl.f.copy \
1712                      -menu .disagl.f.copy.menu \
1713                      -text "Copy phase..." -bd 2 -relief raised] \
1714                -column 2 -row 0 -sticky nse
1715            menu .disagl.f.copy.menu
1716            for {set i 1} {$i <= $j} {incr i} {
1717                .disagl.f.copy.menu add command \
1718                    -command "seldisaglphase $txt [list $phaseloc($i)]" \
1719                    -label "Copy phase $i to clipboard"
1720            }
1721        } elseif {$nph >= 1} {
1722            grid [button .disagl.f.copy \
1723                      -command "seldisaglphase $txt [list $phaseloc($j)]" \
1724                -text "Copy phase $j to clipboard"] \
1725                -column 2 -row 0 -sticky e
1726        }
1727    } else {
1728        runGSASwEXP disagl
1729    }
1730}
1731
1732proc seldisaglphase {txt phaselist} {
1733    # clear selection
1734    $txt tag remove sel 1.1 end
1735    eval $txt tag add sel $phaselist
1736    clipboard clear
1737    clipboard append "               |         Program DISAGL Version MacOSX        |\n"
1738    clipboard append [eval $txt get [$txt tag ranges sel]]
1739} 
1740#------------------------------------------------------------------------------
1741# file conversions
1742#------------------------------------------------------------------------------
1743proc convfile {} {
1744    global expgui
1745    set frm .file
1746    catch {destroy $frm}
1747    toplevel $frm
1748    wm title $frm "Convert File"
1749    bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
1750    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1751    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
1752            -side left -fill y -expand yes
1753    pack [button $frmC.help -text Help -bg yellow \
1754            -command "MakeWWWHelp expgui.html ConvertWin"] -side top
1755    pack [button $frmC.q -text Cancel -command "destroy $frm"] -side bottom
1756    pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
1757            -side bottom
1758    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
1759    winfilebox $frm
1760    bind $frm <Return> "ValidWinCnv $frm"
1761
1762    # force the window to stay on top
1763    putontop $frm
1764    focus $frmC.q 
1765    tkwait window $frm
1766    afterputontop
1767}
1768
1769# validate the files and make the conversion
1770proc ValidWinCnv {frm} {
1771    global expgui
1772    # change backslashes to something sensible
1773    regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
1774    # allow entry of D: for D:/ and D:TEST for d:/TEST
1775    if {[string first : $expgui(FileMenuCnvName)] != -1 && \
1776            [string first :/ $expgui(FileMenuCnvName)] == -1} {
1777        regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
1778    }
1779    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1780        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1781        ChooseWinCnv $frm
1782        return
1783    } elseif [file isdirectory \
1784            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
1785        if {$expgui(FileMenuCnvName) != "."} {
1786            set expgui(FileMenuDir) \
1787                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1788        }
1789        ChooseWinCnv $frm
1790        return
1791    }
1792 
1793    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1794    if ![file exists $file] {
1795        MyMessageBox -parent $frm -title "Convert Error" \
1796                -message "File $file does not exist" -icon error
1797        return
1798    }
1799
1800    set tmpname "[file join [file dirname $file] tempfile.xxx]"
1801    set oldname "[file rootname $file].org"
1802    if [file exists $oldname] {
1803        set ans [MyMessageBox -parent . -title "Overwrite?" \
1804                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
1805                -icon warning -type {Overwrite Cancel} -default Overwrite \
1806                -helplink "expguierr.html OverwriteCnv"]
1807        if {[string tolower $ans] == "cancel"} return
1808        catch {file delete $oldname}
1809    }
1810
1811    if [catch {
1812        set in [open $file r]
1813        set out [open $tmpname w]
1814        fconfigure $out -translation crlf -encoding ascii
1815        set len [gets $in line]
1816        if {$len > 160} {
1817            # this is a UNIX file. Hope there are no control characters
1818            set i 0
1819            set j 79
1820            while {$j < $len} {
1821                puts $out [string range $line $i $j]
1822                incr i 80
1823                incr j 80
1824            }
1825        } else {
1826            while {$len >= 0} {
1827                append line "                                        "
1828                append line "                                        "
1829                set line [string range $line 0 79]
1830                puts $out $line
1831                set len [gets $in line]
1832            }
1833        }
1834        close $in
1835        close $out
1836        file rename -force $file $oldname
1837        file rename -force $tmpname $file
1838    } errmsg] {
1839        MyMessageBox -parent $frm -title "Conversion error" \
1840                -message "Error in conversion:\n$errmsg" -icon warning
1841    } else {
1842        set ans [MyMessageBox -parent $frm -title "More?" \
1843                -message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
1844                -type yesno -default no]
1845        if {$ans == "no"} {destroy $frm}
1846    }
1847}
1848
1849# create a file box
1850proc winfilebox {frm} {
1851    global expgui
1852    set bx $frm.1
1853    pack [frame $bx.top] -side top
1854    pack [label $bx.top.a -text "Directory" ] -side left
1855    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1856    pack $bx.top.d -side left
1857    set expgui(FileMenuDir) [pwd]
1858    # the icon below is from tk8.0/tkfbox.tcl
1859    set upfolder [image create bitmap -data {
1860#define updir_width 28
1861#define updir_height 16
1862static char updir_bits[] = {
1863   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1864   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1865   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1866   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1867   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1868   0xf0, 0xff, 0xff, 0x01};}]
1869
1870    pack [button $bx.top.b -image $upfolder \
1871            -command "updir; ChooseWinCnv $frm" ]
1872    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1873    listbox $bx.a.files -relief raised -bd 2 \
1874            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1875            -height 15 -width 0 -exportselection 0 
1876    listbox $bx.a.dates -relief raised -bd 2 \
1877            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1878            -height 15 -width 0 -takefocus 0 -exportselection 0 
1879    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1880    ChooseWinCnv $frm
1881    bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
1882    bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
1883    bind $bx.a.files <Double-1> "SelectWinCnv $frm"
1884    bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
1885    pack $bx.a.scroll -side left -fill y
1886    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1887    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
1888}
1889
1890# set the box or file in the selection window
1891proc ReleaseWinCnv {frm} {
1892    global expgui
1893    set files $frm.1.a.files
1894    set dates $frm.1.a.dates
1895    set select [$files curselection]
1896    if {$select == ""} {
1897        set select [$dates curselection]
1898    }
1899    if {$select == ""} {
1900        set expgui(FileMenuCnvName) ""
1901    } else {
1902        set expgui(FileMenuCnvName) [string trim [$files get $select]]
1903    }
1904    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1905        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1906        ChooseWinCnv $frm
1907    } elseif [file isdirectory \
1908            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
1909        if {$expgui(FileMenuCnvName) != "."} {
1910            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1911            ChooseWinCnv $frm
1912        }
1913    }
1914    return
1915}
1916
1917# select a file or directory -- called on double click
1918proc SelectWinCnv {frm} {
1919    global expgui
1920    set files $frm.1.a.files
1921    set dates $frm.1.a.dates
1922    set select [$files curselection]
1923    if {$select == ""} {
1924        set select [$dates curselection]
1925    }
1926    if {$select == ""} {
1927        set file .
1928    } else {
1929        set file [string trim [$files get $select]]
1930    }
1931    if {$file == "<Parent>"} {
1932        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1933        ChooseWinCnv $frm
1934    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1935        if {$file != "."} {
1936            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1937            ChooseWinCnv $frm
1938        }
1939    } else {
1940        set expgui(FileMenuCnvName) [file tail $file]
1941        ValidWinCnv $frm
1942    }
1943}
1944
1945# fill the files & dates & Directory selection box with current directory,
1946# also called when box is created to fill it
1947proc ChooseWinCnv {frm} {
1948    global expgui
1949    set files $frm.1.a.files
1950    set dates $frm.1.a.dates
1951    set expgui(FileMenuCnvName) {}
1952    $files delete 0 end
1953    $dates delete 0 end
1954    $files insert end {<Parent>}
1955    $dates insert end {(Directory)}
1956    set filelist [glob -nocomplain \
1957            [file join [set expgui(FileMenuDir)] *] ]
1958    foreach file [lsort -dictionary $filelist] {
1959        if {[file isdirectory $file]} {
1960            $files insert end [file tail $file]
1961            $dates insert end {(Directory)}
1962        }
1963    }
1964    foreach file [lsort -dictionary $filelist] {
1965        if {![file isdirectory $file]} {
1966            set modified [clock format [file mtime $file] -format "%T %D"]
1967            $files insert end [file tail $file]
1968            $dates insert end $modified
1969        }
1970    }
1971    $expgui(FileDirButtonMenu)  delete 0 end
1972    set list ""
1973    global tcl_version
1974    if {$tcl_version > 8.0} {
1975        catch {set list [string tolower [file volume]]}
1976    }
1977    set dir ""
1978    foreach subdir [file split [set expgui(FileMenuDir)]] {
1979        set dir [string tolower [file join $dir $subdir]]
1980        if {[lsearch $list $dir] == -1} {lappend list $dir}
1981    }
1982    foreach path $list {
1983        $expgui(FileDirButtonMenu) add command -label $path \
1984                -command "[list set expgui(FileMenuDir) $path]; \
1985                ChooseWinCnv $frm"
1986    }
1987    return
1988}
1989
1990#------------------------------------------------------------------------------
1991# set options for liveplot
1992proc liveplotopt {} {
1993    global liveplot expmap
1994    set frm .file
1995    catch {destroy $frm}
1996    toplevel $frm
1997    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1998    set last [lindex [lsort -integer $expmap(powderlist)] end]
1999    if {$last == ""} {set last 1}
2000    pack [scale  $frmA.1 -label "Histogram number" -from 1 -to $last \
2001            -length  150 -orient horizontal -variable liveplot(hst)] -side top
2002    pack [checkbutton $frmA.2 -text {include plot legend}\
2003            -variable liveplot(legend)] -side top
2004    pack [button $frm.2 -text OK \
2005            -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
2006            ] -side top
2007    bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
2008   
2009    # force the window to stay on top
2010    putontop $frm 
2011    focus $frm.2
2012    tkwait window $frm
2013    afterputontop
2014}
2015
2016#------------------------------------------------------------------------------
2017# get/validate an experiment file name
2018#------------------------------------------------------------------------------
2019# validate and store the EXP file name. Create a new .EXP file if it does not
2020# exist and set the wd to the location of the .EXP file.
2021proc SetEXPfile {expfile "newOK 0"} {
2022    global expgui tcl_platform
2023    if {[string trim $expfile] == ""} return
2024
2025    # break up the file name and directory
2026    set dirname [file dirname $expfile]
2027    set expname [string toupper [file tail $expfile]]
2028
2029    # check the directory exists
2030    if {(! [file exists $dirname]) || (! [file isdir $dirname])} {
2031        update
2032        MyMessageBox -parent . -title "Directory not found" \
2033            -message "Experiment file location \"$dirname\" is invalid -- no such directory exists" \
2034            -icon warning -type Continue -default continue
2035        set expgui(resize) 1
2036        return
2037    }
2038
2039    # is there a space in the directory name? On windows, try to fix it
2040    set origdir $dirname
2041    if {[string first " " $dirname] != -1} {
2042        set warn 1
2043        catch {set warn $expgui(warnonspaceonce)}
2044        if {$tcl_platform(platform) == "windows"} {
2045            set dirname [file attributes $dirname -shortname]
2046            # was the fix successful?
2047            if {[string first " " $dirname] == -1} {
2048                if {$warn} {
2049                    update
2050                    MyMessageBox -parent . -title "Still debugging..." \
2051                        -message "You are using a directory with a space in the name ($origdir) that will be translated for Windows (to $dirname) -- This should obliviate bugs in EXPGUI, but if still you encounter any please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2052                    -icon warning -type Continue -default continue
2053                    set expgui(resize) 1
2054                }
2055            } else {
2056                if {$warn} {
2057                    update
2058                    MyMessageBox -parent . -title "Can't fix dir" \
2059                        -message "You are using a directory with a space in the name ($origdir) in Windows that cannot be translated to a name without spaces (is this a network drive?) -- this could cause problems in EXPGUI. Please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2060                        -icon warning -type Continue -default continue
2061                    set expgui(resize) 1
2062                }
2063            }
2064        } elseif {$warn} {
2065            if {$warn} {
2066                update
2067                MyMessageBox -parent . -title "Still debugging..." \
2068                    -message "You are using a directory with a space in the name ($origdir). This is not perhaps a wise idea, but I am trying to catch any bugs this causes in EXPGUI. If you encounter any, please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2069                    -icon warning -type Continue -default continue
2070                set expgui(resize) 1
2071            }
2072        }
2073        set expgui(warnonspaceonce) 0
2074    }
2075
2076    # force exp files to be upper case, set to force save if name changes
2077    set origexp $expname
2078    if {$expname != [file tail $expfile] && $tcl_platform(platform) != "windows"} {
2079        set expgui(changed) 1
2080    }
2081    #puts $expgui(expfile)
2082    if {[string match {.O[0-9A-F][0-9A-F]} [file extension $expname]]} {
2083        set expname [ArchiveChoice $expname]
2084        set dirname ""
2085        if {$expname == ""} return
2086    } elseif {[file extension $expname] != ".EXP"} {
2087        append expname ".EXP"
2088    }
2089    if {$dirname == "." || $dirname == ""} {
2090        set newexpfile $expname
2091    } else {
2092        set newexpfile [file join $dirname $expname]
2093    }
2094    # is there a space in the EXP name?
2095    if {[string first " " $expname] != -1} {
2096        # If the file exists in windows, see if there is an equivalent name available.
2097        # if not, we could try to create it and then see, but that is too much
2098        # work.
2099        if {$tcl_platform(platform) == "windows"} { 
2100            if {[file exists $newexpfile]} {
2101                # try to translate it, if possible
2102                set expname [file tail [file attributes $newexpfile -shortname]]
2103                set newexpfile [file join $dirname $expname]
2104                # fixed?
2105                if {[string first " " $expname] == -1} {
2106                    set warn 1
2107                    catch {set warn $expgui(warnonexpspaceonce)}
2108                    if {$warn} {
2109                        update
2110                        MyMessageBox -parent . -title "Still debugging..." \
2111                            -message "You are using an EXP file name with a space in the name ($origexp) that will be translated for Windows (to $expname) -- This should obliviate bugs in EXPGUI, but if you still do encounter any please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2112                            -icon warning -type Continue -default continue
2113                    set expgui(resize) 1
2114                    }
2115                    set expgui(warnonexpspaceonce) 0
2116                }
2117            } 
2118            if {[string first " " $expname] != -1} {
2119                # not fixed (file does not exist or shortname not supported)
2120                update
2121                MyMessageBox -parent . -title "Can't fix name" \
2122                    -message "You are using an EXP file name with a space in the name ($origexp) in Windows that cannot be translated without spaces (is this a network drive?) -- this will cause problems in EXPGUI. Sorry." \
2123                    -icon warning -type Continue -default continue
2124                set expgui(resize) 1
2125                return
2126            }
2127        } else {
2128            update
2129            MyMessageBox -parent . -title "Space in name" \
2130                -message "You are using an EXP file name with a space in the name ($origexp). This is likely to cause problems. Please rename the file or create one with another name. Sorry." \
2131                -icon warning -type Continue -default continue
2132            set expgui(resize) 1
2133            return
2134        }
2135    }
2136
2137    if {(! $newOK) && (! [file exists $newexpfile])} {
2138        update
2139        set ans [
2140                 MyMessageBox -parent . -title "File Open Error" \
2141                     -message "File $expname does not exist in ${dirname}. OK to create?" \
2142                     -icon question -type {"Select other" "Create"} -default "select other" \
2143                     -helplink "expguierr.html OpenErr"
2144                ]
2145        set expgui(resize) 1
2146        if {[string tolower $ans] == "create"} {
2147            # you've been warned this .EXP does not exist!
2148            if [CreateMTexpfile $newexpfile] return
2149        } else {
2150            return
2151        }
2152    }
2153    catch {cd [string trim [file dirname $newexpfile]]}
2154    return $newexpfile
2155}
2156
2157proc ArchiveChoice {expfile} {
2158    set expnam [file rootname $expfile]
2159    set ans [MyMessageBox -parent . -title "Load Archived File" \
2160        -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
2161        -icon question -type "{Use New Name} {Continue with current}" \
2162        -default {Use New Name} \
2163        -helplink "expguierr.html LoadArchived"
2164    ]
2165    # archive the current .EXP file
2166    if {$ans != "use new name" && [file exists $expfile]} {
2167        # get the last archived version
2168        set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
2169        if {$lastf == ""} {
2170            set num 01
2171        } else {
2172            regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
2173            scan $num %x num
2174            if {$num >= 255} {
2175                set num FF
2176            } else {
2177                set num [string toupper [format %.2x [incr num]]]
2178            }
2179        }
2180        catch {
2181            set newfile $expnam.O$num
2182            file rename -force $expnam.EXP $newfile
2183            set fp [open $expnam.LST a+]
2184            puts $fp "\n----------------------------------------------"
2185            puts $fp "     Regressing to archive file [file tail $expfile]"
2186            puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
2187            puts $fp "----------------------------------------------\n"
2188            close $fp
2189        }
2190        file copy -force $expfile $expnam.EXP
2191        set expfile $expnam.EXP
2192    }
2193    if {$ans == "use new name"} {
2194        set newexpfile [getExpFileName new]
2195        if {$newexpfile == ""} {
2196            set expgui(FileMenuEXPNAM) ""
2197            return 
2198        }
2199        file copy -force $expfile $newexpfile
2200        set expgui(needpowpref) 2
2201        set expgui(needpowpref_why) "\tA new .EXP file was created\n" 
2202        return $newexpfile
2203    } else {
2204        return $expfile
2205    }
2206}
2207
2208# create an "empty" exp file
2209proc CreateMTexpfile {newexpfile} {
2210    set expname [file tail $newexpfile]
2211    createexp $newexpfile \
2212        [getstring "title for experiment $expname" 60 0]
2213    if {! [file exists $newexpfile]} {
2214        update
2215        MyMessageBox -parent . -title "File Creation Error" \
2216            -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
2217            -icon warning -type Continue -default continue
2218        set ::expgui(resize) 1
2219        return 1
2220    }
2221    return 0
2222}
2223
2224proc getExpFileName {mode} {
2225    global expgui tcl_platform
2226    set frm .file
2227    catch {destroy $frm}
2228    toplevel $frm
2229    wm title $frm "Experiment file"
2230    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
2231    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
2232    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
2233            -fill y -expand yes
2234    pack [button $frmC.help -text Help -bg yellow \
2235            -command "MakeWWWHelp expguierr.html open"] \
2236            -side top -anchor e
2237    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
2238    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
2239            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
2240    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
2241            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
2242
2243    set expgui(includearchived) 0
2244    set expgui(FileInfoBox) $frmC.info
2245    if {$mode == "old"} {
2246        pack [checkbutton $frmC.ar -text "Include Archived Files" \
2247                -variable expgui(includearchived) \
2248                -command "ChooseExpFil $frmA"] -side top -pady 10
2249        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2250                -class SmallFont] \
2251                -side top -fill both -expand yes -pady 5
2252    } elseif {$mode != "new"} {
2253        # for initial read, don't offer access to archived files
2254        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2255                -class SmallFont] \
2256                -side top -fill both -expand yes -pady 5
2257        set mode "old"
2258    }
2259    pack [button $frmC.b -text Read \
2260            -command "valid_exp_file $frmA $mode"] -side bottom
2261    if {$mode == "new"} {
2262        $frmC.b config -text Save
2263    }
2264    pack [button $frmC.q -text Cancel \
2265            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
2266    bind $frm <Return> "$frmC.b invoke"
2267
2268    if {$mode == "new"} {
2269        pack [label $frmA.0 -text "Enter an experiment file to create"] \
2270                -side top -anchor center
2271    } else {
2272        pack [label $frmA.0 -text "Select an experiment file to read"] \
2273                -side top -anchor center
2274    }
2275    expfilebox $frmA $mode
2276    # force the window to stay on top
2277    putontop $frm
2278    focus $frmC.b
2279    tkwait window $frm
2280    afterputontop
2281    if {$expgui(FileMenuEXPNAM) == ""} return
2282    #puts "end getexp $expgui(expfile)"
2283    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2284}
2285
2286# validation routine
2287# called from getExpFileName, either from Read button or from SelectExpFil (see expfilebox)
2288proc valid_exp_file {frm mode} {
2289    global expgui tcl_platform
2290    # windows fixes
2291    if {$tcl_platform(platform) == "windows"} {
2292        # change backslashes to something sensible
2293        regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
2294        # allow entry of D: for D:/ and D:TEST for d:/TEST
2295        if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
2296                [string first :/ $expgui(FileMenuEXPNAM)] == -1} {
2297            regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
2298        }
2299    }
2300    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2301        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2302        ChooseExpFil $frm
2303        return
2304    } elseif [file isdirectory \
2305            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
2306        if {$expgui(FileMenuEXPNAM) != "."} {
2307            set expgui(FileMenuDir) \
2308                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2309        }
2310        ChooseExpFil $frm
2311        return
2312    }
2313    set ext [string toupper [file extension $expgui(FileMenuEXPNAM)]]
2314    if {$ext == ""} {
2315        # append a .EXP if not present
2316        append expgui(FileMenuEXPNAM) ".EXP"
2317    } elseif {[string match {*.O[0-9A-F][0-9A-F]} $ext] && \
2318            $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
2319        # check for archive files
2320        destroy .file
2321        return
2322    } elseif {$ext != ".EXP"} {
2323        # check for files that end in something other than .EXP .exp or .Exp...
2324        MyMessageBox -parent . -title "File Open Error" \
2325                -message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
2326                -icon error
2327        return
2328    }
2329    # check on the file status
2330    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2331    if {$mode == "new" && [file exists $file]} {
2332        set ans [
2333        MyMessageBox -parent . -title "File Open Error" \
2334                -message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
2335                -icon question -type {"Select other" "Overwrite"} -default "select other" \
2336                -helplink "expguierr.html OverwriteErr"
2337        ]
2338        if {[string tolower $ans] == "overwrite"} {destroy .file}
2339        return
2340    }
2341    # if file does not exist in case provided, set the name to all
2342    # upper case letters, since that is the best choice.
2343    # if it does exist, read from it as is. For UNIX we will force uppercase later.
2344    if {![file exists $file]} {
2345        set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
2346        set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2347    }
2348    if {$mode == "old" && ![file exists $file]} {
2349        set ans [
2350        MyMessageBox -parent . -title "File Open Error" \
2351                -message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
2352                -icon question -type {"Select other" "Create"} -default "select other" \
2353                -helplink "expguierr.html OpenErr"
2354        ]
2355        if {[string tolower $ans] == "create"} {
2356            if [CreateMTexpfile $file] return
2357            destroy .file
2358        }
2359        return
2360    }
2361    destroy .file
2362}
2363
2364proc updir {} {
2365    global expgui
2366    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
2367}
2368
2369# create a file box
2370proc expfilebox {bx mode} {
2371    global expgui
2372    pack [frame $bx.top] -side top
2373    pack [label $bx.top.a -text "Directory" ] -side left
2374    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2375    pack $bx.top.d -side left
2376    set expgui(FileMenuDir) [pwd]
2377    # the icon below is from tk8.0/tkfbox.tcl
2378    set upfolder [image create bitmap -data {
2379#define updir_width 28
2380#define updir_height 16
2381static char updir_bits[] = {
2382   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
2383   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
2384   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
2385   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
2386   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
2387   0xf0, 0xff, 0xff, 0x01};}]
2388
2389    pack [button $bx.top.b -image $upfolder \
2390            -command "updir; ChooseExpFil $bx" ]
2391    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2392    listbox $bx.a.files -relief raised -bd 2 \
2393            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2394            -height 15 -width 0 -exportselection 0 
2395    listbox $bx.a.dates -relief raised -bd 2 \
2396            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2397            -height 15 -width 0 -takefocus 0 -exportselection 0 
2398    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2399    ChooseExpFil $bx
2400    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2401    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2402    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
2403    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
2404    pack $bx.a.scroll -side left -fill y
2405    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2406    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2407}
2408proc sync2boxesX {master slave scroll args} {           
2409    $slave xview moveto [lindex [$master xview] 0]               
2410    eval $scroll set $args               
2411}               
2412proc move2boxesX {boxlist args} {               
2413    foreach listbox $boxlist {                   
2414        eval $listbox xview $args               
2415    }           
2416}
2417proc sync2boxesY {master slave scroll args} {
2418    $slave yview moveto [lindex [$master yview] 0]
2419    eval $scroll set $args
2420}
2421proc move2boxesY {boxlist args} {
2422    foreach listbox $boxlist { 
2423        eval $listbox yview $args
2424    }
2425}
2426
2427# creates a table that is scrollable in both x and y, use ResizeScrollTable
2428# to set sizes after gridding the widgets
2429proc MakeScrollTable {box {width 200} {height 200}} {
2430    proc sync2boxes {cmd master slave scroll args} {
2431        $slave $cmd moveto [lindex [$master $cmd] 0]
2432        eval $scroll set $args
2433    }
2434    proc move2boxes {cmd box1 box2 args} {
2435        eval $box1 $cmd $args
2436        eval $box2 $cmd $args
2437    }
2438    grid [label $box.0] -column 0 -row 0
2439    grid [canvas $box.top -scrollregion {0 0 10 10} \
2440            -xscrollcommand "sync2boxes xview $box.top $box.can $box.scroll" \
2441            -width 10 -height 10] -sticky sew -row 0 -column 1
2442    grid [canvas $box.side -scrollregion {0 0 10 10} \
2443            -yscrollcommand "sync2boxes yview $box.side $box.can $box.yscroll" \
2444            -width 10 -height 10] -sticky nes -row 1 -column 0
2445    grid [canvas $box.can -scrollregion {0 0 10 10} \
2446            -yscrollcommand "sync2boxes yview $box.can $box.side $box.yscroll" \
2447            -xscrollcommand "sync2boxes xview $box.can $box.top $box.scroll" \
2448            -width $width -height $height -bg lightgrey] -sticky news -row 1 -column 1
2449    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
2450                         -command "move2boxes xview $box.can $box.top"]] \
2451            -sticky ew -row 2 -column 1
2452    grid [set sybox [scrollbar $box.yscroll \
2453                         -command "move2boxes yview $box.can $box.side"]] \
2454            -sticky ns -row 1 -column 2
2455
2456    $box.top create window 0 0 -anchor nw  -window [frame $box.top.f -bd 0]
2457    $box.can create window 0 0 -anchor nw  -window [frame $box.can.f -bd 2]
2458    $box.side create window 0 0 -anchor nw  -window [frame $box.side.f -bd 2]
2459    grid columnconfig $box 1 -weight 1
2460    grid rowconfig $box 1 -weight 1
2461    return [list  $box.top.f  $box.can.f $box.side.f $box.0]
2462}
2463
2464proc ResizeScrollTable {box} {
2465    update idletasks
2466    for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
2467        set x1 [lindex [grid bbox $box.can.f $i 0] 2]
2468        set x2 [lindex [grid bbox $box.top.f $i 0] 2]
2469        if {$x2 > $x1} {set x1 $x2}
2470        grid columnconfigure $box.top.f $i -minsize $x1
2471        grid columnconfigure $box.can.f $i -minsize $x1
2472    }
2473    for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
2474        set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
2475        set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
2476        if {$x2 > $x1} {set x1 $x2}
2477        grid rowconfigure $box.can.f $i -minsize $x1
2478        grid rowconfigure $box.side.f $i -minsize $x1
2479    }
2480    update idletasks
2481    set sizes [grid bbox $box.can.f]
2482    $box.can config -scrollregion $sizes
2483    $box.side config -scrollregion $sizes
2484    $box.top config -scrollregion $sizes
2485    $box.side config -width [lindex [grid bbox $box.side.f] 2]
2486    $box.top config -height [lindex [grid bbox $box.top.f] 3]
2487    # remove the scroll when not needed
2488    if {[lindex $sizes 3] > [winfo height $box.can]} {
2489        grid $box.yscroll -sticky ns -column 2 -row 1
2490    } else {
2491        grid forget $box.yscroll
2492    }
2493    if {[lindex $sizes 2] > [winfo width $box.can]} {
2494        grid $box.scroll -sticky ew -column 1 -row 2
2495    } else {
2496        grid forget $box.scroll
2497    }
2498}
2499
2500proc MouseWheelScrollTable {box} {
2501     # causes mouse wheel to operate scroll for main canvas in ScrollTable
2502     # mousewheel can be operated anywhere in parent window
2503    bind [winfo toplevel $box] <MouseWheel> "$box.can yview scroll \[expr {-abs(%D)/%D}\] unit"
2504}
2505
2506
2507# this is used in cifselect -- not sure why anymore
2508proc ExpandScrollTable {box} {
2509    # set height & width of central box
2510    $box.can config -width \
2511            [expr [winfo width [winfo toplevel $box]] \
2512            - [winfo width $box.side] - [winfo width $box.yscroll]-20]
2513    $box.can config -height \
2514            [expr [winfo height [winfo toplevel $box]] \
2515            - [winfo height $box.top] - [winfo height $box.scroll]-25]
2516}
2517proc RevertExpFile {} {
2518    global expgui tcl_platform
2519    set frm .file
2520    catch {destroy $frm}
2521    toplevel $frm
2522    wm title $frm "Experiment file"
2523    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
2524    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
2525    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
2526            -fill y -expand yes
2527    pack [button $frmC.help -text Help -bg yellow \
2528            -command "MakeWWWHelp expguierr.html open"] \
2529            -side top -anchor e
2530    set expgui(filesort) 0
2531    set expgui(includearchived) 1
2532    set expgui(FileInfoBox) $frmC.info
2533    pack [label $frmC.ar -text "(Showing Archived Files Only)"] -side top -pady 10
2534    pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2535              -class SmallFont] \
2536        -side top -fill both -expand yes -pady 5
2537
2538    pack [button $frmC.b -text Read \
2539            -command "valid_exp_file $frmA old"] -side bottom
2540    pack [button $frmC.q -text Cancel \
2541            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
2542    bind $frm <Return> "$frmC.b invoke"
2543
2544    pack [label $frmA.0 -text "Select an archived experiment file to read"] \
2545                -side top -anchor center
2546    set bx $frmA 
2547    pack [frame $bx.top] -side top
2548    #pack [label $bx.top.a -text "Directory" ] -side left
2549    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2550    #pack $bx.top.d -side left
2551    #set expgui(FileMenuDir) [pwd]
2552    # the icon below is from tk8.0/tkfbox.tcl
2553    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2554    listbox $bx.a.files -relief raised -bd 2 \
2555            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2556            -height 15 -width 0 -exportselection 0 
2557    listbox $bx.a.dates -relief raised -bd 2 \
2558            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2559            -height 15 -width 0 -takefocus 0 -exportselection 0 
2560    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2561    ChooseExpFil $bx 1
2562    if {[llength [$bx.a.files get 0 end]] == 0} {
2563        destroy $frm
2564        MyMessageBox -parent . -title "No Archives" \
2565            -message "Sorry no archived versions of $::expgui(expfile) are present" \
2566                    -icon warning -type ok -default ok
2567        return
2568    }
2569    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2570    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2571    bind $bx.a.files <Double-1> "SelectExpFil $bx old"
2572    bind $bx.a.dates <Double-1> "SelectExpFil $bx old"
2573    pack $bx.a.scroll -side left -fill y
2574    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2575    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2576    # force the window to stay on top
2577    putontop $frm
2578    focus $frmC.b
2579    tkwait window $frm
2580    afterputontop
2581    if {$expgui(FileMenuEXPNAM) == ""} return
2582    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2583}
2584
2585# support routine for SetHistUseFlags
2586proc InitHistUseFlags {} {
2587    global expmap expgui
2588    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2589#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2590            set expgui(useflag_$i) [histinfo $i use]
2591#       }
2592    }
2593}
2594
2595# show all Powder histograms; set use/do not use flags
2596proc SetHistUseFlags {} {
2597    set box .test
2598    catch {toplevel $box}
2599    eval destroy [winfo children $box]
2600    grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
2601    grid [frame $box.a] -row 1 -column 0 -columnspan 2
2602    grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
2603    grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
2604    grid columnconfig $box 0 -weight 1
2605    grid columnconfig $box 1 -weight 1
2606    foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
2607    $cbox config -text "Use\nFlag"
2608    [winfo parent $bbox] config -height 250 -width 400
2609    global expmap expgui
2610    set px 5
2611    set row -1
2612    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2613        if {[string range $expmap(htype_$i) 2 2] == "T"} {
2614            set det [format %8.2f [histinfo $i tofangle]]
2615        } elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
2616            set det [format %8.5f [histinfo $i lam1]]
2617        } elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
2618            set det [format %8.2f [histinfo $i lam1]]
2619        } else {
2620            set det {}
2621        }
2622        incr row
2623#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2624            grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0 
2625            set expgui(useflag_$i) [histinfo $i use]
2626#       }
2627        grid [label $bbox.0$i \
2628                -text [string range $expmap(htype_$i) 0 3] \
2629                ] -row $row -column 0 -padx $px
2630        grid [label $bbox.1$i -text [histinfo $i bank] \
2631                ] -row $row -column 1 -padx $px
2632        grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
2633        grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
2634                ] -row $row -column 3 -padx $px -sticky ew
2635    }
2636    grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
2637    grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
2638    grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
2639    grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
2640    ResizeScrollTable $box.a
2641    InitHistUseFlags
2642    putontop $box
2643    tkwait window $box
2644    afterputontop
2645    set prevchages $expgui(changed)
2646    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2647#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2648            if {$expgui(useflag_$i) != [histinfo $i use]} {
2649                histinfo $i use set $expgui(useflag_$i)
2650                RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
2651                incr expgui(changed)
2652                RecordMacroEntry "incr expgui(changed)" 0
2653            }
2654#       }
2655    }
2656    if {$prevchages != $expgui(changed)} {
2657        set msg "You have changed [expr $expgui(changed)-$prevchages] "
2658        append msg "histogram flag(s). You must run POWPREF "
2659        append msg "to include/remove these histograms. Do you want to "
2660        append msg "run POWPREF?"
2661        set ans [MyMessageBox -parent . -message $msg \
2662                -title "Process changes?"\
2663                -helplink "expguierr.html ProcessUse" \
2664                -default {Run POWPREF} \
2665                -type {{Run POWPREF} Skip}]
2666       
2667        if {$ans == "skip"} {
2668            # save and reload the experiment file
2669            savearchiveexp
2670            loadexp $expgui(expfile)
2671        } else {
2672            # run powpref and force a reload
2673            set saveautoload $expgui(autoexpload)
2674            set expgui(autoexpload) 1
2675            runGSASwEXP powpref
2676            set expgui(autoexpload) $saveautoload
2677        }
2678    }
2679}
2680
2681# set the box or file in the selection window
2682proc ReleaseExpFil {frm} {
2683    global expgui
2684    set files $frm.a.files
2685    set dates $frm.a.dates
2686    set select [$files curselection]
2687    if {$select == ""} {
2688        set select [$dates curselection]
2689    }
2690    if {$select == ""} {
2691        set expgui(FileMenuEXPNAM) ""
2692    } else {
2693        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
2694        after idle UpdateInfoBox
2695    }
2696    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2697        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
2698        ChooseExpFil $frm
2699    } elseif [file isdirectory \
2700            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
2701        if {$expgui(FileMenuEXPNAM) != "."} {
2702            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2703            ChooseExpFil $frm
2704        }
2705    }
2706    return
2707}
2708
2709proc ScanEXPforError {"ns {}"} {
2710    # record types to ignore
2711    set ignorelist {DESCR HSTRY PNAM HNAM "REFN STATS"}
2712    set warn {}
2713    set badkeylist {}
2714    # scan file for warnings
2715    foreach key [array names ${ns}::exparray] {
2716        if {[string first "***" [set ${ns}::exparray($key)]] != -1 || 
2717            [string first "#IN" [set ${ns}::exparray($key)]] != -1 ||
2718            [string first "nan" [set ${ns}::exparray($key)]] != -1 ||
2719            [string first "NAN" [set ${ns}::exparray($key)]] != -1 
2720        } {
2721            #puts [set ${ns}::exparray($key)]
2722            set OK 0
2723            foreach i $ignorelist {
2724                if {[string first $i $key] != -1} {
2725                    set OK 1
2726                    break
2727                }
2728            }
2729            # ignore atom name section of Atom records
2730            if {(! $OK) && [string match  "CRS*AT*A" $key]} {
2731                foreach str [list [string range [set ${ns}::exparray($key)] 0 49] 
2732                             [string range [set ${ns}::exparray($key)] 58 end]] {
2733                    if {[string first "***" $str] || 
2734                        [string first "#INF" $str] || 
2735                        [string first "nan" $str] || 
2736                        [string first "NAN" $str]} {
2737                        append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
2738                        lappend badkeylist $key
2739                        break
2740                    }
2741                }
2742                continue
2743            }
2744            if {! $OK} {
2745                append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
2746                lappend badkeylist $key
2747            }
2748        }
2749    }
2750    if {$warn == ""} return
2751    set hint ""
2752    set unknown ""
2753    foreach key $badkeylist {
2754        if {[string match  "CRS*AT*" $key]} {
2755            if {[string first "atomic parameter" $hint] == -1} {
2756                append hint "\t* An atomic parameter (coordinate, occupancy or U) appears out of range\n"
2757            }
2758        } elseif {[string match  "CRS*ABC*" $key] || 
2759                  [string match  "CRS*ANGLES*" $key] || 
2760                  [string match  "CRS*CELVOL*" $key]} {
2761            if {[string first "cell parameter" $hint] == -1} {
2762                append hint "\t* A unit cell parameter appears out of range\n"
2763            }
2764        } elseif {[string match  "CRS*ODF*" $key]} {
2765            if {[string first "spherical harmonic" $hint] == -1} {
2766                append hint "\t* A spherical harmonic (ODF) parameter appears out of range\n"
2767            }
2768        } elseif {[string match  "HST*ICONS" $key]} {
2769            if {[string first "diffractometer constant" $hint] == -1} {
2770                append hint "\t* A diffractometer constant (wave, DIFC,...) appears out of range\n"
2771            }
2772        } elseif {[string match  "HST*TRNGE" $key]} {
2773            if {[string first "histogram data range" $hint] == -1} {
2774                append hint "\t* A histogram data range value appears out of range\n"
2775            }
2776        } elseif {[string match "*GNLS  RUN*" $key] || 
2777                  [string match "*GNLS SHFTS" $key] ||
2778                  [string match "HST*RPOWD" $key] ||
2779                  [string match " REFN RPOWD " $key] ||
2780                  [string match " REFN GDNFT " $key]
2781              } {
2782            if {[string first "refinement statistics" $hint] == -1} {
2783                append hint "\t* The refinement statistics imply the last refinement diverged\n"
2784            }
2785        } else {
2786            lappend unknown $key
2787        }
2788    }
2789    if {$unknown != ""} {
2790        append hint "\t* The following less common problem record(s) appear out of range:\n\t\t"
2791        foreach key $unknown {
2792            append hint "\"" [string trim $key] "\" "
2793        }
2794    }
2795    return "Likely error(s) noted:\n$hint\nDetails of problem(s):\n$warn"
2796}
2797
2798proc ExplainEXPerror {parent message file} {
2799    #ShowCallStack
2800    if {$parent == "."} {
2801        set w .experr
2802    } else {
2803        set w $parent.experr
2804    }
2805    catch {destroy $w}
2806    toplevel $w -class Dialog
2807    wm title $w "Corrupt .EXP file"
2808    wm iconname $w Dialog
2809    wm protocol $w WM_DELETE_WINDOW { }
2810    # Make the message box transient if the parent is viewable.
2811    if {[winfo viewable [winfo toplevel $parent]] } {
2812        wm transient $w $parent
2813    } 
2814    frame $w.bot
2815    pack $w.bot -side bottom -fill both
2816    frame $w.top
2817    pack $w.top -side top -fill both -expand 1
2818    frame $w.msg
2819    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
2820    set txt {Likely errors were noted when reading this file}
2821    append txt " ([file tail $file]). "
2822    append txt "These problems probably\narose from the last refinement, "
2823    append txt "based on settings applied in the previous saved file.\n"
2824    append txt "It is probably not possible to continue with this file.\n"
2825    append txt "You likely need to revert at least two archived versions back."
2826    grid [label $w.msg.s -text $txt -justify left] -row 0 -column 0 -sticky nws
2827    grid [button $w.msg.1 -text Help -bg yellow \
2828              -command "MakeWWWHelp expgui.html badexp"] -row 0 -column 1 -columnspan 2 -sticky ne
2829    bind $w <Key-F1> "MakeWWWHelp expgui.html badexp"
2830    set filelist [lsort -dictionary -decreasing \
2831                      [glob -nocomplain \
2832                           [file root $file.O* ]]]
2833    grid [text  $w.msg.t -font {Times 12} \
2834              -height 10 -width 90 -relief flat -wrap word \
2835              -yscrollcommand "$w.msg.rscr set" \
2836             ] -row 1 -column 0  -columnspan 2 -sticky news
2837    grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
2838             ] -row 1 -column 2 -sticky ns
2839    # give extra space to the text box
2840    grid columnconfigure $w.msg 0 -weight 1
2841    grid rowconfigure $w.msg 1 -weight 1
2842    $w.msg.t insert end $message
2843    button $w.ok -command [list destroy $w] -text OK -default active
2844    pack $w.ok -in $w.bot -side left -expand 1 -padx 3m -pady 2m
2845    putontop $w
2846    tkwait window $w
2847    afterputontop
2848}
2849
2850proc UpdateInfoBox {} {
2851    global expgui
2852    if {![winfo exists $expgui(FileInfoBox)]} return
2853    eval destroy [winfo children $expgui(FileInfoBox)]
2854    set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
2855    if [file isdirectory $file] return
2856    if [file exists $file] {   
2857        pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
2858                -side top
2859        catch {
2860            # load the EXP file into a namespace & scan for errors
2861            expload $file scan
2862            set warnings [ScanEXPforError scan]
2863            if {$warnings != ""} {
2864                pack [frame $expgui(FileInfoBox).1a -bg yellow -padx 4 -pady 4] -side top
2865                pack [label $expgui(FileInfoBox).1a.err -justify left \
2866                          -text "WARNING: Likely corrupt" -bg yellow] \
2867                    -side left -anchor w -fill both
2868                pack [button $expgui(FileInfoBox).1a.show \
2869                          -text "More..." -padx 0 \
2870                          -command "ExplainEXPerror $expgui(FileInfoBox) [list $warnings] $file"\
2871                         ] -side right -anchor w
2872            }
2873            set fp [open $file r]
2874            global testline
2875            set testline [read $fp]
2876            close $fp
2877            update
2878            regexp -linestop {GNLS  RUN on (.*) +Total.*run *([0-9]+) } \
2879                    $testline a last cycles
2880            pack [label $expgui(FileInfoBox).2 -justify left \
2881                    -text "last GENLES run:\n  $last\n  total cycles: $cycles"] \
2882                -side top -anchor w
2883            set chi2 ?
2884            set vars ?
2885            regexp {REFN GDNFT.*= *([0-9]*\.[0-9]*) +for *([0-9]+) variables} \
2886                    $testline a chi2 vars
2887            pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
2888                    -side top -anchor w
2889            pack [label $expgui(FileInfoBox).3.a -justify left \
2890                    -text "c" -font symbol] \
2891                    -side left -anchor w
2892            pack [label $expgui(FileInfoBox).3.b -justify left \
2893                    -text "2: $chi2, $vars vars"] \
2894                    -side top -anchor w
2895            # check first 9 histograms
2896            set lbl "h  Rwp     R(F2)"
2897            set n 0
2898            foreach k {1 2 3 4 5 6 7 8 9} {
2899                set key "HST  $k"
2900                append key { RPOWD +([0-9]*\.[0-9]*) }
2901                set i [regexp $key $testline a Rwp]
2902                set key "HST  $k"
2903                append key { R-FAC +[0-9]+ +([0-9]*\.[0-9]*) }
2904                set j [regexp $key $testline a Rb]
2905                if {$i || $j} {
2906                    incr n
2907                    append lbl "\n$k  "
2908                    if {$i} {
2909                        append lbl [string range $Rwp 0 5]
2910                    } else {
2911                        append lbl "    "
2912                    }
2913                }
2914                if {$j} {
2915                    append lbl " [string range $Rb 0 5]"
2916                }
2917                # stick 1st 3 entries in box
2918                if {$n >= 3} break
2919            }
2920            pack [label $expgui(FileInfoBox).4 -justify left \
2921                    -text $lbl] \
2922                    -side top -anchor w     
2923        } err
2924    }
2925}
2926
2927# select a file or directory -- called on double click
2928proc SelectExpFil {frm mode} {
2929    global expgui
2930    set files $frm.a.files
2931    set dates $frm.a.dates
2932    set select [$files curselection]
2933    if {$select == ""} {
2934        set select [$dates curselection]
2935    }
2936    if {$select == ""} {
2937        set file .
2938    } else {
2939        set file [string trim [$files get $select]]
2940    }
2941    if {$file == "<Parent>"} {
2942        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2943        ChooseExpFil $frm
2944    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
2945        if {$file != "."} {
2946            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
2947            ChooseExpFil $frm
2948        }
2949    } else {
2950        set expgui(FileMenuEXPNAM) [file tail $file]
2951        valid_exp_file $frm $mode
2952    }
2953}
2954
2955# fill the files & dates & Directory selection box with current directory,
2956# also called when box is created to fill it
2957proc ChooseExpFil {frm "archiveonly 0"} {
2958    global expgui
2959    set files $frm.a.files
2960    set dates $frm.a.dates
2961    set expgui(FileMenuEXPNAM) {}
2962    $files delete 0 end
2963    $dates delete 0 end
2964    if {$archiveonly == 0} {
2965        $files insert end {<Parent>}
2966        $dates insert end {(Directory)}
2967        set filelist [glob -nocomplain \
2968                          [file join [set expgui(FileMenuDir)] *] ]
2969        foreach file [lsort -dictionary $filelist] {
2970            if {[file isdirectory $file]} {
2971                $files insert end [file tail $file]
2972                $dates insert end {(Directory)}
2973            }
2974        }
2975    } else {   
2976        set filelist [glob -nocomplain \
2977                          [file root $expgui(expfile)].O* ]
2978    }
2979    set pairlist {}
2980    foreach file [lsort -dictionary $filelist] {
2981        if {![file isdirectory $file]  && \
2982                [string toupper [file extension $file]] == ".EXP" \
2983                && $archiveonly == 0} {
2984            set modified [file mtime $file]
2985            lappend pairlist [list $file $modified]
2986        } elseif {![file isdirectory $file] && $expgui(includearchived) && \
2987                [string match {*.O[0-9A-F][0-9A-F]} $file]} {
2988            set modified [file mtime $file]
2989            lappend pairlist [list $file $modified]
2990        }
2991    }
2992    if {$expgui(filesort) == 0} {
2993        foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
2994            set file [lindex $pair 0]
2995            set modified [clock format [lindex $pair 1] -format "%T %D"]
2996            $files insert end [file tail $file]
2997            $dates insert end $modified
2998        }
2999    } else {
3000        foreach pair [lsort -dictionary -index 0 $pairlist] {
3001            set file [lindex $pair 0]
3002            set modified [clock format [lindex $pair 1] -format "%T %D"]
3003            $files insert end [file tail $file]
3004            $dates insert end $modified
3005        }
3006    }
3007    $expgui(FileDirButtonMenu)  delete 0 end
3008    set list ""
3009    global tcl_platform tcl_version
3010    if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
3011        catch {set list [string tolower [file volume]]}
3012    }
3013    set dir ""
3014    foreach subdir [file split [set expgui(FileMenuDir)]] {
3015        set dir [file join $dir $subdir]
3016        if {$tcl_platform(platform) == "windows"} {
3017            set dir [string tolower $dir]
3018            if {[lsearch $list $dir] == -1} {lappend list $dir}
3019        } else {
3020            lappend list $dir
3021        }
3022    }
3023    foreach path $list {
3024        $expgui(FileDirButtonMenu) add command -label $path \
3025                -command "[list set expgui(FileMenuDir) $path]; \
3026                ChooseExpFil $frm"
3027    }
3028    # highlight the current experiment -- if present
3029    for {set i 0} {$i < [$files size]} {incr i} {
3030        set file [$files get $i]
3031        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
3032            $files selection set $i
3033            set expgui(FileMenuEXPNAM) $file
3034            UpdateInfoBox
3035        }
3036    }
3037    return
3038}
3039
3040
3041#------------------------------------------------------------------------------
3042# platform-specific definitions
3043if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
3044    # windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
3045    # DOS box synchronously, so we create a "lock" file that is deleted
3046    # at the end of the DOS run so we can tell when the run is done.
3047    # We create a window to force the deleting of the file so that if
3048    # the DOS process crashes, the user can continue anyway.
3049    #
3050    # procedure to check if the lock file is still there (Win-9x/me only)
3051    proc checklockfile {file window} {
3052        if [file exists $file] {
3053            after 500 checklockfile $file $window
3054        } else {
3055            catch {destroy $window}
3056        }
3057    }
3058    # this procedure starts the GRWND program, if needed for program $prog
3059    proc StartGRWND {prog} {
3060        global expgui
3061        if {!$expgui(autoGRWND)} return
3062        # at some point we might want to have a real list
3063        if {$prog != "genles" && $prog != "powpref"} {
3064            # get a list of running jobs
3065            exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
3066            set fp [open tlist.tlist r]
3067            set text [read $fp]
3068            close $fp
3069            file delete -force tlist.tlist
3070            # if GRWND.EXE is not currently running, start it
3071            if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
3072                exec [file join $expgui(gsasexe) grwnd.exe] &
3073                # give grwnd a 1 second head start
3074                after 1000
3075            }
3076        }
3077    }
3078    # this creates a DOS box to run a program in
3079    proc forknewterm {title command "wait 1" "scrollbar 1"} {
3080        global env expgui
3081        # Windows environment variables
3082        set env(GSAS) [file nativename $expgui(gsasdir)]
3083        # PGPLOT_FONT is needed by PGPLOT
3084        set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
3085        # this is the number of lines/page in the .LST (etc.) file
3086        set env(LENPAGE) 60
3087        set pwd [file nativename [pwd]]
3088       
3089        # check the .EXP path -- can DOS use it?
3090        if {[string first // [pwd]] != -1} {
3091            MyMessageBox -parent . -title "Invalid Path" \
3092                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
3093                    -icon error -type ok -default ok \
3094                    -helplink "expgui_Win_readme.html NetPath"
3095            return
3096        }
3097        if {[info command winutils::shell] == "" && \
3098                [info command winexec] == ""} {
3099            MyMessageBox -parent . -title "Setup error" \
3100                -message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
3101                -icon error -type darn -default darn \
3102                -helplink "expgui_Win_readme.html Winexec"
3103            return
3104        }
3105        # loop over multiple commands
3106        foreach cmd $command {
3107            # simulate the wait with a lock file
3108            if {$wait} {
3109                if {$expgui(autoiconify)} {wm iconify .}
3110                # create a blank lock file and a message window
3111                close [open expgui.lck w]
3112                toplevel .lock
3113                grid [button .lock.0 -text Help -bg yellow \
3114                        -command "MakeWWWHelp expguierr.html lock"] \
3115                        -column 1 -row 0
3116                grid [label .lock.1 \
3117                        -text "Please wait while the GSAS program finishes."] \
3118                        -column 0 -row 0
3119                grid [label .lock.2 -text \
3120                        "In case a problem occurs, close the DOS box"] \
3121                        -column 0 -columnspan 2 -row 1
3122                grid [label .lock.3 -text \
3123                        "and press the \"Continue\" button (below)"] \
3124                        -column 0 -columnspan 2 -row 2
3125                grid [button .lock.b -text "Continue" \
3126                        -command "destroy .lock; wm deiconify ."] \
3127                        -column 0 -columnspan 2 -row 3
3128                putontop .lock
3129                update
3130                checklockfile expgui.lck .lock
3131            }
3132
3133            # pause is hard coded in the GSASTCL.BAT file
3134            if {$expgui(execprompt)} {
3135                set script gsastcl.bat
3136            } else {
3137                set script gsasnowt.bat
3138            }
3139
3140            # replace the forward slashes with backward
3141            regsub -all / $cmd \\ cmd
3142            if {[info command winutils::shell] != ""} {
3143                winutils::shell [file join $expgui(scriptdir) $script] $cmd
3144            } else {
3145                winexec -d [file nativename [pwd]] \
3146                    [file join $expgui(scriptdir) $script] $cmd
3147            }
3148            if {$expgui(MacroRunning)} {
3149                update 
3150                update idletasks
3151            }
3152            if {$wait} {
3153                tkwait window .lock
3154                file delete -force expgui.lck
3155            }
3156        }
3157        if {$expgui(autoiconify) && $wait} {wm deiconify .}
3158        # check for changes in the .EXP file immediately
3159        whenidle
3160    }
3161} elseif {$tcl_platform(platform) == "windows"} {
3162    # now for Windows-NT, where we can run synchronously
3163    #
3164    # this creates a DOS box to run a program in
3165    proc forknewterm {title command  "wait 1" "scrollbar 1"} {
3166        global env expgui
3167        # Windows environment variables
3168        set env(GSAS) [file nativename $expgui(gsasdir)]
3169        # PGPLOT_FONT is needed by PGPLOT
3170        set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
3171        set env(PGPLOT_DIR) $expgui(pgplotdir)
3172        # this is the number of lines/page in the .LST (etc.) file
3173        set env(LENPAGE) 60
3174        set pwd [file nativename [pwd]]
3175        # check the path -- can DOS use it?
3176        if {[string first // [pwd]] != -1} {
3177            MyMessageBox -parent . -title "Invalid Path" \
3178                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
3179                    -icon error -type ok -default ok \
3180                    -helplink "expgui_Win_readme.html NetPath"
3181            return
3182        }
3183        # pause is hard coded in the .BAT file
3184        if {$expgui(execprompt)} {
3185            set script gsastcl.bat
3186        } else {
3187            set script gsasnowt.bat
3188        }
3189
3190        if {$wait} {
3191            if {$expgui(autoiconify)} {wm iconify .}
3192            # create a blank lock file (keep liveplot from running)
3193            close [open expgui.lck w]
3194            # loop over commands
3195            foreach cmd $command {
3196                # replace the forward slashes with backward
3197                regsub -all / $cmd \\ cmd
3198                # use of file attributes -shortname & normalize and nativename
3199                # might help here
3200                exec $env(COMSPEC) /c \
3201                        "start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
3202            }
3203            file delete -force expgui.lck
3204            if {$expgui(autoiconify)} {wm deiconify .}
3205            # check for changes in the .EXP file immediately
3206            whenidle
3207        } else {
3208            # loop over commands
3209            foreach cmd $command {
3210                # replace the forward slashes with backward
3211                regsub -all / $cmd \\ cmd
3212                # run in background
3213                exec $env(COMSPEC) /c \
3214                        "start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
3215                if {$expgui(MacroRunning)} {
3216                    update 
3217                    update idletasks
3218                }
3219            }
3220        }
3221    }
3222} else {
3223    # UNIX-based machines
3224    if {[auto_execok xterm] != ""} {
3225        # this creates a xterm window for running programs inside
3226        proc forknewterm {title command "wait 1" "scrollbar 1"} {
3227            global env expgui
3228            # UNIX environment variables
3229            set env(GSAS) [file nativename $expgui(gsasdir)]
3230            set env(gsas) [file nativename $expgui(gsasdir)]
3231            set env(GSASEXE) $expgui(gsasexe)
3232            set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
3233            set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
3234            # PGPLOT_DIR is needed by PGPLOT
3235            set env(PGPLOT_DIR) $expgui(pgplotdir)
3236            # this is the number of lines/page in the .LST (etc.) file
3237            set env(LENPAGE) 60
3238            set termopts {}
3239            if $env(GSASBACKSPACE) {
3240                append termopts \
3241                    {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
3242            }
3243            if $scrollbar {
3244                append termopts " -sb"
3245            } else {
3246                append termopts " +sb"
3247            }
3248            if {$wait} {
3249                set suffix {}
3250            } else {
3251                set suffix {&}
3252            }
3253           
3254            # hold window open after commands finish
3255            if {$expgui(execprompt)} {
3256                append command "\; echo -n Press Enter to continue \; read x"
3257            }
3258            if {$wait && $expgui(autoiconify)} {wm iconify .}
3259            catch {eval exec xterm $termopts -title [list $title] \
3260                       -e /bin/sh -c [list $command] $suffix} errmsg
3261            if $expgui(debug) {puts "xterm result = $errmsg"}
3262            if {$expgui(MacroRunning)} {
3263                update 
3264                update idletasks
3265            }
3266            if {$wait} {
3267                if {$expgui(autoiconify)} {wm deiconify .}
3268                # check for changes in the .EXP file immediately
3269                whenidle
3270            }
3271        }
3272    } elseif {[auto_execok gnome-terminal] != ""} {
3273        # this creates a xterm window for running programs inside
3274        proc forknewterm {title command "wait 1" "scrollbar 1"} {
3275            global env expgui
3276            # UNIX environment variables
3277            set env(GSAS) [file nativename $expgui(gsasdir)]
3278            set env(gsas) [file nativename $expgui(gsasdir)]
3279            set env(GSASEXE) $expgui(gsasexe)
3280            set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
3281            set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
3282            # PGPLOT_DIR is needed by PGPLOT
3283            set env(PGPLOT_DIR) $expgui(pgplotdir)
3284            # this is the number of lines/page in the .LST (etc.) file
3285            set env(LENPAGE) 60
3286            if {$wait} {
3287                set suffix {}
3288            } else {
3289                set suffix {&}
3290            }
3291           
3292            # hold window open after commands finish
3293            if {$expgui(execprompt)} {
3294                append command "\; echo -n Press Enter to continue \; read x"
3295            }
3296            if {$wait && $expgui(autoiconify)} {wm iconify .}
3297            catch {exec gnome-terminal --title $title \
3298                       -e " /bin/sh -c \" $command \" " $suffix} errmsg
3299            if $expgui(debug) {puts "gnome-terminal result = $errmsg"}
3300            if {$expgui(MacroRunning)} {
3301                update 
3302                update idletasks
3303            }
3304            if {$wait} {
3305                if {$expgui(autoiconify)} {wm deiconify .}
3306                # check for changes in the .EXP file immediately
3307                whenidle
3308            }
3309        }
3310    } else {
3311        MyMessageBox -parent . -title "Error: no terminal program" \
3312            -message "Error, the xterm or gnome-terminal utility programs could not be found. It is not possible to run the GSAS programs without this." \
3313            -icon error -type NOT-OK -default not-ok
3314    }
3315}
3316
3317# run commands without a terminal window
3318proc runnoterm {command outfile} {
3319    global env expgui tcl_platform
3320    if {$tcl_platform(platform) == "windows"} {
3321        # Windows environment variables
3322        set env(GSAS) [file nativename $expgui(gsasdir)]
3323        # PGPLOT_FONT is needed by PGPLOT
3324        set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
3325        # this is the number of lines/page in the .LST (etc.) file
3326        set env(LENPAGE) 60
3327        set pwd [file nativename [pwd]]
3328        # loop over multiple commands
3329        foreach cmd $command {
3330            # replace the forward slashes with backward
3331            regsub -all / $cmd \\ cmd
3332            exec $cmd >>& $outfile
3333            update
3334            update idletasks
3335        }
3336    } else { 
3337        # UNIX environment variables
3338        set env(GSAS) [file nativename $expgui(gsasdir)]
3339        set env(gsas) [file nativename $expgui(gsasdir)]
3340        set env(GSASEXE) $expgui(gsasexe)
3341        set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
3342        set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
3343        # PGPLOT_DIR is needed by PGPLOT
3344        set env(PGPLOT_DIR) $expgui(pgplotdir)
3345        # this is the number of lines/page in the .LST (etc.) file
3346        set env(LENPAGE) 60
3347        foreach cmd $command {
3348            catch {eval exec $cmd >>& $outfile} errmsg
3349        }
3350        update
3351        update idletasks
3352    }
3353    # check for changes in the .EXP file immediately
3354    #whenidle
3355}
3356
3357proc MacMakeResource {file app} {
3358    # make a resource file. Note that OS X has gotten picky about the length of this
3359    set l [string length $app]
3360    if $::expgui(debug) {puts "$l bytes"}
3361    incr l
3362    if $::expgui(debug) {puts "$l bytes after incr"}
3363    set str "data 'usro' (0) {\n"
3364    append str "  $\""
3365    append str [format %.8X $l]
3366    set bytes 4
3367    foreach char [split $app {}] {
3368        append str [format %.2X [scan $char %c]]   
3369    }
3370    incr bytes $l
3371    set newline 1
3372    for {set i 0} {$i < [expr 1028-$bytes]} {incr i} {
3373        if $newline {
3374            append str "\" \n"
3375            append str "  $\""
3376            set newline 0
3377            set j 0
3378        }
3379        append str {0000 }
3380        incr bytes
3381        incr j 2
3382        if {$j > 15} {set newline 1}
3383    }
3384    if {$l % 2} {
3385        append str "\"\n "
3386    } else {
3387        # even lengths need one more byte
3388        append str "00\"\n "
3389    }
3390    append str "/* $app */\n};\n"
3391    set fp [open $file w]
3392    puts $fp $str
3393    close $fp
3394}
3395
3396# modify resource fork info for a .EXP file on the Mac
3397proc MacSetResourceFork {expfile} {
3398    global expgui tcl_platform
3399    if {$tcl_platform(os) != "Darwin"} {return}
3400    set expnative [file nativename $expfile]
3401    #
3402    # assign an app to the data file, if the app and the
3403    # required tool (Rez) are installed
3404    set app [file nativename [file join $expgui(gsasdir) expgui.app]]
3405    set RezApp {}
3406    foreach pth "/usr/bin  /Developer/Tools $expgui(gsasexe)" {
3407        if [file exists [set tst [file join $pth Rez]]] {
3408            set RezApp $tst
3409            break
3410        }
3411    }
3412    set SetFileApp {}
3413    foreach pth "/usr/bin  /Developer/Tools $expgui(gsasexe)" {
3414        if [file exists [set tst [file join $pth SetFile]]] {
3415            set SetFileApp $tst
3416            break
3417        }
3418    }
3419    if $::expgui(debug) {puts "found app=$app Rez=$RezApp and SetFile=$SetFileApp"}
3420    if {[file exists $app] && $RezApp != ""} {
3421        # make resource file
3422        MacMakeResource setapp.r $app
3423        if $::expgui(debug) {puts "$RezApp setapp.r -o $expnative -a"}
3424        exec $RezApp setapp.r -o $expnative -a
3425        if {! $::expgui(debug)} {
3426            file delete -force setapp.r
3427        }
3428    }
3429
3430    # assign an icon to the data file, if it and the required tools exist
3431    set icon [file join $expgui(gsasexe) gsasicon.r]
3432    if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
3433        exec $RezApp [file nativename $icon] -o $expnative -a
3434        exec $SetFileApp -a C $expnative
3435        if {$::expgui(debug)} {
3436            puts "$RezApp [file nativename $icon] -o $expnative -a"
3437            puts "$SetFileApp -a C $expnative"
3438        }
3439    } elseif {$::expgui(debug)} {
3440        puts "icon=$icon missing?"
3441    }
3442}
3443
3444#-------------------------------------------------------------------------------
3445# Macro Recording
3446#-------------------------------------------------------------------------------
3447set expgui(MacroBufferedCommand) ""
3448set expgui(fpMacroFile) ""
3449set expgui(MacroFile) ""
3450# Turn on/off mode to save commands in MacroFile
3451proc SetRecordMacroOnOff {args} {
3452    global expgui
3453    if {$expgui(RecordMacro)} {
3454        set expgui(fpMacroFile) ""
3455        set expgui(MacroBufferedCommand) ""
3456        while {$expgui(fpMacroFile) == ""} {
3457            set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
3458                                       -parent . \
3459                                       -filetypes {{"EXPGUI Macro file" .expmac}} \
3460                                       -defaultextension .expmac  \
3461                                       -initialfile EXPGUI.expmac \
3462                                       -title "Choose location to save macro"]
3463            if {$expgui(MacroFile) == ""} {
3464                # respond to cancel
3465                set expgui(fpMacroFile) ""
3466                set expgui(MacroFile) ""
3467                set expgui(RecordMacro) 0
3468                return
3469            }
3470            if {[catch {
3471                set expgui(fpMacroFile) [open $expgui(MacroFile) w]
3472                puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
3473            } errmsg]} {
3474                MyMessageBox -parent . -title "Error opening selected file" \
3475                    -message "Error opening macro file:\n$errmsg" \
3476                    -icon warning -type TryAgain -default tryagain
3477                catch {close $expgui(fpMacroFile)}
3478                set expgui(fpMacroFile) ""
3479                set expgui(MacroFile) ""
3480                set expgui(RecordMacro) 0
3481            }
3482        }
3483    } else {
3484        if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3485            puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3486        }
3487        catch {close $expgui(fpMacroFile)}
3488        set expgui(fpMacroFile) ""
3489        set expgui(MacroFile) ""
3490        set expgui(MacroBufferedCommand) ""
3491    }
3492}
3493
3494# record a command in the Macro File
3495proc RecordMacroEntry {command buffer} {
3496    global expgui
3497    if {! $expgui(RecordMacro)} return
3498    # in buffered mode: hold the last command in memory and compare to the
3499    # next. If two commands differ only in the final argument, then the
3500    # second command makes the previous redundant so only the latter version
3501    # is retained (This will happen when a user types a string into a box).
3502    # When the commands differ, then the previous is written to file
3503    # and the next is retained in memory.
3504    if {$buffer} {
3505        if {[string trim $expgui(MacroBufferedCommand)] == ""} {
3506            set expgui(MacroBufferedCommand) $command
3507            return
3508        }
3509        set diff 0
3510        # is command a repeat of previous?
3511        foreach a $command b $expgui(MacroBufferedCommand) {
3512            if {$diff} {
3513                # found a difference, other than in the last arg
3514                puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3515                break
3516            }
3517            if {$a != $b} {set diff 1}
3518        }
3519        set expgui(MacroBufferedCommand) $command
3520    } else {
3521        # no buffering on current command; write the old and new to file.
3522        if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3523            puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3524        }
3525        puts $expgui(fpMacroFile) $command
3526        set expgui(MacroBufferedCommand) ""
3527    }
3528}
3529
3530proc CantRecordMacroEntry {comment} {
3531    global expgui
3532    if {! $expgui(RecordMacro)} return
3533
3534    # no buffering on current command; write the old and new to file.
3535    if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3536        puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3537    }
3538    puts $expgui(fpMacroFile) "# unrecorded: $comment"
3539    set expgui(MacroBufferedCommand) ""
3540    MyMessageBox -parent . -title "No command record" \
3541        -message "EXPGUI is not able to record this action in the macro file: $comment" \
3542        -icon warning
3543}
3544
3545
3546# Play back commands in Macro File
3547proc ReplayMacroFile {"lineatatime 0"} {
3548    global expgui
3549    set expnam [file root [file tail $expgui(expfile)]]
3550    file delete abort_${expnam}_macro.flag
3551    set expgui(MacroRunning) 0
3552    set MacroFile [tk_getOpenFile -initialdir [pwd] \
3553                       -parent . \
3554                       -filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
3555                       -defaultextension .expmac  \
3556                       -title "Choose location to read macro"]
3557    if {$MacroFile == ""} return
3558    set expgui(MacroRunning) 1
3559    if {$lineatatime} {
3560        set expgui(MacroChanged) 0
3561        set top1 .macro
3562        catch {destroy $top1}
3563        toplevel $top1
3564        set txt $top1.t
3565        grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
3566            -column 0 -row 0 -sticky news
3567        wm title $top1 "File $MacroFile"
3568        grid [scrollbar $top1.s -command "$txt yview"] \
3569            -column 1 -row 0 -sticky ns
3570        grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
3571        grid columnconfig $top1 0 -weight 1
3572        grid rowconfig $top1 0 -weight 1
3573        grid [button $top1.b.e -text "Execute line" \
3574                  -command "MacroExecuteCurrentLine $txt"] \
3575            -column 0 -row 0 -sticky w
3576        grid columnconfig $top1.b 1 -weight 1
3577        grid [button $top1.b.s -text "Save As" -state disabled \
3578                  -command "MacroResave $txt"] -column 1 -row 0
3579        set expgui(MacroSaveButton) $top1.b.s 
3580        grid [button $top1.b.c -text "Close " \
3581                  -command "MacroCloseWindow $txt"] -column 2 -row 0
3582        $txt delete 0.0 end
3583        set fp [open $MacroFile r]
3584        $txt insert 0.0 [read $fp]
3585        close $fp
3586        MacroHighlightText $txt 1
3587        # deal with editing in the box
3588        $txt configure -undo 1
3589        $txt edit modified 0
3590        bind $txt <<Modified>> {
3591            $expgui(MacroSaveButton) configure -state normal
3592            set expgui(MacroChanged) 1
3593        }
3594    } else {
3595        close [open running_${expnam}_macro.flag w]
3596        set saveprompt $expgui(execprompt)
3597        set saveautold $expgui(autoexpload)
3598        set expgui(execprompt) 0
3599        set expgui(autoexpload) 1
3600        set expnam [file root [file tail $expgui(expfile)]]
3601        if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3602            set outfile ${expnam}_macout.LST
3603            # create an empty file
3604            catch {file delete $outfile}
3605            close [open $outfile w]
3606            # view it with LSTVIEW
3607            set outfile ${expnam}_macout
3608            exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
3609        } else {
3610            # show status, offer abort with MACROMON
3611            exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
3612        }
3613
3614        set  expgui(MacroStatus) "starting script"
3615        pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus) 
3616
3617        if {[catch {
3618            source $MacroFile
3619        } errmsg]} {
3620            set txt $::errorInfo
3621            catch {
3622                set fp [open error.txt a]
3623                puts $fp "#  [clock format [clock seconds] -format %Y-%m-%dT%T]"
3624                puts $fp $txt
3625                close $fp
3626            }
3627            donewait
3628            MyMessageBox -parent . -title "Error running Macro file" \
3629                -message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
3630                -icon error -type OK -default ok
3631        } else {
3632            donewait
3633        }
3634        file delete running_${expnam}_macro.flag
3635        set expgui(execprompt) $saveprompt
3636        set expgui(autoexpload) $saveautold
3637        set expgui(MacroRunning) 0
3638        # show changes
3639        PaintEXPGUIpages
3640        # put comment in output file
3641        if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3642            set outfile ${expnam}_macout.LST
3643            set fp [open $outfile a]
3644            puts $fp "\n**** Macro ended ****" 
3645            close $fp
3646        }
3647    }
3648}
3649
3650# highlight a line in the Macro file display
3651proc MacroHighlightText {txt line} {
3652    $txt tag delete next
3653    $txt tag add next $line.0 $line.end
3654    $txt see $line.0
3655    $txt tag configure next -background yellow
3656    # tag all text
3657    $txt tag delete all
3658    $txt tag add all 0.0 end
3659    # double-click moves the current line
3660    $txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
3661}
3662
3663# respond to a double click by moving the next line to be executed to
3664# the line where the double click occurred
3665proc MacroDoubleClick {txt} {
3666    set line [lindex [split [$txt tag ranges sel] "."] 0]
3667    MacroHighlightText $txt $line
3668}
3669
3670# respond to Execute button: execute the current line
3671# close window after last command
3672proc MacroExecuteCurrentLine {txt} {
3673    global expgui
3674    set linenum [lindex [split [$txt tag ranges next] "."] 0]
3675    if {$linenum == ""} {return}
3676    set line [$txt get $linenum.0 $linenum.end]
3677    # is this continued (ends with \)?
3678    while {[string range $line end end] == "\\" } {
3679        incr linenum
3680        # get rid of trailing backslash
3681        set line [string range $line 0 end-1]
3682        #append next line
3683        append line [$txt get $linenum.0 $linenum.end]
3684    }
3685     if {[catch $line errmsg]} {
3686        MyMessageBox -parent $txt -title "Error on line" \
3687            -message "Error on line $linenum:\n$errmsg" \
3688            -icon warning -type Continue -default continue
3689    }
3690    # show changes
3691    PaintEXPGUIpages
3692    # move forward in macrofile
3693    incr linenum
3694    MacroHighlightText $txt $linenum
3695    set linenum [lindex [split [$txt tag ranges next] "."] 0]
3696    # at end?
3697    if {$linenum == ""} {MacroCloseWindow $txt}
3698}
3699
3700# Save a modified macro file
3701proc MacroResave {txt} {
3702    global expgui
3703    set MacroFile [tk_getSaveFile -initialdir [pwd] \
3704                       -parent $txt \
3705                       -filetypes {{"EXPGUI Macro file" .expmac}} \
3706                       -defaultextension .expmac  \
3707                       -initialfile $expgui(MacroFile) \
3708                       -title "Choose location to save macro"]
3709    if {[string trim $MacroFile] == ""} {return}
3710    if {[catch {
3711        set fp [open $MacroFile w]
3712        puts $fp [string trim [$txt get 0.0 end]]
3713        close $fp
3714    } errmsg]} {
3715        MyMessageBox -parent $txt -title "Error writing to file" \
3716            -message "Error writing macro file:\n$errmsg" \
3717            -icon warning -type TryAgain -default tryagain
3718        return
3719    }
3720    set expgui(MacroChanged) 0
3721    # gray out the button
3722    $expgui(MacroSaveButton) configure -state disabled
3723}
3724
3725# close the window, but provide a chance to save the file first, if modified
3726proc MacroCloseWindow {txt} {
3727    global expgui
3728    if {$expgui(MacroChanged)} {
3729
3730        set ans [MyMessageBox -parent $txt -title "Save macro file?" \
3731                     -message "Macro file has been changed, do you want to save it?" \
3732                     -icon warning -type "Yes No" -default no]
3733        if {$ans != "no"} {MacroResave $txt}
3734    }
3735    set expgui(MacroRunning) 0
3736    destroy [winfo toplevel $txt]
3737}
3738
3739# Add a comment to a macro file
3740proc AddCommentMacroFile {} {
3741    global expgui
3742    if {! $expgui(RecordMacro)} return
3743    RecordMacroEntry "# [getstring "comment for macro file"]" 0
3744}
3745
3746#------------------------------------------------------------------------------
3747# Subversion support routines
3748#------------------------------------------------------------------------------
3749
3750proc GetSVNVersion {scriptdir} {
3751    if {[CheckSVNinstalled]} {
3752        set SVN [auto_execok svn]
3753        if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} {
3754            set infolist [split $res]
3755            set pos [lsearch $infolist "Revision:"]
3756            return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]"
3757        }
3758    }
3759    return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])"
3760}
3761
3762# can we find the svn program?
3763proc CheckSVNinstalled {} {
3764    # can we find svn in the path?
3765    if {[auto_execok svn] != ""} {return 1}
3766    # add a locally supplied svn version and add to path
3767    if {$::tcl_platform(platform) == "windows"} {
3768        set s [file attributes $::expgui(gsasdir) -shortname]
3769    } else {
3770        set s $::expgui(gsasdir) 
3771    }
3772    # look for svn
3773    set localsvn [file join $s svn bin]
3774    if {[file exists $localsvn]} {
3775        if {$::tcl_platform(platform) == "windows"} {
3776            set localsvn [file nativename $localsvn]
3777            set sep {;}
3778        } else {
3779            set sep {:}
3780        }
3781        if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
3782            append ::env(PATH) $sep $localsvn
3783            # note that auto_reset breaks the tkcon package in Windows -- not sure why
3784            auto_reset
3785        }
3786    }
3787    if {[auto_execok svn] != ""} {return 1}
3788    return 0
3789}
3790
3791proc CheckAndDoUpdate { } {
3792    if [file exists [file join $::expgui(gsasdir) proxyinfo.txt]] {
3793        set fp [open [file join $::expgui(gsasdir) proxyinfo.txt]]
3794        gets $fp proxaddr
3795        gets $fp proxport
3796        set proxy "--config-option servers:global:http-proxy-host=$proxaddr"
3797        set proxp "--config-option servers:global:http-proxy-port=$proxport"
3798        close $fp
3799    } else {
3800        set proxy {}
3801        set proxp {}
3802    }
3803    pleasewait "... Checking with software repository..."
3804    if {! [CheckSVNinstalled]} {
3805        donewait
3806        MyMessageBox -parent . -title "SVN not found" \
3807            -message "Unable to upgrade: Could not locate a copy of the subversion program. It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
3808            -icon error
3809        return
3810    }
3811    #is there a svn directory in the source?
3812    if {! [file exists [file join $::expgui(gsasdir)  .svn]]} {
3813        donewait
3814        MyMessageBox -parent . -title "No .svn directory" \
3815            -message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
3816            -icon error
3817        return
3818    }
3819    # check for updates
3820    set SVN [auto_execok svn]
3821    if [catch {set res \
3822                   [eval exec $SVN status [list $::expgui(gsasdir)] -u $proxy $proxp] \
3823               } err] {
3824        donewait
3825        set ans [MyMessageBox -parent . -title "Error checking status" \
3826                     -message "Error checking for updates: $err\n\nTry to update manually?" \
3827                     -icon error -type "Yes No" -default yes]
3828        if {$ans != "no"} {
3829            forknewterm "manually update in subversion" \
3830                " \"$SVN update [file normalize $::expgui(gsasdir)] $proxy $proxp\""
3831            forknewterm "manually update in subversion" \
3832                " \"$SVN update [file normalize $::expgui(scriptdir)] $proxy $proxp\""
3833        }
3834        return
3835     } else {
3836        if {[string first "*" $res] == -1} {
3837            catch {set res \
3838                       [eval exec $SVN status [list $::expgui(scriptdir)] -u $proxy $proxp]\
3839                   } err
3840        }
3841        if {[string first "*" $res] == -1} {
3842            donewait
3843            MyMessageBox -parent . -title "No updates" \
3844                -message "GSAS & EXPGUI appear up-to-date" \
3845                -icon info
3846            return
3847        }
3848    }
3849    set msg {
3850Updates to GSAS/EXPGUI found on server.
3851                 
3852Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.}
3853    if {$proxy != "" || $proxp != ""} {
3854        append msg "\nUsing proxy settings \"$proxy\" and \"$proxp\""
3855    }
3856    donewait
3857    if {[MyMessageBox -parent . -title "Ready to Update" \
3858             -message $msg \
3859             -type {Cancel "Update & Restart"} -default cancel -icon warning
3860        ] == "cancel"} {return}
3861
3862    if {[confirmBeforeSave] == "Cancel"} return
3863
3864    # special upgrade for windows, where the wish exec blocks upgrade of the exe directory
3865    if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
3866        set fp [open [file join $::expgui(gsasdir) selfupdate.bat] w]
3867        puts $fp {@REM this script must be run from the GSAS installation directory
3868@REM This is run to update the installation, the name of the EXP file is
3869@REM expected as an argument
3870@echo ****************************
3871@echo Press return to start update
3872@echo ****************************
3873@pause
3874.\svn\bin\svn cleanup .
3875}
3876        puts $fp ".\\svn\\bin\\svn update . $proxy $proxp"
3877        puts $fp ".\\svn\\bin\\svn cleanup $::expgui(scriptdir)"
3878        puts $fp ".\\svn\\bin\\svn update $::expgui(scriptdir) $proxy $proxp"
3879        puts $fp {@if (%1)==() goto Install2
3880@echo ****************************************************
3881@echo Update has completed. Press return to restart EXPGUI
3882@echo ****************************************************
3883@pause
3884%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1"
3885exit
3886:Install2
3887@echo ****************************************************
3888@echo Update has completed. EXPGUI starting w/o .EXP file
3889@echo ****************************************************
3890@pause
3891%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui"
3892exit
3893        }
3894        close $fp
3895        # split the directory and EXP file and get rid os spaces in the directory name
3896        set exp [file normalize $::expgui(expfile)]
3897        set dir [file attributes [file dirname $exp] -shortname]
3898        cd $::expgui(gsasdir)
3899        #run the batch file
3900        exec $::env(COMSPEC) /c "start .\\selfupdate.bat [file join $dir [file tail $exp]]" &
3901        exit
3902    }
3903
3904    # do a quiet cleanup. Sometimes needed after install, and never hurts
3905    if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] {
3906        MyMessageBox -parent . -title "Error in cleanup" \
3907            -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3908            -icon error
3909    }
3910    # do a quiet cleanup. Sometimes needed after install, and never hurts
3911    if [catch {set res [eval exec $SVN cleanup [list $::expgui(scriptdir)]]} err] {
3912        MyMessageBox -parent . -title "Error in cleanup" \
3913            -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3914            -icon error
3915    }
3916    if [catch {set res [exec $SVN up $::expgui(gsasdir) $proxy $proxp]} err] {
3917        MyMessageBox -parent . -title "Error updating" \
3918            -message "Error performing update:\n$err" \
3919            -icon error
3920        return
3921    } elseif [catch {set res [exec $SVN up $::expgui(scriptdir) $proxy $proxp]} err] {
3922        MyMessageBox -parent . -title "Error updating" \
3923            -message "Error performing scriptdir update:\n$err" \
3924            -icon error
3925        return
3926    } else {
3927        MyMessageBox -parent . -title "Updating done" \
3928            -message "Results from update:\n$res\n\nPress OK to restart EXPGUI" \
3929            -icon info
3930    }
3931    exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
3932    exit
3933}
3934
3935# Fourier routines
3936proc EditFourier {phase} {
3937    #is this a valid phase #?
3938    if {[lsearch $::expmap(phaselist) $phase] == -1} return
3939    # check that all Fourier records are set to the current phase
3940    foreach i [listFourier] {
3941        set ph [Fourierinfo $i phase]
3942        if {$ph != $phase} {Fourierinfo $i phase set $phase}
3943    }
3944    # for now we will not offer access to section, (dmin, dmax not supported)
3945    set typelist {}
3946    foreach i [listFourier] {
3947        lappend typelist [Fourierinfo $i type]
3948    }
3949    set histlist [FourierHists $phase]
3950    set limits  [getFourierLimits $phase]
3951    if {[winfo exists .export]} {
3952        set box .export.fourier
3953    } else {
3954        set box .fourier
3955    }
3956    catch {destroy $box}
3957    toplevel $box
3958    wm title $box "Set Fourier Options, phase $phase"
3959    grid [frame $box.1] -row 1 -column 1 -rowspan 10
3960    grid [frame $box.2] -row 1 -column 2 -rowspan 10
3961    grid [frame $box.b] -sticky news -row 11 -column 1 -columnspan 2
3962    grid columnconfigure $box.b 0 -weight 1
3963    grid columnconfigure $box.b 3 -weight 1
3964    grid [button $box.b.1 -text Continue \
3965              -command "set ::DXTL(quit) 0; destroy $box" \
3966             ] -row 1 -column 1
3967    grid [button $box.b.2 -text Quit \
3968              -command "set ::DXTL(quit) 1; destroy $box" \
3969             ] -row 1 -column 2
3970   
3971    # map type selection
3972    set row 0
3973    grid [label $box.1.$row -text "Select map type(s)"] -column 1 -row $row
3974    foreach typ {DELF FCLC FOBS 2FDF 3FDF 4FDF PTSN DPTS} lbl {
3975        "Difference Fourier" "Fcalc Fourier" "Fobs Fourier" 
3976        "2*Fo-Fc Fourier" "3*Fo-2*Fc Fourier" "4*Fo-3*Fc Fourier" "Patterson map" "Delta-F Patterson"\
3977        } {
3978            incr row
3979            grid [ \
3980                       checkbutton $box.1.$row -variable ::DXTL($typ) \
3981                       -text "$lbl ($typ)" \
3982                      ] -column 1 -row $row -sticky w
3983            if {[lsearch $typelist $typ] == -1} {
3984                set ::DXTL($typ) 0
3985            } else {
3986                set ::DXTL($typ) 1
3987            }
3988        }
3989    grid [label $box.2.a1 -text "Histogram(s) to be used:\n(last superceeds)"] -column 1 -row 1
3990    grid [label $box.2.a2 -textvariable ::DXTL(histlist) -width 20] -column 2 -row 1 -columnspan 2
3991    grid [button $box.2.a3 -text Set \
3992              -command "SetFourierHists $box"] -column 5 -row 1
3993    set ::DXTL(histlist) {}
3994    foreach i $histlist {
3995        if {$::DXTL(histlist) != ""} {append ::DXTL(histlist) ", "}
3996        append ::DXTL(histlist) $i
3997    }
3998    grid [label $box.2.m1 -text min] -column 2 -row 2
3999    grid [label $box.2.m2 -text max] -column 3 -row 2
4000    grid [label $box.2.m3 -text "map step\n(A)"] -column 4 -row 2
4001    set row 3
4002    foreach axis {X Y Z} lim [lrange $limits 1 end] step [lindex $limits 0] {
4003        incr row
4004        grid [label $box.2.0$axis -text "$axis limits"] -column 1 -row $row -sticky e
4005        grid [entry $box.2.min$axis -width 10 -textvariable ::DXTL(min$axis)] -column 2 -row $row
4006        grid [entry $box.2.max$axis -width 10 -textvariable ::DXTL(max$axis)] -column 3 -row $row
4007        grid [entry $box.2.step$axis -width 10 -textvariable ::DXTL(step$axis)] -column 4 -row $row
4008        set ::DXTL(min$axis) [lindex $lim 0]
4009        set ::DXTL(max$axis) [lindex $lim 1]
4010        set ::DXTL(step$axis) [format "%.4f" [expr {$step + 0.0001}]]
4011    }
4012    putontop $box
4013    tkwait window $box
4014    afterputontop
4015    if $::DXTL(quit) return
4016    delFourier
4017    foreach typ {DELF FCLC FOBS 2FDF 3FDF 4FDF PTSN DPTS} {
4018        if {$::DXTL($typ)} {
4019            addFourier $phase $typ
4020        }
4021    }
4022    if {$::DXTL(histlist) != "<none>"} {
4023        FourierHists $phase set [regsub -all "," $::DXTL(histlist) " "]
4024    }
4025    setFourierLimits $phase \
4026        [list $::DXTL(stepX) $::DXTL(stepY) $::DXTL(stepZ)] \
4027        [list $::DXTL(minX) $::DXTL(maxX)] \
4028        [list $::DXTL(minY) $::DXTL(maxY)] \
4029        [list $::DXTL(minZ) $::DXTL(maxZ)]
4030    incr ::expgui(changed)
4031}
4032
4033proc SetFourierHists {top} {
4034    set box $top.hstsel
4035    set ::DXTL(histbox) $box
4036    catch {destroy $box}
4037    toplevel $box
4038    wm title $box "Select Histograms"
4039    grid [frame $box.1 -class HistList] -column 1 -row 1 -sticky news
4040    grid columnconfigure $box 1 -weight 1
4041    grid [frame $box.2] -column 2 -row 1
4042    grid [label $box.2.a -text {Select a histogram from the box
4043to the left to add it to the
4044histogram list below
4045
4046(note that reflection intensities
4047from the last histograms in list
4048override earlier ones)
4049
4050Histogram List:}] \
4051    -column 1 -row 1
4052    grid [label $box.2.b -textvariable ::DXTL(histlist)] -column 1 -row 2
4053    grid [button $box.2.c -text Clear -command ClearFourierHist] \
4054        -column 1 -row 3
4055    grid [button $box.3 -text Close -command "destroy $box"] \
4056        -column 1 -row 3 -columnspan 2
4057    MakeHistBox $box.1
4058    bind $box.1.lbox <ButtonRelease-1>  {
4059        set selhist [$::DXTL(histbox).1.lbox curselection]
4060        if {[llength $selhist] != 1} return
4061        AddFourierHist [lindex $::expmap(powderlist) $selhist]
4062        lappend ::DXTL(histlist)
4063        set hist [lindex $::expmap(powderlist) $selhist]
4064        $::DXTL(histbox).2.b config -text $hist
4065    }
4066    sethistlist
4067    putontop $box
4068    tkwait window $box
4069    afterputontop
4070}
4071
4072proc AddFourierHist {num} {
4073    if {$::DXTL(histlist) == "<none>"} {
4074        set ::DXTL(histlist) {}
4075    }
4076    if {$::DXTL(histlist) != ""} {append ::DXTL(histlist) ", "}
4077    append ::DXTL(histlist) $num
4078}
4079
4080proc ClearFourierHist {} {
4081    set ::DXTL(histlist) "<none>"
4082}
Note: See TracBrowser for help on using the repository browser.