source: trunk/fillcif.tcl @ 639

Last change on this file since 639 was 639, checked in by toby, 11 years ago

# on 2002/08/09 16:43:35, toby did:
Routine to fill ? fields in CIF template files

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