#===================================================================
# Srouser -- The Tcl Web browser with stock ticker
#  by Mike Doyle, Hattie Schroeder and Clif Flynt 
#       
#  Copyright (c) 1997 Eolas Technologies Inc., portions covered by U.S. Patent 4,847,604
#  Freely modifiable/redistributable under the "Standard Tcl License"
#  See http://www.eolas.com/tcl/license.txt for details
#===================================================================
#
#
# This program calls upon several procedures in the "spynergy.tcl"
# toolkit to handle rendering and navigation of Web pages from within 
# a standard test widget.
#
# These procedures include:
#
#   HB_init {win}:  Called with the name of the
#    text window to be used for rendering the Web page.  It sets up 
#    a group of variables that allow GUI widgets to be attached to
#    the various URL navigational functions in the Spynergy library.
#
#   HB_resolve_url {win url}:  Transforms relative URL
#    pathnames into absolute pathnames that the HTML library functions
#    can handle.  The relative URL is passed as an argument, and the 
#    procedure returns the absolute URL in string form.
#    
#   HB_load_url {win url}:  Loads the given URL into 
#    the text widget defined by "win"
#
#   HB_home {button_path}:  Loads the default home URL
#    into the text widget specified in HB_init
#
#   HB_back {button_path}:  Causes re-loading of the URL which 
#    immediatly preceded the URL being currently viewed, if applicable
#
#   HB_forward {button_path}:  If the Back button has been pushed, this 
#    causes re-loading of the URL which immediately follows the URL being
#    currently viewed
#
#   HB_go_form {button_path}:  Causes the display of a scrolling listbox
#    that displays a "history list" of all of the URLs that the user has
#    visited.  Clicking on any URL in the list will cause that URL to be
#    immediately fetched and rendered into the text widget defined by HB_init
#
#   HB_Stop {button_path}:  This procedure will interrupt the fetching
#    and rendering of HTML data into the Web browser text widget.
# 
#
#
#
#===================================================================

#======================================================================
#: Start of stock retrieval subsection

#======================================================================
#:: doticker {textWindow delay text width} 
#: Displays individual strings in a list of messages as horizontally 
#: scrolling text, with a particular header above the line.
#:
#: textWindow	- The text window in which to display the string
#: delay	- Time to wait each character in scroll
#: text		- A separator string to place between messages
#: width	- The maximum width of the text window.

proc doticker {textWindow delay text width} {
    global index messages header once

    # Find the locatio of the last character on the second line
    # and if that is less than the possible last character,
    # add a new set of strings to the scrolling text in the window.

    scan [$textWindow index 2.end] %d.%d line len

    if {$len < $width} {
	if {![info exists messages($index)]} {
	    set index 0
	}
	set message $messages($index)

	$textWindow configure -state normal
	$textWindow insert 1.end "$text" fill
	$textWindow insert 1.end $header

	# Need a \n at the end of the line 1 to insert on line 2.

	if {$len == 0} {
	    $textWindow insert 1.end "\n" 
	  }

	$textWindow insert 2.end "$text" fill
	$textWindow insert 2.end $message tag$index
	$textWindow configure -state disabled

	incr index
    }

    # Delete the first characters in the first and second line,
    # to scroll the text one position to the left.

    $textWindow configure -state normal
    $textWindow delete 2.0
    $textWindow delete 1.0
    $textWindow configure -state disabled
    after $delay [list doticker $textWindow $delay $text $width]
}


#======================================================================
#:: reformTable {lst}
#: Takes a list composed of lines (one line per list item) as returned
#:   by a webserver, and returns a list composed of one Table Row per
#:   list entry.
#:  ie:
#:  input:
#:    
#:      one two
#:    
#:  output:
#:   one two 
#:
#: lst		- A list of lines from a webserver, one list entry
#:		  per line. - set lst [split $input "\n"]

