diff options
Diffstat (limited to 'ds9')
| -rw-r--r-- | ds9/library/header.tcl | 67 | ||||
| -rw-r--r-- | ds9/library/source.tcl | 2 | ||||
| -rw-r--r-- | ds9/parsers/headerlex.fcl | 16 | ||||
| -rw-r--r-- | ds9/parsers/headerparser.tac | 46 |
4 files changed, 110 insertions, 21 deletions
diff --git a/ds9/library/header.tcl b/ds9/library/header.tcl index 9e945e4..545f70e 100644 --- a/ds9/library/header.tcl +++ b/ds9/library/header.tcl @@ -127,16 +127,30 @@ proc DestroyHeader {frame} { } for {set id 1} {$id <= $cnt} {incr id} { - set varname "hd-$frame-$id" - global $varname - if {[info exists $varname]} { - SimpleTextDestroy $varname - } + DestroyHeaderOne $frame $id + } +} + +proc DestroyHeaderOne {frame id} { + set varname "hd-$frame-$id" + global $varname + if {[info exists $varname]} { + SimpleTextDestroy $varname } } proc ProcessHeaderCmd {varname iname} { upvar $varname var + upvar $iname ii + + header::YY_FLUSH_BUFFER + header::yy_scan_string [lrange $var $ii end] + header::yyparse + incr ii [expr $header::yycnt-1] +} + +proc oProcessHeaderCmd {varname iname} { + upvar $varname var upvar $iname i set item [string tolower [lindex $var $i]] @@ -156,30 +170,41 @@ proc ProcessHeaderCmd {varname iname} { if {$current(frame) != {}} { switch -- $item { close { - set vvarname "hd-$current(frame)-$jj" - global $vvarname - if {[info exists $vvarname]} { - SimpleTextDestroy $vvarname - } + CloseHeaderCmd $jj 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 - } + SaveHeaderCmd $jj [lindex $var $i] } default { - catch {DisplayHeader $current(frame) $jj \ - [$current(frame) get fits file name $jj]} + DisplayHeaderCmd $jj incr i -1 } } } } +proc DisplayHeaderCmd {id} { + global current + + DisplayHeader $current(frame) $id [$current(frame) get fits file name $id] +} + +proc CloseHeaderCmd {id} { + global current + + DestroyHeaderOne $current(frame) $id +} + +proc SaveHeaderCmd {id fn} { + global current + + 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 $id] + close $ch + } +} diff --git a/ds9/library/source.tcl b/ds9/library/source.tcl index 1df6e93..53c605a 100644 --- a/ds9/library/source.tcl +++ b/ds9/library/source.tcl @@ -204,6 +204,8 @@ source $ds9(root)/library/dsssaoparser.tcl source $ds9(root)/library/dsssaolex.tcl source $ds9(root)/library/dssstsciparser.tcl source $ds9(root)/library/dssstscilex.tcl +source $ds9(root)/library/headerparser.tcl +source $ds9(root)/library/headerlex.tcl source $ds9(root)/library/nvssparser.tcl source $ds9(root)/library/nvsslex.tcl source $ds9(root)/library/panparser.tcl diff --git a/ds9/parsers/headerlex.fcl b/ds9/parsers/headerlex.fcl new file mode 100644 index 0000000..dd279a9 --- /dev/null +++ b/ds9/parsers/headerlex.fcl @@ -0,0 +1,16 @@ +#tab headerparser.tab.tcl + +%{ +%} + +#include defs.fin + +%% + +close {return $CLOSE_} +save {return $SAVE_} + +#include numeric.fin +#include string.fin + +%% diff --git a/ds9/parsers/headerparser.tac b/ds9/parsers/headerparser.tac new file mode 100644 index 0000000..45b8bfc --- /dev/null +++ b/ds9/parsers/headerparser.tac @@ -0,0 +1,46 @@ +%{ +%} + +#include numeric.tin +#include string.tin + +%start command + +%token CLOSE_ +%token SAVE_ + +%% + +#include numeric.trl + +command : header + | header {yyclearin; YYACCEPT} STRING_ + ; + + +header : display + | CLOSE_ close {CloseHeaderCmd $2} + | SAVE_ save + ; + +display : {DisplayHeaderCmd 1} + | INT_ {DisplayHeaderCmd $1} + ; + +close : {set _ 1} + | INT_ {set _ $1} + ; + +save : STRING_ {SaveHeaderCmd 1 $1} + | INT_ STRING_ {SaveHeaderCmd $1 $2} + ; + +%% + +proc header::yyerror {msg} { + variable yycnt + variable yy_current_buffer + variable index_ + + ParserError $msg $yycnt $yy_current_buffer $index_ +} |