#!/bin/sh
# the next line restarts this script using wish found in the path\
exec wish "$0" "$@"
# If this does not work, change the #!/usr/bin/wish line below
# to reflect the actual wish location and delete all preceeding lines
#
# (delete here and above)
#!/usr/bin/wish
#
# $Id: cifedit.tcl,v 1.9 2003/07/25 00:32:11 toby Exp toby $
# A routine for editing CIFs
#
# Prerequisites:
# 1) BWidget routines be available (tested with version 1.2.1)
# if the BWidget routines are not in a subdirectory of where this
# file is located & is not in the normal tcl auto_path, add the
# path below by uncommenting & updating the next line:
# lappend auto_path /usr/local/tcltk/
# e.g. use /usr/local/tcltk/ if the package is in /usr/local/tcltk/BWidget-1.2.1
#
# 2) file browsecif.tcl must be in the same directory as this file
#
# 3) file CIF_index must be in the same directory as this file
# This file is an index to the CIF dictionaries in use and is generated
# using routines in indexCIFdict.tcl
# note that variable CIF(cif_path) dictates where these dictionary
# files will be found. The path where these dictionaries were read
# in indexCIFdict.tcl is saved in the CIF_index file. The
# directory where this file is located, as well asl a directory
# below this named data (../data/) is also searched.
# Note the Maximum CIF size is set by this variable:
set CIF(maxvalues) 100000
# where CIF(maxvalues) is the number of data items (each value in a loop
# is counted).
# 100,000 => 25Mb task size (Linux) & ~0.5Mb CIF
# use "set CIF(maxvalues) 0" to defeat the limit
# Note the maximum number of "rows" that can be displayed by selecting a row
# is set by this variable:
set CIF(maxRows) 100
# the maximum number of characters/line in CIF size is set by this variable:
set CIF(maxlinelength) 80
if {[llength $argv] != 1 || ![file exists [lindex $argv 0]]} {
set file [tk_getOpenFile -title "Select CIF" -parent . \
-defaultextension cif -filetypes {{"CIF data" ".cif .CIF"}}]
if {$file == ""} {exit}
set argv $file
} else {
set argv [lindex $argv 0]
}
# where is this file running from?
set script [info script]
# translate links -- go six levels deep
foreach i {1 2 3 4 5 6} {
if {[file type $script] == "link"} {
set link [file readlink $script]
if { [file pathtype $link] == "absolute" } {
set script $link
} {
set script [file dirname $script]/$link
}
} else {
break
}
}
# fixup relative paths
if {[file pathtype $script] == "relative"} {
set script [file join [pwd] $script]
}
set scriptdir [file dirname $script ]
# where to find the BWidget program
lappend auto_path $scriptdir
source [file join $scriptdir browsecif.tcl]
if {$tcl_version < 8.2} {
tk_dialog .error {Old Tcl/Tk} \
"Sorry, the CIF Editor requires version 8.2 or later of the Tcl/Tk package. This is $tcl_version" \
warning 0 Sorry
exit
}
if [catch {package require BWidget}] {
tk_dialog .error {No BWidget} \
"Sorry, the CIF Editor requires the BWidget package" \
warning 0 Sorry
exit
}
if {![file exists [file join $scriptdir CIF_index]]} {
MyMessageBox -parent . -title "No CIF index" \
-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" \
-icon error -type {"Oh darn"} -default "oh darn"
} elseif [catch {
source [file join $scriptdir CIF_index]
} errmsg] {
MyMessageBox -parent . -title "CIF index error" \
-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" \
-icon error -type {"Oh darn"} -default "oh darn"
}
# add the standard location of the dictionary files to the dictionary search path
lappend CIF(cif_path) [file join $scriptdir dict]
wm withdraw .
# create window/text widget for CIF file
catch {destroy [set filew .cif]}
toplevel $filew
wm title $filew "CIF file contents"
set CIF(txt) $filew.t
# shrink file viewer on small screens & add a scroll bar
set w 80
if {[winfo screenwidth .] < 700} {set w 60}
grid [text $CIF(txt) -height 10 -width $w -yscrollcommand "$filew.s set" \
-wrap none] -column 0 -row 0 -sticky news
grid [scrollbar $filew.s -command "$CIF(txt) yview"] \
-column 1 -row 0 -sticky ns
if {[winfo screenwidth .] < 700} {
grid [scrollbar $filew.sx -command "$CIF(txt) xview" \
-orient horizontal] -column 0 -row 1 -sticky ew
$CIF(txt) config -xscrollcommand "$filew.sx set"
}
grid columnconfig $filew 0 -weight 1
grid rowconfig $filew 0 -weight 1
grid [frame $filew.f] -column 0 -columnspan 2 -row 2 -sticky news
grid columnconfig $filew.f 4 -weight 1
grid [button $filew.f.edit -text "Open for Editing" \
-command "EditCIFBox $filew.f.edit"] -column 0 -row 0
grid [button $filew.f.b -text "go to line:" \
-command {MarkGotoLine $CIF(goto)}] -column 5 -row 0
grid [entry $filew.f.e -textvariable CIF(goto) -width 6] -column 6 -row 0
set CIF(goto) 1
bind $filew.f.e "$filew.f.b invoke"
# create window/text widget for the CIF definition
catch {destroy [set defw .def]}
toplevel $defw
wm title $defw "CIF definitions"
set CIF(defBox) $defw.t
# shrink definition viewer on small screens
set w 45
set h 18
if {[winfo screenwidth .] <= 800} {set w 35; set h 12}
grid [text $CIF(defBox) -width $w -height $h -xscrollcommand "$defw.x set" \
-yscrollcommand "$defw.y set" -wrap word] -column 0 -row 0 -sticky news
grid [scrollbar $defw.y -command "$CIF(defBox) yview"] -column 1 -row 0 -sticky ns
grid [scrollbar $defw.x -command "$CIF(defBox) xview" \
-orient horizontal] -column 0 -row 1 -sticky ew
grid columnconfig $defw 0 -weight 1
grid rowconfig $defw 0 -weight 1
# hide it
wm withdraw $defw
update
set CIF(showCIF) 0
set CIF(showDefs) 0
# make window for the CIF Editor
set CIF(browser) .browser
catch {destroy $CIF(browser)}
toplevel $CIF(browser)
wm title $CIF(browser) "CIF Editor"
# put box in upper left
wm withdraw $CIF(browser)
wm geometry $CIF(browser) +0+0
update
wm deiconify $CIF(browser)
grid [frame $CIF(browser).box] -column 0 -row 2 -sticky ew
set col 0
grid [button $CIF(browser).box.c -text Close \
-command "ConfirmDestroy $CIF(browser) [list $argv.new]"] \
-column $col -row 1 -sticky w
grid columnconfig $CIF(browser).box $col -weight 1
incr col
grid [button $CIF(browser).box.f -text "Show CIF Contents" \
-command "ShowCIFWindow $CIF(browser).box.f $filew $CIF(browser)"] \
-column $col -row 1
incr col
grid [button $CIF(browser).box.d -text "Show CIF Definitions" \
-command "ShowDefWindow $CIF(browser).box.d $defw $CIF(browser) $filew"] \
-column $col -row 1 -sticky w
grid columnconfig $CIF(browser).box $col -weight 1
incr col
grid [button $CIF(browser).box.v -text "Validate CIF" \
-command "ValidateAllItems $CIF(txt)"] -column $col -row 1 -sticky w
incr col
grid [button $CIF(browser).box.u -text "Undo" -command UndoChanges \
-state disabled] \
-column $col -row 1 -sticky w
incr col
grid [button $CIF(browser).box.r -text "Redo" -command RedoChanges \
-state disabled] \
-column $col -row 1 -sticky w
incr col
grid [label $CIF(browser).box.3 -text "Mode:"] -column $col -row 1
incr col
grid [radiobutton $CIF(browser).box.4 -text "browse" \
-variable CIF(editmode) -value 0 -command RepeatLastshowCIFvalue \
] -column $col -row 1
incr col
grid [radiobutton $CIF(browser).box.5 -text "edit" \
-variable CIF(editmode) -value 1 -command RepeatLastshowCIFvalue \
] -column $col -row 1
incr col
grid [button $CIF(browser).box.6 -text "Save" \
-command "SaveCIFtoFile [list $argv]" -state disabled] -column $col -row 1
set CIF(editmode) 0
wm protocol $filew WM_DELETE_WINDOW \
"ShowCIFWindow $CIF(browser).box.f $filew $CIF(browser)"
wm protocol $defw WM_DELETE_WINDOW \
"ShowDefWindow $CIF(browser).box.d $defw $CIF(browser) $filew"
wm protocol $CIF(browser) WM_DELETE_WINDOW \
"ConfirmDestroy $CIF(browser) [list $argv.new]"
trace variable CIF(changes) w "EnableSaveEdits $CIF(browser).box.6"
proc EnableSaveEdits {w args} {
global CIF
if {$CIF(changes)} {
$w config -state normal
} else {
$w config -state disabled
}
}
trace variable CIF(undolist) w "EnableUndo $CIF(browser).box.u undolist"
trace variable CIF(redolist) w "EnableUndo $CIF(browser).box.r redolist"
proc EnableUndo {w var args} {
global CIF
if {[llength $CIF($var)] > 0} {
$w config -state normal
} else {
$w config -state disabled
}
}
proc SaveCIFtoFile {file} {
global CIF
set CIF(changes) 0
set CIF(undolist) {}
set CIF(redolist) {}
# at least for the moment, keep the previous version
file rename -force $file ${file}.old
set fp [open $file w]
puts -nonewline $fp [$CIF(txt) get 1.0 end]
close $fp
}
proc ConfirmDestroy {frame file} {
global CIF
if {$CIF(changes) != 0} {
set ans [MyMessageBox -parent . -title "Discard Changes?" \
-message "You have changed this CIF. Do you want to save or discard your changes?" \
-icon question -type {Save Discard Cancel} -default Save]
if {$ans == "save"} {
SaveCIFtoFile $file
destroy $frame
} elseif {$ans == "discard"} {
destroy $frame
}
} else {
destroy $frame
}
exit
}
proc ShowDefWindow {button window master cifw} {
global CIF tcl_platform
if {[lindex [$button cget -text] 0] == "Show"} {
$button config -text "Hide CIF Definitions"
if {$CIF(showDefs) == 0} {
# approximate size of border
if {$tcl_platform(platform) == "windows"} {
# on windows border is included in computations
set border 0
} else {
set border [expr [winfo rooty $master] - [winfo vrooty $master]]
}
# put the window under the browser/file window on the first call
if {[winfo ismapped $cifw]} {
# next to the cif contents window
set x [expr 5 + [winfo x $cifw] + [winfo width $cifw]]
set y [expr [winfo rooty $master] + [winfo height $master] + \
$border]
} else {
# under the browser
set x [winfo x $master]
set y [expr [winfo rooty $master] + [winfo height $master] + \
$border]
}
wm geometry $window +$x+$y
update
set CIF(showDefs) 1
}
wm deiconify $window
} else {
$button config -text "Show CIF Definitions"
wm withdraw $window
}
}
proc ShowCIFWindow {button window master} {
global CIF tcl_platform
if {[lindex [$button cget -text] 0] == "Show"} {
$button config -text "Hide CIF Contents"
# approximate size of border
if {$tcl_platform(platform) == "windows"} {
# on windows border is included in computations
set border 0
} else {
set border [expr [winfo rooty $master] - [winfo vrooty $master]]
}
if {$CIF(showCIF) == 0} {
# put the window under the browser on the first call
set x [winfo x $master]
set y [expr [winfo rooty $master] + [winfo height $master] + \
$border]
wm geometry $window +$x+$y
update
set CIF(showCIF) 1
set CIF(showDefs) 0
}
wm deiconify $window
} else {
$button config -text "Show CIF Contents"
wm withdraw $window
}
}
proc EditCIFBox {button} {
global CIF
if {[$button cget -text] == "Open for Editing"} {
if {[CheckForCIFEdits]} return
$button config -text "Close Editing"
# save the current mode
set CIF(oldeditmode) $CIF(editmode)
set CIF(editmode) 0
RepeatLastshowCIFvalue
$CIF(browser).box.3 config -fg gray
# disable most of the editor to avoid conflicts
foreach w {4 5 6 c f u r} {
$CIF(browser).box.$w config -state disabled
}
$CIF(txt) config -state normal
# prevent other windows from functioning
#grab $CIF(txt)
} else {
$button config -text "Open for Editing"
# reenable the other windows
#grab release $CIF(txt)
$CIF(browser).box.3 config -fg black
foreach w {4 5 6 c f} {
$CIF(browser).box.$w config -state normal
}
incr CIF(changes)
set CIF(editmode) $CIF(oldeditmode)
$CIF(txt) config -state disabled
RepeatLastshowCIFvalue
# need to parse the revised CIF
foreach i $CIF(blocklist) {
global block$i
unset block$i
}
pleasewait "Parsing CIF" CIF(status)
set CIF(maxblocks) [ParseCIF $CIF(txt)]
# update the blocklist & display them
set CIF(blocklist) {}
if {[array names block0] != ""} {
set i 0
} else {
set i 1
}
global argv
set errors ""
for {} {$i <= $CIF(maxblocks)} {incr i} {
lappend CIF(blocklist) $i
if {![catch {set block${i}(errors)}]} {
if {$errors ==""} {set errors "Errors in file $argv\n\n"}
append errors "Data block #$i [set block${i}(data_)]\n"
append errors "======================================\n\n"
append errors "[set block${i}(errors)]\n"
}
}
if {$CIF(blocklist) != ""} {
CIFBrowser $CIF(txt) $CIF(blocklist) "" $CIF(browser)
}
catch {donewait}
if {$errors != ""} {
if {[MyMessageBox -parent $CIF(txt) -title "CIF errors" \
-message "Note: $errors" \
-icon error -type {Continue "Save Errors"} \
-default continue] == "continue"} {return}
set file [tk_getSaveFile -parent $CIF(txt) \
-filetypes {{"text file" .txt}} -defaultextension .txt]
if {$file == ""} return
set fp [open $file w]
puts $fp $error
close $fp
}
}
}
# validate the fields in a CIF
proc ValidateAllItems {txt} {
global CIF argv
set errors 0
set blocklist $CIF(blocklist)
foreach n $blocklist {
set block block$n
global block$n
# make a list of data names in loops
set looplist {}
foreach loop [array names block$n loop_*] {
eval lappend looplist [set block${n}($loop)]
}
# clear out the block error list
set ${block}(validate) {}
# loop over data names
foreach dataname [lsort [array names block$n _*]] {
if {[lsearch $looplist $dataname] == -1} {
set mark [set ${block}($dataname)]
set item [$CIF(txt) get $mark.l $mark.r]
set err [ValidateCIFName $dataname]
if {$err != ""} {
append ${block}(validate) "$err\n"
incr errors
} else {
set err [ValidateCIFItem $dataname $item]
if {$err != ""} {
append ${block}(validate) "$err\n"
incr errors
}
}
} else {
# looped names
set err [ValidateCIFName $dataname]
if {$err != ""} {
append ${block}(validate) "$err\n"
incr errors
continue
}
set index 0
foreach mark [set ${block}($dataname)] {
incr index
set item [$CIF(txt) get $mark.l $mark.r]
set err [ValidateCIFItem $dataname $item]
if {$err != ""} {
append ${block}(validate) "$err (loop index #$index)\n"
incr errors
}
}
}
}
if {[catch {set ${block}(validateicon)} err]} {
if {[set ${block}(validate)] != ""} {
# insert validation error pointer
$CIF(tree) insert 0 block$n [incr CIF(tree_lastindex)] \
-text "Validation-errors" -image [Bitmap::get undo] \
-data block$n
set ${block}(validateicon) $CIF(tree_lastindex)
}
}
}
if {$errors > 0} {
set i 0
set msg "$errors validation errors were found in $argv.\n\n"
foreach n $blocklist {
incr i
set block block$n
global block$n
# get the block name
if {[set err [set block${n}(validate)]] != ""} {
append msg "Data block #$i [set block${n}(data_)]\n"
append msg "======================================\n\n"
append msg "[set block${n}(validate)]\n"
}
}
if {[MyMessageBox -parent $CIF(tree) -title "Validation errors" \
-message $msg -icon error -type {OK "Save Errors"} -default "ok"] \
== "ok"} return
set file [tk_getSaveFile -parent $CIF(tree) \
-filetypes {{"text file" .txt}} -defaultextension .txt]
if {$file == ""} return
set fp [open $file w]
puts $fp $msg
close $fp
}
}
# hide the browser window
wm iconify $CIF(browser)
# center the CIF text window
wm withdraw $filew
set x [expr {[winfo screenwidth $filew]/2 - [winfo reqwidth $filew]/2 \
- [winfo vrootx [winfo parent $filew]]}]
set y [expr {[winfo screenheight $filew]/2 - [winfo reqheight $filew]/2 \
- [winfo vrooty [winfo parent $filew]]}]
wm geometry $filew +$x+$y
update
wm deiconify $filew
pleasewait "while loading CIF file" CIF(status) $filew {Quit exit}
set CIF(maxblocks) [ParseCIF $CIF(txt) $argv]
set CIF(blocklist) {}
if {[array names block0] != ""} {
set i 0
} else {
set i 1
}
set errors ""
for {} {$i <= $CIF(maxblocks)} {incr i} {
lappend CIF(blocklist) $i
if {![catch {set block${i}(errors)}]} {
if {$errors ==""} {set errors "Errors in file $argv\n\n"}
append errors "Data block #$i [set block${i}(data_)]\n"
append errors "======================================\n\n"
append errors "[set block${i}(errors)]\n"
}
}
if {$CIF(blocklist) != ""} {
CIFOpenBrowser $CIF(browser)
wm title $CIF(browser) "CIF Browser: file $argv"
CIFBrowser $CIF(txt) $CIF(blocklist) "" $CIF(browser)
wm deiconify $CIF(browser)
# hide the CIF window
wm withdraw $filew
}
donewait
if {$errors != ""} {
if {[MyMessageBox -parent $CIF(txt) -title "CIF errors" \
-message "Note: this CIF has errors.\n\n$errors" \
-icon error -type {Continue "Save Errors"} \
-default continue] != "continue"} {
set file [tk_getSaveFile -parent $CIF(txt) \
-filetypes {{"text file" .txt}} -defaultextension .txt]
if {$file != ""} {
set fp [open $file w]
puts $fp $errors
close $fp
}
}
}