#!/usr/bin/wish
# A routine for editing CIF template file(s) adapted for specific
# use with GSAS2CIF. This program edits files template_*.cif or
# <expnam>_*.cif. If neither are available, it copies the template_*.cif 
# from the GSAS data directory ../data (relative to this file)
#
# $Id: fillcif.tcl 639 2009-12-04 23:09:32Z toby $

# Prerequisites:
#  1) BWidget routines be available (tested with version 1.2.1)
#      These routines are included with EXPGUI
#
#  2) file browsecif.tcl must be in the same directory as this file
#      (Included with EXPGUI)
#
#  3) file CIF_index must be in the same directory as this file
#      (Included with EXPGUI)
#      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 and the GSAS data directory (../data/) included.
#
#  4) The CIF core & powder dictionaries are included in the GSAS data 
#      directory (../data/), files cif_core_2.2.dic and cif_pd.dic
#      (Included with GSAS/EXPGUI distribution)
#
#  5) The GSAS2CIF template files (template_instrument.cif, 
#      template_phase.cif and template_publ.cif) are included in the GSAS data 
#      directory (../data/).
#      (Included with GSAS/EXPGUI distribution)

if {$tcl_version < 8.2} {
    tk_dialog .error {Old Tcl/Tk} \
	    "Sorry, the CIF Browser requires version 8.2 or later of the Tcl/Tk package. This is $tcl_version" \
	    warning 0 Sorry
    exit
}

if {[llength $argv] != 1} {
    set file [tk_getOpenFile -title "Select GSAS Experiment" -parent . \
	    -defaultextension EXP -filetypes {{"GSAS experiment" .EXP}}]
    if {$file == ""} {exit}
    set prefix [file root $file]
} else {
    set prefix $argv
}

if {[set dir [file dirname $prefix]] != ""} {
    cd $dir
    set prefix [file tail $prefix]
}
# 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 ]
# used by some gsascmds routines
set expgui(scriptdir) $scriptdir
set expgui(gsasdir) [file dirname $expgui(scriptdir)]
set expgui(gsasexe) [file join $expgui(gsasdir) exe]
set expgui(docdir) [file join $expgui(scriptdir) doc]
# location for web pages, if not found locally
set expgui(website) www.ncnr.nist.gov/xtal/software/expgui

# where to find the BWidget program
lappend auto_path $scriptdir
# now look
if [catch {package require BWidget} errmsg] {
    tk_dialog .error {No BWidget} \
	    "Sorry, the CIF Browser requires the BWidget package." \
	    warning 0 Sorry
    exit
}

source [file join $scriptdir browsecif.tcl]
source [file join $scriptdir gsascmds.tcl]
bind . <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"

set CIF(filelist) [glob -nocomplain ${prefix}_*.cif]
if {$CIF(filelist) == ""} {
    set CIF(filelist) [glob -nocomplain template_*.cif]
}
if {$CIF(filelist) == ""} {
    set CIF(filelist) [glob -nocomplain [file join $scriptdir ../data template_*.cif]]
    if {$CIF(filelist) == ""} {
	MyMessageBox -parent . -title "No template files" \
	    -message "No CIF template files found. Cannot continue" \
		-icon error -type Quit -default quit
	exit
    }
    set ans [MyMessageBox -parent . -title "Copy template files?" \
	    -message "No CIF template files (template_*.cif or ${prefix}_*.cif) in the current directory. Copy standard templates from GSAS data directory?" \
	    -icon question -type {Copy Quit} -default copy]
    if {$ans == "quit"} {exit}
    eval file copy $CIF(filelist) .
    set CIF(filelist) [glob -nocomplain template_*.cif]
}

proc EnableSaveEdits {w args} {
    global CIF
    if {$CIF(changes)} {
	$w config -state normal
    } else {
	$w config -state disabled
    }
}

proc SaveCIFtoFile {} {
    global CIF
    set CIF(changes) 0
    # at least for the moment, keep the previous version
    file rename -force $CIF(lastCIFfilename) $CIF(lastCIFfilename).old
    set fp [open $CIF(lastCIFfilename) w]
    puts -nonewline $fp [$CIF(txt) get 1.0 end]
    close $fp
}

