source: trunk/gsascmds.tcl @ 995

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

more space in dir changes

  • Property svn:keywords set to Author Date Revision Id
File size: 114.3 KB
Line 
1# $Id: gsascmds.tcl 995 2010-08-18 23:05:07Z 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    if {$expgui(disaglSeparateBox)} {
1520        set root [file root $expgui(expfile)] 
1521        catch {file delete -force $root.tmp}
1522        if {[catch {file rename -force $root.LST $root.OLS}]} {
1523            file copy -force $root.LST $root.OLS
1524            file delete -force $root.OLS
1525        }
1526        # PSW reports this does not happen right away on windows
1527        set i 0
1528        while {$i < 10 && [file exists $root.LST]} {
1529            # debug code
1530            #catch {console show}
1531            #puts "try $i"
1532            # end debug code
1533            after 100
1534            incr i
1535        }
1536        if {[file exists $root.LST]} {
1537            # it was not possible to rename the file
1538            MyMessageBox -parent . -title "Rename Problem" \
1539                -message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
1540                -icon warning -helplink "expguierr.html NoRename"
1541            return
1542        }
1543
1544        #run the program
1545        pleasewait "Running DISAGL"     
1546        # create an empty input file
1547        close [open disagl.inp w]
1548        catch {exec [file join $expgui(gsasexe) disagl] \
1549                [file tail $root] < disagl.inp > disagl.out}
1550        if {[catch {file rename -force $root.LST $root.tmp}]} {
1551            file copy -force $root.LST $root.tmp
1552            file delete -force $root.LST
1553        }
1554        catch {file delete -force disagl.inp disagl.out}
1555        if {[catch {file rename -force $root.OLS $root.LST}]} {
1556            file copy -force $root.OLS $root.LST
1557            file delete -force $root.OLS
1558        }
1559        donewait
1560        # open a new window
1561        catch {toplevel .disagl}
1562        eval destroy [winfo child .disagl]
1563        set txt .disagl.txt
1564        catch {eval grid forget [grid slaves .disagl]}
1565        text $txt -width 100 -wrap none \
1566                -yscrollcommand ".disagl.yscroll set" \
1567                -xscrollcommand ".disagl.xscroll set" 
1568        scrollbar .disagl.yscroll -command "$txt yview"
1569        scrollbar .disagl.xscroll -command "$txt xview" -orient horizontal
1570        grid .disagl.xscroll -column 0 -row 2 -sticky ew
1571        grid $txt -column 0 -row 1 -sticky nsew
1572        grid .disagl.yscroll -column 1 -row 1 -sticky ns
1573        grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
1574        grid columnconfig .disagl.f 2 -weight 1
1575        grid [button .disagl.f.close -text "Close & Delete" \
1576                -command "destroy .disagl; file delete $root.tmp"] \
1577                -column 3 -row 0 -sticky e
1578        grid [button .disagl.f.rename \
1579                -command "RenameAsFile $root.tmp $root.DIS .disagl" \
1580                -text "Close & Save as..."] \
1581                -column 4 -row 0 -sticky e
1582        # allow font changes on the fly
1583        if {$tcl_version >= 8.0} {
1584            $txt config -font $txtvw(font)
1585            set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
1586            grid .disagl.f.font -column 1 -row 0 -sticky w
1587            grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
1588            $fontbut delete 0 end
1589            foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
1590                $fontbut add command -label "Courier $f" -font "Courier $f"\
1591                        -command "set txtvw(font) \"Courier $f\"; \
1592                        $txt config -font \$txtvw(font)"
1593            }
1594        }
1595       
1596        grid columnconfigure .disagl 0 -weight 1
1597        grid rowconfigure .disagl 1 -weight 1
1598        wm title .disagl "DISAGL results $expgui(expfile)"
1599        wm iconname .disagl "DISAGL $root"
1600        set in [open $root.tmp r]
1601        $txt insert end [read $in]
1602        close $in
1603        bind all  {destroy .disagl}
1604        bind .disagl  "$txt yview scroll -1 page"
1605        bind .disagl  "$txt yview scroll 1 page"
1606        bind .disagl  "$txt xview scroll 1 unit"
1607        bind .disagl  "$txt xview scroll -1 unit"
1608        bind .disagl  "$txt yview scroll -1 unit"
1609        bind .disagl  "$txt yview scroll 1 unit"
1610        bind .disagl  "$txt yview 0"
1611        bind .disagl  "$txt yview end"
1612        # don't disable in Win as this prevents the highlighting of selected text
1613        if {$tcl_platform(platform) != "windows"} {
1614            $txt config -state disabled
1615        }
1616        # find the beginning of the disagl text
1617
1618        set pos 1.0
1619        set nph 0
1620        while {[set loc [$txt search "Program DISAGL Version" $pos end]] != ""} {
1621            set pos [expr {$loc + 1}]
1622            incr nph
1623        }
1624        #puts "Found $nph DISAGL run(s)"
1625        # count phases
1626        set l {}
1627        while {[set loc [$txt search "Lattice constants are" $pos end]] != ""} {
1628            lappend l $loc
1629            set pos [expr {$loc + 1}]
1630}
1631        catch {unset phaseloc}
1632       
1633        set j 0
1634        foreach pos $l {
1635            if {$j == 0} {
1636                set prev $pos
1637                incr j
1638                continue
1639            }
1640            set phaseloc($j) [list $prev $pos]
1641            incr j
1642        }
1643        set phaseloc($j) [list $pos end]
1644        if {$nph >= 1 && $j >= 2} {
1645            grid [menubutton .disagl.f.copy \
1646                      -menu .disagl.f.copy.menu \
1647                      -text "Copy phase..." -bd 2 -relief raised] \
1648                -column 2 -row 0 -sticky nse
1649            menu .disagl.f.copy.menu
1650            for {set i 1} {$i <= $j} {incr i} {
1651                .disagl.f.copy.menu add command \
1652                    -command "seldisaglphase $txt [list $phaseloc($i)]" \
1653                    -label "Copy phase $i to clipboard"
1654            }
1655        } elseif {$nph >= 1} {
1656            grid [button .disagl.f.copy \
1657                      -command "seldisaglphase $txt [list $phaseloc($j)]" \
1658                -text "Copy phase $j to clipboard"] \
1659                -column 2 -row 0 -sticky e
1660        }
1661    } else {
1662        runGSASwEXP disagl
1663    }
1664}
1665
1666proc seldisaglphase {txt phaselist} {
1667    # clear selection
1668    $txt tag remove sel 1.1 end
1669    eval $txt tag add sel $phaselist
1670    clipboard clear
1671    clipboard append "               |         Program DISAGL Version MacOSX        |\n"
1672    clipboard append [eval $txt get [$txt tag ranges sel]]
1673} 
1674#------------------------------------------------------------------------------
1675# file conversions
1676#------------------------------------------------------------------------------
1677proc convfile {} {
1678    global expgui
1679    set frm .file
1680    catch {destroy $frm}
1681    toplevel $frm
1682    wm title $frm "Convert File"
1683    bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
1684    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1685    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
1686            -side left -fill y -expand yes
1687    pack [button $frmC.help -text Help -bg yellow \
1688            -command "MakeWWWHelp expgui.html ConvertWin"] -side top
1689    pack [button $frmC.q -text Cancel -command "destroy $frm"] -side bottom
1690    pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
1691            -side bottom
1692    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
1693    winfilebox $frm
1694    bind $frm <Return> "ValidWinCnv $frm"
1695
1696    # force the window to stay on top
1697    putontop $frm
1698    focus $frmC.q 
1699    tkwait window $frm
1700    afterputontop
1701}
1702
1703# validate the files and make the conversion
1704proc ValidWinCnv {frm} {
1705    global expgui
1706    # change backslashes to something sensible
1707    regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
1708    # allow entry of D: for D:/ and D:TEST for d:/TEST
1709    if {[string first : $expgui(FileMenuCnvName)] != -1 && \
1710            [string first :/ $expgui(FileMenuCnvName)] == -1} {
1711        regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
1712    }
1713    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1714        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1715        ChooseWinCnv $frm
1716        return
1717    } elseif [file isdirectory \
1718            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
1719        if {$expgui(FileMenuCnvName) != "."} {
1720            set expgui(FileMenuDir) \
1721                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1722        }
1723        ChooseWinCnv $frm
1724        return
1725    }
1726 
1727    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1728    if ![file exists $file] {
1729        MyMessageBox -parent $frm -title "Convert Error" \
1730                -message "File $file does not exist" -icon error
1731        return
1732    }
1733
1734    set tmpname "[file join [file dirname $file] tempfile.xxx]"
1735    set oldname "[file rootname $file].org"
1736    if [file exists $oldname] {
1737        set ans [MyMessageBox -parent . -title "Overwrite?" \
1738                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
1739                -icon warning -type {Overwrite Cancel} -default Overwrite \
1740                -helplink "expguierr.html OverwriteCnv"]
1741        if {[string tolower $ans] == "cancel"} return
1742        catch {file delete $oldname}
1743    }
1744
1745    if [catch {
1746        set in [open $file r]
1747        set out [open $tmpname w]
1748        fconfigure $out -translation crlf -encoding ascii
1749        set len [gets $in line]
1750        if {$len > 160} {
1751            # this is a UNIX file. Hope there are no control characters
1752            set i 0
1753            set j 79
1754            while {$j < $len} {
1755                puts $out [string range $line $i $j]
1756                incr i 80
1757                incr j 80
1758            }
1759        } else {
1760            while {$len >= 0} {
1761                append line "                                        "
1762                append line "                                        "
1763                set line [string range $line 0 79]
1764                puts $out $line
1765                set len [gets $in line]
1766            }
1767        }
1768        close $in
1769        close $out
1770        file rename -force $file $oldname
1771        file rename -force $tmpname $file
1772    } errmsg] {
1773        MyMessageBox -parent $frm -title "Conversion error" \
1774                -message "Error in conversion:\n$errmsg" -icon warning
1775    } else {
1776        set ans [MyMessageBox -parent $frm -title "More?" \
1777                -message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
1778                -type yesno -default no]
1779        if {$ans == "no"} {destroy $frm}
1780    }
1781}
1782
1783# create a file box
1784proc winfilebox {frm} {
1785    global expgui
1786    set bx $frm.1
1787    pack [frame $bx.top] -side top
1788    pack [label $bx.top.a -text "Directory" ] -side left
1789    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1790    pack $bx.top.d -side left
1791    set expgui(FileMenuDir) [pwd]
1792    # the icon below is from tk8.0/tkfbox.tcl
1793    set upfolder [image create bitmap -data {
1794#define updir_width 28
1795#define updir_height 16
1796static char updir_bits[] = {
1797   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1798   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1799   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1800   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1801   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1802   0xf0, 0xff, 0xff, 0x01};}]
1803
1804    pack [button $bx.top.b -image $upfolder \
1805            -command "updir; ChooseWinCnv $frm" ]
1806    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1807    listbox $bx.a.files -relief raised -bd 2 \
1808            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1809            -height 15 -width 0 -exportselection 0 
1810    listbox $bx.a.dates -relief raised -bd 2 \
1811            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1812            -height 15 -width 0 -takefocus 0 -exportselection 0 
1813    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1814    ChooseWinCnv $frm
1815    bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
1816    bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
1817    bind $bx.a.files <Double-1> "SelectWinCnv $frm"
1818    bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
1819    pack $bx.a.scroll -side left -fill y
1820    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1821    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
1822}
1823
1824# set the box or file in the selection window
1825proc ReleaseWinCnv {frm} {
1826    global expgui
1827    set files $frm.1.a.files
1828    set dates $frm.1.a.dates
1829    set select [$files curselection]
1830    if {$select == ""} {
1831        set select [$dates curselection]
1832    }
1833    if {$select == ""} {
1834        set expgui(FileMenuCnvName) ""
1835    } else {
1836        set expgui(FileMenuCnvName) [string trim [$files get $select]]
1837    }
1838    if {$expgui(FileMenuCnvName) == "<Parent>"} {
1839        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1840        ChooseWinCnv $frm
1841    } elseif [file isdirectory \
1842            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
1843        if {$expgui(FileMenuCnvName) != "."} {
1844            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1845            ChooseWinCnv $frm
1846        }
1847    }
1848    return
1849}
1850
1851# select a file or directory -- called on double click
1852proc SelectWinCnv {frm} {
1853    global expgui
1854    set files $frm.1.a.files
1855    set dates $frm.1.a.dates
1856    set select [$files curselection]
1857    if {$select == ""} {
1858        set select [$dates curselection]
1859    }
1860    if {$select == ""} {
1861        set file .
1862    } else {
1863        set file [string trim [$files get $select]]
1864    }
1865    if {$file == "<Parent>"} {
1866        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1867        ChooseWinCnv $frm
1868    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1869        if {$file != "."} {
1870            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1871            ChooseWinCnv $frm
1872        }
1873    } else {
1874        set expgui(FileMenuCnvName) [file tail $file]
1875        ValidWinCnv $frm
1876    }
1877}
1878
1879# fill the files & dates & Directory selection box with current directory,
1880# also called when box is created to fill it
1881proc ChooseWinCnv {frm} {
1882    global expgui
1883    set files $frm.1.a.files
1884    set dates $frm.1.a.dates
1885    set expgui(FileMenuCnvName) {}
1886    $files delete 0 end
1887    $dates delete 0 end
1888    $files insert end {<Parent>}
1889    $dates insert end {(Directory)}
1890    set filelist [glob -nocomplain \
1891            [file join [set expgui(FileMenuDir)] *] ]
1892    foreach file [lsort -dictionary $filelist] {
1893        if {[file isdirectory $file]} {
1894            $files insert end [file tail $file]
1895            $dates insert end {(Directory)}
1896        }
1897    }
1898    foreach file [lsort -dictionary $filelist] {
1899        if {![file isdirectory $file]} {
1900            set modified [clock format [file mtime $file] -format "%T %D"]
1901            $files insert end [file tail $file]
1902            $dates insert end $modified
1903        }
1904    }
1905    $expgui(FileDirButtonMenu)  delete 0 end
1906    set list ""
1907    global tcl_version
1908    if {$tcl_version > 8.0} {
1909        catch {set list [string tolower [file volume]]}
1910    }
1911    set dir ""
1912    foreach subdir [file split [set expgui(FileMenuDir)]] {
1913        set dir [string tolower [file join $dir $subdir]]
1914        if {[lsearch $list $dir] == -1} {lappend list $dir}
1915    }
1916    foreach path $list {
1917        $expgui(FileDirButtonMenu) add command -label $path \
1918                -command "[list set expgui(FileMenuDir) $path]; \
1919                ChooseWinCnv $frm"
1920    }
1921    return
1922}
1923
1924#------------------------------------------------------------------------------
1925# set options for liveplot
1926proc liveplotopt {} {
1927    global liveplot expmap
1928    set frm .file
1929    catch {destroy $frm}
1930    toplevel $frm
1931    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1932    set last [lindex [lsort -integer $expmap(powderlist)] end]
1933    if {$last == ""} {set last 1}
1934    pack [scale  $frmA.1 -label "Histogram number" -from 1 -to $last \
1935            -length  150 -orient horizontal -variable liveplot(hst)] -side top
1936    pack [checkbutton $frmA.2 -text {include plot legend}\
1937            -variable liveplot(legend)] -side top
1938    pack [button $frm.2 -text OK \
1939            -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
1940            ] -side top
1941    bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
1942   
1943    # force the window to stay on top
1944    putontop $frm 
1945    focus $frm.2
1946    tkwait window $frm
1947    afterputontop
1948}
1949
1950#------------------------------------------------------------------------------
1951# get an experiment file name
1952#------------------------------------------------------------------------------
1953proc getExpFileName {mode} {
1954    global expgui tcl_platform
1955    set frm .file
1956    catch {destroy $frm}
1957    toplevel $frm
1958    wm title $frm "Experiment file"
1959    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
1960    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1961    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
1962            -fill y -expand yes
1963    pack [button $frmC.help -text Help -bg yellow \
1964            -command "MakeWWWHelp expguierr.html open"] \
1965            -side top -anchor e
1966    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
1967    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
1968            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1969    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
1970            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1971
1972    set expgui(includearchived) 0
1973    set expgui(FileInfoBox) $frmC.info
1974    if {$mode == "old"} {
1975        pack [checkbutton $frmC.ar -text "Include Archived Files" \
1976                -variable expgui(includearchived) \
1977                -command "ChooseExpFil $frmA"] -side top -pady 10
1978        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
1979                -class SmallFont] \
1980                -side top -fill both -expand yes -pady 5
1981    } elseif {$mode != "new"} {
1982        # for initial read, don't access archived files
1983        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
1984                -class SmallFont] \
1985                -side top -fill both -expand yes -pady 5
1986        set mode "old"
1987    }
1988    pack [button $frmC.b -text Read \
1989            -command "valid_exp_file $frmA $mode"] -side bottom
1990    if {$mode == "new"} {
1991        $frmC.b config -text Save
1992    }
1993    pack [button $frmC.q -text Cancel \
1994            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
1995    bind $frm <Return> "$frmC.b invoke"
1996
1997    if {$mode == "new"} {
1998        pack [label $frmA.0 -text "Enter an experiment file to create"] \
1999                -side top -anchor center
2000    } else {
2001        pack [label $frmA.0 -text "Select an experiment file to read"] \
2002                -side top -anchor center
2003    }
2004    expfilebox $frmA $mode
2005    # force the window to stay on top
2006    putontop $frm
2007    focus $frmC.b
2008    tkwait window $frm
2009    afterputontop
2010    if {$expgui(FileMenuEXPNAM) == ""} return
2011    # is there a space in the EXP name?
2012    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
2013        update
2014        MyMessageBox -parent . -title "File Name Error" \
2015            -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
2016            -icon warning -type Continue -default continue
2017#               -helplink "expguierr.html OpenErr"
2018        return
2019    }
2020    if {[string first " " $expgui(FileMenuDir)] != -1} {
2021        update
2022        MyMessageBox -parent . -title "Good luck..." \
2023            -message "You are using a directory with a space in the name ([file dirname $expgui(FileMenuDir)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \
2024            -icon warning -type Continue -default continue
2025#               -helplink "expguierr.html OpenErr"
2026    }
2027    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2028}
2029
2030# validation routine
2031proc valid_exp_file {frm mode} {
2032    global expgui tcl_platform
2033    # windows fixes
2034    if {$tcl_platform(platform) == "windows"} {
2035        # change backslashes to something sensible
2036        regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
2037        # allow entry of D: for D:/ and D:TEST for d:/TEST
2038        if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
2039                [string first :/ $expgui(FileMenuEXPNAM)] == -1} {
2040            regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
2041        }
2042    }
2043    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2044        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2045        ChooseExpFil $frm
2046        return
2047    } elseif [file isdirectory \
2048            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
2049        if {$expgui(FileMenuEXPNAM) != "."} {
2050            set expgui(FileMenuDir) \
2051                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2052        }
2053        ChooseExpFil $frm
2054        return
2055    }
2056    # append a .EXP if not present
2057    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
2058        append expgui(FileMenuEXPNAM) ".EXP"
2059    }
2060    # is there a space in the name?
2061    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
2062        MyMessageBox -parent . -title "File Name Error" \
2063                -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
2064                -icon warning -type Continue -default continue
2065#               -helplink "expguierr.html OpenErr"
2066        return
2067    }
2068    # check for archive files
2069    if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
2070            $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
2071        destroy .file
2072        return
2073    } elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
2074        # check for files that end in something other than .EXP .exp or .Exp...
2075        MyMessageBox -parent . -title "File Open Error" \
2076                -message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
2077                -icon error
2078        return
2079    }
2080    # check on the file status
2081    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2082    if {$mode == "new" && [file exists $file]} {
2083        set ans [
2084        MyMessageBox -parent . -title "File Open Error" \
2085                -message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
2086                -icon question -type {"Select other" "Overwrite"} -default "select other" \
2087                -helplink "expguierr.html OverwriteErr"
2088        ]
2089        if {[string tolower $ans] == "overwrite"} {destroy .file}
2090        return
2091    }
2092    # if file does not exist in case provided, set the name to all
2093    # upper case letters, since that is the best choice.
2094    # if it does exist, read from it as is. For UNIX we will force uppercase later.
2095    if {![file exists $file]} {
2096        set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
2097        set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2098    }
2099    if {$mode == "old" && ![file exists $file]} {
2100        set ans [
2101        MyMessageBox -parent . -title "File Open Error" \
2102                -message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
2103                -icon question -type {"Select other" "Create"} -default "select other" \
2104                -helplink "expguierr.html OpenErr"
2105        ]
2106        if {[string tolower $ans] == "create"} {destroy .file}
2107        return
2108    }
2109    destroy .file
2110}
2111
2112proc updir {} {
2113    global expgui
2114    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
2115}
2116
2117# create a file box
2118proc expfilebox {bx mode} {
2119    global expgui
2120    pack [frame $bx.top] -side top
2121    pack [label $bx.top.a -text "Directory" ] -side left
2122    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2123    pack $bx.top.d -side left
2124    set expgui(FileMenuDir) [pwd]
2125    # the icon below is from tk8.0/tkfbox.tcl
2126    set upfolder [image create bitmap -data {
2127#define updir_width 28
2128#define updir_height 16
2129static char updir_bits[] = {
2130   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
2131   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
2132   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
2133   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
2134   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
2135   0xf0, 0xff, 0xff, 0x01};}]
2136
2137    pack [button $bx.top.b -image $upfolder \
2138            -command "updir; ChooseExpFil $bx" ]
2139    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2140    listbox $bx.a.files -relief raised -bd 2 \
2141            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2142            -height 15 -width 0 -exportselection 0 
2143    listbox $bx.a.dates -relief raised -bd 2 \
2144            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2145            -height 15 -width 0 -takefocus 0 -exportselection 0 
2146    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2147    ChooseExpFil $bx
2148    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2149    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2150    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
2151    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
2152    pack $bx.a.scroll -side left -fill y
2153    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2154    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2155}
2156proc sync2boxesX {master slave scroll args} {
2157    $slave xview moveto [lindex [$master xview] 0]
2158    eval $scroll set $args
2159}
2160proc move2boxesX {boxlist args} {
2161    foreach listbox $boxlist { 
2162        eval $listbox xview $args
2163    }
2164}
2165proc sync2boxesY {master slave scroll args} {
2166    $slave yview moveto [lindex [$master yview] 0]
2167    eval $scroll set $args
2168}
2169proc move2boxesY {boxlist args} {
2170    foreach listbox $boxlist { 
2171        eval $listbox yview $args
2172    }
2173}
2174
2175# creates a table that is scrollable in both x and y, use ResizeScrollTable
2176# to set sizes after gridding the boxes
2177proc MakeScrollTable {box} {
2178    grid [label $box.0] -column 0 -row 0
2179    grid [set tbox [canvas $box.top \
2180            -scrollregion {0 0 10 10} \
2181            -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
2182            -width 10 -height 10]] \
2183            -sticky sew -row 0 -column 1
2184    grid [set sbox [canvas $box.side \
2185            -scrollregion {0 0 10 10} \
2186            -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
2187            -width 10 -height 10]] \
2188            -sticky nes -row 1 -column 0
2189    grid [set bbox [canvas $box.can \
2190            -scrollregion {0 0 10 10} \
2191            -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
2192            -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
2193            -width 200 -height 200 -bg lightgrey]] \
2194            -sticky news -row 1 -column 1
2195    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
2196            -command "move2boxesX \" $box.can $box.top \" "]] \
2197            -sticky ew -row 2 -column 1
2198    grid [set sybox [scrollbar $box.yscroll \
2199            -command "move2boxesY \" $box.can $box.side \" "]] \
2200            -sticky ns -row 1 -column 2
2201    frame $tbox.f -bd 0
2202    $tbox create window 0 0 -anchor nw  -window $tbox.f
2203    frame $bbox.f -bd 2
2204    $bbox create window 0 0 -anchor nw  -window $bbox.f
2205    frame $sbox.f -bd 2 -relief raised
2206    $sbox create window 0 0 -anchor nw  -window $sbox.f
2207    grid columnconfig $box 1 -weight 1
2208    grid rowconfig $box 1 -weight 1
2209    return [list  $tbox.f  $bbox.f $sbox.f $box.0]
2210}
2211
2212proc ResizeScrollTable {box} {
2213    update idletasks
2214    for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
2215        set x1 [lindex [grid bbox $box.can.f $i 0] 2]
2216        set x2 [lindex [grid bbox $box.top.f $i 0] 2]
2217        if {$x2 > $x1} {set x1 $x2}
2218        grid columnconfigure $box.top.f $i -minsize $x1
2219        grid columnconfigure $box.can.f $i -minsize $x1
2220    }
2221    for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
2222        set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
2223        set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
2224        if {$x2 > $x1} {set x1 $x2}
2225        grid rowconfigure $box.can.f $i -minsize $x1
2226        grid rowconfigure $box.side.f $i -minsize $x1
2227    }
2228    update idletasks
2229    set sizes [grid bbox $box.can.f]
2230    $box.can config -scrollregion $sizes
2231    $box.side config -scrollregion $sizes
2232    $box.top config -scrollregion $sizes
2233    $box.top config -height [lindex [grid bbox $box.top.f] 3]
2234    $box.side config -width [lindex [grid bbox $box.side.f] 2]
2235}
2236proc ExpandScrollTable {box} {
2237    # set height & width of central box
2238    $box.can config -width \
2239            [expr [winfo width [winfo toplevel $box]] \
2240            - [winfo width $box.side] - [winfo width $box.yscroll]-20]
2241    $box.can config -height \
2242            [expr [winfo height [winfo toplevel $box]] \
2243            - [winfo height $box.top] - [winfo height $box.scroll]-25]
2244}
2245
2246
2247# support routine for SetHistUseFlags
2248proc InitHistUseFlags {} {
2249    global expmap expgui
2250    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2251#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2252            set expgui(useflag_$i) [histinfo $i use]
2253#       }
2254    }
2255}
2256
2257# show all Powder histograms; set use/do not use flags
2258proc SetHistUseFlags {} {
2259    set box .test
2260    catch {toplevel $box}
2261    eval destroy [winfo children $box]
2262    grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
2263    grid [frame $box.a] -row 1 -column 0 -columnspan 2
2264    grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
2265    grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
2266    grid columnconfig $box 0 -weight 1
2267    grid columnconfig $box 1 -weight 1
2268    foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
2269    $cbox config -text "Use\nFlag"
2270    [winfo parent $bbox] config -height 250 -width 400
2271    global expmap expgui
2272    set px 5
2273    set row -1
2274    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2275        if {[string range $expmap(htype_$i) 2 2] == "T"} {
2276            set det [format %8.2f [histinfo $i tofangle]]
2277        } elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
2278            set det [format %8.5f [histinfo $i lam1]]
2279        } elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
2280            set det [format %8.2f [histinfo $i lam1]]
2281        } else {
2282            set det {}
2283        }
2284        incr row
2285#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2286            grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0 
2287            set expgui(useflag_$i) [histinfo $i use]
2288#       }
2289        grid [label $bbox.0$i \
2290                -text [string range $expmap(htype_$i) 0 3] \
2291                ] -row $row -column 0 -padx $px
2292        grid [label $bbox.1$i -text [histinfo $i bank] \
2293                ] -row $row -column 1 -padx $px
2294        grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
2295        grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
2296                ] -row $row -column 3 -padx $px -sticky ew
2297    }
2298    grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
2299    grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
2300    grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
2301    grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
2302    ResizeScrollTable $box.a
2303    InitHistUseFlags
2304    putontop $box
2305    tkwait window $box
2306    afterputontop
2307    set prevchages $expgui(changed)
2308    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2309#       if {[string range $expmap(htype_$i) 0 0] == "P"} {
2310            if {$expgui(useflag_$i) != [histinfo $i use]} {
2311                histinfo $i use set $expgui(useflag_$i)
2312                RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
2313                incr expgui(changed)
2314                RecordMacroEntry "incr expgui(changed)" 0
2315            }
2316#       }
2317    }
2318    if {$prevchages != $expgui(changed)} {
2319        set msg "You have changed [expr $expgui(changed)-$prevchages] "
2320        append msg "histogram flag(s). You must run POWPREF "
2321        append msg "to include/remove these histograms. Do you want to "
2322        append msg "run POWPREF?"
2323        set ans [MyMessageBox -parent . -message $msg \
2324                -title "Process changes?"\
2325                -helplink "expguierr.html ProcessUse" \
2326                -default {Run POWPREF} \
2327                -type {{Run POWPREF} Skip}]
2328       
2329        if {$ans == "skip"} {
2330            # save and reload the experiment file
2331            savearchiveexp
2332            loadexp $expgui(expfile)
2333        } else {
2334            # run powpref and force a reload
2335            set saveautoload $expgui(autoexpload)
2336            set expgui(autoexpload) 1
2337            runGSASwEXP powpref
2338            set expgui(autoexpload) $saveautoload
2339        }
2340    }
2341}
2342
2343# set the box or file in the selection window
2344proc ReleaseExpFil {frm} {
2345    global expgui
2346    set files $frm.a.files
2347    set dates $frm.a.dates
2348    set select [$files curselection]
2349    if {$select == ""} {
2350        set select [$dates curselection]
2351    }
2352    if {$select == ""} {
2353        set expgui(FileMenuEXPNAM) ""
2354    } else {
2355        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
2356        after idle UpdateInfoBox
2357    }
2358    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2359        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
2360        ChooseExpFil $frm
2361    } elseif [file isdirectory \
2362            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
2363        if {$expgui(FileMenuEXPNAM) != "."} {
2364            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2365            ChooseExpFil $frm
2366        }
2367    }
2368    return
2369}
2370proc UpdateInfoBox {} {
2371    global expgui
2372    if {![winfo exists $expgui(FileInfoBox)]} return
2373    eval destroy [winfo children $expgui(FileInfoBox)]
2374    set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
2375    if [file isdirectory $file] return
2376    if [file exists $file] {
2377        pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
2378                -side top
2379        catch {
2380            set fp [open $file r]
2381            global testline
2382            set testline [read $fp]
2383            close $fp
2384            update
2385            regexp {GNLS  RUN on (.*) +Total.*run *([0-9]+) } \
2386                    $testline a last cycles
2387            pack [label $expgui(FileInfoBox).2 -justify left \
2388                    -text "last GENLES run:\n  $last\n  total cycles: $cycles"] \
2389                -side top -anchor w
2390            regexp {REFN GDNFT.*= *([0-9]*\.[0-9]*) +for *([0-9]+) variables} \
2391                    $testline a chi2 vars
2392            pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
2393                    -side top -anchor w
2394            pack [label $expgui(FileInfoBox).3.a -justify left \
2395                    -text "c" -font symbol] \
2396                    -side left -anchor w
2397            pack [label $expgui(FileInfoBox).3.b -justify left \
2398                    -text "2: $chi2, $vars vars"] \
2399                    -side top -anchor w
2400            # check first 9 histograms
2401            set lbl "h  Rwp     R(F2)"
2402            set n 0
2403            foreach k {1 2 3 4 5 6 7 8 9} {
2404                set key "HST  $k"
2405                append key { RPOWD +([0-9]*\.[0-9]*) }
2406                set i [regexp $key $testline a Rwp]
2407                set key "HST  $k"
2408                append key { R-FAC +[0-9]+ +([0-9]*\.[0-9]*) }
2409                set j [regexp $key $testline a Rb]
2410                if {$i || $j} {
2411                    incr n
2412                    append lbl "\n$k  "
2413                    if {$i} {
2414                        append lbl [string range $Rwp 0 5]
2415                    } else {
2416                        append lbl "    "
2417                    }
2418                }
2419                if {$j} {
2420                    append lbl " [string range $Rb 0 5]"
2421                }
2422                # stick 1st 3 entries in box
2423                if {$n >= 3} break
2424            }
2425            pack [label $expgui(FileInfoBox).4 -justify left \
2426                    -text $lbl] \
2427                    -side top -anchor w     
2428        }
2429    }
2430}
2431
2432# select a file or directory -- called on double click
2433proc SelectExpFil {frm mode} {
2434    global expgui
2435    set files $frm.a.files
2436    set dates $frm.a.dates
2437    set select [$files curselection]
2438    if {$select == ""} {
2439        set select [$dates curselection]
2440    }
2441    if {$select == ""} {
2442        set file .
2443    } else {
2444        set file [string trim [$files get $select]]
2445    }
2446    if {$file == "<Parent>"} {
2447        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2448        ChooseExpFil $frm
2449    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
2450        if {$file != "."} {
2451            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
2452            ChooseExpFil $frm
2453        }
2454    } else {
2455        set expgui(FileMenuEXPNAM) [file tail $file]
2456        valid_exp_file $frm $mode
2457    }
2458}
2459
2460# fill the files & dates & Directory selection box with current directory,
2461# also called when box is created to fill it
2462proc ChooseExpFil {frm} {
2463    global expgui
2464    set files $frm.a.files
2465    set dates $frm.a.dates
2466    set expgui(FileMenuEXPNAM) {}
2467    $files delete 0 end
2468    $dates delete 0 end
2469    $files insert end {<Parent>}
2470    $dates insert end {(Directory)}
2471    set filelist [glob -nocomplain \
2472            [file join [set expgui(FileMenuDir)] *] ]
2473    foreach file [lsort -dictionary $filelist] {
2474        if {[file isdirectory $file]} {
2475            $files insert end [file tail $file]
2476            $dates insert end {(Directory)}
2477        }
2478    }
2479    set pairlist {}
2480    foreach file [lsort -dictionary $filelist] {
2481        if {![file isdirectory $file]  && \
2482                [string toupper [file extension $file]] == ".EXP"} {
2483            set modified [file mtime $file]
2484            lappend pairlist [list $file $modified]
2485        } elseif {![file isdirectory $file] && $expgui(includearchived) && \
2486                [string match {*.O[0-9A-F][0-9A-F]} $file]} {
2487            set modified [file mtime $file]
2488            lappend pairlist [list $file $modified]
2489        }
2490    }
2491    if {$expgui(filesort) == 0} {
2492        foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
2493            set file [lindex $pair 0]
2494            set modified [clock format [lindex $pair 1] -format "%T %D"]
2495            $files insert end [file tail $file]
2496            $dates insert end $modified
2497        }
2498    } else {
2499        foreach pair [lsort -dictionary -index 0 $pairlist] {
2500            set file [lindex $pair 0]
2501            set modified [clock format [lindex $pair 1] -format "%T %D"]
2502            $files insert end [file tail $file]
2503            $dates insert end $modified
2504        }
2505    }
2506    $expgui(FileDirButtonMenu)  delete 0 end
2507    set list ""
2508    global tcl_platform tcl_version
2509    if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
2510        catch {set list [string tolower [file volume]]}
2511    }
2512    set dir ""
2513    foreach subdir [file split [set expgui(FileMenuDir)]] {
2514        set dir [file join $dir $subdir]
2515        if {$tcl_platform(platform) == "windows"} {
2516            set dir [string tolower $dir]
2517            if {[lsearch $list $dir] == -1} {lappend list $dir}
2518        } else {
2519            lappend list $dir
2520        }
2521    }
2522    foreach path $list {
2523        $expgui(FileDirButtonMenu) add command -label $path \
2524                -command "[list set expgui(FileMenuDir) $path]; \
2525                ChooseExpFil $frm"
2526    }
2527    # highlight the current experiment -- if present
2528    for {set i 0} {$i < [$files size]} {incr i} {
2529        set file [$files get $i]
2530        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
2531            $files selection set $i
2532        }
2533    }
2534    return
2535}
2536
2537
2538#------------------------------------------------------------------------------
2539# platform-specific definitions
2540if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
2541    # windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
2542    # DOS box synchronously, so we create a "lock" file that is deleted
2543    # at the end of the DOS run so we can tell when the run is done.
2544    # We create a window to force the deleting of the file so that if
2545    # the DOS process crashes, the user can continue anyway.
2546    #
2547    # procedure to check if the lock file is still there (Win-9x/me only)
2548    proc checklockfile {file window} {
2549        if [file exists $file] {
2550            after 500 checklockfile $file $window
2551        } else {
2552            catch {destroy $window}
2553        }
2554    }
2555    # this procedure starts the GRWND program, if needed for program $prog
2556    proc StartGRWND {prog} {
2557        global expgui
2558        if {!$expgui(autoGRWND)} return
2559        # at some point we might want to have a real list
2560        if {$prog != "genles" && $prog != "powpref"} {
2561            # get a list of running jobs
2562            exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
2563            set fp [open tlist.tlist r]
2564            set text [read $fp]
2565            close $fp
2566            file delete -force tlist.tlist
2567            # if GRWND.EXE is not currently running, start it
2568            if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
2569                exec [file join $expgui(gsasexe) grwnd.exe] &
2570                # give grwnd a 1 second head start
2571                after 1000
2572            }
2573        }
2574    }
2575    # this creates a DOS box to run a program in
2576    proc forknewterm {title command "wait 1" "scrollbar 1"} {
2577        global env expgui
2578        # Windows environment variables
2579        set env(GSAS) [file nativename $expgui(gsasdir)]
2580        # PGPLOT_FONT is needed by PGPLOT
2581        set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
2582        # this is the number of lines/page in the .LST (etc.) file
2583        set env(LENPAGE) 60
2584        set pwd [file nativename [pwd]]
2585       
2586        # check the .EXP path -- can DOS use it?
2587        if {[string first // [pwd]] != -1} {
2588            MyMessageBox -parent . -title "Invalid Path" \
2589                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2590                    -icon error -type ok -default ok \
2591                    -helplink "expgui_Win_readme.html NetPath"
2592            return
2593        }
2594        if {[info command winutils::shell] == "" && \
2595                [info command winexec] == ""} {
2596            MyMessageBox -parent . -title "Setup error" \
2597                -message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
2598                -icon error -type darn -default darn \
2599                -helplink "expgui_Win_readme.html Winexec"
2600            return
2601        }
2602        # loop over multiple commands
2603        foreach cmd $command {
2604            # simulate the wait with a lock file
2605            if {$wait} {
2606                if {$expgui(autoiconify)} {wm iconify .}
2607                # create a blank lock file and a message window
2608                close [open expgui.lck w]
2609                toplevel .lock
2610                grid [button .lock.0 -text Help -bg yellow \
2611                        -command "MakeWWWHelp expguierr.html lock"] \
2612                        -column 1 -row 0
2613                grid [label .lock.1 \
2614                        -text "Please wait while the GSAS program finishes."] \
2615                        -column 0 -row 0
2616                grid [label .lock.2 -text \
2617                        "In case a problem occurs, close the DOS box"] \
2618                        -column 0 -columnspan 2 -row 1
2619                grid [label .lock.3 -text \
2620                        "and press the \"Continue\" button (below)"] \
2621                        -column 0 -columnspan 2 -row 2
2622                grid [button .lock.b -text "Continue" \
2623                        -command "destroy .lock; wm deiconify ."] \
2624                        -column 0 -columnspan 2 -row 3
2625                putontop .lock
2626                update
2627                checklockfile expgui.lck .lock
2628            }
2629
2630            # pause is hard coded in the GSASTCL.BAT file
2631            if {$expgui(execprompt)} {
2632                set script gsastcl.bat
2633            } else {
2634                set script gsasnowt.bat
2635            }
2636
2637            # replace the forward slashes with backward
2638            regsub -all / $cmd \\ cmd
2639            if {[info command winutils::shell] != ""} {
2640                winutils::shell [file join $expgui(scriptdir) $script] $cmd
2641            } else {
2642                winexec -d [file nativename [pwd]] \
2643                    [file join $expgui(scriptdir) $script] $cmd
2644            }
2645            if {$expgui(MacroRunning)} {
2646                update 
2647                update idletasks
2648            }
2649            if {$wait} {
2650                tkwait window .lock
2651                file delete -force expgui.lck
2652            }
2653        }
2654        if {$expgui(autoiconify) && $wait} {wm deiconify .}
2655        # check for changes in the .EXP file immediately
2656        whenidle
2657    }
2658} elseif {$tcl_platform(platform) == "windows"} {
2659    # now for Windows-NT, where we can run synchronously
2660    #
2661    # this creates a DOS box to run a program in
2662    proc forknewterm {title command  "wait 1" "scrollbar 1"} {
2663        global env expgui
2664        # Windows environment variables
2665        set env(GSAS) [file nativename $expgui(gsasdir)]
2666        # PGPLOT_FONT is needed by PGPLOT
2667        set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
2668        set env(PGPLOT_DIR) $expgui(pgplotdir)
2669        # this is the number of lines/page in the .LST (etc.) file
2670        set env(LENPAGE) 60
2671        set pwd [file nativename [pwd]]
2672        # check the path -- can DOS use it?
2673        if {[string first // [pwd]] != -1} {
2674            MyMessageBox -parent . -title "Invalid Path" \
2675                    -message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2676                    -icon error -type ok -default ok \
2677                    -helplink "expgui_Win_readme.html NetPath"
2678            return
2679        }
2680        # pause is hard coded in the .BAT file
2681        if {$expgui(execprompt)} {
2682            set script gsastcl.bat
2683        } else {
2684            set script gsasnowt.bat
2685        }
2686
2687        if {$wait} {
2688            if {$expgui(autoiconify)} {wm iconify .}
2689            # create a blank lock file (keep liveplot from running)
2690            close [open expgui.lck w]
2691            # loop over commands
2692            foreach cmd $command {
2693                # replace the forward slashes with backward
2694                regsub -all / $cmd \\ cmd
2695                # use of file attributes -shortname & normalize and nativename
2696                # might help here
2697                exec $env(COMSPEC) /c \
2698                        "start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
2699            }
2700            file delete -force expgui.lck
2701            if {$expgui(autoiconify)} {wm deiconify .}
2702            # check for changes in the .EXP file immediately
2703            whenidle
2704        } else {
2705            # loop over commands
2706            foreach cmd $command {
2707                # replace the forward slashes with backward
2708                regsub -all / $cmd \\ cmd
2709                # run in background
2710                exec $env(COMSPEC) /c \
2711                        "start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
2712                if {$expgui(MacroRunning)} {
2713                    update 
2714                    update idletasks
2715                }
2716            }
2717        }
2718    }
2719} else {
2720    # UNIX-based machines
2721    if {[auto_execok xterm] != ""} {
2722        # this creates a xterm window for running programs inside
2723        proc forknewterm {title command "wait 1" "scrollbar 1"} {
2724            global env expgui
2725            # UNIX environment variables
2726            set env(GSAS) [file nativename $expgui(gsasdir)]
2727            set env(gsas) [file nativename $expgui(gsasdir)]
2728            set env(GSASEXE) $expgui(gsasexe)
2729            set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2730            set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2731            # PGPLOT_DIR is needed by PGPLOT
2732            set env(PGPLOT_DIR) $expgui(pgplotdir)
2733            # this is the number of lines/page in the .LST (etc.) file
2734            set env(LENPAGE) 60
2735            set termopts {}
2736            if $env(GSASBACKSPACE) {
2737                append termopts \
2738                    {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
2739            }
2740            if $scrollbar {
2741                append termopts " -sb"
2742            } else {
2743                append termopts " +sb"
2744            }
2745            if {$wait} {
2746                set suffix {}
2747            } else {
2748                set suffix {&}
2749            }
2750           
2751            # hold window open after commands finish
2752            if {$expgui(execprompt)} {
2753                append command "\; echo -n Press Enter to continue \; read x"
2754            }
2755            if {$wait && $expgui(autoiconify)} {wm iconify .}
2756            catch {eval exec xterm $termopts -title [list $title] \
2757                       -e /bin/sh -c [list $command] $suffix} errmsg
2758            if $expgui(debug) {puts "xterm result = $errmsg"}
2759            if {$expgui(MacroRunning)} {
2760                update 
2761                update idletasks
2762            }
2763            if {$wait} {
2764                if {$expgui(autoiconify)} {wm deiconify .}
2765                # check for changes in the .EXP file immediately
2766                whenidle
2767            }
2768        }
2769    } elseif {[auto_execok gnome-terminal] != ""} {
2770        # this creates a xterm window for running programs inside
2771        proc forknewterm {title command "wait 1" "scrollbar 1"} {
2772            global env expgui
2773            # UNIX environment variables
2774            set env(GSAS) [file nativename $expgui(gsasdir)]
2775            set env(gsas) [file nativename $expgui(gsasdir)]
2776            set env(GSASEXE) $expgui(gsasexe)
2777            set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2778            set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2779            # PGPLOT_DIR is needed by PGPLOT
2780            set env(PGPLOT_DIR) $expgui(pgplotdir)
2781            # this is the number of lines/page in the .LST (etc.) file
2782            set env(LENPAGE) 60
2783            if {$wait} {
2784                set suffix {}
2785            } else {
2786                set suffix {&}
2787            }
2788           
2789            # hold window open after commands finish
2790            if {$expgui(execprompt)} {
2791                append command "\; echo -n Press Enter to continue \; read x"
2792            }
2793            if {$wait && $expgui(autoiconify)} {wm iconify .}
2794            catch {exec gnome-terminal --title $title \
2795                       -e " /bin/sh -c \" $command \" " $suffix} errmsg
2796            if $expgui(debug) {puts "gnome-terminal result = $errmsg"}
2797            if {$expgui(MacroRunning)} {
2798                update 
2799                update idletasks
2800            }
2801            if {$wait} {
2802                if {$expgui(autoiconify)} {wm deiconify .}
2803                # check for changes in the .EXP file immediately
2804                whenidle
2805            }
2806        }
2807    } else {
2808        MyMessageBox -parent . -title "Error: no terminal program" \
2809            -message "Error, the xterm or gnome-terminal utility programs could not be found. It is not possible to run the GSAS programs without this." \
2810            -icon error -type NOT-OK -default not-ok
2811    }
2812}
2813
2814# run commands without a terminal window
2815proc runnoterm {command outfile} {
2816    global env expgui tcl_platform
2817    if {$tcl_platform(platform) == "windows"} {
2818        # Windows environment variables
2819        set env(GSAS) [file nativename $expgui(gsasdir)]
2820        # PGPLOT_FONT is needed by PGPLOT
2821        set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
2822        # this is the number of lines/page in the .LST (etc.) file
2823        set env(LENPAGE) 60
2824        set pwd [file nativename [pwd]]
2825        # loop over multiple commands
2826        foreach cmd $command {
2827            # replace the forward slashes with backward
2828            regsub -all / $cmd \\ cmd
2829            exec $cmd >>& $outfile
2830            update
2831            update idletasks
2832        }
2833    } else { 
2834        # UNIX environment variables
2835        set env(GSAS) [file nativename $expgui(gsasdir)]
2836        set env(gsas) [file nativename $expgui(gsasdir)]
2837        set env(GSASEXE) $expgui(gsasexe)
2838        set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2839        set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2840        # PGPLOT_DIR is needed by PGPLOT
2841        set env(PGPLOT_DIR) $expgui(pgplotdir)
2842        # this is the number of lines/page in the .LST (etc.) file
2843        set env(LENPAGE) 60
2844        foreach cmd $command {
2845            catch {eval exec $cmd >>& $outfile} errmsg
2846        }
2847        update
2848        update idletasks
2849    }
2850    # check for changes in the .EXP file immediately
2851    #whenidle
2852}
2853
2854proc MacMakeResource {file app} {
2855    # make a resource file. Note that OS X has gotten picky about the length of this
2856    set l [string length $app]
2857    if $::expgui(debug) {puts "$l bytes"}
2858    incr l
2859    if $::expgui(debug) {puts "$l bytes after incr"}
2860    set str "data 'usro' (0) {\n"
2861    append str "  $\""
2862    append str [format %.8X $l]
2863    set bytes 4
2864    foreach char [split $app {}] {
2865        append str [format %.2X [scan $char %c]]   
2866    }
2867    incr bytes $l
2868    set newline 1
2869    for {set i 0} {$i < [expr 1028-$bytes]} {incr i} {
2870        if $newline {
2871            append str "\" \n"
2872            append str "  $\""
2873            set newline 0
2874            set j 0
2875        }
2876        append str {0000 }
2877        incr bytes
2878        incr j 2
2879        if {$j > 15} {set newline 1}
2880    }
2881    if {$l % 2} {
2882        append str "\"\n "
2883    } else {
2884        # even lengths need one more byte
2885        append str "00\"\n "
2886    }
2887    append str "/* $app */\n};\n"
2888    set fp [open $file w]
2889    puts $fp $str
2890    close $fp
2891}
2892
2893# modify resource fork info for a .EXP file on the Mac
2894proc MacSetResourceFork {expfile} {
2895    global expgui tcl_platform
2896    if {$tcl_platform(os) != "Darwin"} {return}
2897    set expnative [file nativename $expfile]
2898    #
2899    # assign an app to the data file, if the app and the
2900    # required tool (Rez) are installed
2901    set app [file nativename [file join $expgui(gsasdir) expgui.app]]
2902    set RezApp {}
2903    foreach pth "/usr/bin  /Developer/Tools $expgui(gsasexe)" {
2904        if [file exists [set tst [file join $pth Rez]]] {
2905            set RezApp $tst
2906            break
2907        }
2908    }
2909    set SetFileApp {}
2910    foreach pth "/usr/bin  /Developer/Tools $expgui(gsasexe)" {
2911        if [file exists [set tst [file join $pth SetFile]]] {
2912            set SetFileApp $tst
2913            break
2914        }
2915    }
2916    if $::expgui(debug) {puts "found app=$app Rez=$RezApp and SetFile=$SetFileApp"}
2917    if {[file exists $app] && $RezApp != ""} {
2918        # make resource file
2919        MacMakeResource setapp.r $app
2920        if $::expgui(debug) {puts "$RezApp setapp.r -o $expnative -a"}
2921        exec $RezApp setapp.r -o $expnative -a
2922        if {! $::expgui(debug)} {
2923            file delete -force setapp.r
2924        }
2925    }
2926
2927    # assign an icon to the data file, if it and the required tools exist
2928    set icon [file join $expgui(gsasexe) gsasicon.r]
2929    if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
2930        exec $RezApp [file nativename $icon] -o $expnative -a
2931        exec $SetFileApp -a C $expnative
2932        if {$::expgui(debug)} {
2933            puts "$RezApp [file nativename $icon] -o $expnative -a"
2934            puts "$SetFileApp -a C $expnative"
2935        }
2936    } elseif {$::expgui(debug)} {
2937        puts "icon=$icon missing?"
2938    }
2939}
2940
2941#-------------------------------------------------------------------------------
2942# Macro Recording
2943#-------------------------------------------------------------------------------
2944set expgui(MacroBufferedCommand) ""
2945set expgui(fpMacroFile) ""
2946set expgui(MacroFile) ""
2947# Turn on/off mode to save commands in MacroFile
2948proc SetRecordMacroOnOff {args} {
2949    global expgui
2950    if {$expgui(RecordMacro)} {
2951        set expgui(fpMacroFile) ""
2952        set expgui(MacroBufferedCommand) ""
2953        while {$expgui(fpMacroFile) == ""} {
2954            set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
2955                                       -parent . \
2956                                       -filetypes {{"EXPGUI Macro file" .expmac}} \
2957                                       -defaultextension .expmac  \
2958                                       -initialfile EXPGUI.expmac \
2959                                       -title "Choose location to save macro"]
2960            if {$expgui(MacroFile) == ""} {
2961                # respond to cancel
2962                set expgui(fpMacroFile) ""
2963                set expgui(MacroFile) ""
2964                set expgui(RecordMacro) 0
2965                return
2966            }
2967            if {[catch {
2968                set expgui(fpMacroFile) [open $expgui(MacroFile) w]
2969                puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
2970            } errmsg]} {
2971                MyMessageBox -parent . -title "Error opening selected file" \
2972                    -message "Error opening macro file:\n$errmsg" \
2973                    -icon warning -type TryAgain -default tryagain
2974                catch {close $expgui(fpMacroFile)}
2975                set expgui(fpMacroFile) ""
2976                set expgui(MacroFile) ""
2977                set expgui(RecordMacro) 0
2978            }
2979        }
2980    } else {
2981        if {[string trim $expgui(MacroBufferedCommand)] != ""} {
2982            puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
2983        }
2984        catch {close $expgui(fpMacroFile)}
2985        set expgui(fpMacroFile) ""
2986        set expgui(MacroFile) ""
2987        set expgui(MacroBufferedCommand) ""
2988    }
2989}
2990
2991# record a command in the Macro File
2992proc RecordMacroEntry {command buffer} {
2993    global expgui
2994    if {! $expgui(RecordMacro)} return
2995    # in buffered mode: hold the last command in memory and compare to the
2996    # next. If two commands differ only in the final argument, then the
2997    # second command makes the previous redundant so only the latter version
2998    # is retained (This will happen when a user types a string into a box).
2999    # When the commands differ, then the previous is written to file
3000    # and the next is retained in memory.
3001    if {$buffer} {
3002        if {[string trim $expgui(MacroBufferedCommand)] == ""} {
3003            set expgui(MacroBufferedCommand) $command
3004            return
3005        }
3006        set diff 0
3007        # is command a repeat of previous?
3008        foreach a $command b $expgui(MacroBufferedCommand) {
3009            if {$diff} {
3010                # found a difference, other than in the last arg
3011                puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3012                break
3013            }
3014            if {$a != $b} {set diff 1}
3015        }
3016        set expgui(MacroBufferedCommand) $command
3017    } else {
3018        # no buffering on current command; write the old and new to file.
3019        if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3020            puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3021        }
3022        puts $expgui(fpMacroFile) $command
3023        set expgui(MacroBufferedCommand) ""
3024    }
3025}
3026
3027proc CantRecordMacroEntry {comment} {
3028    global expgui
3029    if {! $expgui(RecordMacro)} return
3030
3031    # no buffering on current command; write the old and new to file.
3032    if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3033        puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3034    }
3035    puts $expgui(fpMacroFile) "# unrecorded: $comment"
3036    set expgui(MacroBufferedCommand) ""
3037    MyMessageBox -parent . -title "No command record" \
3038        -message "EXPGUI is not able to record this action in the macro file: $comment" \
3039        -icon warning
3040}
3041
3042
3043# Play back commands in Macro File
3044proc ReplayMacroFile {"lineatatime 0"} {
3045    global expgui
3046    set expnam [file root [file tail $expgui(expfile)]]
3047    file delete abort_${expnam}_macro.flag
3048    set expgui(MacroRunning) 0
3049    set MacroFile [tk_getOpenFile -initialdir [pwd] \
3050                       -parent . \
3051                       -filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
3052                       -defaultextension .expmac  \
3053                       -title "Choose location to read macro"]
3054    if {$MacroFile == ""} return
3055    set expgui(MacroRunning) 1
3056    if {$lineatatime} {
3057        set expgui(MacroChanged) 0
3058        set top1 .macro
3059        catch {destroy $top1}
3060        toplevel $top1
3061        set txt $top1.t
3062        grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
3063            -column 0 -row 0 -sticky news
3064        wm title $top1 "File $MacroFile"
3065        grid [scrollbar $top1.s -command "$txt yview"] \
3066            -column 1 -row 0 -sticky ns
3067        grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
3068        grid columnconfig $top1 0 -weight 1
3069        grid rowconfig $top1 0 -weight 1
3070        grid [button $top1.b.e -text "Execute line" \
3071                  -command "MacroExecuteCurrentLine $txt"] \
3072            -column 0 -row 0 -sticky w
3073        grid columnconfig $top1.b 1 -weight 1
3074        grid [button $top1.b.s -text "Save As" -state disabled \
3075                  -command "MacroResave $txt"] -column 1 -row 0
3076        set expgui(MacroSaveButton) $top1.b.s 
3077        grid [button $top1.b.c -text "Close " \
3078                  -command "MacroCloseWindow $txt"] -column 2 -row 0
3079        $txt delete 0.0 end
3080        set fp [open $MacroFile r]
3081        $txt insert 0.0 [read $fp]
3082        close $fp
3083        MacroHighlightText $txt 1
3084        # deal with editing in the box
3085        $txt configure -undo 1
3086        $txt edit modified 0
3087        bind $txt <<Modified>> {
3088            $expgui(MacroSaveButton) configure -state normal
3089            set expgui(MacroChanged) 1
3090        }
3091    } else {
3092        close [open running_${expnam}_macro.flag w]
3093        set saveprompt $expgui(execprompt)
3094        set saveautold $expgui(autoexpload)
3095        set expgui(execprompt) 0
3096        set expgui(autoexpload) 1
3097        set expnam [file root [file tail $expgui(expfile)]]
3098        if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3099            set outfile ${expnam}_macout.LST
3100            # create an empty file
3101            catch {file delete $outfile}
3102            close [open $outfile w]
3103            # view it with LSTVIEW
3104            set outfile ${expnam}_macout
3105            exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
3106        } else {
3107            # show status, offer abort with MACROMON
3108            exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
3109        }
3110
3111        set  expgui(MacroStatus) "starting script"
3112        pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus) 
3113
3114        if {[catch {
3115            source $MacroFile
3116        } errmsg]} {
3117            set txt $::errorInfo
3118            catch {
3119                set fp [open error.txt a]
3120                puts $fp "#  [clock format [clock seconds] -format %Y-%m-%dT%T]"
3121                puts $fp $txt
3122                close $fp
3123            }
3124            donewait
3125            MyMessageBox -parent . -title "Error running Macro file" \
3126                -message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
3127                -icon error -type OK -default ok
3128        } else {
3129            donewait
3130        }
3131        file delete running_${expnam}_macro.flag
3132        set expgui(execprompt) $saveprompt
3133        set expgui(autoexpload) $saveautold
3134        set expgui(MacroRunning) 0
3135        # show changes
3136        PaintEXPGUIpages
3137        # put comment in output file
3138        if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3139            set outfile ${expnam}_macout.LST
3140            set fp [open $outfile a]
3141            puts $fp "\n**** Macro ended ****" 
3142            close $fp
3143        }
3144    }
3145}
3146
3147# highlight a line in the Macro file display
3148proc MacroHighlightText {txt line} {
3149    $txt tag delete next
3150    $txt tag add next $line.0 $line.end
3151    $txt see $line.0
3152    $txt tag configure next -background yellow
3153    # tag all text
3154    $txt tag delete all
3155    $txt tag add all 0.0 end
3156    # double-click moves the current line
3157    $txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
3158}
3159
3160# respond to a double click by moving the next line to be executed to
3161# the line where the double click occurred
3162proc MacroDoubleClick {txt} {
3163    set line [lindex [split [$txt tag ranges sel] "."] 0]
3164    MacroHighlightText $txt $line
3165}
3166
3167# respond to Execute button: execute the current line
3168# close window after last command
3169proc MacroExecuteCurrentLine {txt} {
3170    global expgui
3171    set linenum [lindex [split [$txt tag ranges next] "."] 0]
3172    if {$linenum == ""} {return}
3173    set line [$txt get $linenum.0 $linenum.end]
3174    # is this continued (ends with \)?
3175    while {[string range $line end end] == "\\" } {
3176        incr linenum
3177        # get rid of trailing backslash
3178        set line [string range $line 0 end-1]
3179        #append next line
3180        append line [$txt get $linenum.0 $linenum.end]
3181    }
3182     if {[catch $line errmsg]} {
3183        MyMessageBox -parent $txt -title "Error on line" \
3184            -message "Error on line $linenum:\n$errmsg" \
3185            -icon warning -type Continue -default continue
3186    }
3187    # show changes
3188    PaintEXPGUIpages
3189    # move forward in macrofile
3190    incr linenum
3191    MacroHighlightText $txt $linenum
3192    set linenum [lindex [split [$txt tag ranges next] "."] 0]
3193    # at end?
3194    if {$linenum == ""} {MacroCloseWindow $txt}
3195}
3196
3197# Save a modified macro file
3198proc MacroResave {txt} {
3199    global expgui
3200    set MacroFile [tk_getSaveFile -initialdir [pwd] \
3201                       -parent $txt \
3202                       -filetypes {{"EXPGUI Macro file" .expmac}} \
3203                       -defaultextension .expmac  \
3204                       -initialfile $expgui(MacroFile) \
3205                       -title "Choose location to save macro"]
3206    if {[string trim $MacroFile] == ""} {return}
3207    if {[catch {
3208        set fp [open $MacroFile w]
3209        puts $fp [string trim [$txt get 0.0 end]]
3210        close $fp
3211    } errmsg]} {
3212        MyMessageBox -parent $txt -title "Error writing to file" \
3213            -message "Error writing macro file:\n$errmsg" \
3214            -icon warning -type TryAgain -default tryagain
3215        return
3216    }
3217    set expgui(MacroChanged) 0
3218    # gray out the button
3219    $expgui(MacroSaveButton) configure -state disabled
3220}
3221
3222# close the window, but provide a chance to save the file first, if modified
3223proc MacroCloseWindow {txt} {
3224    global expgui
3225    if {$expgui(MacroChanged)} {
3226        set ans [MyMessageBox -parent $txt -title "Save macro file?" \
3227                     -message "Macro file has been changed, do you want to save it?" \
3228                     -icon warning -type "Yes No" -default no]
3229        if {$ans != "no"} {MacroResave $txt}
3230    }
3231    set expgui(MacroRunning) 0
3232    destroy [winfo toplevel $txt]
3233}
3234
3235# Add a comment to a macro file
3236proc AddCommentMacroFile {} {
3237    global expgui
3238    if {! $expgui(RecordMacro)} return
3239    RecordMacroEntry "# [getstring "comment for macro file"]" 0
3240}
3241
3242#------------------------------------------------------------------------------
3243# Subversion support routines
3244#------------------------------------------------------------------------------
3245# is there a subversion stub and can we find the svn program
3246proc CheckUpdateImplemented {scriptdir} {
3247    #is there a svn directory in the source?
3248    if {! [file exists [file join $scriptdir .svn]]} {return 0}
3249    # can we find svn in the path?
3250    if {[auto_execok svn] != ""} {return 1}
3251    # add a locally supplied svn version, if not in the path already
3252    set pathlist [list [file join $scriptdir svn bin]]
3253    lappend pathlist "/sw/bin/"
3254    lappend pathlist "/opt/local/bin/"
3255    catch {lappend pathlist $::expgui(pathlist)}
3256    foreach localsvn $pathlist {
3257        if {[file exists $localsvn]} {
3258            if {$::tcl_platform(platform) == "windows"} {
3259                set localsvn [file nativename $localsvn]
3260                set sep {;}
3261            } else {
3262                set sep {:}
3263            }
3264            if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
3265                append ::env(PATH) $sep $localsvn
3266                auto_reset
3267                if {[auto_execok svn] != ""} {return 1}
3268            }
3269        }
3270    }
3271    return 0
3272}
3273
3274proc GetSVNVersion {scriptdir} {
3275    if {$::tcl_platform(platform) == "windows"} {
3276        set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3277    } else {
3278        set SVN [auto_execok svn]
3279    }
3280    if {$SVN != ""} {
3281        if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
3282            set infolist [split $res]
3283            set pos [lsearch $infolist "Revision:"]
3284            return "EXPGUI SVN version [lindex $infolist [incr pos]]"
3285        }
3286    }
3287    return "EXPGUI version: $::expgui(Revision)"
3288}
3289
3290proc GetSVNrepository {scriptdir} {
3291    if {$::tcl_platform(platform) == "windows"} {
3292        set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3293    } else {
3294        set SVN [auto_execok svn]
3295    }
3296    if {$SVN != ""} {
3297        if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
3298            set infolist [split $res]
3299            set pos [lsearch $infolist "URL:"]
3300            return [lindex $infolist [incr pos]]
3301        }
3302    }
3303    return {}
3304}
3305
3306proc SetSVNbranch {branch} {
3307    # reset the track label
3308    set ::command(SVNversion) [lindex [split [GetSVNrepository $::expgui(scriptdir)] '/'] end]
3309    if {$::tcl_platform(platform) == "windows"} {
3310        set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3311    } else {
3312        set SVN [auto_execok svn]
3313    }
3314    if {$SVN == ""} {
3315        return 0
3316    }
3317    set curURL [GetSVNrepository $expgui(scriptdir)]
3318    set curbranch [lindex [split $curURL '/'] end]
3319    if {$curbranch == $branch} {return 0}
3320    if {$branch == "trunk"} {
3321        set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/trunk"
3322        set lbl development
3323    } elseif {$branch == "stable"} {
3324        set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/tags/stable"
3325        set lbl standard
3326    } else {
3327        MyMessageBox -parent . -title "Internal error" \
3328        -message "No $branch track." -icon error
3329        return 0
3330    }
3331    set msg {Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.}
3332    if {[MyMessageBox -parent . -title "Ready to switch" \
3333        -message "Ready to update to the $lbl track.\n\n$msg" \
3334                 -type {Cancel "Update & Restart"} -default cancel -icon warning
3335        ] == "cancel"} {return}
3336    if {[confirmBeforeSave] == "Cancel"} return
3337
3338    # do a quiet cleanup. Sometimes needed after install, and never hurts
3339    if [catch {set res [exec $SVN cleanup $::expgui(scriptdir)]} err] {
3340        MyMessageBox -parent . -title "Error in cleanup" \
3341            -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3342            -icon error
3343    }
3344
3345    # switch the source
3346    set cmd1 "$SVN switch $newURL $scriptdir"
3347    if [catch {set res1 [exec $SVN switch $newURL $::expgui(scriptdir)]} err] {
3348        MyMessageBox -parent . -title "Error updating" \
3349            -message "Error performing update:\n$err" \
3350            -icon error
3351        return 0
3352    }
3353    set msg "Results from update:\n$cmd1\n$res1"
3354    # update done, now need to "reboot"
3355    MyMessageBox -parent . -title "Updating done" -icon info \
3356        -message "Update Complete\nPress OK to restart EXPGUI\n\n$msg"
3357    exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
3358    exit
3359}
3360
3361proc CheckAndDoUpdate { } {
3362    if {$::tcl_platform(platform) == "windows"} {
3363        set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3364    } else {
3365        set SVN [auto_execok svn]
3366    }
3367    if {$SVN == ""} {
3368        tk_dialog .msg "Error: no svn" \
3369            "Error: SVN not found. Should not happen." \
3370            error 0 OK   
3371        return
3372    }
3373    #set wish "[info nameofexecutable]"
3374    # check for updates
3375    if [catch {
3376        set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u]
3377    } err] {
3378        set ans [MyMessageBox -parent . -title "Error checking status" \
3379                     -message "Error checking for updates: $err\n\nTry to update manually?" \
3380                     -icon error -type "Yes No" -default yes]
3381        if {$ans != "no"} {
3382            forknewterm "manually update in subversion" \
3383                "$SVN update [file normalize $::expgui(gsasdir)]"
3384        }
3385        return
3386    } else {
3387        if {[string first "*" $res] == -1} {
3388            MyMessageBox -parent . -title "No updates" \
3389                -message "GSAS/EXPGUI appears up-to-date" \
3390                -icon info
3391            return
3392        }
3393    }
3394    if {[MyMessageBox -parent . -title "Ready to Update" \
3395             -message {
3396Updates to GSAS/EXPGUI found.
3397                 
3398Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \
3399             -type {Cancel "Update & Restart"} -default cancel -icon warning
3400        ] == "cancel"} {return}
3401
3402    if {[confirmBeforeSave] == "Cancel"} return
3403
3404     # special upgrade for windows, where the wish exec blocks upgrade of the exe directory
3405    if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
3406        # create a batch file
3407        set out [file normalize ~/expgui_update.bat]
3408        set fp [open [file normalize ~/expgui_update.bat] w]
3409        puts $fp "@echo *"
3410        puts $fp "@echo ******************************************************************"
3411        puts $fp "@echo Preparing to start upgrade of EXPGUI."
3412        puts $fp "@pause"
3413        puts $fp "$SVN cleanup $::expgui(gsasdir)"
3414        puts $fp "$SVN up $::expgui(gsasdir)"
3415        puts $fp "@echo *"
3416        puts $fp "@echo ******************************************************************"
3417        puts $fp "@echo Upgrade is complete. This window will close and EXPGUI will restart."
3418        puts $fp "@pause"
3419        puts $fp "$::env(COMSPEC) /c \"start [info nameofexecutable] \
3420[file attributes [file normalize $::expgui(script)] -shortname] \
3421[file attributes [file normalize $::expgui(expfile)] -shortname] \""
3422        puts $fp "exit"
3423        close $fp
3424        #run the batch file
3425        exec $::env(COMSPEC) /c "start [file nativename [file attributes $out -shortname]]" &
3426        exit
3427    }
3428
3429    # do a quiet cleanup. Sometimes needed after install, and never hurts
3430    if [catch {set res [exec $SVN cleanup $::expgui(gsasdir)]} err] {
3431        MyMessageBox -parent . -title "Error in cleanup" \
3432            -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3433            -icon error
3434    }
3435    if [catch {set res [exec $SVN up $::expgui(gsasdir)]} err] {
3436        MyMessageBox -parent . -title "Error updating" \
3437            -message "Error performing update:\n$err" \
3438            -icon error
3439        return
3440    } else {
3441        MyMessageBox -parent . -title "Updating done" \
3442            -message "Results from update:\n$res\n\nPress OK to restart EXPGUI" \
3443            -icon info
3444    }
3445    exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
3446    exit
3447}
Note: See TracBrowser for help on using the repository browser.