#===================================================================
# 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 >-----