proc ConfirmDestroy {} {
    global CIF
    if {[CheckForCIFEdits]} return
    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
	SaveCIFtoFile
    }
    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
	    destroy .
	} elseif {$ans == "discard"} {
	    destroy .
	}
    } else {
	destroy .
    }
}

proc ShowDefWindow {button window} {
    if {[lindex [$button cget -text] 0] == "Show"} {
	$button config -text "Hide CIF\nDefinitions"
	# this is an attempt to put the window under the browser
	set x [winfo x .]
	set y [expr 5 + [winfo y .] + [winfo height .]]
	wm geometry $window +$x+$y
	wm deiconify $window
    } else {
	$button config -text "Show CIF\nDefinitions"
	wm withdraw $window
    }
}
proc ShowCIFWindow {button window} {
    if {[lindex [$button cget -text] 0] == "Show"} {
	$button config -text "Hide CIF\nContents"
	# this is an attempt to put the window under the browser
	set x [winfo x .]
	set y [expr 5 + [winfo y .] + [winfo height .]]
	wm geometry $window +$x+$y
	wm deiconify $window
    } else {
	$button config -text "Show CIF\nContents"
	wm withdraw $window
    }
}

proc ParseShowCIF {frame} {
    global CIF

    # check for edits in progress
    if {[CheckForCIFEdits]} return
    # check for unsaved changes here
    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
	} elseif {$ans == "cancel"} {
	    set CIF(CIFfilename) $CIF(lastCIFfilename)
	    return
	}
    }
    set CIF(changes) 0

    $CIF(txt) delete 1.0 end
    set CIF(maxblocks) [ParseCIF $CIF(txt) $CIF(CIFfilename)]
    set CIF(lastCIFfilename) $CIF(CIFfilename)
    wm title . "CIF Browser: file $CIF(CIFfilename)"
	
    set allblocks {}
    if {[array names block0] != ""} {
	set i 0
    } else {
	set i 1
    }
    set errors {}
    for {} {$i <= $CIF(maxblocks)} {incr i} {
	lappend allblocks $i
	if {![catch {set block${i}(errors)} errmsg]} {
	    append errors "Block $i ([set block${i}(data_)]) errors: [set block${i}(errors)]\n"
	}
	if {$errors != ""} {
	    MyMessageBox -parent . -title "CIF errors" \
		    -message "Note: file $CIF(CIFfilename) has errors.\n$errors" \
		    -icon error -type Continue -default continue
	}
    }

    if {$allblocks != ""} {
	CIFBrowser $CIF(txt) $allblocks "" $frame
    }
}

# create window/text widget for CIF file
catch {destroy [set file .file]}
toplevel $file
wm title $file "CIF file contents"
bind .file <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
set CIF(txt) $file.t
grid [text $CIF(txt) -height 10 -width 80 -yscrollcommand "$file.s set"] \
	-col 0 -row 0 -sticky news
grid [scrollbar $file.s -command "$CIF(txt) yview"] -col 1 -row 0 -sticky ns
grid columnconfig $file 0 -weight 1
grid rowconfig $file 0 -weight 1
# hide it
wm withdraw $file

# create window/text widget for the CIF definition
catch {destroy [set defw .def]}
toplevel $defw
bind $defw <Key-F1> "MakeWWWHelp gsas2cif.html filltemplate"
wm title $defw "CIF definitions"
set CIF(defBox) $defw.t
grid [text $CIF(defBox) -width 65 -xscrollcommand "$defw.x set" \
	-yscrollcommand "$defw.y set"] -col 0 -row 0 -sticky news
grid [scrollbar $defw.y -command "$CIF(defBox) yview"] -col 1 -row 0 -sticky ns
grid [scrollbar $defw.x -command "$CIF(defBox) xview" \
	-orient horizontal] -col 0 -row 1 -sticky ew
