add ds9 web parser

4 files changed, 177 insertions, 5 deletions

diff --git a/ds9/library/hv.tcl b/ds9/library/hv.tcl
index cd42c57..a197300 100644
--- a/ds9/library/hv.tcl
+++ b/ds9/library/hv.tcl
@@ -821,14 +821,23 @@ proc HVArchChandraFTP {} {
 # Process Cmds
 
 proc ProcessWebCmd {varname iname} {
-    global ihv
-
-    set w {hvweb}
-
     upvar $varname var
     upvar $iname i
+    global ihv
+
+    global debug
+    if {$debug(tcl,parser)} {
+	set ref [lindex $ihv(windows) end]
+	global cvarname
+	set cvarname $ref
+
+	web::YY_FLUSH_BUFFER
+	web::yy_scan_string [lrange $var $i end]
+	web::yyparse
+	incr i [expr $web::yycnt-1]
+    } else {
 
-    # determine which web browser window
+    set w {hvweb}
     switch -- [string tolower [lindex $var $i]] {
 	new {
 	    incr i
@@ -910,6 +919,90 @@ proc ProcessWebCmd {varname iname} {
 	}
     }
 }
+}
+
+proc WebCmdCheck {} {
+    global cvarname
+    upvar #0 $cvarname cvar
+
+    if {![info exists cvar(top)]} {
+	Error "[msgcat::mc {Unable to find web window}] $cvarname"
+	cat::YYABORT
+	return
+    }
+    if {![winfo exists $cvar(top)]} {
+	Error "[msgcat:: mc {Unable to find web window}] $cvarname"
+	cat::YYABORT
+	return
+    }
+}
+
+proc WebCmdRef {ref} {
+    global ihv
+    global cvarname
+
+    # look for reference in current list
+    if {[lsearch $ihv(windows) $ref] < 0} {
+	Error "[msgcat::mc {Unable to find web window}] $ref"
+	plot::YYABORT
+	return
+    }
+    set cvarname $ref
+    WebCmdCheck
+}
+
+proc WebCmdNew {url {ww {hvweb}}} {
+    global ihv
+    global cvarname
+    upvar #0 $cvarname cvar
+
+    set ii [lsearch $ihv(windows) $ww]
+    if {$ii>=0} {
+	append ww $ihv(unique)
+	incr ihv(unique)
+    }
+
+    if {[string length $url] == 0} {
+	HV $ww Web {} {} 1
+    } else {
+	ParseURL $url rr
+	switch -- $rr(scheme) {
+	    {} {
+		# append 'http://' if needed
+		if {[string range $rr(path) 0 0] == "/"} {
+		    set url "http:/$url"
+		} else {
+		    set url "http://$url"
+		}
+	    }
+	}
+	HV $ww Web $url {} 1
+    }
+}
+
+proc WebCmdClick {id} {
+    global cvarname
+    upvar #0 $cvarname cvar
+    
+    if {![info exists cvar(widget)]} {
+	return
+    }
+
+    set tokens [$cvar(widget) token list 1.0 end]
+    set cnt 0
+    for {set ii 0} {$ii<[llength $tokens]} {incr ii} {
+	set tok [lindex $tokens $ii]
+	if {[string tolower [lindex $tok 0]] == "markup" && 
+	    [string tolower [lindex $tok 2]] == "href"} {
+	    set url [lindex $tok 3]
+	    incr cnt
+	    if {$cnt == $id} {
+		HVResolveURL $cvarname [$cvar(widget) resolve $url]
+		break;
+	    }
+	}
+    }
+}
 
 proc ProcessSendWebCmd {proc id param} {
     global ihv
diff --git a/ds9/library/source.tcl b/ds9/library/source.tcl
index e24dbad..a249248 100644
--- a/ds9/library/source.tcl
+++ b/ds9/library/source.tcl
@@ -358,6 +358,8 @@ source $ds9(root)/library/voparser.tcl
 source $ds9(root)/library/volex.tcl
 source $ds9(root)/library/wcsparser.tcl
 source $ds9(root)/library/wcslex.tcl
+source $ds9(root)/library/webparser.tcl
+source $ds9(root)/library/weblex.tcl
 source $ds9(root)/library/widthparser.tcl
 source $ds9(root)/library/widthlex.tcl
 source $ds9(root)/library/xpaparser.tcl
diff --git a/ds9/parsers/weblex.fcl b/ds9/parsers/weblex.fcl
new file mode 100644
index 0000000..e051e1c
--- /dev/null
+++ b/ds9/parsers/weblex.fcl
@@ -0,0 +1,22 @@
+#tab webparser.tab.tcl
+
+%{
+%}
+
+#include defs.fin
+
+%%
+
+back	    {return $BACK_}
+clear	    {return $CLEAR_}
+click	    {return $CLICK_}
+close	    {return $CLOSE_}
+forward	    {return $FORWARD_}
+new	    {return $NEW_}
+reload	    {return $RELOAD_}
+stop	    {return $STOP_}
+
+#include numeric.fin
+#include string.fin
+
+%%
diff --git a/ds9/parsers/webparser.tac b/ds9/parsers/webparser.tac
new file mode 100644
index 0000000..d3298db
--- /dev/null
+++ b/ds9/parsers/webparser.tac
@@ -0,0 +1,55 @@
+%{
+%}
+
+#include numeric.tin
+#include string.tin
+
+%start command
+
+%token BACK_
+%token CLEAR_
+%token CLICK_
+%token CLOSE_
+%token FORWARD_
+%token NEW_
+%token RELOAD_
+%token STOP_
+
+%%
+
+#include numeric.trl
+
+command : web 
+ | web {yyclearin; YYACCEPT} STRING_
+ ;
+
+web : {WebCmdNew {}}
+ | STRING_ {WebCmdNew $1}
+ | NEW_ STRING_ {WebCmdNew $2}
+ | NEW_ STRING_ STRING_ {WebCmdNew $3 $2}
+
+ | {WebCmdCheck} webCmd
+ | STRING_ {WebCmdRef $1} webCmd
+ ;
+
+webCmd : CLICK_ click
+ | CLEAR_ {global cvarname; HVClearCmd $cvarname}
+ | CLOSE_ {global cvarname; HVDestroy $cvarname}
+ ;
+
+click : BACK_ {global cvarname; HVBackCmd $cvarname}
+ | FORWARD_ {global cvarname; HVForwardCmd $cvarname}
+ | STOP_ {global cvarname; HVStopCmd $cvarname}
+ | RELOAD_ {global cvarname; HVReloadCmd $cvarname}
+ | INT_ {WebCmdClick $1}
+ ;
+ 
+%%
+
+proc web::yyerror {msg} {
+     variable yycnt
+     variable yy_current_buffer
+     variable index_
+
+     ParserError $msg $yycnt $yy_current_buffer $index_
+}