source: trunk/fillcif.tcl @ 705

Last change on this file since 705 was 663, checked in by toby, 16 years ago

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