| 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 644 2009-12-04 23:09:37Z 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 | |
|---|
| 32 | if {$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 | |
|---|
| 39 | if {[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 | |
|---|
| 48 | if {[set dir [file dirname $prefix]] != ""} { |
|---|
| 49 | cd $dir |
|---|
| 50 | set prefix [file tail $prefix] |
|---|
| 51 | } |
|---|
| 52 | # where is this file running from? |
|---|
| 53 | set script [info script] |
|---|
| 54 | # translate links -- go six levels deep |
|---|
| 55 | foreach 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 |
|---|
| 68 | if {[file pathtype $script] == "relative"} { |
|---|
| 69 | set script [file join [pwd] $script] |
|---|
| 70 | } |
|---|
| 71 | set scriptdir [file dirname $script ] |
|---|
| 72 | # used by some gsascmds routines |
|---|
| 73 | set expgui(scriptdir) $scriptdir |
|---|
| 74 | set expgui(gsasdir) [file dirname $expgui(scriptdir)] |
|---|
| 75 | set expgui(gsasexe) [file join $expgui(gsasdir) exe] |
|---|
| 76 | set expgui(docdir) [file join $expgui(scriptdir) doc] |
|---|
| 77 | # location for web pages, if not found locally |
|---|
| 78 | set expgui(website) www.ncnr.nist.gov/xtal/software/expgui |
|---|
| 79 | |
|---|
| 80 | # where to find the BWidget program |
|---|
| 81 | lappend auto_path $scriptdir |
|---|
| 82 | # now look |
|---|
| 83 | if [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 | |
|---|
| 90 | source [file join $scriptdir browsecif.tcl] |
|---|
| 91 | source [file join $scriptdir gsascmds.tcl] |
|---|
| 92 | bind . <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate" |
|---|
| 93 | |
|---|
| 94 | set CIF(filelist) [glob -nocomplain ${prefix}_*.cif] |
|---|
| 95 | if {$CIF(filelist) == ""} { |
|---|
| 96 | set CIF(filelist) [glob -nocomplain template_*.cif] |
|---|
| 97 | } |
|---|
| 98 | if {$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 | proc 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 | |
|---|
| 123 | proc 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 | |
|---|
| 133 | proc 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 | |
|---|
| 154 | proc 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 | } |
|---|
| 167 | proc 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 | |
|---|
| 181 | proc 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 |
|---|
| 230 | catch {destroy [set file .file]} |
|---|
| 231 | toplevel $file |
|---|
| 232 | wm title $file "CIF file contents" |
|---|
| 233 | bind $file <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate" |
|---|
| 234 | set CIF(txt) $file.t |
|---|
| 235 | grid [text $CIF(txt) -height 10 -width 80 -yscrollcommand "$file.s set"] \ |
|---|
| 236 | -col 0 -row 0 -sticky news |
|---|
| 237 | grid [scrollbar $file.s -command "$CIF(txt) yview"] -col 1 -row 0 -sticky ns |
|---|
| 238 | grid columnconfig $file 0 -weight 1 |
|---|
| 239 | grid rowconfig $file 0 -weight 1 |
|---|
| 240 | # hide it |
|---|
| 241 | wm withdraw $file |
|---|
| 242 | |
|---|
| 243 | # create window/text widget for the CIF definition |
|---|
| 244 | catch {destroy [set defw .def]} |
|---|
| 245 | toplevel $defw |
|---|
| 246 | bind $defw <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate" |
|---|
| 247 | wm title $defw "CIF definitions" |
|---|
| 248 | set CIF(defBox) $defw.t |
|---|
| 249 | grid [text $CIF(defBox) -width 65 -xscrollcommand "$defw.x set" \ |
|---|
| 250 | -yscrollcommand "$defw.y set"] -col 0 -row 0 -sticky news |
|---|
| 251 | grid [scrollbar $defw.y -command "$CIF(defBox) yview"] -col 1 -row 0 -sticky ns |
|---|
| 252 | grid [scrollbar $defw.x -command "$CIF(defBox) xview" \ |
|---|
| 253 | -orient horizontal] -col 0 -row 1 -sticky ew |
|---|
| 254 | grid columnconfig $defw 0 -weight 1 |
|---|
| 255 | grid rowconfig $defw 0 -weight 1 |
|---|
| 256 | # hide it |
|---|
| 257 | wm withdraw $defw |
|---|
| 258 | |
|---|
| 259 | if {![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 |
|---|
| 274 | lappend CIF(cif_path) $scriptdir [file join [file dirname $scriptdir] data] |
|---|
| 275 | |
|---|
| 276 | # make frame for the CIF browser |
|---|
| 277 | wm title . "CIF Browser" |
|---|
| 278 | grid [set CIF(browserBox) [frame .top]] -column 0 -row 0 -sticky ew |
|---|
| 279 | grid [set box [frame .box]] -column 0 -row 1 -sticky ew |
|---|
| 280 | |
|---|
| 281 | set filemenu [tk_optionMenu $box.file CIF(CIFfilename) ""] |
|---|
| 282 | $box.file config -width 25 |
|---|
| 283 | $filemenu delete 0 end |
|---|
| 284 | foreach f $CIF(filelist) { |
|---|
| 285 | $filemenu add radiobutton -value $f -label $f -variable CIF(CIFfilename) \ |
|---|
| 286 | -command "ParseShowCIF $CIF(browserBox)" |
|---|
| 287 | } |
|---|
| 288 | |
|---|
| 289 | set col -1 |
|---|
| 290 | grid [label $box.lf -text "template\nfile:"] -column [incr col] \ |
|---|
| 291 | -row 1 -rowspan 2 |
|---|
| 292 | grid $box.file -column [incr col] -row 1 -rowspan 2 -sticky w |
|---|
| 293 | grid [button $box.next -text "Next ? in\ntemplate" \ |
|---|
| 294 | -command NextCIFtemplate] -column [incr col] -row 1 -rowspan 2 |
|---|
| 295 | grid columnconfig $box $col -weight 1 |
|---|
| 296 | incr col |
|---|
| 297 | grid [button $box.c -text Exit -command ConfirmDestroy] \ |
|---|
| 298 | -column [incr col] -row 1 -rowspan 2 -sticky w |
|---|
| 299 | wm protocol . WM_DELETE_WINDOW ConfirmDestroy |
|---|
| 300 | grid columnconfig $box $col -weight 1 |
|---|
| 301 | incr col |
|---|
| 302 | grid [button $box.f -text "Show CIF\nContents" \ |
|---|
| 303 | -command "ShowCIFWindow $box.f $file"] -column [incr col] \ |
|---|
| 304 | -row 1 -rowspan 2 |
|---|
| 305 | wm protocol $file WM_DELETE_WINDOW "ShowCIFWindow $box.f $file" |
|---|
| 306 | grid [button $box.d -text "Show CIF\nDefinitions" \ |
|---|
| 307 | -command "ShowDefWindow $box.d $defw"] -column [incr col] \ |
|---|
| 308 | -row 1 -rowspan 2 -sticky w |
|---|
| 309 | wm protocol $defw WM_DELETE_WINDOW "ShowDefWindow $box.d $defw" |
|---|
| 310 | |
|---|
| 311 | grid [button $box.6 -text "Save\nEdits" \ |
|---|
| 312 | -command SaveCIFtoFile -state disabled] -column [incr col] \ |
|---|
| 313 | -row 1 -rowspan 2 |
|---|
| 314 | grid [checkbutton $box.7a -text "Auto-Accept" \ |
|---|
| 315 | -variable CIF(autosave_edits)] -column [incr col] -row 1 -sticky w |
|---|
| 316 | grid [checkbutton $box.7b -text "Auto-Save" \ |
|---|
| 317 | -variable CIF(autosavetodisk)] -column $col -row 2 -sticky w |
|---|
| 318 | grid [button $box.help -text Help -bg yellow \ |
|---|
| 319 | -command "MakeWWWHelp gsas2cif.html filltemplate"] \ |
|---|
| 320 | -column [incr col] -row 1 -rowspan 2 -sticky nw |
|---|
| 321 | |
|---|
| 322 | set CIF(autosavetodisk) 0 |
|---|
| 323 | set CIF(editmode) 1 |
|---|
| 324 | set CIF(changes) 0 |
|---|
| 325 | trace variable CIF(changes) w "EnableSaveEdits $box.6" |
|---|
| 326 | set CIF(CIFfilename) [lindex $CIF(filelist) 0] |
|---|
| 327 | CIFBrowserWindow $CIF(browserBox) |
|---|
| 328 | ParseShowCIF $CIF(browserBox) |
|---|
| 329 | |
|---|
| 330 | #------- work in progress |
|---|
| 331 | |
|---|
| 332 | set CIF(TemplateIgnoreList) {_journal_*} |
|---|
| 333 | |
|---|
| 334 | proc 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 | |
|---|
| 407 | proc 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 | } |
|---|
