source: trunk/fillcif.tcl @ 649

Last change on this file since 649 was 649, checked in by toby, 13 years ago

# on 2002/09/05 20:59:20, toby did:
Revise to use updated browsecif:

implement undo
changes made in-memory automatically
manual editing of cif must be enabled
  • Property rcs:author set to toby
  • Property rcs:date set to 2002/09/05 20:59:20
  • Property rcs:lines set to +209 -180
  • Property rcs:rev set to 1.3
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 15.9 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 649 2009-12-04 23:09:42Z 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) files browsecif.tcl & gsascmds.tcl must be in the same directory as
14#      this file (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
114
115proc SaveCIFtoFile {} {
116    global CIF
117    set CIF(changes) 0
118    set CIF(undolist) {}
119    set CIF(redolist) {}
120    # at least for the moment, keep the previous version
121    file rename -force $CIF(lastCIFfilename) $CIF(lastCIFfilename).old
122    set fp [open $CIF(lastCIFfilename) w]
123    puts -nonewline $fp [$CIF(txt) get 1.0 end]
124    close $fp
125}
126
127proc ConfirmDestroy {} {
128    global CIF
129    if {[CheckForCIFEdits]} return
130    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
131        SaveCIFtoFile
132    }
133    if {$CIF(changes) != 0} {
134        set ans [MyMessageBox -parent . -title "Discard Changes?" \
135                -message "You have changed this CIF. Do you want to save or discard your changes?" \
136                -icon question -type {Save Discard Cancel} -default Save]
137        if {$ans == "save"} {
138            SaveCIFtoFile
139            destroy .
140        } elseif {$ans == "discard"} {
141            destroy .
142        }
143    } else {
144        destroy .
145    }
146}
147
148proc NextCIFtemplate {} {
149    global CIF CIFtreeindex
150    if {[CheckForCIFEdits]} return
151    set loopindex ""
152    set pointer ""
153    set block ""
154    set dataname ""
155    set nextpointer ""
156
157    if {$CIF(lastShownItem) != ""} {
158        set pointer [lindex $CIF(lastShownItem) 0]
159        set block [lindex $pointer 0]
160        set dataname [lindex $CIF(lastShownItem) 1]
161    }
162    if {[llength $pointer] == 2} {     
163        set loopindex [$CIF(LoopSpinBox) getvalue]
164    }
165    # find the next template item in current file
166    foreach {nextpointer nextdataname nextloopindex} \
167            [FindNextCIFQuestionMark $block $dataname $loopindex] {}
168    if {$nextpointer != ""} {
169        # got one
170        showCIFbyDataname $nextpointer $nextdataname $nextloopindex
171        # show the tree here
172        catch {
173            $CIF(tree) see $CIFtreeindex([lindex $nextpointer 0]$nextdataname)
174        }
175        return
176    }
177    # go on to the next file
178    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
179        SaveCIFtoFile
180    }
181    if {$CIF(changes) != 0} {
182        set ans [MyMessageBox -parent . -title "Save Changes?" \
183                -message "You have changed this CIF. Do you want to save your changes?" \
184                -icon question -type {Save Cancel} -default Save]
185        if {$ans == "save"} {
186            SaveCIFtoFile
187        } else {
188            return
189        }
190    }
191    # is there another file to look at?
192    if {$CIF(CIFfilename) == [lindex $CIF(filelist) end]} {
193        set ans [MyMessageBox -parent . -title "No remaining items" \
194                -message "No template items from this point in the current file, scan from the beginning of the first file?" \
195                -icon question -type {Yes Cancel} -default Cancel]
196        if {$ans == "cancel"} return
197        # go on to first file here
198        set filelist $CIF(filelist)
199    } else {
200        # go on to next file here
201        set filelist [lrange $CIF(filelist) [expr 1+[lsearch $CIF(filelist) $CIF(CIFfilename)]] end]
202    }
203    foreach CIF(CIFfilename) $filelist {
204        ParseShowCIF $CIF(browserBox)
205        foreach {nextpointer nextdataname nextloopindex} \
206                [FindNextCIFQuestionMark $block $dataname $loopindex] {}
207        if {$nextpointer != ""} {
208            showCIFbyDataname $nextpointer $nextdataname $nextloopindex
209            # show the tree here
210            catch {
211                $CIF(tree) see $CIFtreeindex([lindex $nextpointer 0]$nextdataname)
212            }
213            return
214        }
215    }
216    MyMessageBox -parent . -title "All done" \
217            -message "No ? fields found. All template items have been completed." \
218            -type OK -default OK
219}
220
221proc FindNextCIFQuestionMark {block dataname loopindex} {
222    global CIF
223
224    set blocklist {}
225    foreach i $CIF(blocklist) {
226        if {$block == "block$i"} {
227            set blocklist block$i
228        } else {
229            lappend blocklist block$i
230        }
231    }
232
233    set first -1
234    foreach n $blocklist {
235        global $n       
236        incr first
237        # compile a list of names then loops
238        set namelist [lsort [array names $n _*]]
239        set looplist [lsort [array names $n loop_*]]
240        if {$looplist != ""} {set namelist [concat $namelist $looplist]}
241        # make a list of data names in loops
242        set loopednames {}
243        foreach loop [array names $n loop_*] {
244            eval lappend loopednames [set ${n}($loop)]
245        }
246
247        # loop index, if needed
248        set start 0
249        # on the first pass
250        if {$first == 0} {
251            set i [lsearch $namelist $dataname]
252            if {$i != -1} {
253                # found the last entry -- is it looped?
254                if {$loopindex == ""} {
255                    incr i
256                } else {
257                    set start [expr 1 + $loopindex]
258                }
259                set namelist [lrange $namelist $i end]
260            }
261        }
262        # now start searching for an entry
263        foreach name $namelist {
264            # skip over datanames in loops or in the ignore list
265            set match 0
266            foreach ignore $CIF(TemplateIgnoreList) {
267                if {[string match $ignore $name]} {
268                    set match 1
269                    break
270                }
271            }
272            if {$match} continue
273            if {[lsearch $loopednames $name] != -1} continue
274
275            if {[string range $name 0 4] != "loop_"} {
276                set mark [set ${n}($name)]
277                set value [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
278                if {$value == "?"} {return "$n $name {}"}
279            } else {
280                set looplist [set ${n}($name)]
281                set looplength [llength [set ${n}([lindex $looplist 0])]]
282                for {set i $start} {$i < $looplength} {incr i} {
283                    foreach var $looplist {
284                        set mark [lindex [set ${n}($var)] $i]
285                        set value [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
286                        if {$value == "?"} {
287                            return [list [list $n loop] $name $i]
288                        }
289                    }
290                }
291            }
292        }
293    }
294}
295
296proc ShowDefWindow {button window} {
297    if {[lindex [$button cget -text] 0] == "Show"} {
298        $button config -text "Hide CIF\nDefinitions"
299        # this is an attempt to put the window under the browser
300        set x [winfo x .]
301        set y [expr 5 + [winfo y .] + [winfo height .]]
302        wm geometry $window +$x+$y
303        wm deiconify $window
304    } else {
305        $button config -text "Show CIF\nDefinitions"
306        wm withdraw $window
307    }
308}
309proc ShowCIFWindow {button window} {
310    if {[lindex [$button cget -text] 0] == "Show"} {
311        $button config -text "Hide CIF\nContents"
312        # this is an attempt to put the window under the browser
313        set x [winfo x .]
314        set y [expr 5 + [winfo y .] + [winfo height .]]
315        wm geometry $window +$x+$y
316        wm deiconify $window
317    } else {
318        $button config -text "Show CIF\nContents"
319        wm withdraw $window
320    }
321}
322
323proc ParseShowCIF {frame} {
324    global CIF
325    # check for edits in progress
326    if {[CheckForCIFEdits]} return
327    # check for unsaved changes here
328    if {$CIF(changes) != 0} {
329        set ans [MyMessageBox -parent . -title "Discard Changes?" \
330                -message "You have changed this CIF. Do you want to save or discard your changes?" \
331                -icon question -type {Save Discard Cancel} -default Save]
332        if {$ans == "save"} {
333            SaveCIFtoFile
334        } elseif {$ans == "cancel"} {
335            set CIF(CIFfilename) $CIF(lastCIFfilename)
336            return
337        }
338    }
339    set CIF(changes) 0
340    set CIF(undolist) {}
341    set CIF(redolist) {}
342
343    $CIF(txt) configure -state normal
344    $CIF(txt) delete 1.0 end
345    $CIF(txt) configure -state disabled
346    foreach i $CIF(blocklist) {
347        global block$i
348        unset block$i
349    }
350    set CIF(maxblocks) [ParseCIF $CIF(txt) $CIF(CIFfilename)]
351    set CIF(lastCIFfilename) $CIF(CIFfilename)
352    wm title . "CIF Browser: file $CIF(CIFfilename)"
353       
354    # make a list of blocks
355    set CIF(blocklist) {}
356    set errors {}
357    global block0
358    if {[array names block0] != ""} {
359        set i 0
360    } else {
361        set i 1
362    }
363    for {} {$i <= $CIF(maxblocks)} {incr i} {
364        lappend CIF(blocklist) ${i}
365        if {![catch {set block${i}(errors)} errmsg]} {
366            append errors "Block $i ([set block${i}(data_)]) errors: [set block${i}(errors)]\n"
367        }
368        if {$errors != ""} {
369            MyMessageBox -parent . -title "CIF errors" \
370                    -message "Note: file $CIF(CIFfilename) has errors.\n$errors" \
371                    -icon error -type Continue -default continue
372        }
373    }
374
375    if {$CIF(blocklist) != ""} {
376        CIFBrowser $CIF(txt) $CIF(blocklist) "" $frame
377    }
378}
379
380# create window/text widget for CIF file
381catch {destroy [set file .file]}
382toplevel $file
383wm title $file "CIF file contents"
384bind $file <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
385
386set CIF(txt) $file.t
387grid [text $CIF(txt) -height 10 -width 80 -yscrollcommand "$file.s set"] \
388        -col 0 -row 0 -sticky news
389grid [scrollbar $file.s -command "$CIF(txt) yview"] -col 1 -row 0 -sticky ns
390grid columnconfig $file 0 -weight 1
391grid rowconfig $file 0 -weight 1
392# hide it
393wm withdraw $file
394
395# create window/text widget for the CIF definition
396catch {destroy [set defw .def]}
397toplevel $defw
398bind $defw <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
399wm title $defw "CIF definitions"
400set CIF(defBox) $defw.t
401grid [text $CIF(defBox) -width 65 -xscrollcommand "$defw.x set" \
402        -yscrollcommand "$defw.y set"] -col 0 -row 0 -sticky news
403grid [scrollbar $defw.y -command "$CIF(defBox) yview"] -col 1 -row 0 -sticky ns
404grid [scrollbar $defw.x -command "$CIF(defBox) xview" \
405        -orient horizontal] -col 0 -row 1 -sticky ew
406grid columnconfig $defw 0 -weight 1
407grid rowconfig $defw 0 -weight 1
408# hide it
409wm withdraw $defw
410
411if {![file exists [file join $scriptdir CIF_index]]} {
412    MyMessageBox -parent . -title "No CIF index" \
413            -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" \
414            -icon error -type {"Oh darn"} -default "oh darn"
415} elseif [catch {
416    source  [file join $scriptdir CIF_index]
417} errmsg] {
418    MyMessageBox -parent . -title "CIF index error" \
419            -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" \
420            -icon error -type {"Oh darn"} -default "oh darn"
421}
422
423
424# add location of these files & the typical GSAS data directory
425# to the dictionary search path
426lappend CIF(cif_path) $scriptdir [file join [file dirname $scriptdir] data]
427
428# make frame for the CIF browser
429wm title . "CIF Browser"
430grid [set CIF(browserBox) [frame .top]] -column 0 -row 0 -sticky ew
431grid [set box [frame .box]] -column 0 -row 1 -sticky ew
432
433set filemenu [tk_optionMenu $box.file CIF(CIFfilename) ""]
434$box.file config -width 25
435$filemenu delete 0 end
436foreach f $CIF(filelist) {
437    $filemenu add radiobutton -value $f -label $f -variable CIF(CIFfilename) \
438            -command "ParseShowCIF $CIF(browserBox)"
439}
440
441set col -1
442grid [label $box.lf -text "template\nfile:"] -column [incr col] \
443        -row 1 -rowspan 2
444grid $box.file  -column [incr col] -row 1 -rowspan 2 -sticky w
445grid [button $box.next -text "Next ? in\ntemplate" \
446        -command NextCIFtemplate] -column [incr col] -row 1 -rowspan 2
447grid columnconfig $box $col -weight 1
448incr col
449grid [button $box.c -text Exit -command ConfirmDestroy] \
450        -column [incr col] -row 1 -rowspan 2 -sticky w
451grid columnconfig $box $col -weight 1
452
453incr col
454grid [button $box.f -text "Show CIF\nContents" \
455        -command "ShowCIFWindow $box.f $file"] -column [incr col] \
456        -row 1 -rowspan 2
457grid [button $box.d -text "Show CIF\nDefinitions" \
458        -command "ShowDefWindow $box.d $defw"] -column [incr col] \
459        -row 1 -rowspan 2 -sticky w
460
461incr col
462grid [button $box.u -text "Undo" -command UndoChanges \
463        -state disabled] \
464        -column $col -row 1 -rowspan 2 -sticky w
465incr col
466grid [button $box.r -text "Redo" -command RedoChanges \
467        -state disabled] \
468        -column $col -row 1 -rowspan 2 -sticky w
469
470incr col
471grid [button $box.6 -text "Save" \
472        -command SaveCIFtoFile -state disabled] -column $col \
473        -row 1
474grid [checkbutton $box.7b -text "Auto-Save" \
475        -variable CIF(autosavetodisk)] -column $col -columnspan 2 \
476        -row 2 -sticky w
477
478grid [button $box.help -text Help -bg yellow \
479            -command "MakeWWWHelp gsas2cif.html filltemplate"] \
480            -column [incr col] -row 1 -rowspan 2 -sticky nw
481
482set CIF(autosavetodisk) 0
483set CIF(editmode) 1
484
485wm protocol . WM_DELETE_WINDOW ConfirmDestroy
486wm protocol $file WM_DELETE_WINDOW "ShowCIFWindow $box.f $file"
487wm protocol $defw WM_DELETE_WINDOW "ShowDefWindow $box.d $defw"
488
489trace variable CIF(changes) w "EnableSaveEdits $box.6"
490proc EnableSaveEdits {w args} {
491    global CIF
492    if {$CIF(changes)} {
493        $w config -state normal
494    } else {
495        $w config -state disabled
496    }
497}
498trace variable CIF(undolist) w "EnableUndo $box.u undolist"
499trace variable CIF(redolist) w "EnableUndo $box.r redolist"
500proc EnableUndo {w var args} {
501    global CIF
502    if {[llength $CIF($var)] > 0} {
503        $w config -state normal
504    } else {
505        $w config -state disabled
506    }
507}
508
509set CIF(blocklist) {}
510set CIF(CIFfilename) [lindex $CIF(filelist) 0]
511CIFBrowserWindow $CIF(browserBox)
512ParseShowCIF $CIF(browserBox)
513
514#------- work in progress
515
516set CIF(TemplateIgnoreList) {_journal_*}
517
Note: See TracBrowser for help on using the repository browser.