grid columnconfig $defw 0 -weight 1
grid rowconfig $defw 0 -weight 1
# hide it
wm withdraw $defw

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 location of these files & the typical GSAS data directory 
# to the dictionary search path
lappend CIF(cif_path) $scriptdir [file join [file dirname $scriptdir] data]

# make frame for the CIF browser
wm title . "CIF Browser"
grid [set CIF(browserBox) [frame .top]] -column 0 -row 0 -sticky ew
grid [set box [frame .box]] -column 0 -row 1 -sticky ew

set filemenu [tk_optionMenu $box.file CIF(CIFfilename) ""]
$box.file config -width 25
$filemenu delete 0 end
foreach f $CIF(filelist) {
    $filemenu add radiobutton -value $f -label $f -variable CIF(CIFfilename) \
	    -command "ParseShowCIF $CIF(browserBox)"
}

set col -1
grid [label $box.lf -text "template\nfile:"] -column [incr col] \
	-row 1 -rowspan 2
grid $box.file	-column [incr col] -row 1 -rowspan 2 -sticky w
grid [button $box.next -text "Next ? in\ntemplate" \
	-command NextCIFtemplate] -column [incr col] -row 1 -rowspan 2
grid columnconfig $box $col -weight 1
incr col
grid [button $box.c -text Exit -command ConfirmDestroy] \
	-column [incr col] -row 1 -rowspan 2 -sticky w
wm protocol . WM_DELETE_WINDOW ConfirmDestroy
grid columnconfig $box $col -weight 1
incr col
grid [button $box.f -text "Show CIF\nContents" \
	-command "ShowCIFWindow $box.f $file"] -column [incr col] \
	-row 1 -rowspan 2
wm protocol $file WM_DELETE_WINDOW "ShowCIFWindow $box.f $file"
grid [button $box.d -text "Show CIF\nDefinitions" \
	-command "ShowDefWindow $box.d $defw"] -column [incr col] \
	-row 1 -rowspan 2 -sticky w
wm protocol $defw WM_DELETE_WINDOW "ShowDefWindow $box.d $defw"

grid [button $box.6 -text "Save\nEdits" \
	-command SaveCIFtoFile -state disabled] -column [incr col] \
	-row 1 -rowspan 2
grid [checkbutton $box.7a -text "Auto-Accept" \
	-variable CIF(autosave_edits)] -column [incr col] -row 1 -sticky w
grid [checkbutton $box.7b -text "Auto-Save" \
	-variable CIF(autosavetodisk)] -column $col -row 2 -sticky w
grid [button $box.help -text Help -bg yellow \
	    -command "MakeWWWHelp gsas2cif.html filltemplate"] \
	    -column [incr col] -row 1 -rowspan 2 -sticky nw

set CIF(autosavetodisk) 0
set CIF(editmode) 1
set CIF(changes) 0
trace variable CIF(changes) w "EnableSaveEdits $box.6"
set CIF(CIFfilename) [lindex $CIF(filelist) 0]
CIFBrowserWindow $CIF(browserBox)
ParseShowCIF $CIF(browserBox)

#------- work in progress

set CIF(TemplateIgnoreList) {_journal_*}

