source: trunk/fillcif.tcl @ 1021

Last change on this file since 1021 was 953, checked in by toby, 15 years ago

remove NIST refs; review space in dir warn; use PGPLOT_DIR on win-NT, etc.; doc updates; tkcon problems on windows, add open console; move update menu from help
  • Property svn:keywords set to Author Date Revision Id
File size: 15.2 KB
Line 
1# A routine for editing CIF template file(s) adapted for specific
2# use with GSAS2CIF. This program edits files template_*.cif or
3# <expnam>_*.cif. If neither are available, it copies the template_*.cif
4# from the GSAS data directory ../data (relative to this file)
5#
6
7# $Id: fillcif.tcl 953 2010-03-11 20:00:14Z chlake $
8
9# this routine is intended for use within the EXPGUI program, but may be
10# useful for adaptation into other CIF preparation environments.
11# Permission is granted by the author (Brian Toby) for reuse of any part
12# of this code.
13
14# Prerequisites:
15#  1) BWidget routines be available (tested with version 1.2.1)
16#      These routines are included with EXPGUI
17#
18#  2) files browsecif.tcl & gsascmds.tcl must be in the same directory as
19#      this file (Included with EXPGUI)
20#
21#  3) The CIF core & powder dictionaries are included in the GSAS data
22#      directory (../data/), files cif_core_2.2.dic and cif_pd.dic
23#      (Included with GSAS/EXPGUI distribution)
24#
25#  4) The GSAS2CIF template files (template_instrument.cif,
26#      template_phase.cif and template_publ.cif) are included in the GSAS data
27#      directory (../data/).
28#      (Included with GSAS/EXPGUI distribution)
29
30# where is this file running from?
31set script [info script]
32# translate links -- go six levels deep
33foreach i {1 2 3 4 5 6} {
34    if {[file type $script] == "link"} {
35        set link [file readlink $script]
36        if { [file  pathtype  $link] == "absolute" } {
37            set script $link
38        } {
39            set script [file dirname $script]/$link
40        }
41    } else {
42        break
43    }
44}
45# fixup relative paths
46if {[file pathtype $script] == "relative"} {
47    set script [file join [pwd] $script]
48}
49set scriptdir [file dirname $script ]
50
51if {$tcl_version < 8.2} {
52    tk_dialog .error {Old Tcl/Tk} \
53            "Sorry, the CIF Browser requires version 8.2 or later of the Tcl/Tk package. This is $tcl_version" \
54            warning 0 Sorry
55    exit
56}
57
58if {[llength $argv] != 1} {
59    set file [tk_getOpenFile -title "Select GSAS Experiment" -parent . \
60            -defaultextension EXP -filetypes {{"GSAS experiment" .EXP}}]
61    if {$file == ""} {exit}
62    set prefix [file root $file]
63} else {
64    set prefix $argv
65}
66
67if {[set dir [file dirname $prefix]] != ""} {
68    cd $dir
69    set prefix [file tail $prefix]
70}
71# used by some gsascmds routines
72set expgui(scriptdir) $scriptdir
73set expgui(gsasdir) [file dirname $expgui(scriptdir)]
74set expgui(gsasexe) [file join $expgui(gsasdir) exe]
75set expgui(docdir) [file join $expgui(scriptdir) doc]
76# location for web pages, if not found locally
77set expgui(website) 11bm.xor.aps.anl.gov/expguidoc/
78
79# where to find the BWidget program
80lappend auto_path $scriptdir
81# now look
82if [catch {package require BWidget} errmsg] {
83    tk_dialog .error {No BWidget} \
84            "Sorry, the CIF Browser requires the BWidget package." \
85            warning 0 Sorry
86    exit
87}
88
89source [file join $scriptdir browsecif.tcl]
90source [file join $scriptdir gsascmds.tcl]
91bind . <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
92
93set CIF(filelist) [glob -nocomplain ${prefix}_*.cif]
94if {$CIF(filelist) == ""} {
95    set CIF(filelist) [glob -nocomplain template_*.cif]
96}
97if {$CIF(filelist) == ""} {
98    set CIF(filelist) [glob -nocomplain [file join $scriptdir ../data template_*.cif]]
99    if {$CIF(filelist) == ""} {
100        MyMessageBox -parent . -title "No template files" \
101            -message "No CIF template files found. Cannot continue" \
102                -icon error -type Quit -default quit
103        exit
104    }
105    set ans [MyMessageBox -parent . -title "Copy template files?" \
106            -message "No CIF template files (template_*.cif or ${prefix}_*.cif) in the current directory. Copy standard templates from GSAS data directory?" \
107            -icon question -type {Copy Quit} -default copy]
108    if {$ans == "quit"} {exit}
109    eval file copy $CIF(filelist) .
110    set CIF(filelist) [glob -nocomplain template_*.cif]
111}
112
113
114proc SaveCIFtoFile {} {
115    global CIF
116    set CIF(changes) 0
117    set CIF(undolist) {}
118    set CIF(redolist) {}
119    # at least for the moment, keep the previous version
120    file rename -force $CIF(lastCIFfilename) $CIF(lastCIFfilename).old
121    set fp [open $CIF(lastCIFfilename) w]
122    puts -nonewline $fp [$CIF(txt) get 1.0 end]
123    close $fp
124}
125
126proc ConfirmDestroy {} {
127    global CIF
128    if {[CheckForCIFEdits]} return
129    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
130        SaveCIFtoFile
131    }
132    if {$CIF(changes) != 0} {
133        set ans [MyMessageBox -parent . -title "Discard Changes?" \
134                -message "You have changed this CIF. Do you want to save or discard your changes?" \
135                -icon question -type {Save Discard Cancel} -default Save]
136        if {$ans == "save"} {
137            SaveCIFtoFile
138            destroy .
139        } elseif {$ans == "discard"} {
140            destroy .
141        }
142    } else {
143        destroy .
144    }
145}
146
147proc NextCIFtemplate {} {
148    global CIF CIFtreeindex
149    if {[CheckForCIFEdits]} return
150    set loopindex ""
151    set pointer ""
152    set block ""
153    set dataname ""
154    set nextpointer ""
155
156    if {$CIF(lastShownItem) != ""} {
157        set pointer [lindex $CIF(lastShownItem) 0]
158        set block [lindex $pointer 0]
159        set dataname [lindex $CIF(lastShownItem) 1]
160    }
161    if {[llength $pointer] == 2} {     
162        set loopindex [$CIF(LoopSpinBox) getvalue]
163    }
164    # find the next template item in current file
165    foreach {nextpointer nextdataname nextloopindex} \
166            [FindNextCIFQuestionMark $block $dataname $loopindex] {}
167    if {$nextpointer != ""} {
168        # got one
169        showCIFbyDataname $nextpointer $nextdataname $nextloopindex
170        # show the tree here
171        catch {
172            $CIF(tree) see $CIFtreeindex([lindex $nextpointer 0]$nextdataname)
173        }
174        return
175    }
176    # go on to the next file
177    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
178        SaveCIFtoFile
179    }
180    if {$CIF(changes) != 0} {
181        set ans [MyMessageBox -parent . -title "Save Changes?" \
182                -message "You have changed this CIF. Do you want to save your changes?" \
183                -icon question -type {Save Cancel} -default Save]
184        if {$ans == "save"} {
185            SaveCIFtoFile
186        } else {
187            return
188        }
189    }
190    # is there another file to look at?
191    if {$CIF(CIFfilename) == [lindex $CIF(filelist) end]} {
192        set ans [MyMessageBox -parent . -title "No remaining items" \
193                -message "No template items from this point in the current file, scan from the beginning of the first file?" \
194                -icon question -type {Yes Cancel} -default Cancel]
195        if {$ans == "cancel"} return
196        # go on to first file here
197        set filelist $CIF(filelist)
198    } else {
199        # go on to next file here
200        set filelist [lrange $CIF(filelist) [expr 1+[lsearch $CIF(filelist) $CIF(CIFfilename)]] end]
201    }
202    foreach CIF(CIFfilename) $filelist {
203        ParseShowCIF $CIF(browserBox)
204        foreach {nextpointer nextdataname nextloopindex} \
205                [FindNextCIFQuestionMark $block $dataname $loopindex] {}
206        if {$nextpointer != ""} {
207            showCIFbyDataname $nextpointer $nextdataname $nextloopindex
208            # show the tree here
209            catch {
210                $CIF(tree) see $CIFtreeindex([lindex $nextpointer 0]$nextdataname)
211            }
212            return
213        }
214    }
215    MyMessageBox -parent . -title "All done" \
216            -message "No ? fields found. All template items have been completed." \
217            -type OK -default OK
218}
219
220proc FindNextCIFQuestionMark {block dataname loopindex} {
221    global CIF
222
223    set blocklist {}
224    foreach i $CIF(blocklist) {
225        if {$block == "block$i"} {
226            set blocklist block$i
227        } else {
228            lappend blocklist block$i
229        }
230    }
231
232    set first -1
233    foreach n $blocklist {
234        global $n       
235        incr first
236        # compile a list of names then loops
237        set namelist [lsort [array names $n _*]]
238        set looplist [lsort [array names $n loop_*]]
239        if {$looplist != ""} {set namelist [concat $namelist $looplist]}
240        # make a list of data names in loops
241        set loopednames {}
242        foreach loop [array names $n loop_*] {
243            eval lappend loopednames [set ${n}($loop)]
244        }
245
246        # loop index, if needed
247        set start 0
248        # on the first pass
249        if {$first == 0} {
250            set i [lsearch $namelist $dataname]
251            if {$i != -1} {
252                # found the last entry -- is it looped?
253                if {$loopindex == ""} {
254                    incr i
255                } else {
256                    set start [expr 1 + $loopindex]
257                }
258                set namelist [lrange $namelist $i end]
259            }
260        }
261        # now start searching for an entry
262        foreach name $namelist {
263            # skip over datanames in loops or in the ignore list
264            set match 0
265            foreach ignore $CIF(TemplateIgnoreList) {
266                if {[string match $ignore $name]} {
267                    set match 1
268                    break
269                }
270            }
271            if {$match} continue
272            if {[lsearch $loopednames $name] != -1} continue
273
274            if {[string range $name 0 4] != "loop_"} {
275                set mark [set ${n}($name)]
276                set value [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
277                if {$value == "?"} {return "$n $name {}"}
278            } else {
279                set looplist [set ${n}($name)]
280                set looplength [llength [set ${n}([lindex $looplist 0])]]
281                for {set i $start} {$i < $looplength} {incr i} {
282                    foreach var $looplist {
283                        set mark [lindex [set ${n}($var)] $i]
284                        set value [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
285                        if {$value == "?"} {
286                            return [list [list $n loop] $name $i]
287                        }
288                    }
289                }
290            }
291        }
292    }
293}
294
295proc ShowDefWindow {button window} {
296    if {[lindex [$button cget -text] 0] == "Show"} {
297        $button config -text "Hide CIF\nDefinitions"
298        # this is an attempt to put the window under the browser
299        set x [winfo x .]
300        set y [expr 5 + [winfo y .] + [winfo height .]]
301        wm geometry $window +$x+$y
302        wm deiconify $window
303    } else {
304        $button config -text "Show CIF\nDefinitions"
305        wm withdraw $window
306    }
307}
308proc ShowCIFWindow {button window} {
309    if {[lindex [$button cget -text] 0] == "Show"} {
310        $button config -text "Hide CIF\nContents"
311        # this is an attempt to put the window under the browser
312        set x [winfo x .]
313        set y [expr 5 + [winfo y .] + [winfo height .]]
314        wm geometry $window +$x+$y
315        wm deiconify $window
316    } else {
317        $button config -text "Show CIF\nContents"
318        wm withdraw $window
319    }
320}
321
322proc ParseShowCIF {frame} {
323    global CIF
324    # check for edits in progress
325    if {[CheckForCIFEdits]} return
326    # check for unsaved changes here
327    if {$CIF(changes) != 0} {
328        set ans [MyMessageBox -parent . -title "Discard Changes?" \
329                -message "You have changed this CIF. Do you want to save or discard your changes?" \
330                -icon question -type {Save Discard Cancel} -default Save]
331        if {$ans == "save"} {
332            SaveCIFtoFile
333        } elseif {$ans == "cancel"} {
334            set CIF(CIFfilename) $CIF(lastCIFfilename)
335            return
336        }
337    }
338    set CIF(changes) 0
339    set CIF(undolist) {}
340    set CIF(redolist) {}
341
342    $CIF(txt) configure -state normal
343    $CIF(txt) delete 1.0 end
344    $CIF(txt) configure -state disabled
345    foreach i $CIF(blocklist) {
346        global block$i
347        unset block$i
348    }
349    set CIF(maxblocks) [ParseCIF $CIF(txt) $CIF(CIFfilename)]
350    set CIF(lastCIFfilename) $CIF(CIFfilename)
351    wm title . "CIF Browser: file $CIF(CIFfilename)"
352       
353    # make a list of blocks
354    set CIF(blocklist) {}
355    set errors {}
356    global block0
357    if {[array names block0] != ""} {
358        set i 0
359    } else {
360        set i 1
361    }
362    for {} {$i <= $CIF(maxblocks)} {incr i} {
363        lappend CIF(blocklist) ${i}
364        if {![catch {set block${i}(errors)} errmsg]} {
365            append errors "Block $i ([set block${i}(data_)]) errors: [set block${i}(errors)]\n"
366        }
367        if {$errors != ""} {
368            MyMessageBox -parent . -title "CIF errors" \
369                    -message "Note: file $CIF(CIFfilename) has errors.\n$errors" \
370                    -icon error -type Continue -default continue
371        }
372    }
373
374    if {$CIF(blocklist) != ""} {
375        CIFBrowser $CIF(txt) $CIF(blocklist) "" $frame
376    }
377}
378
379# create window/text widget for CIF file
380catch {destroy [set file .file]}
381toplevel $file
382wm title $file "CIF file contents"
383bind $file <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
384
385set CIF(txt) $file.t
386grid [text $CIF(txt) -height 10 -width 80 -yscrollcommand "$file.s set"] \
387        -column 0 -row 0 -sticky news
388grid [scrollbar $file.s -command "$CIF(txt) yview"] -column 1 -row 0 -sticky ns
389grid columnconfig $file 0 -weight 1
390grid rowconfig $file 0 -weight 1
391# hide it
392wm withdraw $file
393
394# create window/text widget for the CIF definition
395catch {destroy [set defw .def]}
396toplevel $defw
397bind $defw <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
398wm title $defw "CIF definitions"
399set CIF(defBox) $defw.t
400grid [text $CIF(defBox) -width 45 -height 18 -xscrollcommand "$defw.x set" \
401        -yscrollcommand "$defw.y set" -wrap word] -column 0 -row 0 -sticky news
402grid [scrollbar $defw.y -command "$CIF(defBox) yview"] -column 1 -row 0 -sticky ns
403grid [scrollbar $defw.x -command "$CIF(defBox) xview" \
404        -orient horizontal] -column 0 -row 1 -sticky ew
405grid columnconfig $defw 0 -weight 1
406grid rowconfig $defw 0 -weight 1
407# hide it
408wm withdraw $defw
409
410# is there a defined list of dictionary files?
411if {[catch {set ::CIF(dictfilelist)}]} {
412    set dictfilelist [glob -nocomplain \
413                          [file join $::expgui(gsasdir) data *.dic]]
414    foreach f $dictfilelist {
415        lappend ::CIF(dictfilelist) $f
416        set ::CIF(dict_$f) 1
417    }
418}
419# load the initial CIF dictionaries
420LoadDictIndices
421
422# make frame for the CIF browser
423wm title . "CIF Browser"
424grid [set CIF(browserBox) [frame .top]] -column 0 -row 0 -sticky ew
425grid [set box [frame .box]] -column 0 -row 1 -sticky ew
426
427set filemenu [tk_optionMenu $box.file CIF(CIFfilename) ""]
428$box.file config -width 25
429$filemenu delete 0 end
430foreach f $CIF(filelist) {
431    $filemenu add radiobutton -value $f -label $f -variable CIF(CIFfilename) \
432            -command "ParseShowCIF $CIF(browserBox)"
433}
434
435set col -1
436grid [label $box.lf -text "template\nfile:"] -column [incr col] \
437        -row 1 -rowspan 2
438grid $box.file  -column [incr col] -row 1 -rowspan 2 -sticky w
439grid [button $box.next -text "Next ? in\ntemplate" \
440        -command NextCIFtemplate] -column [incr col] -row 1 -rowspan 2
441grid columnconfig $box $col -weight 1
442incr col
443grid [button $box.c -text Exit -command ConfirmDestroy] \
444        -column [incr col] -row 1 -rowspan 2 -sticky w
445grid columnconfig $box $col -weight 1
446
447incr col
448grid [button $box.f -text "Show CIF\nContents" \
449        -command "ShowCIFWindow $box.f $file"] -column [incr col] \
450        -row 1 -rowspan 2
451grid [button $box.d -text "Show CIF\nDefinitions" \
452        -command "ShowDefWindow $box.d $defw"] -column [incr col] \
453        -row 1 -rowspan 2 -sticky w
454
455incr col
456grid [button $box.u -text "Undo" -command UndoChanges \
457        -state disabled] \
458        -column $col -row 1 -rowspan 2 -sticky w
459incr col
460grid [button $box.r -text "Redo" -command RedoChanges \
461        -state disabled] \
462        -column $col -row 1 -rowspan 2 -sticky w
463
464incr col
465grid [button $box.6 -text "Save" \
466        -command SaveCIFtoFile -state disabled] -column $col \
467        -row 1
468grid [checkbutton $box.7b -text "Auto-Save" \
469        -variable CIF(autosavetodisk)] -column $col -columnspan 2 \
470        -row 2 -sticky w
471
472grid [button $box.help -text Help -bg yellow \
473            -command "MakeWWWHelp gsas2cif.html filltemplate"] \
474            -column [incr col] -row 1 -rowspan 2 -sticky nw
475
476set CIF(autosavetodisk) 0
477set CIF(editmode) 1
478
479wm protocol . WM_DELETE_WINDOW ConfirmDestroy
480wm protocol $file WM_DELETE_WINDOW "ShowCIFWindow $box.f $file"
481wm protocol $defw WM_DELETE_WINDOW "ShowDefWindow $box.d $defw"
482
483trace variable CIF(changes) w "EnableSaveEdits $box.6"
484proc EnableSaveEdits {w args} {
485    global CIF
486    if {$CIF(changes)} {
487        $w config -state normal
488    } else {
489        $w config -state disabled
490    }
491}
492trace variable CIF(undolist) w "EnableUndo $box.u undolist"
493trace variable CIF(redolist) w "EnableUndo $box.r redolist"
494proc EnableUndo {w var args} {
495    global CIF
496    if {[llength $CIF($var)] > 0} {
497        $w config -state normal
498    } else {
499        $w config -state disabled
500    }
501}
502
503set CIF(blocklist) {}
504set CIF(CIFfilename) [lindex $CIF(filelist) 0]
505CIFOpenBrowser $CIF(browserBox)
506ParseShowCIF $CIF(browserBox)
507
508#------- work in progress
509
510set CIF(TemplateIgnoreList) {_journal_*}
511
Note: See TracBrowser for help on using the repository browser.