Changeset 649


Ignore:
Timestamp:
Dec 4, 2009 5:09:42 PM (13 years ago)
Author:
toby
Message:

# 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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/fillcif.tcl

    • Property rcs:date changed from 2002/09/05 18:21:33 to 2002/09/05 20:59:20
    • Property rcs:lines changed from +1 -1 to +209 -180
    • Property rcs:rev changed from 1.2 to 1.3
    r644 r649  
    1 #!/usr/bin/wish
    21# A routine for editing CIF template file(s) adapted for specific
    32# use with GSAS2CIF. This program edits files template_*.cif or
    … …  
    54# from the GSAS data directory ../data (relative to this file)
    65#
     6
    77# $Id$
    88
    … …  
    1111#      These routines are included with EXPGUI
    1212#
    13 #  2) file browsecif.tcl must be in the same directory as this file
    14 #      (Included with EXPGUI)
     13#  2) files browsecif.tcl & gsascmds.tcl must be in the same directory as
     14#      this file (Included with EXPGUI)
    1515#
    1616#  3) file CIF_index must be in the same directory as this file
    … …  
    112112}
    113113
    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 }
    122114
    123115proc SaveCIFtoFile {} {
    124116    global CIF
    125117    set CIF(changes) 0
     118    set CIF(undolist) {}
     119    set CIF(redolist) {}
    126120    # at least for the moment, keep the previous version
    127121    file rename -force $CIF(lastCIFfilename) $CIF(lastCIFfilename).old
    … …  
    152146}
    153147
    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 
    334148proc NextCIFtemplate {} {
    335149    global CIF CIFtreeindex
     150    if {[CheckForCIFEdits]} return
    336151    set loopindex ""
    337152    set pointer ""
    … …  
    361176    }
    362177    # go on to the next file
    363     if {[CheckForCIFEdits]} return
    364178    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
    365179        SaveCIFtoFile
    … …  
    407221proc FindNextCIFQuestionMark {block dataname loopindex} {
    408222    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     }
     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
    427233    set first -1
    428234    foreach n $blocklist {
    … …  
    487293    }
    488294}
     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 TracChangeset for help on using the changeset viewer.