proc reformTable {lst} {
  global debug;
    if {$debug} {puts "reformTable: $lst"}
    
    if {[string length $lst] < 5} {return ""}
    set tdState 0
    set tdline ""
    
    #
    # Loop through the list items checking for Table markers ( 
    # Append the text between  and  (inclusive) into a single
    #   list item in a new list.
    #
    # The automata is in one of these states:
    # 
    #  0) No  2} {
	            if {$debug} {puts "tdState: $tdState -- LINE: $line"}
		    if {([string first "= 0} {
	        if {$debug} {puts "TD : $tdState -- $line" }
		set st2 [expr $st1+4]
		set tdline [string range $line $st1 $st2]
		set line [string range $line $st2 end]
		set tdState 1
	    }

	    # If there is a  should be transfered to the holding space,
	    # before the holding string is lappended to the list
	    # of table definitions.

	    if {[set st1 [string first "= 0} {
	        if {$debug} {puts "/TD : $tdState -- $line" }
		set st2 [expr $st1+5]
		if {$tdState} {
		    append tdline [string range $line 0 $st2]
		    lappend tdlst $tdline
		    set tdline ""
		    set tdState 0
		}
		set line [string range $line $st2 end]
	    }
	}
    }
    return $tdlst
}

#======================================================================
#:: extractNumber {line} 
#: extracts a number from the data in a line
#: line		- A line in the rough format ...> ## ##/##  <...

proc extractNumber {line} {
    # The numeric values are extracted using a regular expression that
    # looks for a string of numbers between a ">", and a "<"

    set xx [regexp {>([	 ]*)([0-9%\./-]+ *[0-9%\./-]*)([ 	]*)<} $line \
      mat p1 p2 p3]
    if {$xx == 0} {
      puts "FAILED TO FIND NUMBER IN: $line"
      return "XX"
      } else {
      return $p2
      }
  }

#======================================================================
#:: readstocks {stock_list}
#:  Reads a set of stocks from a list of ticker symbols.
#:  stock_list -	The list of stock ticker symbols.
#:
#: NOTE: This proc contains many heuristics based on the format of
#:       the html page generated by www.newsalert.com.  Other formats
#:       will require modifications to the heuristics for extracting
#:       the stock price information.
#:
#:       For a discussion on building heuristics for extracting
#:       information from web pages, see: 
#:
#:	 A Scalable Comparison-Shopping Agent for the World-Wide Web
#:	 Doorenbos, Etzionis & Weld
#:  	 Proceedings of the First Internation Conference on Autonomous Agents
#:	 ACM, 1997

proc readstock {symbol} {
global messages debug formatstr

    # Convert the symbol to upper case for later comparisons.
    set upsym [string toupper $symbol]

    # Get the page of data from newsalert.com

    set data [fetchURL http://www.newsalert.com/free/stocknews?Symbol=$symbol \
    		-initialtimeout 45 -timeout 15]
    
    if {[string first "$upsym not found" $data] != -1} {
      puts "$upsym was not found!"
      return "";
      }

    # Extract the table with the stock values from the output.
    # This is the portion of the data between Symbol=XXX and the end of the
    # table.

    set st1 [string first "Symbol=$symbol" $data]
    set st2 [string first "" $data]
    incr st1
    set data [string range $data $st1 $st2]

    # Skip the first two rows in the table.

    set st1 [string first "" $line]
    set line [string range $line $st1 end]
    set st1 [string first ">" $line]
    set st2 [string first "<" $line]
    incr st1
    incr st2 -1

    #  puts "st1: $st1 st2: $st2 line: $line"
    set company [string range $line $st1 $st2]"

    # The numeric values are extracted using a regular expression that
    # looks for a string of numbers between a ">", and a "<"

    set last [extractNumber [lindex $tdlst 3]]
    set chg  [extractNumber [lindex $tdlst 4]]
    set pct  [extractNumber [lindex $tdlst 5]]
    set open [extractNumber [lindex $tdlst 7]]
    set high [extractNumber [lindex $tdlst 8]]
    set low  [extractNumber [lindex $tdlst 9]]

  set stockinfo [format $formatstr \
      $upsym [string range $company 0 11] $last $chg $pct $open $high $low]

  return $stockinfo
}

#======================================================================
#::  displayStocks {stock_list win} 
#: displays a list of stocks in the appropriate window.
#: Initializes the message list for the display
#:
#: stock_list	- A list of the ticker symbols of stocks to display
#: win		- The window in which to display the stock readings.

proc displayStocks {stock_list win} {
  global messages header index debug
  wm title .rouser "SRouser: Fetching stock quotes"

  foreach symbol $stock_list {
    set x [readstock $symbol]
    if {$x != ""} {
      set in  [expr [lsearch -exact $stock_list $symbol]]
      set messages($in) "$x"	   
  
      #comment out the following line if you don't want the stock data 
      #  echo'ed to the console
      puts $messages($in)
      doticker $win 1500 "  ******  " 250
      }
    }
  wm title .rouser "SRouser: The Tcl stock center"
  after 900000 "displayStocks [list $stock_list] $win"
}

#======================================================================
#:: init_ticker {win} 
#:  initialize the stock ticker.  Creates the window and loads the stocks.
#:  win		- Parent window for the text window.

proc init_ticker {win} {

  # Define the globals that the stock subsystem uses, and initialize them.

  global debug index messages header formatstr
 
  set debug 0; set index 0; set messages(0) ""; set header "";

  set formatstr "%-10s %-12s %10s %10s %12s %12s %12s %12s"

  set header [format $formatstr \
  	Symbol "Company Name" Lst Chg Pct Open High Low ]

  text $win.t -relief ridge -bd 2 -wrap none \
            -bg black -fg green -state disabled -height 2

  set stock_list [list aapl gwrx ibm mot msft nscp pkt spyg sunw]

  displayStocks $stock_list $win.t
}

# End of stocks subsection
#======================================================================

source spynergy.tcl

##############################
# Rouser Configuration Section  
# This section allows you to set several configuration options, such as the default
# URL that the browser loads at satartup, Whether or not to display the navigation
# buttons and URL window, the default color of the HTML document background, 
# the default color and width of the frame surrounding the Web page, and whether 
# or not to display a scrollbar at the right of the document window.

global ROUSERURL BASE BUTFLAG BORDWID BG index messages header once
global FRMBG SCROLFLAG FILLAREA weather
# -- Rouser configuration variables for .rouser.f1
set ROUSERURL(1) "http://www.eolas.com"
set BASE(1) .rouser.main
set BUTFLAG(1) "1"
set BORDWID(1) "0"
set FILLAREA(1)  "0"
set BG(1) "white"
set FRMBG(1) "LightGray"
set SCROLFLAG(1) "1"
### End of Rouser Configuration Section

##############################
# -- embed_arg override processing for Rouser defaults from within plugin
#
global embed_args
if {[info exists embed_args]} {
    foreach key [array names embed_args] {
        set embed_args([string toupper $key]) $embed_args($key)
    }
    foreach em_url [array names embed_args ROUSERURL*] {
        if {$em_url == "ROUSERURL"} {
            set ROUSERURL(1) "$embed_args($em_url)"
        } else {
            set i [string range $em_url 12 end]
            set ROUSERURL($i) "$embed_args($em_url)"
        }
    }
    unset em_url
    foreach em_butf [array names embed_args BUTTONS*] {
        if {$em_butf == "BUTTONS"} {
            set BUTFLAG(1) "$embed_args($em_butf)"
        } else {
            set i [string range $em_butf 7 end]
            set BUTFLAG($i) "$embed_args($em_butf)"
        }
    }
    unset em_butf
    foreach em_bord [array names embed_args BORDERWIDTH*] {
        if {$em_bord == "BORDERWIDTH"} {
            set BORDWID(1) "$embed_args($em_bord)"
        } else {
            set i [string range $em_bord 11 end]
            set BORDWID($i) "$embed_args($em_bord)"
        }
    }
    unset em_bord
    foreach em_bg [array names embed_args BACKGROUND*] {
        if {$em_bg == "BACKGROUND"} {
            set BG(1) "$embed_args($em_bg)"
        } else {
            set i [string range $em_bg 10 end]
            set BG($i) "$embed_args($em_bg)"
        }
    }
    unset em_bg
    foreach em_frmbg [array names embed_args FRAMEBACKGROUND*] {
        if {$em_frmbg == "FRAMEBACKGROUND"} {
            set FRMBG(1) "$embed_args($em_frmbg)"
        } else {
            set i [string range $em_frmbg 15 end]
            set FRMBG($i) "$embed_args($em_frmbg)"
        }
    }
    unset em_frmbg
    foreach em_srf [array names embed_args SCROLLBARS*] {
        if {$em_srf == "SCROLLBARS"} {
            set SCROLFLAG(1) "$embed_args($em_srf)"
        } else {
            set i [string range $em_srf 3 end]
            set SCROLFLAG($i) "$embed_args($em_srf)"
        }
    }
    unset em_srf
    foreach em_fill [array names embed_args FILLAREA*] {
        if {$em_fill == "FILLAREA"} {
            set FILLAREA(1) "$embed_args($em_fill)"
        } else {
            set i [string range $em_fill 8 end]
            set FILLAREA($i) "$embed_args($em_fill)"
        }
    }
    unset em_srf
}

##############################
#-----This section sets up the GUI-----

set Name .rouser
catch "destroy .rouser"
    toplevel $Name     -background LightGray
    wm title $Name "Srouser, the Tcl Web browser"
    wm geometry $Name 624x447
    wm geometry $Name +20+20
    wm withdraw $Name


set Parent $Name

##############################


set Name $Parent.main
frame $Name     -relief ridge
pack $Name -anchor nw -side top -expand yes -fill both

set Name $Parent.main.top
frame $Name     -background LightGray \
    -borderwidth 2 \
    -height 50 \
    -relief raised \
    -width 50
pack $Name     -side top

set Name $Parent.main.top.buttons
frame $Name     -background LightGray
pack $Name     -anchor nw \
    -expand 1 \
    -fill x \
    -side top

##############################
#-----The Back button-----
#
set Name $Parent.main.top.buttons.back
button $Name     -activebackground  gray40 \
    -activeforeground green \
    -background gray40 \
    -command "HB_back $Parent.main.top.buttons.back" \
    -disabledforeground LightGray \
    -foreground White \
    -highlightbackground LightGray \
    -highlightcolor LightGray \
    -padx 5 \
    -pady 1 \
    -text Back
pack $Name     -anchor nw \
    -fill none \
    -side left

##############################
#-----The Forward button-----
#
set Name $Parent.main.top.buttons.forward
button $Name     -activebackground gray40 \
    -activeforeground green \
    -background gray40 \
    -command "HB_forward $Parent.main.top.buttons.forward" \
    -disabledforeground LightGray \
    -foreground White \
    -highlightbackground LightGray \
    -highlightcolor LightGray\
    -padx 5 \
    -pady 1 \
    -text Forward
pack $Name     -anchor nw \
    -fill none \
    -side left

##############################
#-----The Home button-----
#
set Name $Parent.main.top.buttons.home
button $Name     -activebackground gray40 \
    -activeforeground green \
    -background gray40 \
    -command "HB_home $Parent.main.top.buttons.home" \
    -disabledforeground LightGray \
    -foreground White \
    -highlightbackground LightGray \
    -highlightcolor LightGray \
    -padx 5 \
    -pady 1 \
    -text Home
pack $Name     -anchor nw \
    -fill none \
    -side left

##############################
#-----The Go button (pops up the history listbox)-----
#
set Name $Parent.main.top.buttons.go
button $Name     -activebackground gray40 \
    -activeforeground green \
    -background gray40 \
    -command "HB_go_form $Parent.main.top.buttons.go" \
    -disabledforeground LightGray \
    -foreground White \
    -highlightbackground LightGray \
    -highlightcolor LightGray \
    -padx 5 \
    -pady 1 \
    -text Go
pack $Name     -anchor nw \
    -fill none \
    -side left

##############################
#-----The Show Ticker button-----
#

set show_tick 1
set Name $Parent.main.top.buttons.ticker
button $Name     -activebackground gray40 \
    -activeforeground green \
    -background gray40 \
    -command  {
		if {$show_tick} { 
		pack .rouser.main.txt.ticker.t -expand 1 -fill x
 		pack .rouser.main.txt.ticker -anchor nw -side bottom -expand 1 -fill x \
			-before .rouser.main.txt.win
 		.rouser.main.top.buttons.ticker configure -text "Hide Ticker"
		set show_tick 0
		} else {
		pack forget .rouser.main.txt.ticker 
		.rouser.main.top.buttons.ticker configure -text "Show Ticker"
		set show_tick 1
          	       }}  \
    -disabledforeground LightGray \
    -foreground White \
    -highlightbackground LightGray \
    -highlightcolor LightGray \
    -padx 5 \
    -pady 1 \
    -text "Show Ticker"
pack $Name     -anchor nw -fill none -side left


################################
#-----The Stop button-----
#
set Name $Parent.main.top.buttons.stop
button $Name     -activebackground gray40 \
    -activeforeground red \
    -background gray40 \
    -command "HB_Stop $Parent.main.top.buttons.stop" \
    -disabledforeground LightGray \
    -foreground White \
    -highlightbackground LightGray \
    -highlightcolor LightGray \
    -padx 5 \
    -pady 1 \
    -text Stop
pack $Name     -anchor nw \
    -fill none \
    -side left


set Name $Parent.main.top.buttons.l22
label $Name     -anchor w \
    -background LightGray \
    -foreground white \
    -justify left
pack $Name     -anchor nw \
    -fill none \
    -side left

set Name $Parent.main.top.buttons.status
label $Name     -anchor w \
    -background LightGray \
    -foreground white \
    -justify left
pack $Name     -anchor nw \
    -fill none \
    -side left

##############################


#-----The Exit button-----
set Name $Parent.main.top.buttons.exit
button $Name     -activebackground lavender \
    -background gray40 \
    -command exit \
    -foreground white \
    -highlightbackground LightGray \
    -text Exit
pack $Name -anchor nw -side right


set Name $Parent.main.top.ubar
frame $Name     -background LightGray
pack $Name     -anchor nw \
    -expand 1 \
    -fill x \
    -side top

##############################
#-----The URL label to the left of the URL entry widget-----
#
set Name $Parent.main.top.ubar.l13
label $Name     -background LightGray \
    -foreground black \
    -text URL:
pack $Name     -anchor w \
    -side left

##############################
#----The URL entry widget------
#
set Name $Parent.main.top.ubar.url
entry $Name     -background white \
    -highlightbackground LightGray \
    -highlightcolor cyan \
    -selectbackground skyblue \
    -width 0
pack $Name     -anchor nw \
	-expand yes \
    -fill x \
    -side left


set Name $Parent.main.txt
frame $Name     -background LightGray \
    -borderwidth 2 \
    -highlightbackground lightgray \
    -relief raised
pack $Name     -anchor nw \
    -expand 1 \
    -fill both \
    -side top
frame .rouser.main.txt.ticker -height 10
pack .rouser.main.txt.ticker -anchor nw -side bottom -expand 1 -fill x
##############################
#-----The text widget that displays the Web document-----
#
set Name $Parent.main.txt.win
text $Name     -background white \
    -cursor arrow \
    -foreground black \
    -height 100 \
    -highlightbackground lightgray \
    -insertbackground black \
    -selectbackground LightGray \
    -selectforeground black \
    -takefocus 0 \
    -width 20 \
    -yscrollcommand "$Parent.main.txt.scroll set"
$Name insert end {





}
pack $Name     -anchor nw \
    -expand 1 \
    -fill both \
    -padx 2 \
    -pady 2 \
    -side left

set Name $Parent.main.txt.scroll
scrollbar $Name     -activebackground plum \
    -activerelief sunken \
    -background LightGray \
    -command "$Parent.main.txt.win yview" \
    -highlightbackground LightGray \
    -troughcolor gray40 -width 16
pack $Name     -anchor center \
    -fill y \
    -padx 2 \
    -pady 2 \
    -side right



###########################################
# Set _url array variables to use 
# in Spynergy Toolkit procedures 

	set win $Parent.main.txt.win
	global _url 
	set base .rouser.main 
	set _url($win~~statuslabel) "$base.top.buttons.status"
	set _url($win~~entrywidget) "$base.top.ubar.url"
	set _url($win~~backbut)     "$base.top.buttons.back"
	set _url($win~~forwardbut)  "$base.top.buttons.forward"
	set _url($win~~homebut)     "$base.top.buttons.home"
	set _url($win~~gobut)       "$base.top.buttons.go"
	set _url($win~~stopbut)     "$base.top.buttons.stop"






##############################
# ----- Load HTML into the browser text widget -------
#
proc LoadHTML {w url} {
    global _url 
 
    HB_init $w
    if {$url != ""} {
        $_url($w~~entrywidget) configure -text $url
        update
        set urllist [HB_resolve_url $w $url]
        HB_load_url $w [lindex $urllist 0] [lindex $urllist 1] 1
        if {[lindex $urllist 1] != ""} {HMgoto [lindex $urllist 1]}
    }
}

##############################
# ----- Post browser text widget -------
#
wm deiconify .rouser
if {!$BUTFLAG(1)} {
    pack forget .rouser.main.top		
} else {
    pack .rouser.main.top -before .rouser.main.txt -anchor nw -expand 1 -fill x -side top
}
if {!$SCROLFLAG(1)} {
    pack forget .rouser.main.txt.scroll
} else {
    pack .rouser.main.txt.scroll -after .rouser.main.txt.win -anchor center -expand 0 -fill y -padx 2 -pady 2 -side right
}
.rouser.main configure -borderwidth $BORDWID(1)
.rouser.main.txt configure -background $FRMBG(1)
.rouser.main.txt.win configure -background $BG(1)
if {$FILLAREA(1)} {
    place .rouser.f1 -x 0 -y 0 -width 0 -height 0 -relx 0 -rely 0 -relwidth 1.0 -relheight 1.0 -anchor nw
}
update
if {$ROUSERURL(1) != ""} {
    LoadHTML .rouser.main.txt.win "$ROUSERURL(1)"
}


init_ticker .rouser.main.txt.ticker

#
#------< End of File >-----