source: trunk/addcmds.tcl @ 1232

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

trunk: clean up spacegroup checking [1230]; cleanup chem. restr & CIF Biso to Uiso conv [1231]

  • Property svn:keywords set to Author Date Revision Id
File size: 96.3 KB
Line 
1# $Id: addcmds.tcl 1232 2013-02-28 21:28:14Z toby $
2
3#----------- Add Phase routines ----------------------------------------
4
5proc MakeAddPhaseBox {} {
6    global expmap expgui
7
8    set expgui(coordList) {}
9    set nextphase ""
10    foreach p {1 2 3 4 5 6 7 8 9} {
11        if {[lsearch $expmap(phaselist) $p] == -1} {
12            set nextphase $p
13            break
14        }
15    }
16
17    # no more room
18    if {$nextphase == ""} {
19        MyMessageBox -parent . -title "Add Phase Error" \
20                -message "There are already 9 phases. You cannot add more." \
21                -icon error
22        return
23    }
24
25    set np .newphase
26    catch {destroy $np}
27    toplevel $np
28    bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
29
30    grid [label $np.l1 -text "Adding phase #$nextphase"] \
31            -column 0 -row 0 -sticky w
32    grid [label $np.l2 -text "Phase title:"] -column 0 -row 1 
33    grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
34    grid [label $np.l3 -text "Space Group:"] -column 0 -row 2 
35    grid [entry $np.t2 -width 12] -column 1 -row 2 
36    grid [frame $np.ct -bd 2 -relief groove] -column 3 -row 2
37    grid [frame $np.f -bd 4 -relief groove] -column 4 -row 2 -columnspan 8
38    grid [label $np.ct.l -text "Cell\nType"] -column 0 -row 2 
39    set menu [tk_optionMenu $np.ct.s expgui(addPhaseCellType) ""]
40    $menu delete 0
41    foreach val {Any Cubic Tetragonal Hexagonal Rhombohedral Orthorhombic Monoclinic} \
42        lbl {Any Cubic Tetrag Hexag Rhomb. Ortho Mono} {
43            $menu add radiobutton -value $lbl -label $val \
44                -command "set expgui(addPhaseCellType) $lbl"
45        }
46    grid $np.ct.s
47    foreach v [ trace vinfo expgui(addPhaseCellType)] {
48        eval trace vdelete expgui(addPhaseCellType) $v
49    }
50    #set expgui(addPhaseCellType) Any
51    $menu invoke 0
52    trace variable expgui(addPhaseCellType) w "SetAddCellSymConstr $np.f"
53
54    set col -1
55    foreach i {a b c} {
56        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
57        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
58    }
59    set col -1
60    foreach i {a b g} {
61        grid [label $np.f.l2$i -text $i] -column [incr col] -row 2
62        set font [$np.f.l2$i cget -font]
63        $np.f.l2$i config -font "Symbol [lrange $font 1 end]"
64        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
65        $np.f.e2$i insert 0 90.
66    }   
67   
68    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
69    grid [button $np.bf.b1 -text Add \
70            -command "addphase $np"] -column 2 -row 3
71    bind $np <Return> "addphase $np"
72    grid [button $np.bf.b2 -text Cancel \
73            -command "destroy $np"] -column 3 -row 3
74    grid columnconfig $np.bf 4 -weight 1
75    grid [button $np.bf.help -text Help -bg yellow \
76            -command "MakeWWWHelp expgui2.html addphase"] \
77            -column 4 -row 3
78
79    # get the input formats if not already defined
80    GetImportFormats
81    if {[llength $expgui(importFormatList)] > 0} {
82        grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
83        grid [button $np.bf.fr.b3 -text "Import phase from: " \
84                -command "ImportPhase \$expgui(importFormat) $np"] \
85                -column 0 -row 0 -sticky e
86        set menu [eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
87                $expgui(importFormatList)]
88        for {set i 0} {$i <= [$menu index end]} {incr i} {
89            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $np"
90        }
91        grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
92        grid rowconfig $np.bf.fr 0 -pad 10
93        grid columnconfig $np.bf.fr 0 -pad 10
94        grid columnconfig $np.bf.fr 1 -pad 10
95    }
96    wm title $np "add new phase"
97
98    # set grab, etc.
99    putontop $np
100   
101    tkwait window $np
102   
103    # fix grab...
104    afterputontop
105}
106proc SetAddCellSymConstr {box args} {
107    switch $::expgui(addPhaseCellType) {
108        Any {
109            foreach i {a b c} {
110                $box.e1$i configure -textvariable "" -state normal
111            }
112            foreach i {a b g} {
113                $box.e2$i configure -textvariable "" -state normal
114            }
115        }
116        Cubic {
117            set ::expgui(AddCella) [$box.e1a get]
118            foreach i {a b c} {
119                $box.e1$i configure -textvariable expgui(AddCella) -state normal
120            }
121            foreach i {a b g} {
122                $box.e2$i configure -textvariable "" -state normal
123                $box.e2$i delete 0 end
124                $box.e2$i insert 0 90.
125                $box.e2$i configure -textvariable "" -state disabled
126            }
127        }
128        Tetrag {
129            set ::expgui(AddCella) [$box.e1a get]
130            foreach i {a b} {
131                $box.e1$i configure -textvariable expgui(AddCella) -state normal
132            }
133            $box.e1c configure -textvariable "" -state normal
134            foreach i {a b g} {
135                $box.e2$i configure -textvariable "" -state normal
136                $box.e2$i delete 0 end
137                $box.e2$i insert 0 90.
138                $box.e2$i configure -textvariable "" -state disabled
139            }
140        }
141        Hexag {
142            set ::expgui(AddCella) [$box.e1a get]
143            foreach i {a b} {
144                $box.e1$i configure -textvariable expgui(AddCella) -state normal
145            }
146            $box.e1c configure -textvariable "" -state normal
147            foreach i {a b g} {
148                $box.e2$i configure -textvariable "" -state normal
149                $box.e2$i delete 0 end
150                if {$i == "g"} {
151                    $box.e2$i insert 0 120.
152                } else {
153                    $box.e2$i insert 0 90.
154                }
155                $box.e2$i configure -textvariable "" -state disabled
156            }
157        }
158        Rhomb. {
159            set ::expgui(AddCella) [$box.e1a get]
160            foreach i {a b c} {
161                $box.e1$i configure -textvariable expgui(AddCella) -state normal
162            }
163            set ::expgui(AddCellalpha) [$box.e2a get]
164            foreach i {a b g} {
165                $box.e2$i configure -textvariable expgui(AddCellalpha) -state normal
166            }
167        }
168        Ortho {
169            foreach i {a b c} {
170                $box.e1$i configure -textvariable "" -state normal
171            }
172            foreach i {a b g} {
173                $box.e2$i configure -textvariable "" -state normal
174                $box.e2$i delete 0 end
175                $box.e2$i insert 0 90.
176                $box.e2$i configure -textvariable "" -state disabled
177            }
178        }
179        Mono {
180            foreach i {a b c} {
181                $box.e1$i configure -textvariable "" -state normal
182            }
183            foreach i {a g} {
184                $box.e2$i configure -textvariable "" -state normal
185                $box.e2$i delete 0 end
186                $box.e2$i insert 0 90.
187                $box.e2$i configure -textvariable "" -state disabled
188            }
189            $box.e2b configure -textvariable "" -state normal
190        }
191    }
192}
193
194
195proc addphase {np} {
196    global expgui expmap
197    # validate the input
198    set err {}
199    set warn {}
200    set title [$np.t1 get]
201    if {[string trim $title] == ""} {
202        append err "  Title cannot be blank\n"
203    }
204    set spg [$np.t2 get]
205    if {[string trim $spg] == ""} {
206        append err "  Space group cannot be blank\n"
207    }
208    # check if standard and add spaces, as needed
209    if {[set nspg [CheckSpg $spg]] != ""} {
210        set spg $nspg
211        $np.t2 delete 0 end
212        $np.t2 insert end $nspg
213    }
214    foreach i {a b c} {
215        set cell($i) [$np.f.e1$i get]
216        if {[string trim $cell($i)] == ""} {
217            append err "  $i cannot be blank\n"
218        } elseif {[catch {expr $cell($i)}]} {
219            append err "  $i is not valid\n"
220        }
221    }
222
223    foreach i {a b g} lbl {alpha beta gamma} {
224        set cell($lbl) [$np.f.e2$i get]
225        if {[string trim $cell($lbl)] == ""} {
226            append err "  $lbl cannot be blank\n"
227        } elseif {[catch {expr $cell($lbl)}]} {
228            append err "  $lbl is not valid\n"
229        }
230    }
231
232    if {$expgui(addPhaseCellType) == "Rhomb."} {
233        # check for proper use of space group in Rhomb. setting
234        if {[string toupper [string range [string trim $spg] 0 0]] != "R"} {
235            append err "Rhombohedral cell specified, but space group does not start with R\n"
236        }
237        if {[string toupper [string range [string trim $spg] end end]] != "R"} {
238            append spg " R"
239            if {$err == ""} {
240                append warn "Note that a rhombohedral setting was used, the space group symbol ($spg) as been flagged accordingly\n"
241            }
242        }
243    }
244    if {$err != ""} {
245        MyMessageBox -parent . -title "Add Phase Error" \
246                -message "The following error(s) were found in your input:\n$err" \
247                -icon error
248        set expgui(oldphaselist) -1
249        return
250    }
251
252    # check the space group
253    set fp [open spg.in w]
254    puts $fp "N"
255    puts $fp "N"
256    puts $fp $spg
257    puts $fp "Q"
258    close $fp
259    global tcl_platform
260    catch {
261        if {$tcl_platform(platform) == "windows"} {
262            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
263        } else {
264            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
265        }
266    }
267    set fp [open spg.out r]
268    set out [read $fp]
269    close $fp
270    # attempt to parse out the output (fix up if parse did not work)
271    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
272            $out a b ] != 1} {set b $out}
273    if {[string first Error $b] != -1} {
274        # got an error, show it
275        ShowBigMessage \
276                 $np.error \
277                 "Error processing space group\nReview error message below" \
278                 $b OK "" 1
279        set expgui(oldphaselist) -1
280        return
281    } else {
282        # show the result and confirm
283        set opt [ShowBigMessage \
284                $np.check \
285                "Check the symmetry operators in the output below" \
286                $b \
287                {Continue Redo} ]
288        if {$opt > 1} {
289            set expgui(oldphaselist) -1
290            return
291        }
292    }
293    file delete spg.in spg.out
294    # ok do it!
295    set errmsg [runAddPhase $title $spg \
296                    $cell(a) $cell(b) $cell(c) \
297                    $cell(alpha) $cell(beta) $cell(gamma)]
298    RecordMacroEntry "runAddPhase [list $title] [list $spg] \
299                    $cell(a) $cell(b) $cell(c) \
300                    $cell(alpha) $cell(beta) $cell(gamma)" 0
301    destroy $np
302    if {$expgui(showexptool) || $errmsg != ""} {
303        if {$errmsg != ""} {
304            set err 1
305            append errmsg "\n" $expgui(exptoolout) 
306        } else {
307            set err 0
308            set errmsg $expgui(exptoolout) 
309        }
310        set msg "Please review the result from adding the phase" 
311        if { $errmsg != ""} {append msg "\nIt appears an error occurred!"}
312        ShowBigMessage $np $msg $errmsg OK "" $err
313    }
314    # set the powpref warning (2 = required)
315    set expgui(needpowpref) 2
316    set msg "A phase was added" 
317    if {[string first $msg $expgui(needpowpref_why)] == -1} {
318        append expgui(needpowpref_why) "\t$msg\n"
319    }
320    # now select the new phase
321    set phase [lindex $expmap(phaselist) end]
322    SelectOnePhase $phase
323    SpaceGroupWarnings $warn $phase $spg
324}
325
326proc runAddPhase {title spg a b c alpha beta gamma} {
327    global expgui expmap tcl_platform
328    set fp [open exptool.in w]
329    puts $fp "P"
330    puts $fp $title
331    puts $fp $spg
332    puts $fp "$a $b $c $alpha $beta $gamma"
333    puts $fp "/"
334    close $fp
335    # Save the current exp file
336    savearchiveexp
337    # disable the file changed monitor
338    set expgui(expModifiedLast) 0
339    set expnam [file root [file tail $expgui(expfile)]]
340    # save the previous phase list
341    set expgui(oldphaselist) $expmap(phaselist)
342    set err [catch {
343        if {$tcl_platform(platform) == "windows"} {
344            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
345                    < exptool.in >& exptool.out
346        } else {
347            exec [file join $expgui(gsasexe) exptool] $expnam \
348                    < exptool.in >& exptool.out
349        }
350    } errmsg]
351    # load the revised exp file
352    set oldphaselist $expmap(phaselist)
353    loadexp $expgui(expfile)
354    set fp [open exptool.out r]
355    set expgui(exptoolout) [read $fp]
356    close $fp
357    catch {file delete exptool.in exptool.out}
358
359    if {[llength $oldphaselist] == [llength $expmap(phaselist)]} {
360        set err 1
361        if {$errmsg == ""} {set errmsg "No phase added"}
362    }
363    if {$err} {
364        return $errmsg
365    } else {
366        return ""
367    }
368}
369
370
371#----------- Add Histogram routines --------------------------------------
372proc LabelInstParm {args} {
373    global newhist
374    switch $newhist(insttype) {
375        TOF {
376            set newhist(instfiletext) "Neutron Time of Flight"
377            catch {
378                set b $newhist(setnum)
379                append newhist(instfiletext) ", 2theta = $newhist(inst${b}Angle)"
380            }
381        }
382        ED {set newhist(instfiletext) "X-ray Energy Dispersive"}
383        "CW X" {set newhist(instfiletext) "CW X-ray"}
384        "CW N" {set newhist(instfiletext) "CW Neutron"}
385    }
386}
387set newhist(LimitMode) 1
388trace variable newhist(setnum) w LabelInstParm
389trace variable newhist(LimitMode) w ClearHistLimit
390set newhist(LimitMode_boxes) {}
391
392proc ClearHistLimit {args} {
393    global newhist
394    if {$newhist(LimitMode) == 1} {return}
395    foreach box $newhist(LimitMode_boxes) {
396        catch {$box delete 0 end}
397    }
398}
399
400proc MakeAddHistBox {} {
401    global expmap newhist expgui
402
403    # --> should check here if room for another histogram, but only texture
404    # folks will ever need that
405
406
407    # set if the CIF import loads OK
408    set OK 1
409    catch {
410        if {[info procs ReadCIF4GSAS] == ""} {
411            set OK 0
412            source [file join $::expgui(scriptdir) cif2fxye.tcl]
413        }
414    } errmsg
415
416    set np .newhist
417    catch {destroy $np}
418    toplevel $np
419    bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
420
421    grid [label $np.l0 -text "Adding a new histogram"] \
422            -column 0 -row 0 -sticky ew -columnspan 7
423    grid [checkbutton $np.d0 -text "Dummy Histogram" -variable newhist(dummy) \
424            -command "PostInstBankopts $np" \
425            ] -column 2 -row 0 -columnspan 99 -sticky e
426    grid [label $np.l1 -text "Data file:"] -column 0 -row 2
427    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
428            -column 1 -row 2 -columnspan 3 -sticky ew
429    grid [button $np.b1 -text "Select File" \
430            -command "getrawfile $np" \
431            ] -column 4 -row 2
432    if {$OK} {
433        grid [button $np.b1a -text "Import CIF" \
434                  -command "ReadCIF4GSAS $np" \
435                 ] -column 5 -row 2
436    }
437
438    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 3 -sticky w
439    grid [frame $np.bank]  -column 2 -row 3 -columnspan 7 -sticky ew
440
441    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 5
442    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
443            -column 1 -row 5 -columnspan 3 -sticky ew
444    grid [button $np.b2 -text "Select File" \
445            -command "getinstfile $np" \
446            ] -column 4 -row 5
447    grid [button $np.edit -text "Edit file" \
448            -command {EditInstFile $newhist(instfile)}] \
449            -column 5 -row 5
450
451    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 6 -sticky w
452    grid [frame $np.set]  -column 2 -row 6 -columnspan 7 -sticky ew
453    grid [label $np.t2a -textvariable newhist(instfiletext) \
454            -justify center -anchor center -fg blue] \
455            -column 0 -row 8 -columnspan 99 -sticky ew
456
457    grid [button $np.f6a -text "Run\nRAWPLOT" -command "RunRawplot $np"] \
458            -column 4 -row 18 -rowspan 2
459    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 18 -rowspan 3 
460    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
461            ] -column 1 -row 18 -rowspan 3
462    grid [radiobutton $np.cb3 -text "d-min" -variable newhist(LimitMode) \
463            -value 0] -column 2 -row 18 -sticky w
464    grid [radiobutton $np.cb4 -textvariable newhist(limitLbl)  \
465            -variable newhist(LimitMode) -anchor w -justify l \
466            -value 1] -column 2 -row 20 -sticky w
467    set newhist(LimitMode_boxes) $np.e3
468    grid [radiobutton $np.cb5 -text "Q-max" -variable newhist(LimitMode) \
469            -value 2] -column 2 -row 19 -sticky w
470    set newhist(limitLbl) "TOF-min\n2-Theta Max"
471    # spacers
472    grid [frame $np.sp0 -bg white] \
473            -columnspan 20 -column 0 -row 1 -sticky nsew -ipady 2
474    grid [frame $np.sp1 -bg white] \
475            -columnspan 20 -column 0 -row 4 -sticky nsew -ipady 2
476    grid [frame $np.sp2 -bg white] \
477            -columnspan 20 -column 0 -row 17 -sticky nsew -ipady 2
478    grid [frame $np.sp3 -bg white] \
479            -columnspan 20 -column 0 -row 98 -sticky nsew -ipady 2
480    grid [frame $np.f6] -column 0 -row 99 -columnspan 5 -sticky ew
481    grid [button $np.f6.b6a -text Add \
482            -command "addhist $np"] -column 0 -row 0
483    bind $np <Return> "addhist $np"
484    grid [button $np.f6.b6b -text Cancel \
485            -command "destroy $np"] -column 1 -row 0
486    grid [button $np.f6.b6c -text "Add multiple banks" \
487            -command "addMultiplehist $np" -state disabled] -column 2 -row 0
488    grid [button $np.f6.help -text Help -bg yellow \
489            -command "MakeWWWHelp expgui3.html AddHist"] \
490            -column 2 -row 0 -sticky e
491    grid columnconfigure $np.f6 2 -weight 1
492    grid columnconfigure $np 3 -weight 1
493
494    # dummy histogram stuff
495    frame $np.d1
496    grid [label $np.d1.l1 -text min] -column 1 -row 1
497    grid [label $np.d1.l2 -text max] -column 2 -row 1
498    grid [label $np.d1.l3 -text step] -column 3 -row 1
499    grid [label $np.d1.lu -text ""] -column 4 -row 1 -rowspan 2
500    grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -column 1 -row 2
501    grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -column 2 -row 2
502    grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -column 3 -row 2
503    grid [label $np.d1.m1 -anchor w] -column 1 -row 3 -sticky ew
504    grid [label $np.d1.m2 -anchor w] -column 2 -row 3 -sticky ew
505    label $np.dl1 -text "Data range:"
506    label $np.dl2 -text "Allowed"
507    label $np.dl3 -text "\n" -justify left -fg blue
508    wm title $np "add new histogram"
509
510    set newhist(banknum) {}
511    set newhist(setnum) {}
512    if {[string trim $newhist(rawfile)] != {}} {
513        validaterawfile $np $newhist(rawfile)
514    }
515    if {[string trim $newhist(instfile)] != {}} {
516        validateinstfile $np $newhist(instfile)
517    }
518
519    PostInstBankopts $np
520    # set grab, etc.
521    putontop $np
522
523    tkwait window $np
524
525    # fix grab...
526    afterputontop
527    # if no histogram is selected, select the last
528    if {$expgui(curhist) == "" && $expmap(powderlist) != ""} {
529        $expgui(histFrame).hs.lbox select set end
530        set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
531        DisplayHistogram
532    }
533}
534
535# convert a file to Win-95 direct access -- this is not used anymore
536proc WinCvt {file win} {
537    global expgui
538    if ![file exists $file] {
539        MyMessageBox -parent $win -title "Convert Error" \
540                -message "File $file does not exist" -icon error
541        return
542    }
543
544    set tmpname "[file join [file dirname $file] tempfile.xxx]"
545    set oldname "[file rootname $file].org"
546    if [file exists $oldname] {
547        set ans [MyMessageBox -parent $win -title "OK to overwrite?" \
548                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
549                -icon question -type yesno -default yes]
550        if {$ans == "no"} return
551        catch {file delete $oldname}
552    }
553
554    if [catch {
555        set in [open $file r]
556        # needed to test under UNIX
557        set out [open $tmpname w]
558        fconfigure $out -translation crlf
559        set len [gets $in line]
560        if {$len > 160} {
561            # this is an old-style UNIX file. Hope there are no control characters
562            set i 0
563            set j 79
564            while {$j < $len} {
565                puts $out [string range $line $i $j]
566                incr i 80
567                incr j 80
568            }
569        } else {
570            while {$len >= 0} {
571                append line "                                        "
572                append line "                                        "
573                set line [string range $line 0 79]
574                puts $out $line
575                set len [gets $in line]
576            }
577        }
578        close $in
579        close $out
580        file rename $file $oldname
581        file rename $tmpname $file
582    } errmsg] {
583        MyMessageBox -parent $win -title Notify \
584                -message "Error in conversion:\n$errmsg" -icon warning
585    }
586    return $file
587}
588
589proc getrawfile {np} {
590    global newhist tcl_platform
591    if {$tcl_platform(platform) == "windows"} {
592        set inp [
593        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
594            {"Data files" .GSAS} {"Data files" .GSA} 
595            {"Data files" .RAW}  {"Data files" .FXYE} {"All files" *}
596        }
597        ]
598    } else {
599        set inp [
600        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
601            {"Data files" .GSA*} {"Data files" .RAW} 
602            {"Data files" .gsa*} {"Data files" .raw} {"Data files" .fxye}   
603            {"All files" *}
604        } 
605        ]
606    }
607    validaterawfile $np $inp
608}
609
610proc validaterawfile {np inp} {
611    global expgui newhist
612    if {$inp == ""} return
613    if [catch {set in [open $inp r]}] {
614        MyMessageBox -parent $np -title "Open error" \
615                -message "Unable to open file $inp" -icon error
616        return 
617    }
618    set newhist(banklist) {}
619    foreach child [winfo children $np.bank] {destroy $child}
620    # is this a properly formatted file?
621    # -- are lines the correct length & terminated with a CR-LF?   
622    fconfigure $in -translation lf
623    set i 0
624    while {[set len [gets $in line]] > 0} {
625        incr i
626        #if {$len != 81 || [string range $line end end] != "\r"} {
627        #    set ans [MyMessageBox -parent $np -title "Convert?" \
628        #           -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
629        #           -icon warning -type {OK Quit} -default OK]
630        #    if {$ans == "ok"} {
631        #       # convert and reopen the file
632        #       close $in
633        #       WinCvt $inp $np
634        #       set i 0
635        #       set in [open $inp r]
636        #       fconfigure $in -translation lf
637        #       set line {}
638        #    } else {
639        #       return
640        #    }
641        #}
642        # scan for BANK lines
643        if {[string first BANK $line] == 0} {
644            scan $line "BANK%d" num
645            lappend newhist(banklist) $num
646            # compute last point
647            set tmin 0
648            set tmax 0
649            catch {
650                scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
651                set tmin [expr $start/100.]
652                set tmax [expr ($start + $step*($nchan-1))/100.]
653            }
654            set newhist(tmin$num) $tmin
655            set newhist(tmax$num) $tmax
656        }
657        # check for "Instrument parameter file" line
658        if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
659            validateinstfile $np \
660                    [file join [file dirname $inp] \
661                    [string trim [string range $line 26 end]]]
662        }
663    }
664    # were banks found?
665    if {$newhist(banklist) == ""} {
666        MyMessageBox -parent $np -title "Read error" \
667                -message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \
668                -icon warning
669        return
670    }
671    # don't use a full path unless needed
672    if {[pwd] == [file dirname $inp]} {
673        set newhist(rawfile) [file tail $inp]
674    } else {
675        set newhist(rawfile) $inp
676    }
677    set row 0
678    set col -1
679    set flag 0
680    foreach i $newhist(banklist) {
681        if {$col > 8} {
682            set col -1
683            incr row
684        }
685        grid [radiobutton $np.bank.$i -text $i -command SetDefaultBank \
686                -variable newhist(banknum) -value $i] \
687                -column [incr col] -row $row -sticky w
688    }
689    # if only 1 choice, set it
690    if {[llength $newhist(banklist)] == 1} {
691        set newhist(banknum) $i
692        SetDefaultBank
693    } else {
694        set flag 1
695    }
696    if {$flag} {
697        set newhist(2tLimit) {}
698    }
699    SetMultipleAdd $np
700}
701
702proc SetDefaultBank {} {
703    # set the default instrument parameter set to follow the bank # when the
704    # numbers of banks in each place agree. Do this when the data bank # is set
705    global newhist
706    if {[llength $newhist(banklist)] == $newhist(instbanks)} {
707        set newhist(setnum) $newhist(banknum)
708    }
709    SetTmax
710}
711
712proc SetTmax {} {
713    # set the default data range when the data or instrument parameter set is changed
714    global newhist
715    # mode must be t-max or 2theta, at least for now
716    if {$newhist(LimitMode) != 1} return
717    # get data bank number, test if valid
718    set num $newhist(banknum)
719    if {[catch {expr $num}]} {return}
720    if {$newhist(insttype) == "TOF"} {
721        # is a instrument parameter file loaded? If not, try again later
722        if {[string trim $newhist(instfile)] == ""} return
723        set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
724        # at Ashfia's request, override the bank header # with the
725        # value from the instrument parameter file.
726        catch {
727            set s $newhist(setnum)
728            foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
729            if {$tmin > 0} {set newhist(2tLimit) $tmin}
730        }
731    } else {
732        set newhist(2tLimit) $newhist(tmax$num)
733    }
734}
735
736proc getinstfile {np} {
737    global newhist tcl_platform
738    if {$tcl_platform(platform) == "windows"} {
739        set inp [
740        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
741            {"Inst files" .INST} {"Inst files" .INS} 
742            {"Inst files" .PRM} {"All files" *}
743        }
744        ]
745    } else {
746        set inp [
747        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
748            {"Inst files" .INS*} {"Inst files" .ins*}
749            {"Inst files" .PRM}  {"Inst files" .prm} 
750            {"All files" *}
751        }
752        ]
753    }
754    set newhist(setnum) {}
755    validateinstfile $np $inp
756}
757
758proc validateinstfile {np inp} {
759    global expgui newhist
760    if {$inp == ""} return
761    if [catch {set in [open $inp r]}] {
762        MyMessageBox -parent $np -title "Open error" \
763                -message "Unable to open file $inp" -icon error
764        return 
765    }
766    set newhist(instbanks) {}
767    foreach child [winfo children $np.set] {destroy $child}
768    # is this a properly formatted file?
769    # -- are lines the correct length & terminated with a CR-LF?   
770    fconfigure $in -translation lf
771    while {[set len [gets $in line]] >= 0} {
772        #if {$len != 81 || [string range $line end end] != "\r"} {
773        #    set ans [MyMessageBox -parent $np -title "Convert?" \
774        #           -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
775        #           -icon warning -type {OK Quit} -default OK]
776        #    if {$ans == "ok"} {
777                # convert and reopen the file
778        #       close $in
779        #       WinCvt $inp $np
780        #       set in [open $inp r]
781        #       fconfigure $in -translation lf
782        #       set line {}
783        #    } else {
784        #       return
785        #    }
786        #}
787        # scan for the INS   BANK line
788        if {[string first "INS   BANK" $line] == 0} {
789            set newhist(instbanks) \
790                    [string trim [string range $line 12 end]]
791        }
792        # scan for the INS   HTYPE line
793        if {[string first "INS   HTYPE" $line] == 0} {
794            if {[string index [lindex $line 2] 2] == "T"} {
795                set newhist(insttype) TOF
796            } elseif {[string index [lindex $line 2] 2] == "E"} {
797                set newhist(insttype) ED
798            } elseif {[string index [lindex $line 2] 1] == "X"} {
799                set newhist(insttype) "CW X"
800            } else {
801                set newhist(insttype) "CW N"
802            }
803        }
804        # scan for the instrument constants
805        if {[regexp {INS ([ 1-9][0-9]) ICONS(.*)} $line a b c]} {
806            set b [string trim $b]
807            set newhist(inst${b}ICONS) [string trim $c]
808        }
809        if {[regexp {INS ([ 1-9][0-9])I ITYP(.*)} $line a b c]} {
810            set b [string trim $b]
811            set newhist(inst${b}ITYP) [string trim $c]
812        }
813        if {[regexp {INS ([ 1-9][0-9])BNKPAR(.*)} $line a b c]} {
814            set b [string trim $b]
815            set newhist(inst${b}Angle) [string trim [lindex $c 1]]
816        }
817    }
818    # were banks found?
819    if {$newhist(instbanks) == ""} {
820        MyMessageBox -parent $np -title "Read error" -message \
821                "File $inp has no \"INS   BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \
822                -icon warning
823        return
824    }
825    # don't use a full path unless needed
826    if {[pwd] == [file dirname $inp]} {
827        set newhist(instfile) [file tail $inp]
828    } else {
829        set newhist(instfile) $inp
830    }
831    set col -1
832    set row 0
833    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
834        if {$col > 8} {
835            set col -1
836            incr row
837        }
838        grid [radiobutton $np.set.$i -text $i \
839                -command "PostInstBankopts $np; ValidateDummyHist $np" \
840                -variable newhist(setnum) -value $i] \
841                -column [incr col] -row $row -sticky w
842        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
843    }
844    if {$newhist(dummy)} {PostInstBankopts $np; ValidateDummyHist $np}
845    LabelInstParm
846    SetMultipleAdd $np
847}
848
849proc addhist {np} {
850    global expgui newhist tcl_platform expmap
851    if {$newhist(dummy)} {
852        AddDummyHist $np
853        return
854    }
855    # validate the input
856    set err {}
857    if {[string trim $newhist(rawfile)] == ""} {
858        append err "  No data file specified\n"
859    }
860    if {[string trim $newhist(instfile)] == ""} {
861        append err "  No instrument parameter file specified\n"
862    }
863    if {[string trim $newhist(banknum)] == ""} {
864            append err "  Bank number must be specified\n"
865    } elseif {[catch {expr $newhist(banknum)}]} {
866            append err "  Bank number is not valid\n"
867    }
868    if {[string trim $newhist(setnum)] == ""} {
869        append err "  Parameter set number must be specified\n"
870    } elseif {[catch {expr $newhist(setnum)}]} {
871        append err "  Parameter set number is not valid\n"
872    }
873    if {[string trim $newhist(2tLimit)] == ""} {
874        append err "  2Theta/d-space limit must be specified\n"
875    } elseif {[catch {expr $newhist(2tLimit)}]} {
876        append err "  The 2Theta/d-space limit is not valid\n"
877    } elseif {$newhist(2tLimit) <= 0} {
878        append err "  The 2Theta/d-space limit is not valid\n"
879    }
880    if {[string trim $newhist(LimitMode)] == ""} {
881        append err "  Please choose between either a 2Theta, Q or d-space limit\n"
882    }
883
884    if {$err != ""} {
885        MyMessageBox -parent $np -title  "Add Histogram Error" \
886                -message "The following error(s) were found in your input:\n$err" \
887                -icon error -type ok -default ok \
888                -helplink "expgui3.html AddHistErr"
889        return
890    }
891
892    if {$newhist(LimitMode) == 1} {
893        set mode "T"
894        set value $newhist(2tLimit)
895    } elseif {$newhist(LimitMode) == 2} {
896        set mode "D"
897        set Q 100
898        catch {set Q [expr {4*acos(0)/$newhist(2tLimit)}]}
899        set value $Q
900    } else {
901        set mode "D"
902        set value $newhist(2tLimit)
903    }
904
905    # ok do it!
906    set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $newhist(banknum) $newhist(setnum) $mode $value]
907    # save call to Macro file
908    RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $newhist(banknum) $newhist(setnum) $mode $value" 0
909   
910    destroy $np
911    if {$expgui(showexptool) || $errmsg != ""} {
912        if {$errmsg != ""} {
913            set errcode 1
914            append errmsg "\n" $expgui(exptoolout)
915            set err "error"
916        } else {
917            set errcode 0
918            set errmsg $expgui(exptoolout) 
919        }
920        set msg "Please review the result from adding the histogram" 
921        if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
922        ShowBigMessage $np $msg $errmsg OK "" $errcode
923    }
924    # select the most recently added histogram
925    if {$err != ""} {
926        # set the powpref warning (2 = required)
927        set expgui(needpowpref) 2
928        set msg "A histogram was added" 
929        if {[string first $msg $expgui(needpowpref_why)] == -1} {
930            append expgui(needpowpref_why) "\t$msg\n"
931        }
932        set i [llength $expmap(histlistboxcontents)]
933        if {$i > 0} {
934            incr i -1
935            set expgui(curhist) $i
936            sethistlist
937        }
938    }
939}
940proc runAddHist {rawfile instfile banknum setnum mode value} {
941    global expgui expmap tcl_platform
942    set fp [open exptool.in w]
943    puts $fp "H"
944    if {$tcl_platform(platform) == "windows"} {
945        if {[string length $rawfile] > 50} {
946            puts $fp [file attributes $rawfile -shortname]
947        } else {
948            puts $fp $rawfile
949        }
950        if {[string length $instfile] > 50} {           
951            puts $fp [file attributes $instfile -shortname]
952        } else {
953            puts $fp $instfile
954        }
955    } else {
956        puts $fp $rawfile
957        puts $fp $instfile
958    }
959    puts $fp $banknum
960    puts $fp $setnum
961    puts $fp $mode
962    puts $fp "$value"
963    puts $fp "/"
964    puts $fp "X"
965    puts $fp "X"
966    close $fp
967    # Save the current exp file
968    savearchiveexp
969    # disable the file changed monitor
970    set expgui(expModifiedLast) 0
971    set expnam [file root [file tail $expgui(expfile)]]
972    set err [catch {
973        if {$tcl_platform(platform) == "windows"} {
974            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
975                    < exptool.in >& exptool.out
976        } else {
977            exec [file join $expgui(gsasexe) exptool] $expnam \
978                    < exptool.in >& exptool.out
979        }
980    } errmsg]
981    # load the revised exp file
982    set oldpowderlist $expmap(powderlist)
983    loadexp $expgui(expfile)
984    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
985        append errmsg "\nNo histogram added"
986        set err 1
987    }
988    set fp [open exptool.out r]
989    set expgui(exptoolout) [read $fp]
990    close $fp
991    catch {file delete exptool.in exptool.out}
992    if {$err} {
993        return $errmsg
994    } else {
995        return ""
996    }
997}
998
999proc RunRawplot {parent} {
1000    global newhist tcl_platform
1001    set f1 $newhist(rawfile)
1002    set f2 $newhist(instfile)
1003    # for Windows put a message on top, in case file names must be shortened
1004    if {$tcl_platform(platform) == "windows"} {
1005        catch {set f1 [file nativename \
1006                    [file attributes $newhist(rawfile) -shortname]]}
1007        catch {set f2 [file nativename \
1008                [file attributes $newhist(instfile) -shortname]]}
1009    }
1010    if {$f1 != "" || $f2 != ""} {
1011        #set msg "Note: input to RAWPLOT\n"
1012        #if {$f1 != ""} {append msg "data file: $f1\n"}
1013        #if {$f2 != ""} {append msg "instrument file: $f2"}
1014        catch {toplevel $parent.msg}
1015        catch {eval destroy [winfo children $parent.msg]}
1016        wm title $parent.msg "File names"
1017        grid [label $parent.msg.1 \
1018                -text "File names to be input to RAWPLOT" \
1019                -justify center -anchor center] \
1020                -column 0 -row 0 -columnspan 2
1021        if {$f1 != ""} {
1022            grid [label $parent.msg.2a \
1023                    -text "Raw histogram: $f1" \
1024                    -justify center -anchor e] \
1025                    -column 0 -row 1
1026            grid [button $parent.msg.2b \
1027                    -command "clipboard clear; clipboard append $f1" \
1028                    -text "put name\nin clipboard"] \
1029                    -column 1 -row 1
1030        }           
1031        if {$f2 != ""} {
1032            grid [label $parent.msg.3a \
1033                    -text "Raw histogram: $f2" \
1034                    -justify center -anchor e] \
1035                    -column 0 -row 2
1036            grid [button $parent.msg.3b \
1037                    -command "clipboard clear; clipboard append $f2" \
1038                    -text "put name\nin clipboard"] \
1039                    -column 1 -row 2
1040        }           
1041        grid [button $parent.msg.4 \
1042                -command "destroy $parent.msg" \
1043                -text "Close"] \
1044                -column 0 -columnspan 2 -row 9
1045    }
1046    # start RAWPLOT
1047    runGSASprog rawplot 1
1048    if {[winfo exists $parent.msg]} {raise $parent.msg}
1049    update
1050}
1051#--- Respond to the setting of the bank # for the Instrument parameter file.
1052proc PostInstBankopts {np} {
1053    global newhist
1054    if {$newhist(dummy)} {
1055        trace variable newhist(tmin) w "ValidateDummyHist $np"
1056        trace variable newhist(tmax) w "ValidateDummyHist $np"
1057        trace variable newhist(tstep) w "ValidateDummyHist $np"
1058        foreach w {l1 t1 lbank} {
1059            $np.$w config -fg grey
1060        }
1061        $np.d1.m1 config -text {}
1062        $np.d1.m2 config -text {}
1063        $np.b1 config -state disabled
1064        $np.b1a config -state disabled
1065        grid forget $np.l3 $np.e3 $np.cb3 $np.cb4 $np.cb5 $np.bank $np.f6a
1066        grid $np.dl1 -column 0 -row 18
1067        grid $np.d1 -column 1 -row 18 -rowspan 2 -columnspan 4 -sticky e
1068        grid $np.dl3 -column 0 -columnspan 99 -row 20 -sticky ew
1069        if {$newhist(insttype) == "TOF"} {
1070            $np.dl1 config -text "Data range:\n(TOF)"
1071            $np.d1.lu config -text millisec
1072            grid $np.dl2 -column 0 -row 19
1073            catch {
1074                set s $newhist(setnum)
1075                foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1076                $np.d1.m1 config -text $tmin
1077                $np.d1.m2 config -text $tmax
1078            }
1079        } elseif {[lindex $newhist(insttype) 0] == "CW"} {
1080            $np.dl1 config -text "Data range:\n(2Theta)"
1081            $np.d1.lu config -text degrees
1082            #grid forget $np.dl2
1083            $np.d1.m1 config -text >0.
1084            $np.d1.m2 config -text <180.
1085        } elseif {$newhist(insttype) == "ED"} {
1086            $np.dl1 config -text "Data range:\n(Energy)"
1087            $np.d1.lu config -text KeV
1088            $np.d1.m1 config -text 1.
1089            $np.d1.m2 config -text 200.
1090            grid $np.dl2 -column 0 -row 19
1091        } else {
1092            $np.dl1 config -text "No file\nselected"
1093            $np.d1.lu config -text {}
1094        }
1095    } else {
1096        foreach var {tmin tmax tstep} {
1097            foreach v [ trace vinfo newhist($var)] {
1098                eval trace vdelete newhist($var) $v
1099            }
1100        }
1101        grid forget $np.dl1 $np.d1 $np.dl2 $np.dl3
1102        foreach w {l1 t1 lbank} {
1103            $np.$w config -fg black
1104        }
1105        $np.b1 config -state normal
1106        $np.b1a config -state normal
1107        grid $np.bank -column 2 -row 3 -columnspan 7 -sticky ew
1108        grid $np.f6a -column 4 -row 18 -rowspan 3
1109        grid $np.l3 -column 0 -row 18 -rowspan 3
1110        grid $np.e3 -column 1 -row 18 -rowspan 3 
1111        grid $np.cb3 -column 2 -row 18 -sticky w
1112        grid $np.cb4 -column 2 -row 20 -sticky w
1113        grid $np.cb5 -column 2 -row 19 -sticky w
1114        SetTmax
1115    }
1116}
1117
1118proc ValidateDummyHist {np args} {
1119    # validate input
1120    global newhist
1121    set msg {}
1122    $np.dl3 config -text "\n"
1123    foreach e {e1 e2 e3} v {tmin tmax tstep} {
1124        if [catch {expr $newhist($v)}] {
1125            $np.d1.$e config -fg red
1126            append msg "Value of $newhist($v) is invalid for $v\n"
1127        } else {
1128            $np.d1.$e config -fg black
1129        }
1130    }
1131    if {[catch {expr $newhist(setnum)}]} {
1132        append msg "An instrument file bank number must be selected\n"
1133    } elseif {$newhist(setnum) <= 0 || \
1134            $newhist(setnum) > $newhist(instbanks)} {
1135        append msg "An invalid instrument file bank has been selected\n"
1136    }
1137
1138    if {$msg != ""} {return $msg}
1139
1140    if {$newhist(tmax) <= $newhist(tmin)} {
1141        $np.d1.e1 config -fg red
1142        $np.d1.e2 config -fg red
1143        return "Tmax <= Tmin\n"
1144    }
1145
1146
1147    set dmin -1
1148    set dmax -1
1149    if {$newhist(insttype) == "TOF"} {
1150        catch {
1151            set s $newhist(setnum)
1152            foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1153            if {$newhist(tmin) <$tmin } {
1154                $np.d1.e1 config -fg red
1155                append msg "Min value of $newhist(tmin) msec is invalid.\n"
1156            }
1157            if {$newhist(tmax) >$tmax } {
1158                $np.d1.e2 config -fg red
1159                append msg "Max value of $newhist(tmax) msec is invalid.\n"
1160            }
1161            set s $newhist(setnum)
1162            set dmin [expr {1000. * $newhist(tmin) / \
1163                    [lindex $newhist(inst${s}ICONS) 0]}]
1164            set dmax [expr {1000. * $newhist(tmax) / \
1165                    [lindex $newhist(inst${s}ICONS) 0]}]
1166        }
1167    } elseif {[lindex $newhist(insttype) 0] == "CW"} {
1168        if {$newhist(tmin) <= 0 } {
1169            $np.d1.e1 config -fg red
1170            append msg "Min value of $newhist(tmin) degrees is invalid.\n"
1171        }
1172        if {$newhist(tmax) >=180 } {
1173            $np.d1.e2 config -fg red
1174            append msg "Max value of $newhist(tmax) degrees is invalid.\n"
1175        }
1176        catch {
1177            set s $newhist(setnum)
1178            set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
1179                    * 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
1180            set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
1181                    * 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
1182        }
1183    } else {
1184        if {$newhist(tmin) <1 } {
1185            $np.d1.e1 config -fg red
1186            append msg "Min value of $newhist(tmin) KeV is invalid.\n"
1187        }
1188        if {$newhist(tmax) >200 } {
1189            $np.d1.e2 config -fg red
1190            append msg "Max value of $newhist(tmax) KeV is invalid.\n"
1191        }
1192        catch {
1193            set s $newhist(setnum)
1194            set ang [lindex $newhist(inst${s}ICONS) 0]
1195            set dmin [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
1196                    $newhist(tmax))}]
1197            set dmax [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
1198                    $newhist(tmin))}]
1199        }
1200    }
1201    if {$msg != ""} {return $msg}
1202    set pnts -1
1203    catch {
1204        set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
1205        set qmin [expr {4.*acos(0)/$dmax}]
1206        set qmax [expr {4.*acos(0)/$dmin}]
1207    }
1208    if {$pnts <= 0} {
1209        $np.d1.e3 config -fg red
1210        append msg "Step value of $newhist(tstep) is invalid.\n"
1211    }
1212    if {$pnts >20000} {
1213        $np.d1.e3 config -fg red
1214        append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
1215    }
1216    if {$msg != ""} {return $msg}
1217    if {$dmin > 0 && $dmax > 0} {
1218        catch {
1219            set msg [format \
1220                    {  %d points.%s  D-space range: %.2f-%.2f A,  Q: %.2f-%.2f/A} \
1221                    $pnts "\n" $dmin $dmax $qmin $qmax]
1222            $np.dl3 config -text $msg
1223        }
1224    }
1225    if {$msg != ""} {return ""}
1226    $np.dl3 config -text [format {  %d points.%s  Range: ?} $pnts "\n"]
1227    return "Invalid data range -- something is wrong!"
1228}
1229
1230proc AddDummyHist {np} {
1231    global newhist expgui expmap
1232    global tcl_platform
1233    set msg [ValidateDummyHist $np]
1234    if {$msg != ""} {
1235        MyMessageBox -parent $np -title  "Add Histogram Error" \
1236                -message "The following error(s) were found in your input:\n$msg" \
1237                -icon error -type ok -default ok \
1238                -helplink "expgui3.html AddHistErr"
1239        return
1240    }
1241
1242    set errmsg [runAddDummyHist $newhist(instfile) $newhist(setnum) \
1243                    $newhist(insttype) \
1244                    $newhist(tmin) $newhist(tmax) $newhist(tstep)]
1245    RecordMacroEntry "runAddDummyHist [list $newhist(instfile)] $newhist(setnum) $newhist(insttype) $newhist(tmin) $newhist(tmax) $newhist(tstep)" 0
1246
1247    if {[regexp {\(P,H,A\)} $expgui(exptoolout)]} {
1248        set msg {You must upgrade the EXPTOOL program.}
1249        append msg { This version cannot add dummy histograms.}
1250        MyMessageBox -icon error -title "Old EXPTOOL program" \
1251                -message $msg -parent $np \
1252                -helplink "expguierr.html OldEXPTOOL"
1253        # update the documentation & link
1254        destroy $np
1255    } elseif {$expgui(showexptool) || $errmsg != ""} {
1256        if {$errmsg != ""} {
1257            set err 1
1258            append errmsg "\n" $expgui(exptoolout) 
1259        } else {
1260            set err 0
1261            set errmsg $expgui(exptoolout) 
1262        }
1263        set msg "Please review the result from adding the dummy histogram" 
1264        if {$err} {append msg "\nIt appears an error occurred!"}
1265        ShowBigMessage $np $msg $errmsg OK "" $err
1266    } else {
1267        destroy $np
1268    }
1269    file delete exptool.in exptool.out
1270    # set the powpref warning (2 = required)
1271    set expgui(needpowpref) 2
1272    set msg "A histogram was added" 
1273    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1274        append expgui(needpowpref_why) "\t$msg\n"
1275    }
1276}
1277proc runAddDummyHist {instfile setnum insttype tmin tmax tstep} {
1278    global expgui expmap tcl_platform
1279    set fp [open exptool.in w]
1280    puts $fp "D"
1281    puts $fp $instfile
1282    puts $fp $setnum
1283    if {$insttype == "TOF"} {
1284        puts $fp "C"
1285    }
1286    puts $fp $tmin
1287    puts $fp $tmax
1288    puts $fp $tstep
1289    puts $fp "X"
1290    puts $fp "0"
1291    close $fp
1292    # Save the current exp file
1293    savearchiveexp
1294    # disable the file changed monitor
1295    set expgui(expModifiedLast) 0
1296    set expnam [file root [file tail $expgui(expfile)]]
1297    set err [catch {
1298        if {$tcl_platform(platform) == "windows"} {
1299            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1300                    < exptool.in >& exptool.out
1301        } else {
1302            exec [file join $expgui(gsasexe) exptool] $expnam \
1303                    < exptool.in >& exptool.out
1304        }
1305    } errmsg ]
1306    # load the revised exp file
1307    set oldpowderlist $expmap(powderlist)
1308    loadexp $expgui(expfile)
1309    set fp [open exptool.out r]
1310    set expgui(exptoolout) [read $fp]
1311    close $fp
1312    catch {file delete exptool.in exptool.out}
1313    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
1314        set err 1
1315        if {$errmsg == ""} {set errmsg "No histogram added"}
1316    }
1317    if {$err} {
1318        return $errmsg
1319    } else {
1320        return ""
1321    }
1322}
1323
1324#--- multiple histogram stuff
1325proc SetMultipleAdd {np} {
1326    global newhist
1327    $np.f6.b6c configure -state disabled
1328    catch {
1329        if {$newhist(instbanks) == [llength $newhist(banklist)] \
1330                && $newhist(instbanks) > 1} {
1331            $np.f6.b6c configure -state normal
1332        }
1333    }
1334}
1335
1336proc addMultiplehist {np} {
1337    global newhist
1338    # should not happen, but just in case
1339    if {$newhist(instbanks) != [llength $newhist(banklist)]} {
1340        $np.f6.b6c configure -state disable
1341        return
1342    }
1343    catch {destroy [set top $np.addMult]}
1344    toplevel $top
1345    grid [canvas $top.canvas \
1346            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1347            -yscrollcommand "$top.scroll set"] \
1348            -column 0 -columnspan 2 -row 2 -sticky ns
1349    grid columnconfigure $top 0 -weight 1
1350    grid rowconfigure $top 2 -weight 1
1351    scrollbar $top.scroll \
1352            -command "$top.canvas yview"
1353    frame [set cfr $top.canvas.fr]
1354    $top.canvas create window 0 0 -anchor nw -window $cfr
1355    grid [label $top.top \
1356              -text "Select banks to add; set the\nuseful range of data, limiting\nthe # of reflections." -anchor w -justify left \
1357              -bg beige] -column 0 -columnspan 3 -row 0 -sticky ew
1358    grid [frame $top.vartyp -bd 2 -relief groove] \
1359            -column 0 -columnspan 3 -row 1 -sticky ew
1360    grid [label $top.vartyp.top -text "Data limit units:"] -column 0 -row 0 -columnspan 3 -sticky w
1361    grid [radiobutton $top.vartyp.cb3 -text "d-min\n(A)" -variable newhist(LimitMode) \
1362            -value 0] -column 0 -row 1 -sticky w
1363    grid [radiobutton $top.vartyp.cb4 -textvariable newhist(datalimlbl)  \
1364            -variable newhist(LimitMode) -anchor w -justify l \
1365            -value 1] -column 1 -row 1 -sticky w
1366    grid [radiobutton $top.vartyp.cb5 -text "Q-max\n(A-1)" -variable newhist(LimitMode) \
1367            -value 2] -column 2 -row 1 -sticky w
1368   
1369    grid [button $top.add -text Add -command "destroy $np"] -column 0 -row 3
1370    grid [button $top.cancel -text Cancel -command "destroy $top"] \
1371            -column 1 -row 3 -columnspan 2
1372    set row 1
1373    grid [label $cfr.t1 -text "Bank\n#"] -column 0 -row 0
1374    switch $newhist(insttype) {
1375        TOF {set newhist(datalimlbl) "T-min\n(ms)"}
1376        ED  {set newhist(datalimlbl) "E-max\n(KeV)"}
1377        default {set newhist(datalimlbl) "2theta\nmax"}
1378    }
1379    grid [label $cfr.t2 -text "Upper\ndata limit"] -column 1 -row 0
1380    foreach i $newhist(banklist) {
1381        grid [checkbutton $cfr.c$i -text $i \
1382                -variable newhist(usebank$i)] \
1383                -column 0 -row [incr row] -sticky w
1384        set newhist(usebank$i) 1
1385        grid [entry $cfr.e$i -width 8 -textvariable newhist(tlimit$i)] \
1386            -column 1 -row $row -sticky w
1387        lappend newhist(LimitMode_boxes) $cfr.e$i
1388        if {$newhist(insttype) == "TOF"} {
1389            set newhist(tlimit$i) $newhist(tmin$i)
1390            catch {
1391                foreach {x tmin tmax x} $newhist(inst${i}ITYP) {}
1392                if {$tmin > 0} {set newhist(tlimit$i) $tmin}
1393            }
1394        } else {
1395            set newhist(tlimit$i) $newhist(tmax$i)
1396        }
1397    }
1398    # resize the list
1399    update
1400    set sizes [grid bbox $top.canvas.fr]
1401    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1402    # use the scroll for BIG lists
1403    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1404        grid $top.scroll -sticky ns -column 3 -row 2
1405    } else {
1406        grid forget $top.scroll 
1407    }
1408    update
1409    putontop $top
1410    tkwait window $top
1411    afterputontop
1412
1413    if {[winfo exists $np]} return
1414
1415    # validate the input
1416    set err {}
1417    if {[string trim $newhist(rawfile)] == ""} {
1418        append err "  No data file specified\n"
1419    }
1420    if {[string trim $newhist(instfile)] == ""} {
1421        append err "  No instrument parameter file specified\n"
1422    }
1423    foreach i $newhist(banklist) {
1424        if {$newhist(usebank$i)} {
1425            if {[catch {expr $newhist(tlimit$i)}]} {
1426                append err "  The Max/Min limit is not valid for bank $i\n"
1427            } elseif {$newhist(tlimit$i) <= 0} {
1428                append err "  The Max/Min limit is not valid for bank $i\n"
1429            }
1430        }
1431    }
1432    if {$err != ""} {
1433        MyMessageBox -parent $np -title  "Add Histogram Error" \
1434                -message "The following error(s) were found in your input:\n$err" \
1435                -icon error -type ok -default ok \
1436                -helplink "expgui3.html AddHistErr"
1437        return
1438    }
1439
1440    # ok do it!
1441    global tcl_platform expmap expgui
1442    # Save the current exp file
1443    savearchiveexp
1444    set oldpowderlist $expmap(powderlist)
1445    # disable the file changed monitor
1446    set expgui(expModifiedLast) 0
1447    set k 0
1448    set added 0
1449    set outlog {}
1450    set err 0
1451    pleasewait "adding histograms" expgui(temp)
1452    foreach i $newhist(banklist) {
1453        incr k
1454        if {$newhist(usebank$i)} {
1455            incr added
1456            set expgui(temp) "adding bank $i"
1457            update
1458
1459            if {$newhist(LimitMode) == 1} {
1460                set mode "T"
1461                set value $newhist(tlimit$i)
1462            } elseif {$newhist(LimitMode) == 2} {
1463                set mode "D"
1464                set Q 100
1465                catch {set Q [expr {4*acos(0)/$newhist(tlimit$i)}]}
1466                set value $Q
1467            } else {
1468                set mode "D"
1469                set value $newhist(tlimit$i)
1470            }
1471            set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $i $k $mode $value]
1472            # save call to Macro file
1473            RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $i $k $mode $value" 0
1474            if {$errmsg != ""} {
1475                append outlog "\n\n\nNOTE ERROR:\n" $errmsg $expgui(exptoolout)
1476                set err 1
1477            } else {
1478                append outlog $expgui(exptoolout)
1479            }
1480        }
1481    }
1482    # load the revised exp file
1483    loadexp $expgui(expfile)
1484    if {[llength $oldpowderlist]+$added != [llength $expmap(powderlist)]} {
1485        set err 1
1486    }
1487    # set the powpref warning (2 = required)
1488    set expgui(needpowpref) 2
1489    set msg "A histogram was added" 
1490    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1491        append expgui(needpowpref_why) "\t$msg\n"
1492    }
1493    donewait 
1494    if {$expgui(showexptool) || $err} {
1495        set msg "Please review the result from adding the histogram" 
1496        if {$err} {append msg "\nIt appears an error occurred!"}
1497        ShowBigMessage $np $msg $outlog OK "" $err
1498    }
1499    # select the most recently added histogram
1500    if {!$err} {
1501        set i [llength $expmap(histlistboxcontents)]
1502        if {$i > 0} {
1503            incr i -1
1504            set expgui(curhist) $i
1505            sethistlist
1506        }
1507    }
1508}
1509
1510#----------- Add Atoms routines ----------------------------------------
1511proc MakeAddAtomsBox {phase "atomlist {}"} {
1512    global expmap expgui
1513
1514    # is there room for more atoms? Well, we will check this someday
1515    if {$phase == ""} return
1516    if {[llength $phase] != 1} return
1517
1518    set top .newatoms
1519    catch {destroy $top}
1520    toplevel $top
1521    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
1522
1523    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1524            -text "Adding atoms to phase #$phase"] \
1525            -column 0 -row 0 \
1526            -sticky we -columnspan 10
1527   
1528    grid [canvas $top.canvas \
1529            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1530            -yscrollcommand "$top.scroll set"] \
1531            -column 0 -row 2 -columnspan 4 -sticky nsew
1532    grid columnconfigure $top 3 -weight 1
1533    grid rowconfigure $top 2 -weight 1
1534    grid rowconfigure $top 1 -pad 5
1535    scrollbar $top.scroll \
1536            -command "$top.canvas yview"
1537    frame $top.canvas.fr
1538    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1539
1540    set np $top.canvas.fr
1541    set row 0
1542    set col 0
1543    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
1544    foreach i {Atom\ntype Name x y z Occ Uiso} \
1545            var {type name x y z occ uiso} {
1546        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1547                -command "sortAddAtoms $phase $top $var"] \
1548                -column [incr col] -row $row -sticky nsew
1549    }
1550    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
1551
1552    set expgui(SetAddAtomsScroll) 0
1553    set i [llength $atomlist]
1554    if {$i == 0} {incr i}
1555    for {set j 0} {$j < $i} {incr j} {
1556        MakeAddAtomsRow $top
1557    }
1558    set row 0
1559    foreach item $atomlist {
1560        incr row
1561        foreach val $item w {n x y z t o u} {
1562            if {$val != ""} {
1563                $np.e${row}$w delete 0 end
1564                $np.e${row}$w insert end $val
1565            }
1566        }
1567    }
1568    bind $top <Configure> "SetAddAtomsScroll $top"
1569    grid rowconfigure $top 3 -min 10
1570    grid [button $top.b1 -text "Add Atoms"\
1571            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
1572    bind $top <Return> "addatom $phase $top"
1573    grid [button $top.b2 -text Cancel \
1574            -command "destroy $top"] -column 1 -row 5 -sticky w
1575    grid [button $top.help -text Help -bg yellow \
1576            -command "MakeWWWHelp expgui2.html addatoms"] \
1577            -column 0 -columnspan 2 -row 4
1578
1579    # get the input formats if not already defined
1580    GetImportFormats
1581    if {[llength $expgui(importFormatList)] > 0} {
1582        grid [frame $top.fr -bd 4 -relief groove] \
1583                -column 3 -row 5 -columnspan 2 -sticky e
1584        grid [button $top.fr.b3 -text "Import atoms from: " \
1585                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1586                -column 0 -row 0 -sticky e
1587        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1588                $expgui(importFormatList)]
1589        for {set i 0} {$i <= [$menu index end]} {incr i} {
1590            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1591        }
1592        grid $top.fr.b4 -column 1 -row 0 -sticky w
1593        grid rowconfig $top.fr 0 -pad 10
1594        grid columnconfig $top.fr 0 -pad 10
1595        grid columnconfig $top.fr 1 -pad 10
1596    }
1597
1598    grid [button $top.b3 -text  "More atom boxes" \
1599            -command "MakeAddAtomsRow $top"] -column 3 \
1600            -columnspan 2 -row 4 -sticky e
1601   
1602    wm title $top "add new atom"
1603
1604    # set grab, etc.
1605    putontop $top
1606
1607    tkwait window $top
1608
1609    # fix grab...
1610    afterputontop
1611}
1612
1613proc MakeAddAtomsRow {top} {
1614    set np $top.canvas.fr
1615    set col -1
1616    set row 1
1617    # find an empty row
1618    while {![catch {grid info $np.e${row}t}]} {incr row}
1619    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
1620    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
1621    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
1622    foreach i {x y z o u} {
1623        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
1624    }
1625    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1626            -column [incr col] -row $row
1627    # default occupancy
1628    $np.e${row}o delete 0 end
1629    $np.e${row}o insert end 1.0
1630    # default Uiso
1631    $np.e${row}u delete 0 end
1632    $np.e${row}u insert end 0.025
1633    # default label
1634    $np.e${row}n delete 0 end
1635    $np.e${row}n insert end (default)
1636    # use by default
1637    $np.e${row}use select
1638
1639    SetAddAtomsScroll $top
1640    return $row
1641}
1642
1643proc SetAddAtomsScroll {top} {
1644    global expgui
1645    if $expgui(SetAddAtomsScroll) return
1646    # prevent reentrance
1647    set expgui(SetAddAtomsScroll) 1
1648    update
1649    set sizes [grid bbox $top.canvas.fr]
1650    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1651    # use the scroll for BIG atom lists
1652    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1653        grid $top.scroll -sticky ns -column 4 -row 2
1654    } else {
1655        grid forget $top.scroll
1656    }
1657    update
1658    set expgui(SetAddAtomsScroll) 0
1659}
1660
1661set expgui(atmtypelist) {}
1662proc GetAtmTypes {} {
1663    set ::expgui(atmtypelist) {}
1664    set ::expgui(magtypelist) {}
1665    catch {
1666        set fp [open [file join $::expgui(gsasdir) data atmdata.dat] r]
1667        while {[gets $fp line] >= 0} {
1668            set token [string toupper [string trim [string range $line 2 8]]]
1669            if {$token == ""} continue
1670            # nuclear/magnetic
1671            if {[lindex $token 1] == "N" || [lindex $token 1] == "M"} {
1672                set magarr([lindex $token 0]) 1
1673                continue
1674            }
1675            if {[string is integer $token]} continue
1676            if {[string first "_" $token] != -1} {
1677                set sp [split $token "_"]
1678                if {[lindex $sp 1] == ""} continue
1679                if {! [string is integer [lindex $sp 1]]} continue
1680            }
1681            set tmparr([string toupper $token]) 1
1682        }
1683        set ::expgui(atmtypelist) [array names tmparr]
1684        set ::expgui(magtypelist) [array names magarr]
1685        close $fp
1686    } errmsg
1687    if {$::expgui(debug) && $errmsg != ""} {
1688        puts "GetAtmTypes error: $errmsg"
1689    }
1690}
1691
1692# Validate the atoms in the atoms add/phase replace box
1693# returns a null string on error or a list of atoms
1694proc ValidateAtomsBox {top np} {
1695    global expgui
1696    set row 0
1697    # loop over the defined rows
1698    set err {}
1699    set atomlist {}
1700    set validatmtypes {
1701        H H-1 H_1 H_2 D H_3 HE HE_3 HE_4 LI LI+1 LI_6 LI_7 BE BE+2 B B_10
1702        B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O-2 O_16 O_17 O_18 F F-1 F_19 NE
1703        NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1704        AL_27 SI SI+4 SIV SI_28 SI_29 SI_30 P P_31 S S_32 S_33 S_34 CL CL-1
1705        CL_35 CL_37 AR AR_36 AR_40 K K+1 K_39 K_41 CA CA+2 CA_40 CA_44 SC SC+3
1706        SC_45 TI TI+2 TI+3 TI+4 TI_46 TI_47 TI_48 TI_49 TI_50 V V+2 V+3 V+5
1707        V_51 CR CR+2 CR+3 CR_50 CR_52 CR_53 CR_54 MN MN+2 MN+3 MN+4 MN_55 FE
1708        FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1709        NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1710        ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1711        RB RB+1 SR SR+2 Y Y+3 Y_89 ZR ZR+4 NB NB+3 NB+5 NB_93 MO MO+3 MO+5
1712        MO+6 TC TC_98 RU RU+3 RU+4 RH RH+3 RH+4 RH_103 PD PD+2 PD+4 AG AG+1
1713        AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1714        SN+4 SB SB+3 SB+5 TE I I-1 I_127 XE CS CS+1 CS_133 BA BA+2 LA LA+3 CE
1715        CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 SM SM+3 SM_152
1716        SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1717        HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1718        TA+5 TA_181 W W+6 RE OS OS+4 IR IR+3 IR+4 PT PT+2 PT+4 AU AU+1 AU+3
1719        AU_197 HG HG+1 HG+2 TL TL+1 TL+3 PB PB+2 PB+4 BI BI+3 BI+5 BI_209 PO
1720        AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1721        TH+4 TH_232 PA PA_231 U U+3 U+4 U+6 U_235 U_238 NP NP+3 NP+4 NP+6
1722        NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1723        BK_247 CF CF_249
1724    }
1725    # loop over the defined rows
1726    while {![catch {grid info $np.e[incr row]t}]} {
1727        if !{$expgui(UseAtom$row)} continue
1728        # ignore blank entries
1729        set line {}
1730        foreach i {t x y z} {
1731            append line [string trim [$np.e${row}$i get]]
1732        }
1733        if {$line == ""} continue
1734
1735        # validate the input
1736        if {[set type [string trim [$np.e${row}t get]]] == ""} {
1737            append err "  line $row: No atom type specified\n"
1738        }
1739        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1740            if {[llength $expgui(atmtypelist)] == 0} GetAtmTypes
1741            if {[lsearch $expgui(atmtypelist) [string toupper $type]] == -1} {
1742                if {[lsearch $expgui(magtypelist) [string toupper $type]] == -1} {
1743                    append err "  line $row: Atom type $type is not defined in GSAS.\n\n"
1744                } else {
1745                    append err "  line $row: Atom type $type is not defined for x-rays in GSAS, but is defined for magnetic/nuclear scattering. If you want to use this symbol choose a different type here and change it later in EXPEDT.\n\n"
1746                }
1747            }
1748        }
1749        set name [string trim [$np.e${row}n get]]
1750        if {$name == "(default)"} {set name "/"}
1751        if {$name == ""} {set name "/"}
1752        foreach i {x y z o u} n {x y z Occ Uiso} {
1753            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1754                append err "  line $row: No value specified for $n\n"
1755            } elseif {[catch {expr [set $i]}]} {
1756                append err "  line $row: The value for $n is invalid\n"
1757            }
1758        }
1759        lappend atomlist "$type $x $y $z $o $name I $u"
1760    }
1761    if {$err != ""} {
1762        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
1763        return {}
1764    }
1765    if {[llength $atomlist] == 0} {
1766        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1767        return {}
1768    }
1769    return $atomlist
1770}
1771
1772proc runAddAtoms {phase atomlist} {
1773    global expgui env expmap tcl_platform
1774    # needed in UNIX
1775    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1776    set env(gsas) [file nativename $expgui(gsasdir)]
1777    # needed in Windows
1778    set env(GSAS) [file nativename $expgui(gsasdir)]
1779
1780    set fp [open exptool.in w]
1781    puts $fp "A"
1782    puts $fp $phase
1783    # number of atoms
1784    puts $fp [llength $atomlist]
1785    foreach atomline $atomlist {
1786        puts $fp $atomline
1787    }
1788    close $fp
1789 
1790    # Save the current exp file
1791    savearchiveexp
1792    # disable the file changed monitor
1793    set expgui(expModifiedLast) 0
1794    set expnam [file root [file tail $expgui(expfile)]]
1795
1796    set err [catch {
1797        if {$tcl_platform(platform) == "windows"} {
1798            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1799                    < exptool.in >& exptool.out
1800        } else {
1801            exec [file join $expgui(gsasexe) exptool] $expnam \
1802                    < exptool.in >& exptool.out
1803        }
1804    } errmsg]
1805    # load the revised exp file
1806    set oldatomlist $expmap(atomlist_$phase)
1807    loadexp $expgui(expfile)
1808    set fp [open exptool.out r]
1809    set expgui(exptoolout) [read $fp]
1810    close $fp
1811    catch {file delete exptool.in exptool.out}
1812    if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1813        set err 1
1814        if {$errmsg == ""} {set errmsg "No atom(s) added"}
1815    }
1816}
1817
1818proc addatom {phase top} {
1819    global expgui env expmap
1820    set np $top.canvas.fr
1821    # validate the atoms info
1822    set atomlist [ValidateAtomsBox $top $np]
1823    if {$atomlist == ""} return
1824
1825    # ok add the atoms!
1826    set errmsg [runAddAtoms $phase $atomlist]
1827    RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
1828
1829    destroy $top
1830    set err 0
1831    if {$errmsg != ""} {
1832        append errmsg "\n" $expgui(exptoolout)
1833        set err 1
1834    } else {
1835        set errmsg $expgui(exptoolout)
1836    }
1837    if {$expgui(showexptool) || $err} {
1838        set msg "Please review the result from adding the atom(s)" 
1839        if {$err} {append msg "\nIt appears an error occurred!"}
1840        ShowBigMessage $top $msg $errmsg OK "" $err
1841    }
1842}
1843
1844#---------------------------------------------------------------------------
1845# commands to modify a group of selected atoms
1846#---------------------------------------------------------------------------
1847
1848# make the dialog to choose an action
1849proc MakeXformAtomsBox {phase} {
1850    global expgui expmap
1851    set numberList {}
1852    set p $expgui(curPhase)
1853    foreach AtomIndex $expgui(selectedatomlist) {
1854        # get atom number & phase
1855        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1856        lappend numberList [lindex $tuple 0]
1857    }
1858    if {$numberList == ""} return
1859    if {[llength $numberList] > 1} {
1860        set suffix s
1861        set suffixy "ies"
1862    } else {
1863        set suffix ""
1864        set suffixy "y"
1865    }
1866    set w .global
1867    catch {destroy $w}
1868    toplevel $w
1869    wm title $w "Edit Atomic Parameter -- phase #$phase"
1870    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
1871    # this needs to track by phase
1872    grid [label $w.0 \
1873            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
1874            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
1875            -sticky nsew
1876    grid rowconfigure $w 0 -pad 5
1877    grid rowconfigure $w 1 -minsize 2
1878
1879    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
1880            -row 2 -column 0 -columnspan 10 -sticky news
1881    set w1 [$w.1 getframe]
1882    set row 0
1883    foreach v {x y z} {
1884        incr row
1885        set col -1
1886        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
1887        foreach o {x y z} {
1888            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
1889            $w1.e${v}${o} delete 0 end
1890            if {$v == $o} {
1891                $w1.e${v}${o} insert end "1.0"
1892            } else {
1893                $w1.e${v}${o} insert end "0."
1894            }
1895            grid [label $w1.p${v}${o} -text " $o  +  "] \
1896                    -column [incr col] -row $row
1897        }
1898        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
1899        $w1.e${v} delete 0 end
1900        $w1.e${v} insert end "0."
1901    }
1902    grid [button $w1.do -text "Transform Coordinates" \
1903            -command "XformAtomsCoord $phase [list $numberList] $w1" \
1904            ] -row [incr row] -column 0 -columnspan 10
1905
1906    set shift [GetOrigin1Shift $phase]
1907    grid [button $w1.d1 -text "Xform Origin 1 to Origin 2" \
1908              -command "XformAtoms2Origin2 $phase [list $numberList] $w1 [list $shift]" \
1909             ] -row [incr row] -column 3 -columnspan 10 -sticky e
1910    if {$shift == ""} {$w1.d1 config -state disabled}
1911
1912    grid [button $w1.d4 -text "Reset Multiplicities" \
1913                -command "ResetMultiplicities $phase $w" \
1914                ] -row $row -column 0 -columnspan 3 -sticky w
1915
1916
1917    grid rowconfigure $w 3 -minsize 5
1918    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1919            -row 4 -column 0 -columnspan 10 -sticky news
1920    set w2 [$w.4 getframe]
1921    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1922    grid [entry $w2.e -width 10] -column 1 -row 1
1923    $w2.e delete 0 end
1924    $w2.e insert end 1.0
1925    grid columnconfigure $w2 2 -weight 1
1926    grid [button $w2.do -text "Set Occupanc${suffixy}" \
1927            -command "XformAtomsOcc $phase [list $numberList] $w2" \
1928            ] -row 2 -column 0 -columnspan 10
1929
1930    grid rowconfigure $w 5 -minsize 5
1931    grid [TitleFrame $w.6 -bd 6 -relief groove \
1932            -text "Modify Displacement Parameter$suffix"] \
1933            -row 6 -column 0 -columnspan 10 -sticky news
1934    set w2 [$w.6 getframe]
1935    grid [entry $w2.e -width 10] -column 1 -row 1
1936    $w2.e delete 0 end
1937    $w2.e insert end 0.025
1938    grid columnconfigure $w2 2 -weight 1
1939    grid [button $w2.do -text "Set U" \
1940            -command "XformAtomsU $phase [list $numberList] $w2" \
1941            ] -row 2 -column 0 -columnspan 10
1942    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1943
1944    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1945        grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1946        grid [button $w2.f.iso -text "Set Isotropic" \
1947                -command "XformAtomsU $phase [list $numberList] iso" \
1948                ] -row 0 -column 0
1949        grid [button $w2.f.aniso -text "Set Anisotropic" \
1950                -command "XformAtomsU $phase [list $numberList] aniso" \
1951                ] -row 0 -column 1
1952    } else {
1953        grid [label $w2.1 -text "Uiso: "] -row 1 -column 0
1954    }
1955
1956    grid rowconfigure $w 7 -minsize 5
1957    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1958        grid [TitleFrame $w.8 -bd 6 -relief groove \
1959                -text "Erase Atom$suffix"] \
1960                -row 8 -column 0 -columnspan 10 -sticky news
1961        set w2 [$w.8 getframe]
1962        grid [button $w2.do -text "Erase Atom${suffix}" \
1963                -command "EraseAtoms $phase [list $numberList] $w" \
1964                ] -row 2 -column 0 -columnspan 10
1965    }
1966
1967    # allow fixing of atom coordinates
1968    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1969        grid [TitleFrame $w.10 -bd 6 -relief groove \
1970                  -text "Fix Coordinates for Atom$suffix"] \
1971            -row 9 -column 0 -columnspan 10 -sticky news
1972        set fix [$w.10 getframe]
1973        # set button labels
1974        set ::fixbtn_lbl(X) [Fix_State $phase $numberList X]
1975        set ::fixbtn_lbl(Y) [Fix_State $phase $numberList Y]
1976        set ::fixbtn_lbl(Z) [Fix_State $phase $numberList Z]
1977
1978        label $fix.xlab -text "  x  " -width 8
1979        label $fix.ylab -text "  y  " -width 8
1980        label $fix.zlab -text "  z  " -width 8
1981        grid $fix.xlab -row 2 -column 0
1982        grid $fix.ylab -row 2 -column 1
1983        grid $fix.zlab -row 2 -column 2
1984
1985
1986        button $fix.x -textvariable fixbtn_lbl(X) -width 8 \
1987            -command "Fix_Atoms $phase [list $numberList] X"
1988        button $fix.y -textvariable fixbtn_lbl(Y) -width 8 \
1989            -command "Fix_Atoms $phase [list $numberList] Y"
1990        button $fix.z -textvariable fixbtn_lbl(Z) -width 8 \
1991            -command "Fix_Atoms $phase [list $numberList] Z"
1992        grid $fix.x -row 3 -column 0
1993        grid $fix.y -row 3 -column 1
1994        grid $fix.z -row 3 -column 2
1995    }
1996    #xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
1997
1998    grid rowconfigure $w 11 -minsize 5
1999    grid [frame $w.b] -row 12 -column 0 -columnspan 10 -sticky ew
2000    pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
2001            -padx 5 -pady 5
2002    pack [button $w.b.help -text Help -bg yellow \
2003            -command "MakeWWWHelp expgui2.html xform"] -side right \
2004            -padx 5 -pady 5
2005    bind $w <Return> "destroy $w"
2006
2007    # force the window to stay on top
2008    putontop $w
2009    focus $w.b.3
2010    tkwait window $w
2011    afterputontop
2012    # if there are selected atoms, reset their display
2013    if {[llength $expgui(selectedatomlist)] != 0} editRecord
2014}
2015
2016# test the fixed status of variable for several atoms
2017proc Fix_State {phase numberList coord} {
2018    set status_fixed 0
2019    set status_unfixed 0
2020    #puts "$coord before: $status_fixed $status_unfixed"
2021    foreach i $numberList {
2022        set temp [atom_constraint_get $phase $i $coord]
2023        if {$temp == 0} {
2024            set status_unfixed 1
2025        } else {
2026            set status_fixed 1
2027        }
2028        if {$status_fixed == 1 && $status_unfixed == 1} {
2029            return "fix\nsome"
2030        }
2031    }
2032    #puts "$coord after $status_fixed $status_unfixed"
2033    if {$status_fixed == 0} {return "fix"}
2034    return "release"
2035}
2036
2037# fix or release the selected atoms
2038proc Fix_Atoms {phase numberList coord} {
2039    if {$::fixbtn_lbl($coord) == "release"} {
2040        set ::fixbtn_lbl($coord) "fix"
2041        set mode 0
2042    } else {
2043        set ::fixbtn_lbl($coord) "release"
2044        set mode 1
2045    }
2046    atom_constraint_set $phase $numberList $coord $mode
2047    incr ::expgui(changed)
2048    RecordMacroEntry "atom_constraint_set $phase [list $numberList] $coord $mode" 0
2049    RecordMacroEntry "incr expgui(changed)" 0
2050    DisplayAllAtoms $phase
2051}
2052
2053
2054# transform the coordinates
2055proc XformAtomsCoord {phase numberList w1} {
2056    global expgui expmap
2057    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2058        set cmd mmatominfo
2059    } else {
2060        set cmd atominfo
2061    }
2062    # get the matrix
2063    foreach v {x y z} {
2064        foreach o {x y z} {
2065            set matrix(${v}${o}) [$w1.e${v}${o} get]
2066        }
2067        set matrix(${v}) [$w1.e${v} get]
2068    }
2069    foreach atom $numberList {
2070        foreach v {x y z} {
2071            set $v [$cmd $phase $atom $v]
2072        }
2073        foreach v {x y z} {
2074            set new$v $matrix(${v})
2075            foreach o {x y z} {
2076                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
2077            }
2078            $cmd $phase $atom $v set [set new$v]
2079            RecordMacroEntry "$cmd $phase $atom $v set [set new$v]" 0
2080        }
2081        incr expgui(changed)
2082    }
2083    RecordMacroEntry "incr expgui(changed)" 0
2084    # update multiplicities for the phase
2085    set parent [winfo toplevel $w1]
2086    ResetMultiplicities $phase $parent
2087    SelectOnePhase $phase
2088    MyMessageBox -parent $parent -type OK -default ok -title "Transform applied" \
2089        -message "The coordinates of atoms [CompressList $numberList] have been transformed"
2090#    UpdateAtomLine $numberList $phase
2091    destroy $parent
2092}
2093
2094# set the occupancies to a single value
2095proc XformAtomsOcc {phase numberList w2} {
2096    global expgui expmap
2097    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2098        set cmd mmatominfo
2099    } else {
2100        set cmd atominfo
2101    }
2102    # get the value
2103    set val [$w2.e get]
2104    foreach atom $numberList {
2105        $cmd $phase $atom frac set $val
2106        RecordMacroEntry "$cmd $phase $atom frac set $val" 0
2107        incr expgui(changed)
2108    }
2109    RecordMacroEntry "incr expgui(changed)" 0
2110    UpdateAtomLine $numberList $phase
2111}
2112
2113# transform Uiso or Uij; if anisotropic set Uequiv to Uij
2114proc XformAtomsU {phase numberList w2} {
2115    global expgui
2116    set istart $expgui(changed)
2117    if {$w2 == "iso"} {
2118        foreach atom $numberList {
2119            if {[atominfo $phase $atom temptype] != "I"} {
2120                atominfo $phase $atom temptype set I
2121                RecordMacroEntry "atominfo $phase $atom temptype set I" 0
2122                incr expgui(changed)
2123            }
2124        }
2125    } elseif {$w2 == "aniso"} {
2126        foreach atom $numberList {
2127            if {[atominfo $phase $atom temptype] == "I"} {
2128                atominfo $phase $atom temptype set A
2129                RecordMacroEntry "atominfo $phase $atom temptype set A" 0
2130                incr expgui(changed)
2131            }
2132        }
2133    } else {
2134        # get the value
2135        set val [$w2.e get]
2136        foreach atom $numberList {
2137            global expmap
2138            if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2139                mmatominfo $phase $atom Uiso set $val
2140                RecordMacroEntry "mmatominfo $phase $atom Uiso set $val" 0
2141            } elseif {[atominfo $phase $atom temptype] == "I"} {
2142                atominfo $phase $atom Uiso set $val
2143                RecordMacroEntry "atominfo $phase $atom Uiso set $val" 0
2144            } else {
2145                foreach var {U11 U22 U33} {
2146                    atominfo $phase $atom $var set $val
2147                    RecordMacroEntry "atominfo $phase $atom $var set $val" 0
2148                }
2149                foreach var {U12 U13 U23} {
2150                    atominfo $phase $atom $var set 0.0
2151                    RecordMacroEntry "atominfo $phase $atom $var set 0.0" 0
2152                }
2153            }
2154            incr expgui(changed)
2155        }
2156    }
2157    if {$istart != $expgui(changed)} {RecordMacroEntry "incr expgui(changed)" 0}
2158    UpdateAtomLine $numberList $phase
2159}
2160
2161# confirm and erase atoms
2162proc EraseAtoms {phase numberList w2} {
2163    global expgui
2164    if {[llength $numberList] <= 0} return
2165    # make a list of atoms
2166    foreach atom $numberList {
2167        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
2168    }
2169    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
2170    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
2171            -default cancel -title "Confirm Erase" -message $msg]
2172    if {$val == "ok"} {
2173        foreach atom $numberList {
2174            EraseAtom $atom $phase
2175            RecordMacroEntry "EraseAtom $atom $phase" 0
2176            incr expgui(changed)
2177        }
2178        RecordMacroEntry "incr expgui(changed)" 0
2179        mapexp
2180        RecordMacroEntry "mapexp" 0
2181        DisplayAllAtoms $phase
2182        destroy $w2
2183    }
2184}
2185
2186#----------- more Add Phase routines (import) -------------------------------
2187proc ImportPhase {format np} {
2188    global expgui
2189    if {[llength $expgui(extensions_$format)] == 1} {
2190        lappend typelist [list $format $expgui(extensions_$format)]
2191    } else {
2192        foreach item $expgui(extensions_$format) {
2193            lappend typelist [list "All $format" $item]
2194            lappend typelist [list "$format $item" $item]
2195        }
2196    }
2197    lappend typelist [list "All files" *]
2198    set file [tk_getOpenFile -parent $np -filetypes $typelist]
2199    if {![file exists $file]} return
2200    # read in the file
2201    set expgui(addPhaseCellType) Any
2202    set input [$expgui(proc_$format) $file]
2203    catch {
2204        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
2205        bind $np <Return> "addphase $np; AddAtomsList"
2206    }
2207    catch {
2208        $np.t1 delete 0 end
2209        $np.t1 insert end "from $file"
2210    }
2211    set spg [lindex $input 0]
2212    set expgui(coordList) [lindex $input 2]
2213    set msg [lindex $input 3]
2214
2215    $np.t2 delete 0 end
2216    if {$spg == ""} {
2217        set msg "Warning: a Space Group must be specified."
2218    } elseif {[set nspg [CheckSpg $spg]] == ""} {
2219        $np.t2 insert end $spg
2220        if {$msg != ""} {append msg " "}
2221        append msg "Warning: this space group is not a standard setting. It may be correct, but check it carefully."
2222    } else {
2223        $np.t2 insert end $nspg
2224    }
2225    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
2226        $np.f$i delete 0 end
2227        $np.f$i insert end $val
2228    }
2229    if {$msg != ""} {
2230        catch {destroy $np.msg}
2231        grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised -wraplength 60] \
2232                -column 0 -columnspan 99 -row 20 -sticky ew
2233    }
2234}
2235
2236proc ImportAtoms {format top phase} {
2237    global expgui
2238    if {[llength $expgui(extensions_$format)] == 1} {
2239        lappend typelist [list $format $expgui(extensions_$format)]
2240    } else {
2241        foreach item $expgui(extensions_$format) {
2242            lappend typelist [list "All $format" $item]
2243            lappend typelist [list "$format $item" $item]
2244        }
2245    }
2246    lappend typelist [list "All files" *]
2247    set file [tk_getOpenFile -parent $top -filetypes $typelist]
2248    if {![file exists $file]} return
2249    # disable during read
2250    catch {
2251        foreach b "$top.b1 $top.b2 $top.fr.b3" {
2252            $b config -state disabled
2253        }
2254    }
2255    # read in the file
2256    set input [$expgui(proc_$format) $file]
2257    # add atoms to table
2258    foreach item [lindex $input 2] {
2259        set row [MakeAddAtomsRow $top]
2260        set np $top.canvas.fr
2261        foreach val $item w {n x y z t o u} {
2262            if {$val != ""} {
2263                $np.e${row}$w delete 0 end
2264                $np.e${row}$w insert end $val
2265            }
2266        }
2267    }
2268    # sort the atoms by number, so that empty entries are at the bottom
2269    sortAddAtoms $phase $top number
2270    # reenable
2271    catch {
2272        foreach b "$top.b1 $top.b2 $top.fr.b3" {
2273            $b config -state normal
2274        }
2275    }
2276}
2277
2278proc AddAtomsList {} {
2279    global expgui expmap
2280    # skip if we aborted out of addphase
2281    if {$expgui(oldphaselist) == -1} return
2282    # find the new phase
2283    set phase {}
2284    foreach p $expmap(phaselist) {
2285        if {[lsearch $expgui(oldphaselist) $p] == -1} {
2286            set phase $p
2287            break
2288        }
2289    }
2290    if {$phase == ""} return
2291    MakeAddAtomsBox $phase $expgui(coordList)
2292}
2293
2294# get the input formats by sourcing files named import_*.tcl
2295proc GetImportFormats {} {
2296    global expgui tcl_platform
2297    # only needs to be done once
2298    if [catch {set expgui(importFormatList)}] {
2299        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
2300        foreach file $filelist {
2301            set description ""
2302            source $file
2303            if {$description != ""} {
2304                lappend expgui(importFormatList) $description
2305                if {$tcl_platform(platform) == "unix"} {
2306                    set extensions "[string tolower $extensions] [string toupper $extensions]"
2307                }
2308                set expgui(extensions_$description) $extensions
2309                set expgui(proc_$description) $procname
2310            }
2311        }
2312    }
2313}
2314
2315proc MakeReplacePhaseBox {} {
2316    global expmap expgui tcl_platform
2317
2318    set expgui(coordList) {}
2319    # ignore the command if no phase is selected
2320    foreach p {1 2 3 4 5 6 7 8 9} {
2321        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
2322            return
2323        }
2324    }
2325
2326    set top .newphase
2327    catch {destroy $top}
2328    toplevel $top
2329    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
2330
2331    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
2332            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
2333    grid [label $top.l3a -text "Current Space Group: "] \
2334            -column 0 -row 2 -columnspan 2 -sticky e
2335    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
2336            -bd 4 -relief groove] \
2337            -column 2 -row 2  -sticky ew
2338    grid [label $top.l4 -text "New Space Group: "] \
2339            -column 0 -row 3 -columnspan 2 -sticky e
2340    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
2341    grid [radiobutton $top.r1 -text "Keep atoms in phase"\
2342            -variable expgui(DeleteAllAtoms) -value 0] \
2343            -column 1 -row 4 -columnspan 8 -sticky w
2344    grid [radiobutton $top.r2 -text "Delete current atoms" \
2345            -variable expgui(DeleteAllAtoms) -value 1] \
2346            -column 1 -row 5 -columnspan 8 -sticky w
2347   
2348    grid [frame $top.f -bd 4 -relief groove] \
2349            -column 3 -row 2 -columnspan 3 -rowspan 4
2350    set col -1
2351    foreach i {a b c} {
2352        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
2353        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
2354        $top.f.e1$i delete 0 end
2355        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
2356    }
2357    set col -1
2358    foreach i {a b g} var {alpha beta gamma} {
2359        grid [label $top.f.l2$i -text $i] -column [incr col] -row 2
2360        set font [$top.f.l2$i cget -font]
2361        $top.f.l2$i config -font "Symbol [lrange $font 1 end]"
2362        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
2363        $top.f.e2$i delete 0 end
2364        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
2365    } 
2366
2367    grid [button $top.b1 -text Continue \
2368            -command "replacephase1 $top $expgui(curPhase)"] \
2369            -column 0 -row 6 -sticky w
2370    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
2371    grid [button $top.b2 -text Cancel \
2372            -command "destroy $top"] -column 1 -row 6 -sticky w
2373    grid [button $top.help -text Help -bg yellow \
2374            -command "MakeWWWHelp expgui2.html replacephase"] \
2375            -column 2 -row 6
2376
2377    # get the input formats if not already defined
2378    GetImportFormats
2379    if {[llength $expgui(importFormatList)] > 0} {
2380        grid [frame $top.fr -bd 4 -relief groove] \
2381                -column 2 -row 6 -columnspan 8 -sticky e
2382        grid [button $top.fr.b3 -text "Import phase from: " \
2383                -command "ImportPhase \$expgui(importFormat) $top"] \
2384                -column 0 -row 0 -sticky e
2385        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2386                $expgui(importFormatList)]
2387        for {set i 0} {$i <= [$menu index end]} {incr i} {
2388            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $top"
2389        }
2390        grid $top.fr.b4 -column 1 -row 0 -sticky w
2391        grid rowconfig $top.fr 0 -pad 10
2392        grid columnconfig $top.fr 0 -pad 10
2393        grid columnconfig $top.fr 1 -pad 10
2394#       grid columnconfig $top 4 -weight 1
2395        grid columnconfig $top 2 -weight 1
2396    }
2397   
2398    wm title $top "Replace phase $expgui(curPhase)"
2399
2400    # set grab, etc.
2401    putontop $top
2402
2403    tkwait window $top
2404
2405    # fix grab...
2406    afterputontop
2407}
2408
2409proc replacephase1 {top phase} {
2410    # validate cell & space group & save to pass
2411    global expgui expmap
2412    set expgui(SetAddAtomsScroll) 0
2413    # validate the input
2414    set err {}
2415    set spg [$top.t2 get]
2416    if {[string trim $spg] == ""} {
2417        append err "  Space group cannot be blank\n"
2418    }
2419    set cell {}
2420    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
2421        set $lbl [$top.f.e${n}$i get]
2422        if {[string trim [set $lbl]] == ""} {
2423            append err "  $lbl cannot be blank\n"
2424        } elseif {[catch {expr [set $lbl]}]} {
2425            append err "  [set $lbl] is not valid for $lbl\n"
2426        }
2427        lappend cell [set $lbl]
2428    }
2429
2430    if {$err != ""} {
2431        MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
2432                -message "The following error(s) were found in your input:\n$err" 
2433        return
2434    }
2435
2436    # check the space group
2437    set fp [open spg.in w]
2438    puts $fp "N"
2439    puts $fp "N"
2440    puts $fp $spg
2441    puts $fp "Q"
2442    close $fp
2443    global tcl_platform
2444    catch {
2445        if {$tcl_platform(platform) == "windows"} {
2446            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
2447        } else {
2448            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
2449        }
2450    }
2451    set fp [open spg.out r]
2452    set out [read $fp]
2453    close $fp
2454    # attempt to parse out the output (fix up if parse did not work)
2455    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
2456            $out a b ] != 1} {set b $out}
2457    if {[string first Error $b] != -1} {
2458        # got an error, show it
2459        ShowBigMessage \
2460                 $top.error \
2461                 "Error processing space group\nReview error message below" \
2462                 $b OK "" 1
2463        return
2464    } else {
2465        # show the result and confirm
2466        set opt [ShowBigMessage \
2467                $top.check \
2468                "Check the symmetry operators in the output below" \
2469                $b \
2470                {Continue Redo} ]
2471        if {$opt > 1} return
2472    }
2473    file delete spg.in spg.out
2474    # draw coordinates box
2475    eval destroy [winfo children $top]
2476    grid [label $top.l1 -relief groove -bd 4 -anchor center\
2477            -text "Atom list for phase #$phase"] \
2478            -column 0 -row 0 \
2479            -sticky we -columnspan 10
2480    grid [canvas $top.canvas \
2481            -scrollregion {0 0 5000 500} -width 0 -height 250 \
2482            -yscrollcommand "$top.scroll set"] \
2483            -column 0 -row 2 -columnspan 4 -sticky nsew
2484    grid columnconfigure $top 3 -weight 1
2485    grid rowconfigure $top 2 -weight 1
2486    grid rowconfigure $top 1 -pad 5
2487    scrollbar $top.scroll \
2488            -command "$top.canvas yview"
2489    frame $top.canvas.fr
2490    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
2491
2492    set np $top.canvas.fr
2493    set row 0
2494    set col 0
2495    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
2496    foreach i {Atom\ntype Name x y z Occ Uiso} \
2497            var {type name x y z occ uiso} {
2498        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
2499                -command "sortAddAtoms $phase $top $var"] \
2500                -column [incr col] -row $row -sticky nsew
2501    }
2502    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
2503
2504    # add the old atoms, if appropriate
2505    if {!$expgui(DeleteAllAtoms)} {
2506        # loop over all atoms
2507        foreach atom $expmap(atomlist_$phase) {
2508            set row [MakeAddAtomsRow $top]
2509            # add all atoms in the current phase to the list
2510            foreach w {n x y z t o} var {label x y z type frac} {
2511                $np.e${row}$w delete 0 end
2512                $np.e${row}$w insert end [atominfo $phase $atom $var]
2513            }
2514            $np.e${row}u delete 0 end
2515            if {[atominfo $phase $atom temptype] == "I"} {
2516                $np.e${row}u insert end [atominfo $phase $atom Uiso]
2517            } else {
2518                $np.e${row}u insert end [expr ( \
2519                        [atominfo $phase $atom U11] + \
2520                        [atominfo $phase $atom U22] + \
2521                        [atominfo $phase $atom U33]) / 3.]
2522            }
2523        }
2524    }
2525
2526    # add coordinates that have been read in, if any
2527    foreach item $expgui(coordList) {
2528        set row [MakeAddAtomsRow $top]
2529        foreach val $item w {n x y z t o u} {
2530            if {$val != ""} {
2531                $np.e${row}$w delete 0 end
2532                $np.e${row}$w insert end $val
2533            }
2534        }
2535    }
2536    # a blank spot in the table
2537    MakeAddAtomsRow $top
2538
2539    bind $top <Configure> "SetAddAtomsScroll $top"
2540    grid rowconfigure $top 3 -min 10
2541    grid [button $top.b1 -text "Continue"\
2542            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
2543            -column 0 -row 5 -sticky w
2544    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
2545    grid [button $top.b2 -text Cancel \
2546            -command "destroy $top"] -column 1 -row 5 -sticky w
2547    if {[llength $expgui(importFormatList)] > 0} {
2548        grid [frame $top.fr -bd 4 -relief groove] \
2549                -column 3 -row 5 -columnspan 2 -sticky e
2550        grid [button $top.fr.b3 -text "Import atoms from: " \
2551                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
2552                -column 0 -row 0 -sticky e
2553        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2554                $expgui(importFormatList)]
2555        for {set i 0} {$i <= [$menu index end]} {incr i} {
2556            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
2557        }
2558        grid $top.fr.b4 -column 1 -row 0 -sticky w
2559        grid rowconfig $top.fr 0 -pad 10
2560        grid columnconfig $top.fr 0 -pad 10
2561        grid columnconfig $top.fr 1 -pad 10
2562    }
2563
2564    grid [button $top.b3 -text  "More atom boxes" \
2565            -command "MakeAddAtomsRow $top"] -column 3 \
2566            -columnspan 2 -row 4 -sticky e
2567   
2568    wm title $top "Replacing phase: Enter atoms"
2569    SetAddAtomsScroll $top
2570
2571    # fix grab for old window
2572    afterputontop
2573    # set grab, etc.
2574    putontop $top
2575}
2576
2577proc replacephase2 {phase top spg cell} {
2578    global expgui expmap
2579    # validate coordinates
2580    set np $top.canvas.fr
2581    # validate the atoms info
2582    set atomlist [ValidateAtomsBox $top $np]
2583    if {$atomlist == ""} return
2584
2585    pleasewait "updating phase"
2586    set errmsg [replacephase3 $phase $spg $cell $atomlist]
2587
2588    set err 0
2589    if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
2590        set err 1
2591    }
2592    if {$errmsg != ""} {
2593        set err 1
2594    }
2595    donewait 
2596    if {$expgui(showexptool) || $err} {
2597        set msg "Please review the result from adding the atom(s)" 
2598        if {$err} {append msg "\nIt appears an error occurred!"}
2599        ShowBigMessage $top $msg $errmsg OK "" $err
2600    }
2601    # set the powpref warning (2 = required)
2602    set expgui(needpowpref) 2
2603    set msg "A phase was replaced"
2604    if {[string first $msg $expgui(needpowpref_why)] == -1} {
2605        append expgui(needpowpref_why) "\t$msg\n"
2606    }
2607    destroy $top
2608}
2609
2610
2611proc replacephase3 {phase spg cell atomlist} {
2612    global expgui expmap
2613    # replace spacegroup and cell
2614    if $::expgui(debug) {puts "phaseinfo $phase spacegroup set $spg"}
2615    phaseinfo $phase spacegroup set $spg
2616    RecordMacroEntry "phaseinfo $phase spacegroup set [list $spg]" 0
2617    foreach val $cell var {a b c alpha beta gamma} {
2618        phaseinfo $phase $var set $val
2619        RecordMacroEntry "phaseinfo $phase $var set $val" 0
2620    }
2621    incr expgui(changed) 
2622    # delete all atoms
2623    foreach i $expmap(atomlist_$phase) {
2624        EraseAtom $i $phase
2625        RecordMacroEntry "EraseAtom $i $phase" 0
2626        incr expgui(changed)
2627    }
2628    set expmap(atomlist_$phase) {}
2629    RecordMacroEntry "incr expgui(changed)" 0
2630    # write new atoms from table as input to exptool
2631    set errmsg [runAddAtoms $phase $atomlist]
2632    RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
2633    SpaceGroupWarnings "" $phase $spg
2634    return $errmsg
2635}
2636
2637proc SpaceGroupWarnings {warn phase spg} {
2638    # warning on possible origin 1 setting
2639    set shift [GetOrigin1Shift $phase]
2640    if {$shift != ""} {
2641        append warn "Note that this space group ($spg) has both Origin 1 and Origin 2 settings. Origin 2 must be used in GSAS. Please check atom multiplicities (or use the Results/composition command) to verify you have the correct origin setting. Note that the Xform Atoms/Xform Origin 1 to Origin 2 button can be used to correct this.\n"
2642    } elseif {[CheckSpg $spg] == ""} {
2643        append warn "Note that this space group is not a standard setting. It still may be correct as input or may have a typographic error. Please confirm that the computed density is in the expected range and that atoms have the correct site multiplicities."
2644    }
2645    if {$warn != ""} {
2646        MyMessageBox -parent . -title "Space Group Note" \
2647            -message $warn -icon warning
2648    }
2649}
2650
2651proc sortAddAtoms {phase top sortvar} {
2652    global expgui
2653    set np $top.canvas.fr
2654    set validlist {}
2655    set invalidlist {}
2656    set row 0
2657    while {![catch {grid info $np.e[incr row]t}]} {
2658        set valid 1
2659        set line $row
2660        if !{$expgui(UseAtom$row)} {set valid 0}
2661        lappend line $expgui(UseAtom$row)
2662        if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
2663        lappend line [string trim [$np.e${row}t get]]
2664        lappend line [string trim [$np.e${row}n get]]
2665        foreach i {x y z o u} {
2666            set tmp [string trim [$np.e${row}$i get]]
2667            lappend line $tmp
2668            if {$tmp == "" || [catch {expr $tmp}]} {set valid 0}
2669        }
2670        if {$valid} {
2671            lappend validlist $line
2672        } else {
2673            lappend invalidlist $line
2674        }
2675    }
2676    switch $sortvar {
2677        type {set sortlist [lsort -index 2 -dictionary $validlist]}
2678        name {set sortlist [lsort -index 3 -dictionary $validlist]}
2679        x {set sortlist [lsort -index 4 -real $validlist]}
2680        y {set sortlist [lsort -index 5 -real $validlist]}
2681        z {set sortlist [lsort -index 6 -real $validlist]}
2682        occ {set sortlist [lsort -index 7 -real $validlist]}
2683        uiso  {set sortlist [lsort -index 8 -real $validlist]}
2684        default {set sortlist $validlist}
2685    }
2686
2687    if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
2688    set row 0
2689    foreach line $sortlist {
2690        incr row
2691        set expgui(UseAtom$row) [lindex $line 1]
2692        foreach item [lrange $line 2 end] \
2693                var {t n x y z o u} {
2694            $np.e${row}$var delete 0 end
2695            $np.e${row}$var insert end $item
2696        }
2697    }
2698}
2699
2700proc EditInstFile {"filename {}"} {
2701    global expgui
2702    # on the first call, load the commands
2703    if {[catch {
2704        if {[info procs instMakeWindow] == ""} {
2705            source [file join $expgui(scriptdir) instedit.tcl]
2706        }
2707    } errmsg]} {
2708        MyMessageBox -parent . -title "Load error" \
2709                -message "Unexpected error while sourcing file instedit.tcl: $errmsg" \
2710                -icon error
2711    }
2712    instMakeWindow $filename
2713}
2714
2715# load a list of Origin 1/2 space groups
2716proc GetOrigin12List {} {
2717    # don't need to read the file twice
2718    if {[array names ::Origin1list] != ""} return
2719    set line {}
2720    set fp1 [open [file join $::expgui(scriptdir) spacegrp.ref] r]
2721    while {[lindex $line 1] != 230} {
2722        if {[gets $fp1 line] < 0} break
2723    }
2724    while {[gets $fp1 line] >= 0} {
2725        set key [string tolower [lindex $line 8]]
2726        regsub -all " " $key "" key
2727        regsub -- "-3" $key "3" key
2728        if {$key != ""} {
2729#       puts "$key -- [lindex $line 1] [lindex $line 8] [lindex $line 9]"
2730            set ::Origin1list($key) [lindex $line 9]
2731        }
2732    }
2733    close $fp1
2734}
2735
2736# get the shift to be added to origin 1 coordinates to obtain origin 2 settings
2737proc GetOrigin1Shift {phase} {
2738    GetOrigin12List
2739    set spg [string tolower [phaseinfo $phase spacegroup]]
2740    regsub -all " " $spg "" spg
2741    regsub -- "-3" $spg "3" spg
2742    if {[catch {set shift $::Origin1list($spg)}]} {
2743        return ""
2744    } else {
2745        return $shift
2746    }
2747}
2748
2749proc XformAtoms2Origin2 {phase numberList w1 shift} {
2750    global expgui expmap
2751    set parent [winfo toplevel $w1]
2752    if {[llength $numberList] != [llength $expmap(atomlist_$phase)]} {
2753        # not all atoms were selected in phase -- do a sanity check
2754        set msg {You have selected only some atoms to be shifted. Do you want to shift all atoms or only the selected atoms?}
2755        set val [MyMessageBox -parent $parent -icon warning \
2756                     -type "{Use all} {Use Selection}" -default "use all" \
2757                     -title "Shift all" -message $msg]
2758#       puts "$phase $numberList $w1 $shift"
2759        if {$val == "use all"} {set numberList $expmap(atomlist_$phase)}
2760    }
2761    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2762        set cmd mmatominfo
2763    } else {
2764        set cmd atominfo
2765    }
2766    foreach atom $numberList {
2767        foreach v {x y z} vs $shift {
2768            set c [$cmd $phase $atom $v]
2769            $cmd $phase $atom $v set [expr {$c + $vs}]
2770            RecordMacroEntry "$cmd $phase $atom $v set [expr {$c + $vs}]" 0
2771        }
2772        incr expgui(changed)
2773    }
2774
2775    RecordMacroEntry "incr expgui(changed)" 0
2776    ResetMultiplicities $phase $parent
2777    SelectOnePhase $phase
2778    MyMessageBox -parent $parent -type OK -default ok -title "Shift applied" \
2779        -message "A shift of \"$shift\" has been added to coordinates of atoms [CompressList $numberList]"
2780#    UpdateAtomLine $numberList $phase
2781    destroy $parent
2782}
2783
2784# reset the site multiplicities using the EXPEDT program
2785proc ResetMultiplicities {phase parent} {
2786    global expgui
2787    set errmsg [RunResetMultiplicities $phase]
2788    RecordMacroEntry "RunResetMultiplicities $phase" 0
2789
2790    if {$expgui(showexptool) || $errmsg != ""} {
2791        if {$errmsg != ""} {
2792            set err 1
2793            append errmsg "\n" $expgui(exptoolout) 
2794        } else {
2795            set err 0
2796            set errmsg $expgui(exptoolout) 
2797        }
2798        set msg "Please review the result from listing the phase." 
2799        if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
2800        ShowBigMessage $parent.msg $msg $errmsg OK "" $err
2801    }
2802}
2803proc RunResetMultiplicities {phase} {
2804    global expgui tcl_platform
2805    set input [open resetmult.inp w]
2806    puts $input "Y"
2807    puts $input "l a p $phase"
2808    puts $input "l"
2809    puts $input "x x x"
2810    puts $input "x"
2811    close $input
2812    # Save the current exp file
2813    savearchiveexp
2814    # disable the file changed monitor
2815    set expgui(expModifiedLast) 0
2816    set expnam [file root [file tail $expgui(expfile)]]
2817    set err [catch {
2818        if {$tcl_platform(platform) == "windows"} {
2819            exec [file join $expgui(gsasexe) expedt.exe] $expnam < resetmult.inp >& resetmult.out
2820        } else {
2821            exec [file join $expgui(gsasexe) expedt] $expnam < resetmult.inp >& resetmult.out
2822        }
2823    } errmsg]
2824    loadexp $expgui(expfile)
2825    set fp [open resetmult.out r]
2826    set out [read $fp]
2827    close $fp
2828    set expgui(exptoolout) $out
2829    catch {file delete resetmult.inp resetmult.out}
2830    if {$err} {
2831        return $errmsg
2832    } else {
2833        return ""
2834    }
2835}
2836# space group table
2837set spglist {
2838    "P 1" "P -1"
2839
2840    "P 2" "P 21" "P m" "P a" "P c" "P n" "P 2/m" "P 21/m" 
2841    "P 2/c" "P 2/a" "P 2/n" "P 21/c" "P 21/a" "P 21/n" 
2842
2843    "C 2" "C m" "C c" "C n" "C 2/m" "C 2/c" "C 2/n" 
2844
2845    "P 2 2 2" "P 2 2 21" "P 2 21 2" "P 21 2 2" "P 21 21 2" "P 21 2 21" 
2846    "P 2 21 21" "P 21 21 21" "P m m 2" "P m 2 m" "P 2 m m" "P m c 21" 
2847    "P c m 21" "P 21 m a" "P 21 a m" "P b 21 m" "P m 21 b" "P c c 2" 
2848    "P 2 a a" "P b 2 b" "P m a 2" "P b m 2" "P 2 m b" "P 2 c m" 
2849    "P c 2 m" "P m 2 a" "P c a 21" "P b c 21" "P 21 a b" "P 21 c a" 
2850    "P c 21 b" "P b 21 a" "P n c 2" "P c n 2" "P 2 n a" "P 2 a n" 
2851    "P b 2 n" "P n 2 b" "P m n 21" "P n m 21" "P 21 m n" "P 21 n m" 
2852    "P n 21 m" "P m 21 n" "P b a 2" "P 2 c b" "P c 2 a" "P n a 21" 
2853    "P b n 21" "P 21 n b" "P 21 c n" "P c 21 n" "P n 21 a" 
2854    "P n n 2" "P 2 n n" "P n 2 n" "P m m m" "P n n n" "P c c m" 
2855    "P m a a" "P b m b" "P b a n" "P n c b" "P c n a" 
2856    "P m m a" "P m m b" "P b m m" "P c m m" "P m c m" "P m a m" 
2857    "P n n a" "P n n b" "P b n n" "P c n n" "P n c n" "P n a n" 
2858    "P m n a" "P n m b" "P b m n" "P c n m" "P n c m" "P m a n" 
2859    "P c c a" "P c c b" "P b a a" "P c a a" "P b c b" "P b a b" 
2860    "P b a m" "P m c b" "P c m a" "P c c n" "P n a a" "P b n b" 
2861    "P b c m" "P c a m" "P m c a" "P m a b" "P b m a" "P c m b" 
2862    "P n n m" "P m n n" "P n m n" "P m m n" "P n m m" "P m n m" 
2863    "P b c n" "P c a n" "P n c a" "P n a b" "P b n a" "P c n b" 
2864    "P b c a" "P c a b" "P n m a" "P m n b" "P b n m" "P c m n" 
2865    "P m c n" "P n a m" 
2866
2867    "C 2 2 21" "C 2 2 2" "C m m 2" "C m c 21" "C c c 2" "C m 2 m" "C 2 m m" 
2868    "C m 2 a" "C 2 m b" "C 2 c m" "C c 2 m" "C 2 c m" "C c 2 m" 
2869    "C m c a" "C m m m" "C c c m" "C m m a" "C c c a" "C m c m" 
2870
2871    "I 2 2 2" "I 21 21 21" "I m m m" "I m m 2" "I m 2 m" "I 2 m m" 
2872    "I b a 2" "I 2 c b" "I c 2 a" "I m a 2" "I b m 2" "I 2 m b" 
2873    "I 2 c m" "I c 2 m" "I m 2 a" "I b a m" "I m c b" "I c m a" 
2874    "I b c a" "I c a b" "I m m a" "I m m b" "I b m m " "I c m m" 
2875    "I m c m" "I m a m" 
2876   
2877    "F 2 2 2" "F m m m"  "F d d d" "F m m 2" "F m 2 m" "F 2 m m" 
2878    "F d d 2" "F d 2 d" "F 2 d d"
2879
2880    "P 4" "P 41" "P 42" "P 43" "P -4" "P 4/m" "P 42/m" "P 4/n" "P 42/n" 
2881    "P 4 2 2" "P 4 21 2" "P 41 2 2" "P 41 21 2" "P 42 2 2" 
2882    "P 42 21 2" "P 43 2 2" "P 43 21 2" "P 4 m m" "P 4 b m" "P 42 c m" 
2883    "P 42 n m" "P 4 c c" "P 4 n c" "P 42 m c" "P 42 b c" "P -4 2 m" 
2884    "P -4 2 c" "P -4 21 m" "P -4 21 c" "P -4 m 2" "P -4 c 2" "P -4 b 2" 
2885    "P -4 n 2" "P 4/m m m" "P 4/m c c" "P 4/n b m" "P 4/n n c" "P 4/m b m" 
2886    "P 4/m n c" "P 4/n m m" "P 4/n c c" "P 42/m m c" "P 42/m c m" 
2887    "P 42/n b c" "P 42/n n m" "P 42/m b c" "P 42/m n m" "P 42/n m c" 
2888    "P 42/n c m"
2889
2890    "I 4" "I 41" "I -4" "I 4/m" "I 41/a" "I 4 2 2" "I 41 2 2" "I 4 m m" 
2891    "I 4 c m" "I 41 m d" "I 41 c d" 
2892    "I -4 m 2" "I -4 c 2" "I -4 2 m" "I -4 2 d" "I 4/m m m" "I 4/m c m" 
2893    "I 41/a m d" "I 41/a c d"
2894
2895    "R 3" "R -3" "R 3 2" "R 3 m" "R 3 c" "R -3 m" "R -3 c"
2896   
2897    "P 3" "P 31" "P 32" "P -3" "P 3 1 2" "P 3 2 1" "P 31 1 2" 
2898    "P 31 2 1" "P 32 1 2" "P 32 2 1"  "P 3 m 1" "P 3 1 m" "P 3 c 1" 
2899    "P 3 1 c" "P -3 1 m" "P -3 1 c" "P -3 m 1" "P -3 c 1" "P 6" "P 61" 
2900    "P 65" "P 62" "P 64" "P 63" "P -6" "P 6/m" "P 63/m" "P 6 2 2" 
2901    "P 61 2 2" "P 65 2 2" "P 62 2 2" "P 64 2 2" "P 63 2 2" "P 6 m m" 
2902    "P 6 c c" "P 63 c m" "P 63 m c" "P -6 m 2" "P -6 c 2" "P -6 2 m" 
2903    "P -6 2 c" "P 6/m m m" "P 6/m c c" "P 63/m c m" "P 63/m m c"
2904
2905    "P 2 3" "P 21 3" "P m 3" "P n 3" "P a 3" "P 4 3 2" "P 42 3 2" 
2906    "P 43 3 2" "P 41 3 2" "P -4 3 m" "P -4 3 n" "P m 3 m" "P n 3 n" 
2907    "P m 3 n" "P n 3 m" 
2908
2909    "I 2 3" "I 21 3" "I m -3" "I a -3"  "I 4 3 2" "I 41 3 2" 
2910    "I -4 3 m"  "I -4 3 d" "I m -3 m" "I a -3 d"
2911
2912    "F 2 3" "F m -3" "F d -3" "F 4 3 2" "F 41 3 2" "F -4 3 m" 
2913    "F -4 3 c" "F m -3 m" "F m -3 c" "F d -3 m" "F d -3 c"
2914}
2915
2916# check a space group ignoring spaces to see if it matches a
2917# standard one, if so adjust spaces.
2918# retain final "R" for rhombodedral settings, but remove the optional "H"
2919proc CheckSpg {spg} {
2920    set spg [string trim $spg]
2921    set lastchar [string toupper [string range $spg end end]]
2922    if {$lastchar == "R"} {
2923        # truncate cell setting code
2924        set spg [string range $spg 0 end-1]
2925    } elseif {$lastchar == "H"} {
2926        set spg [string range $spg 0 end-1]
2927        set lastchar ""
2928    } else {
2929        set lastchar ""
2930    }
2931    regsub -all { } [string tolower $spg] {} spg
2932    foreach s $::spglist {
2933        if {$spg == [regsub -all { } [string tolower $s] {}]} {
2934            if {$lastchar == ""} {return $s}
2935            return "$s $lastchar"
2936        }
2937    }
2938    return 
2939}
2940
2941# default values
2942set newhist(insttype) {}
2943set newhist(dummy) 0
2944set newhist(instfiletext) {}
2945set newhist(instbanks) {}
Note: See TracBrowser for help on using the repository browser.