From dbe5cbeeb8acd95acc3db6ce30132a248fca4e63 Mon Sep 17 00:00:00 2001 From: William Joye Date: Mon, 14 May 2018 16:42:30 -0400 Subject: add ds9 web parser --- ds9/library/hv.tcl | 103 +++++++++++++++++++++++++++++++++++++++++++--- ds9/library/source.tcl | 2 + ds9/parsers/weblex.fcl | 22 ++++++++++ ds9/parsers/webparser.tac | 55 +++++++++++++++++++++++++ 4 files changed, 177 insertions(+), 5 deletions(-) create mode 100644 ds9/parsers/weblex.fcl create mode 100644 ds9/parsers/webparser.tac 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_ +} -- cgit v0.12