#  Copyright (C) 1999-2014
#  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
#  For conditions of distribution and use, see copyright notice in "copyright"

package provide DS9 1.0

proc DisplayHeaderMenu {} {
    global current

    set last {}
    set prim {}
    set cnt [$current(frame) get fits count]

    if {$cnt > 0} {
	set slb(count) 0

	for {set ii 1} {$ii <= $cnt} {incr ii} {
	    set fn [$current(frame) get fits file name $ii]
	    set xten [string trim [$current(frame) get fits header $ii keyword {XTENSION}]]

	    if {$xten != {}} {
		set b [string first {[} $fn]
		set pn [string range $fn 0 [expr $b-1]]
		if {$b > 0 && $pn != $prim} {
		    incr slb(count)
		    set slb($slb(count),item) $pn
		    set slb($slb(count),value) "-$ii"
		    set prim $pn
		}
	    }
	    
	    if {$fn != $last && $fn != $prim} {
		incr slb(count)
		set slb($slb(count),item) $fn
		set slb($slb(count),value) $ii
		set last $fn
	    }
	}

	if {$slb(count) <= 1} {
	    DisplayHeader $current(frame) 1 $fn
	} else {
	    if {[SLBDialog slb {Select Header} 40]} {
		DisplayHeader $current(frame) $slb(value) $slb(item)
	    }
	}
    }
}

proc DisplayHeader {frame which title} {
    global current

    set varname "hd[string range $frame end end]-$which"

    upvar #0 $varname var
    global $varname

    SimpleTextDialog $varname $title 80 40 insert top \
	[$current(frame) get fits header $which]

    # create a special text tag for keywords
    $var(text) tag configure keyword -foreground blue
    
    # color tag keywords
    set stop [$var(text) index end]
    for {set ii 1.0} {$ii<$stop} {set ii [expr $ii+1]} {
	$var(text) tag add keyword $ii "$ii +8 chars"
    }
}

proc DestroyHeader {frame} {
    global st

    set ttt "hd[string range $frame end end]"

    foreach x [array names st] {
	set f [split $x ,]
	if {[lindex $f 1] == "top"} {
	    set varname [lindex $f 0]

	    upvar #0 $varname var
	    global $varname

	    set fff [split $tt :]
	    if {[lindex $fff 0] == $ttt} {
		if {[info exists $varname] && [winfo exists ${varname}(top)]} {
		    SimpleTextDestroy $varname
		}
	    }
	}
    }
}

proc ProcessHeaderCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    set item [string tolower [lindex $var $i]]
    switch -- $item {
	close -
	save {incr i}
    }

    if {[lindex $var $i] != {} && [string is integer [lindex $var $i]]} {
	set jj [lindex $var $i]
	incr i
    } else {
	set jj 1
    }

    global current
    if {$current(frame) != {}} {
	switch -- $item {
	    close {
		set vvarname "hd[string range $current(frame) end end]-$jj"
		upvar #0 $vvarname vvar
		global $vvarname

		if {[info exists vvar(top)]} {
		    SimpleTextDestroy $vvarname
		}
		incr i -1
	    }
	    save {
		set fn [lindex $var $i]
		if {$fn != {}} {
		    if {[catch {set ch [open "| cat > \"$fn\"" w]}]} {
			Error [msgcat::mc {An error has occurred while saving}]
			return
		    }
		    puts -nonewline $ch [$current(frame) get fits header $jj]
		    close $ch
		}
	    }
	    default {
		catch {DisplayHeader $current(frame) $jj \
			   [$current(frame) get fits file name $jj]}
		incr i -1
	    }
	}
    }
}