proc NextCIFtemplate {} {
    global CIF CIFtreeindex
    set loopindex ""
    set pointer ""
    set block ""
    set dataname ""
    set nextpointer ""

    if {$CIF(lastShownItem) != ""} {
	set pointer [lindex $CIF(lastShownItem) 0]
	set block [lindex $pointer 0]
	set dataname [lindex $CIF(lastShownItem) 1]
    }
    if {[llength $pointer] == 2} {	
	set loopindex [$CIF(LoopSpinBox) getvalue]
    }
    # find the next template item in current file
    foreach {nextpointer nextdataname nextloopindex} \
	    [FindNextCIFQuestionMark $block $dataname $loopindex] {}
    if {$nextpointer != ""} {
	# got one
	showCIFbyDataname $nextpointer $nextdataname $nextloopindex
	# show the tree here
	catch {
	    $CIF(tree) see $CIFtreeindex([lindex $nextpointer 0]$nextdataname)
	}
	return
    }
    # go on to the next file
    if {[CheckForCIFEdits]} return
    if {$CIF(changes) != 0 && $CIF(autosavetodisk)} {
	SaveCIFtoFile
    }
    if {$CIF(changes) != 0} {
	set ans [MyMessageBox -parent . -title "Save Changes?" \
		-message "You have changed this CIF. Do you want to save your changes?" \
		-icon question -type {Save Cancel} -default Save]
	if {$ans == "save"} {
	    SaveCIFtoFile
	} else {
	    return
	}
    }
    # is there another file to look at?
    if {$CIF(CIFfilename) == [lindex $CIF(filelist) end]} {
	set ans [MyMessageBox -parent . -title "No remaining items" \
		-message "No template items from this point in the current file, scan from the beginning of the first file?" \
		-icon question -type {Yes Cancel} -default Cancel]
	if {$ans == "cancel"} return
	# go on to first file here
	set filelist $CIF(filelist)
    } else {
	# go on to next file here
	set filelist [lrange $CIF(filelist) [expr 1+[lsearch $CIF(filelist) $CIF(CIFfilename)]] end]
    }
    foreach CIF(CIFfilename) $filelist {
	ParseShowCIF $CIF(browserBox)
	foreach {nextpointer nextdataname nextloopindex} \
		[FindNextCIFQuestionMark $block $dataname $loopindex] {}
	if {$nextpointer != ""} {
	    showCIFbyDataname $nextpointer $nextdataname $nextloopindex
	    # show the tree here
	    catch {
		$CIF(tree) see $CIFtreeindex([lindex $nextpointer 0]$nextdataname)
	    }
	    return
	}
    }
    MyMessageBox -parent . -title "All done" \
	    -message "No ? fields found. All template items have been completed." \
	    -type OK -default OK
}

proc FindNextCIFQuestionMark {block dataname loopindex} {
    global CIF
    # make a list of blocks
    set allblocks {}
    global block0
    if {[array names block0] != ""} {
	set i 0
    } else {
	set i 1
    }
    for {} {$i <= $CIF(maxblocks)} {incr i} {
	lappend allblocks block${i}
    }

    set i [lsearch $allblocks $block]
    if {$i != -1} {
	set blocklist [lrange $allblocks $i end]
    } else {
	set blocklist $allblocks
    }
    set first -1
    foreach n $blocklist {
	global $n	
	incr first
	# compile a list of names then loops
	set namelist [lsort [array names $n _*]]
	set looplist [lsort [array names $n loop_*]]
	if {$looplist != ""} {set namelist [concat $namelist $looplist]}
	# make a list of data names in loops
	set loopednames {}
	foreach loop [array names $n loop_*] {
	    eval lappend loopednames [set ${n}($loop)]
	}

	# loop index, if needed
	set start 0
	# on the first pass
	if {$first == 0} {
	    set i [lsearch $namelist $dataname]
	    if {$i != -1} {
		# found the last entry -- is it looped?
		if {$loopindex == ""} {
		    incr i
		} else {
		    set start [expr 1 + $loopindex]
		}
		set namelist [lrange $namelist $i end]
	    }
	}
	# now start searching for an entry
	foreach name $namelist {
	    # skip over datanames in loops or in the ignore list
	    set match 0
	    foreach ignore $CIF(TemplateIgnoreList) {
		if {[string match $ignore $name]} {
		    set match 1
		    break
		}
	    }
	    if {$match} continue
	    if {[lsearch $loopednames $name] != -1} continue

	    if {[string range $name 0 4] != "loop_"} {
		set mark [set ${n}($name)]
		set value [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
		if {$value == "?"} {return "$n $name {}"}
	    } else {
		set looplist [set ${n}($name)]
		set looplength [llength [set ${n}([lindex $looplist 0])]]
		for {set i $start} {$i < $looplength} {incr i} {
		    foreach var $looplist {
			set mark [lindex [set ${n}($var)] $i]
			set value [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
			if {$value == "?"} {
			    return [list [list $n loop] $name $i]
			}
		    }
		}
	    }
	}
    }
}