source: trunk/gsascmds.tcl @ 1025

Last change on this file since 1025 was 1025, checked in by toby, 10 years ago

see https://subversion.xor.aps.anl.gov/trac/EXPGUI/wiki/News20101013

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