summaryrefslogtreecommitdiffstats
path: root/ds9
diff options
context:
space:
mode:
Diffstat (limited to 'ds9')
-rw-r--r--ds9/library/header.tcl67
-rw-r--r--ds9/library/source.tcl2
-rw-r--r--ds9/parsers/headerlex.fcl16
-rw-r--r--ds9/parsers/headerparser.tac46
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_
+}