add ds9 parsers

3 files changed, 700 insertions, 0 deletions

diff --git a/ds9/library/zoomlex.tcl b/ds9/library/zoomlex.tcl
new file mode 100644
index 0000000..2adcb27
--- /dev/null
+++ b/ds9/library/zoomlex.tcl
@@ -0,0 +1,369 @@
+source $ds9(root)/library/zoomparser.tab.tcl
+
+######
+# Begin autogenerated fickle (version 2.1) routines.
+# Although fickle itself is protected by the GNU Public License (GPL)
+# all user-supplied functions are protected by their respective
+# author's license.  See http://mini.net/tcl/fickle for other details.
+######
+
+namespace eval zoom {
+    variable yytext {}
+    variable yyleng 0
+    variable yyin stdin
+    variable yyout stdout
+    variable yy_current_buffer {}
+
+    variable yylineno 1
+
+    variable index_ 0
+    variable done_ 0
+}
+
+# ECHO copies yytext to the scanner's output if no arguments are
+# given.  The scanner writes its ECHO output to the yyout global
+# (default, stdout), which may be redefined by the user simply by
+# assigning it to some other channel.
+#   -- from the flex(1) man page
+proc zoom::ECHO {{s ""}} {
+    variable yytext
+    variable yyout
+
+    if {$s == ""} {
+        puts -nonewline $yyout $yytext
+    } else {
+        puts -nonewline $yyout $s
+    }
+}
+
+# YY_FLUSH_BUFFER flushes the scanner's internal buffer so that the
+# next time the scanner attempts to match a token, it will first
+# refill the buffer using YY_INPUT.
+#   -- from the flex(1) man page
+proc zoom::YY_FLUSH_BUFFER {} {
+    variable yy_current_buffer
+    variable index_
+    variable done_
+
+    set yy_current_buffer ""
+    set index_ 0
+    set done_ 0
+}
+
+# yyrestart(new_file) may be called to point yyin at the new input
+# file.  The switch-over to the new file is immediate (any previously
+# buffered-up input is lost).  Note that calling yyrestart with yyin
+# as an argument thus throws away the current input buffer and
+# continues scanning the same input file.
+#   -- from the flex(1) man page
+proc zoom::yyrestart {new_file} {
+    variable yyin
+
+    set yyin $new_file
+    YY_FLUSH_BUFFER
+}
+
+# The nature of how it gets its input can be controlled by defining
+# the YY_INPUT macro.  YY_INPUT's calling sequence is
+# "YY_INPUT(buf,result,max_size)".  Its action is to place up to
+# max_size characters in the character array buf and return in the
+# integer variable result either the number of characters read or the
+# constant YY_NULL (0 on Unix systems) to indicate EOF.  The default
+# YY_INPUT reads from the global file-pointer "yyin".
+#   -- from the flex(1) man page
+proc zoom::YY_INPUT {buf result max_size} {
+    variable yyin
+
+    upvar $result ret_val
+    upvar $buf new_data
+    if {$yyin != ""} {
+        set new_data [read $yyin $max_size]
+        set ret_val [string length $new_data]
+    } else {
+        set new_data ""
+        set ret_val 0
+    }
+}
+
+# yy_scan_string sets up input buffers for scanning in-memory
+# strings instead of files.  Note that switching input sources does
+# not change the start condition.
+#   -- from the flex(1) man page
+proc zoom::yy_scan_string {str} {
+    variable yy_current_buffer
+    variable yyin
+
+    append yy_current_buffer $str
+    set yyin ""
+}
+
+# unput(c) puts the character c back onto the input stream.  It will
+# be the next character scanned.
+#   -- from the flex(1) man page
+proc zoom::unput {c} {
+    variable yy_current_buffer
+    variable index_
+
+    set s [string range $yy_current_buffer 0 [expr {$index_ - 1}]]
+    append s $c
+    set yy_current_buffer [append s [string range $yy_current_buffer $index_ end]]
+}
+
+# Returns all but the first n characters of the current token back to
+# the input stream, where they will be rescanned when the scanner
+# looks for the next match.  yytext and yyleng are adjusted
+# appropriately.
+#   -- from the flex(1) man page
+proc zoom::yyless {n} {
+    variable yy_current_buffer
+    variable index_
+    variable yytext
+    variable yyleng
+
+    set s [string range $yy_current_buffer 0 [expr {$index_ - 1}]]
+    append s [string range $yytext $n end]
+    set yy_current_buffer [append s [string range $yy_current_buffer $index_ end]]
+    set yytext [string range $yytext 0 [expr {$n - 1}]]
+    set yyleng [string length $yytext]
+}
+
+# input() reads the next character from the input stream.
+#   -- from the flex(1) man page
+proc zoom::input {} {
+    variable yy_current_buffer
+    variable index_
+    variable done_
+
+    if {[string length $yy_current_buffer] - $index_ < 1024} {
+       set new_buffer ""
+       set new_buffer_size 0
+       if {$done_ == 0} {
+           YY_INPUT new_buffer new_buffer_size 1024
+           append yy_current_buffer $new_buffer
+           if {$new_buffer_size == 0} {
+               set done_ 1
+           }
+       }
+       if $done_ {
+           if {[string length $yy_current_buffer] - $index_ == 0} {
+               return {}
+           }
+        }
+    }
+    set c [string index $yy_current_buffer $index_]
+    incr index_
+    return $c
+}
+
+######
+# autogenerated yylex function created by fickle
+######
+
+# Whenever yylex() is called, it scans tokens from the global input
+# file yyin (which defaults to stdin).  It continues until it either
+# reaches an end-of-file (at which point it returns the value 0) or
+# one of its actions executes a return statement.
+#   -- from the flex(1) man page
+proc zoom::yylex {} {
+    variable yytext
+    variable yylineno
+    variable yyleng
+    variable yy_current_buffer
+    variable yy_flex_debug
+
+    variable index_
+    variable done_
+    variable state_table_
+
+    while {1} {
+        if {[string length $yy_current_buffer] - $index_ < 1024} {
+            if {$done_ == 0} {
+	        set buffer_size 0
+                set new_buffer ""
+                YY_INPUT new_buffer buffer_size 1024
+                append yy_current_buffer $new_buffer
+                if {$buffer_size == 0 && \
+                        [string length $yy_current_buffer] - $index_ == 0} {
+                    set done_ 1
+                }
+            }
+            if $done_ {
+                if {[string length $yy_current_buffer] - $index_ == 0} {
+                    break
+                }
+            }            
+        }
+        set yyleng 0
+        set matched_rule -1
+        # rule 0: close
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(close)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 0
+        }
+        # rule 1: in
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(in)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 1
+        }
+        # rule 2: fit
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(fit)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 2
+        }
+        # rule 3: open
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(open)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 3
+        }
+        # rule 4: out
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(out)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 4
+        }
+        # rule 5: to
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(to)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 5
+        }
+        # rule 6: [+-]?{D}+
+        if {[regexp -start $index_ -indices -line -nocase -- {\A([+-]?([0-9])+)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 6
+        }
+        # rule 7: [+-]?{D}+\.?({E})?
+        if {[regexp -start $index_ -indices -line -nocase -- {\A([+-]?([0-9])+\.?(([Ee][+-]?([0-9])+))?)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 7
+        }
+        # rule 8: [+-]?{D}*\.{D}+({E})?
+        if {[regexp -start $index_ -indices -line -nocase -- {\A([+-]?([0-9])*\.([0-9])+(([Ee][+-]?([0-9])+))?)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 8
+        }
+        # rule 9: \"[^\"]*\"
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(\"[^\"]*\")} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 9
+        }
+        # rule 10: \'[^\']*\'
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(\'[^\']*\')} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 10
+        }
+        # rule 11: \{[^\}]*\}
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(\{[^\}]*\})} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 11
+        }
+        # rule 12: \S+\S+
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(\S+\S+)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 12
+        }
+        # rule 13: \s
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(\s)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 13
+        }
+        # rule 14: .
+        if {[regexp -start $index_ -indices -line -nocase -- {\A(.)} $yy_current_buffer match] > 0 && \
+                [lindex $match 1] - $index_ + 1 > $yyleng} {
+            set yytext [string range $yy_current_buffer $index_ [lindex $match 1]]
+            set yyleng [string length $yytext]
+            set matched_rule 14
+        }
+        if {$matched_rule == -1} {
+            set yytext [string index $yy_current_buffer $index_]
+            set yyleng 1
+        }
+        incr index_ $yyleng
+        # workaround for Tcl's circumflex behavior
+        if {[string index $yytext end] == "\n"} {
+            set yy_current_buffer [string range $yy_current_buffer $index_ end]
+            set index_ 0
+        }
+        set numlines [expr {[llength [split $yytext "\n"]] - 1}]
+        switch -- $matched_rule {
+            0 {
+return $zoom::CLOSE_
+            }
+            1 {
+return $zoom::IN_
+            }
+            2 {
+return $zoom::FIT_
+            }
+            3 {
+return $zoom::OPEN_
+            }
+            4 {
+return $zoom::OUT_
+            }
+            5 {
+return $zoom::TO_
+            }
+            6 {
+set zoom::yylval $yytext; return $zoom::INT_
+            }
+            7 -
+            8 {
+set zoom::yylval $yytext; return $zoom::REAL_
+            }
+            9 {
+set zoom::yylval [string range $yytext 1 end-1]; return $zoom::STRING_
+            }
+            10 {
+set zoom::yylval [string range $yytext 1 end-1]; return $zoom::STRING_
+            }
+            11 {
+set zoom::yylval [string range $yytext 1 end-1]; return $zoom::STRING_
+            }
+            12 {
+set zoom::yylval $yytext; return $zoom::STRING_
+            }
+            13 {
+# ignore whitespace
+            }
+            14 {
+set zoom::yylval $yytext; return $zoom::yylval
+            }
+            default
+                { puts stderr "unmatched token: $yytext"; exit -1 }
+        }
+        incr yylineno $numlines
+    }
+    return 0
+}
+######
+# end autogenerated fickle functions
+######
+
+
diff --git a/ds9/library/zoomparser.tab.tcl b/ds9/library/zoomparser.tab.tcl
new file mode 100644
index 0000000..4deda09
--- /dev/null
+++ b/ds9/library/zoomparser.tab.tcl
@@ -0,0 +1,12 @@
+namespace eval zoom {
+set INT_ 257
+set REAL_ 258
+set STRING_ 259
+set CLOSE_ 260
+set IN_ 261
+set FIT_ 262
+set OPEN_ 263
+set OUT_ 264
+set TO_ 265
+set yylval {}
+}
diff --git a/ds9/library/zoomparser.tcl b/ds9/library/zoomparser.tcl
new file mode 100644
index 0000000..f16b6e5
--- /dev/null
+++ b/ds9/library/zoomparser.tcl
@@ -0,0 +1,319 @@
+
+######
+# Begin autogenerated taccle (version 1.2) routines.
+# Although taccle itself is protected by the GNU Public License (GPL)
+# all user-supplied functions are protected by their respective
+# author's license.  See http://mini.net/tcl/taccle for other details.
+######
+
+namespace eval zoom {
+    variable yylval {}
+    variable table
+    variable rules
+    variable token {}
+    variable yycnt 0
+
+    namespace export yylex
+}
+
+proc zoom::YYABORT {} {
+    return -code return 1
+}
+
+proc zoom::YYACCEPT {} {
+    return -code return 0
+}
+
+proc zoom::yyclearin {} {
+    variable token
+    variable yycnt
+    set token {}
+    incr yycnt -1
+}
+
+proc zoom::yyerror {s} {
+    puts stderr $s
+}
+
+proc zoom::setupvalues {stack pointer numsyms} {
+    upvar 1 1 y
+    set y {}
+    for {set i 1} {$i <= $numsyms} {incr i} {
+        upvar 1 $i y
+        set y [lindex $stack $pointer]
+        incr pointer
+    }
+}
+
+proc zoom::unsetupvalues {numsyms} {
+    for {set i 1} {$i <= $numsyms} {incr i} {
+        upvar 1 $i y
+        unset y
+    }
+}
+
+array set zoom::table {
+  9:262,target 12
+  0:257 reduce
+  0:258 reduce
+  5:0,target 6
+  0:260 reduce
+  2:257 shift
+  15:0,target 4
+  0:261 reduce
+  0:266,target 1
+  2:264,target 8
+  2:258 shift
+  11:0 reduce
+  2:260 shift
+  4:257 reduce
+  11:270 goto
+  4:258 reduce
+  0:263 reduce
+  2:261 shift
+  0:264 reduce
+  3:257,target 13
+  0:265 reduce
+  2:263 shift
+  15:0 reduce
+  0:266 goto
+  2:264 shift
+  0:267 goto
+  2:265 shift
+  0:265,target 1
+  2:263,target 7
+  6:0,target 7
+  16:0,target 12
+  2:268 goto
+  2:270 goto
+  9:270,target 14
+  9:269,target 13
+  6:0 reduce
+  0:264,target 1
+  7:0,target 5
+  12:0 reduce
+  9:258,target 4
+  10:0,target 2
+  11:270,target 15
+  4:258,target 14
+  0:263,target 1
+  2:261,target 6
+  16:0 reduce
+  9:257,target 3
+  14:257 shift
+  8:0,target 8
+  3:0 reduce
+  14:258 shift
+  11:258,target 4
+  1:0,target 0
+  11:0,target 3
+  4:257,target 14
+  2:260,target 5
+  2:270,target 11
+  7:0 reduce
+  14:270,target 16
+  3:257 reduce
+  3:258 reduce
+  11:257,target 3
+  13:0 reduce
+  0:261,target 1
+  2:258,target 4
+  2:268,target 10
+  14:270 goto
+  12:0,target 10
+  14:258,target 4
+  9:257 shift
+  9:258 shift
+  9:262 shift
+  0:260,target 1
+  2:257,target 3
+  4:0 reduce
+  14:257,target 3
+  3:0,target 13
+  13:0,target 9
+  8:0 reduce
+  10:0 reduce
+  9:270 goto
+  9:269 goto
+  0:258,target 1
+  14:0 reduce
+  4:0,target 14
+  14:0,target 11
+  11:257 shift
+  11:258 shift
+  0:257,target 1
+  1:0 accept
+  0:267,target 2
+  2:265,target 9
+  5:0 reduce
+  3:258,target 13
+}
+
+array set zoom::rules {
+  9,l 268
+  11,l 269
+  2,l 266
+  6,l 268
+  12,l 269
+  3,l 268
+  7,l 268
+  13,l 270
+  0,l 271
+  4,l 268
+  8,l 268
+  10,l 269
+  14,l 270
+  1,l 267
+  5,l 268
+}
+
+array set zoom::rules {
+  5,dc 1
+  0,dc 1
+  12,dc 2
+  8,dc 1
+  3,dc 1
+  10,dc 1
+  6,dc 1
+  1,dc 0
+  13,dc 1
+  9,dc 2
+  4,dc 2
+  11,dc 1
+  7,dc 1
+  2,dc 2
+  14,dc 1
+}
+
+array set zoom::rules {
+  13,line 37
+  7,line 27
+  10,line 32
+  4,line 24
+  1,line 19
+  9,line 29
+  12,line 34
+  6,line 26
+  3,line 23
+  14,line 38
+  8,line 28
+  11,line 33
+  5,line 25
+  1,e 0
+  2,line 20
+}
+
+proc zoom::yyparse {} {
+    variable yylval
+    variable table
+    variable rules
+    variable token
+    variable yycnt
+
+    set state_stack {0}
+    set value_stack {{}}
+    set token ""
+    set accepted 0
+
+    while {$accepted == 0} {
+        set state [lindex $state_stack end]
+        if {$token == ""} {
+            set yylval ""
+            set token [yylex]
+            set buflval $yylval
+	    if {$token>0} {
+	        incr yycnt
+            }
+        }
+        if {![info exists table($state:$token)]} {
+            # pop off states until error token accepted
+            while {[llength $state_stack] > 0 && \
+                       ![info exists table($state:error)]} {
+                set state_stack [lrange $state_stack 0 end-1]
+                set value_stack [lrange $value_stack 0 \
+                                       [expr {[llength $state_stack] - 1}]]
+                set state [lindex $state_stack end]
+            }
+            if {[llength $state_stack] == 0} {
+                yyerror "parse error"
+                return 1
+            }
+            lappend state_stack [set state $table($state:error,target)]
+            lappend value_stack {}
+            # consume tokens until it finds an acceptable one
+            while {![info exists table($state:$token)]} {
+                if {$token == 0} {
+                    yyerror "end of file while recovering from error"
+                    return 1
+                }
+                set yylval {}
+                set token [yylex]
+                set buflval $yylval
+            }
+            continue
+        }
+        switch -- $table($state:$token) {
+            shift {
+                lappend state_stack $table($state:$token,target)
+                lappend value_stack $buflval
+                set token ""
+            }
+            reduce {
+                set rule $table($state:$token,target)
+                set ll $rules($rule,l)
+                if {[info exists rules($rule,e)]} {
+                    set dc $rules($rule,e)
+                } else {
+                    set dc $rules($rule,dc)
+                }
+                set stackpointer [expr {[llength $state_stack]-$dc}]
+                setupvalues $value_stack $stackpointer $dc
+                set _ $1
+                set yylval [lindex $value_stack end]
+                switch -- $rule {
+                    1 { ProcessRealizeDS9 }
+                    3 { Zoom $1 $1 }
+                    4 { Zoom $1 $2 }
+                    5 { PanZoomDialog }
+                    6 { PanZoomDestroyDialog }
+                    7 { Zoom 2 2 }
+                    8 { Zoom .5 .5 }
+                    10 { ZoomToFit }
+                    11 { global zoom; set current(zoom) " $1 $1 "; ChangeZoom }
+                    12 { global zoom; set current(zoom) " $1 $2 "; ChangeZoom }
+                    13 { set _ $1 }
+                    14 { set _ $1 }
+                }
+                unsetupvalues $dc
+                # pop off tokens from the stack if normal rule
+                if {![info exists rules($rule,e)]} {
+                    incr stackpointer -1
+                    set state_stack [lrange $state_stack 0 $stackpointer]
+                    set value_stack [lrange $value_stack 0 $stackpointer]
+                }
+                # now do the goto transition
+                lappend state_stack $table([lindex $state_stack end]:$ll,target)
+                lappend value_stack $_
+            }
+            accept {
+                set accepted 1
+            }
+            goto -
+            default {
+                puts stderr "Internal parser error: illegal command $table($state:$token)"
+                return 2
+            }
+        }
+    }
+    return 0
+}
+
+######
+# end autogenerated taccle functions
+######
+
+proc zoom::yyerror {msg} {
+     puts stderr "$msg:"
+     puts stderr "$zoom::yy_current_buffer"
+     puts stderr [format "%*s" $zoom::index_ ^]
+}