#!/bin/bash
# the next line restarts using wish \
exec /usr/bin/wish "$0" "$@"
#
#################################
# copyright 2004 Mike Tuxford (aka moogyCode[TM])
# tuxford@earthlink.net
# irc.fdfnet.net #Linux #Groklaw
#
# stockwatch.tcl
# Relies on yahoo for stock quotes. Have fun!
#
# Right mouse click will raise a little menu for exiting
# or Ctrl-c or key-q will exit safely
#
#################################################
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; Version 2.
# (http://www.gnu.org/licenses/gpl.txt) This guarantees your
# right to use, modify, and redistribute under certain conditions.
#
#################################################
### Features along the bottom of the display ####
#
# [<-] [->] Buttons forward/backward through the stocks watched
#
# DISPLAY [] SEC is the time delay in seconds between rotating
# the displayed stock. You can change the cycle
# time by entering a number and pressing <enter>
#
# () indicator light will show GREEN while stock quotes are being
# fetched, RED when idle, and YELLOW indicates that
# one or more new stock quotes failed to be fetched.
#
# UPDATE button will fetch new quotes immediately and reset the
# fetch cycle.
#
# FETCH [] MIN is the cycle time, in minutes, between fetching new
# stock quotes. Enter a new value and press <enter> and
# it will reset the cycle to the new value.
#
# ADD/DELETE button Add or Delete stock symbols.
#
# CLOCK Your current time. :)
#
# () indicator light shows GREEN when stock market is open and RED
# when closed. This affects automated fetching of stock
# quotes but you can still always use the UPDATE button
# to fetch the last quotes when stock market is closed
#
#################################################
### NOTES on array variables ####################
# "stocks,watched" "symbol symbol"
# You can add or delete stock symbols but must notice
# that they are quoted all together as a group and not
# indiviually.
# Correct: "aaa bbb ccc"
# Incorrect: "aaa" "bbb" "ccc"
#
# "fecth,cycle" <n> Where <n> is minutes between fetching stock quotes
#
# "display,cycle" <n> Where <n> is seconds between displaying the stocks
#
# "daylight,savings" This should be set either on or off depending on
# whether NYC is currently on DST or not. This is for
# the sutomated fetching of stock qoutes to know when
# the stock market is open or closed.
#
# colors can be RGB in the form "#RRGGBB" or common color names such
# as "white", "red", etc... Just keep them in quotes
#
package require Tk
array set opt {
"stocks,watched" "SCOX NOVL IBM RHAT"
"fetch,cycle" 10
"display,cycle" 15
"daylight,savings" "off"
"gui,bg" "#000000"
"clock,bg" "#000000"
"clock,fg" "#ffd700"
"title,bg" "#000000"
"title,fg" "#ff0000"
"ticker,bg" "#000000"
"ticker,fg" "#ffd700"
"title,font" "Helvetica 12"
}
array set bmp {
"dot" "#define dot11_width 11 #define dot11_height 11
static unsigned char dot11_bits[] = {
0x00, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe, 0x03, 0xfe, 0x03, 0xfe, 0x03,
0xfe, 0x03, 0xfe, 0x03, 0xfc, 0x01, 0xf8, 0x00, 0x00, 0x00};"
}
set stock(fields) "symbol price change volume low high open time"
proc safe_exit {} {
foreach id [after info] {
catch {after cancel $id}
}
catch {destroy .s .}
return
}
proc update_clock {} {
## sanity check
if {![winfo exists .s]} {
safe_exit
} else {
.s.ctrl.clock configure -text [clock format [clock seconds] -format "%H:%M:%S"]
after 1000 update_clock
}
return
}
proc init_stock {s} {
global stock
foreach field $stock(fields) {
set stock($s,$field) ""
}
return
}
proc geturl_followRedirects {url args} {
array set URI [::uri::split $url] ;# Need host info from here
while {1} {
set token [eval [list http::geturl $url] $args]
if {![string match {30[1237]} [::http::ncode $token]]} {return $token}
array set meta [set ${token}(meta)]
if {![info exist meta(Location)]} {
return $token
}
array set uri [::uri::split $meta(Location)]
unset meta
if {$uri(host) == ""} { set uri(host) $URI(host) }
# problem w/ relative versus absolute paths
set url [eval ::uri::join [array get uri]]
}
}
#"SCOX",14.37,"1/30/2004","3:58pm",-0.48,15.07,15.07,14.36,87362
# ID price date time change open high low volume
proc get_stocks {} {
global opt stock
set stock(fails) ""
if {$opt(stocks,watched) == ""} {
return 0
}
bimg(market,ud) configure -foreground #00ff00
foreach symbol $opt(stocks,watched) {
http::config -useragent "Mozilla/5.0 (Windows; U; Windows NT 5.2; en-US; rv:1.9.2.6) Gecko/20100625 Firefox/3.6.6"
if {[catch {geturl_followRedirects http://finance.yahoo.com/d/quotes.csv?s=$symbol&f=sl1d1t1c1ohgv&e=.csv -timeout 30000} tok]} {
lappend stock(fails) $symbol
} else {
# sanity check
if {[http::status $tok] == "ok"} {
set stock($symbol,raw) [split [http::data $tok] \n]
set r [split [lindex $stock($symbol,raw) 0] ","]
array set v {"symbol" 0 "price" 1 "change" 4 "volume" 8 "low" 7 "high" 6 "open" 5 "time" 3}
foreach field [array names v] {
set stock($symbol,$field) [string map {\" ""} [lindex $r $v($field)]]
}
http::cleanup $tok
} else {
http::cleanup $tok
lappend stock(fails) $symbol
}
}
}
if {[llength $stock(fails)] > 0} {
bimg(market,ud) configure -foreground #ffff00
return 0
} else {
bimg(market,ud) configure -foreground #ff0000
return 1
}
}
proc cycle_fetch {} {
global opt
catch {after cancel $opt(fetch,after)}
if {[is_market_open]} {
set result [get_stocks]
bimg(market,oc) configure -foreground #00ff00
} else {
bimg(market,oc) configure -foreground #ff0000
}
set opt(fetch,after) [after [expr {$opt(fetch,cycle)*60000}] cycle_fetch]
return
}
proc is_market_open {} {
global opt
if {[string tolower $opt(daylight,savings)] == "off"} {
set ts [expr {[clock scan "now" -base [clock seconds] -gmt 1]-18000}]
} else {
set ts [expr {[clock scan "now" -base [clock seconds] -gmt 1]-14400}]
}
set day [clock format $ts -gmt 1 -format "%w"]
if {$day == 0 || $day == 6} {
return 0
} else {
set hh [clock format $ts -gmt 1 -format "%H"]
scan $hh %d hh
set mm [clock format $ts -gmt 1 -format "%M"]
scan $mm %d mm
}
if {$hh < 9 || $hh > 15} {
return 0
}
if {$hh == 9 && $mm < 30} {
return 0
}
return 1
}
proc change_display {dir} {
global opt stock
switch -- $dir {
forward {
if {$opt(display,cur) >= [expr {[llength $opt(stocks,watched)]-1}]} {
set opt(display,cur) 0
} else {
incr opt(display,cur)
}
}
back {
if {$opt(display,cur) <= 0} {
set opt(display,cur) [expr {[llength $opt(stocks,watched)]-1}]
} else {
incr opt(display,cur) -1
}
}
default {}
}
foreach f $stock(fields) {
.s.stocks.$f configure -text $stock([lindex $opt(stocks,watched) $opt(display,cur)],$f)
}
return
}
proc cycle_display {} {
global opt
catch {after cancel $opt(display,after)}
if {[llength $opt(stocks,watched)] > 1} {
change_display "forward"
}
set opt(display,after) [after [expr {$opt(display,cycle)*1000}] cycle_display]
return
}
proc set_cycle {type} {
global opt
set w ".s.ctrl.$type"
if {![string is integer [$w get]]} {
bell
return
} else {
set opt($type,cycle) [$w get]
}
focus .s
if {$type == "display"} {
set delay [expr {$opt($type,cycle)*1000}]
} else {
set delay [expr {$opt($type,cycle)*60000}]
}
catch {after cancel $opt($type,after)}
after $delay cycle_$type
return
}
proc init_widgets {} {
global opt bmp stock
frame .s.title
foreach name $stock(fields) {
label .s.title.$name \
-bg $opt(title,bg) -foreground $opt(title,fg) \
-font $opt(title,font) -height 1 -width 9 -text $name
pack .s.title.$name -side left
}
pack .s.title -side top
frame .s.stocks
foreach field $stock(fields) {
label .s.stocks.$field \
-bg $opt(ticker,bg) -foreground $opt(ticker,fg) \
-font $opt(title,font) -height 1 -width 9 -text ""
pack .s.stocks.$field -side left
}
pack .s.stocks -side top
set b(left) "<-"
set b(right) "->"
frame .s.ctrl -bg $opt(title,bg)
foreach but {left right} {
button .s.ctrl.$but \
-activebackground #ffffff -activeforeground #0000ff \
-background #eaeaea -foreground #0000ff \
-borderwidth 1 -relief solid \
-height 1 -width 2 \
-font {Helvetica 10 bold} -text $b($but) \
-command {}
pack .s.ctrl.$but -side left -padx 3
}
.s.ctrl.left configure -command {change_display "back"}
.s.ctrl.right configure -command {change_display "forward"}
label .s.ctrl.displayHead \
-background #000000 -foreground #ffff00 \
-borderwidth 0 -relief solid \
-font {Helvetica 10} -text "DISPLAY" -height 1 -width 7
pack .s.ctrl.displayHead -side left
entry .s.ctrl.display -relief sunken -bd 1 -width 3 \
-background #ffffff -font {Helvetica 12}
pack .s.ctrl.display -side left
.s.ctrl.display insert 0 $opt(display,cycle)
bind .s.ctrl.display <Key-Return> {set_cycle "display"}
label .s.ctrl.displayTail \
-background #000000 -foreground #ffff00 \
-borderwidth 0 -relief solid \
-font {Helvetica 10} -text "SEC" -height 1 -width 4
pack .s.ctrl.displayTail -side left
image create bitmap bimg(market,ud) -data $bmp(dot)
bimg(market,ud) configure -foreground #ffff00
label .s.ctrl.ud \
-background #000000 -foreground #000000 \
-borderwidth 1 -relief solid \
-image bimg(market,ud)
pack .s.ctrl.ud -side left
button .s.ctrl.update \
-activebackground #ffffff -activeforeground #0000ff \
-background #eaeaea -foreground #0000ff \
-borderwidth 1 -relief solid \
-font {Helvetica 10} -text "UPDATE" -height 1 -width 6 \
-command {get_stocks}
pack .s.ctrl.update -side left -padx 5
label .s.ctrl.fetchHead \
-background #000000 -foreground #ffff00 \
-borderwidth 0 -relief solid \
-font {Helvetica 10} -text "FETCH" -height 1 -width 6
pack .s.ctrl.fetchHead -side left
entry .s.ctrl.fetch -relief sunken -bd 1 -width 2 \
-background #ffffff -font {Helvetica 12}
pack .s.ctrl.fetch -side left
.s.ctrl.fetch insert 0 $opt(fetch,cycle)
bind .s.ctrl.fetch <Key-Return> {set_cycle "fetch"}
label .s.ctrl.fetchTail \
-background #000000 -foreground #ffff00 \
-borderwidth 0 -relief solid \
-font {Helvetica 10} -text "MIN" -height 1 -width 4
pack .s.ctrl.fetchTail -side left
button .s.ctrl.edit \
-activebackground #ffffff -activeforeground #0000ff \
-background #eaeaea -foreground #0000ff \
-borderwidth 1 -relief solid -font {Helvetica 10} \
-text "ADD/DEL" -height 1 -width 8 -command {pop_win "edit" "Add/Del Stocks"}
pack .s.ctrl.edit -side left -padx 5
image create bitmap bimg(market,oc) -data $bmp(dot)
bimg(market,oc) configure -foreground #ff0000
label .s.ctrl.market \
-background #000000 -foreground #000000 \
-borderwidth 1 -relief solid \
-image bimg(market,oc)
pack .s.ctrl.market -side right -padx 5
label .s.ctrl.clock \
-bg $opt(clock,bg) -foreground $opt(clock,fg) \
-font {Helvetica 14} -text "00:00:00" -height 1 -width 8
pack .s.ctrl.clock -side right
pack .s.ctrl -side top -anchor w -fill x
set opt(display,cur) 0
return
}
proc edit_stock {t} {
global opt
set w .edit
focus $w
if {[$w.$t.$t get] == ""} {
focus $w.$t.$t
pop_win "error" "Illegal value!"
return
} else {
set sym [string trim [string toupper [$w.$t.$t get]]]
$w.$t.$t delete 0 end
}
switch -- $t {
"add" {
if {[lsearch $sym $opt(stocks,watched)] != -1} {
focus $w.add.add
pop_win "error" "$sym already being watched"
return
}
if {[string first " " $sym] != -1} {
focus $w.add.add
pop_win "error" "Can only add one stock at a time."
return
}
pop_win notice "$sym added to stocks watched"
set result [init_stock $sym]
lappend opt(stocks,watched) $sym
set result [get_stocks]
}
"delete" {
if {[lsearch -exact $opt(stocks,watched) $sym] == -1} {
focus $w.add.add
pop_win "error" "I don't see \"$sym\" among the stocks watched."
return
} else {
set idx [lsearch -exact $opt(stocks,watched) $sym]
set opt(stocks,watched) [lreplace $opt(stocks,watched) $idx $idx]
catch {after cancel $opt(display,after)}
set opt(display,cur) 0
cycle_display
}
}
default {}
}
return
}
array set win {
"about,x" 220 "about,y" 100
"about,bg" "#0000ff"
"edit,bg" "#000000"
"error,bg" "#eaeaea"
"notice,bg" "#eaeaea"
}
proc pop_win {n txt} {
global opt win
set w .$n
# Abort if window already exists
if {[winfo exists $w]} {
raise $w
focus $w
return
}
toplevel $w
wm deiconify $w
$w configure -background $win($n,bg)
$w configure -cursor draft_small
switch -- $n {
"about" {
wm geometry $w $win($n,x)x$win($n,y)+[expr {[winfo x .s]+50}]+[winfo y .s]
wm title $w $txt
label $w.title \
-bg #0000ff -foreground #ffffff \
-font {Helvetica 14 bold} -height 3 -width 30 \
-text "Stock Watch was written by\nmoogyCode\[TM\] 2004\nMike Tuxford"
pack $w.title -side top
button $w.close \
-activebackground #ffffff -activeforeground #0000ff \
-background #eaeaea -foreground #0000ff \
-borderwidth 1 -relief solid -height 1 -width 20 \
-font {Helvetica 14} -text "I knew that!" -command {destroy .about}
pack $w.close -side top
bind $w <Control-c> "destroy $w"
}
"edit" {
wm geometry $w +[expr {[winfo x .s]+50}]+[winfo y .s]
wm title $w $txt
frame $w.add -relief groove -bd 5
label $w.add.head \
-background #eaeaea -foreground #000000 \
-borderwidth 0 -relief flat \
-font {Helvetica 12} -text "Add a Stock" -height 1 -width 15
pack $w.add.head -side left -padx 10 -pady 5
entry $w.add.add -relief sunken -bd 3 -width 6 \
-background #ffffff -font {Helvetica 12}
pack $w.add.add -side left -padx 10 -pady 5
bind $w.add.add <Key-Return> {edit_stock "add"}
pack $w.add -side top -padx 10 -pady 5
frame $w.delete -relief groove -bd 5
label $w.delete.head \
-background #eaeaea -foreground #000000 \
-borderwidth 0 -relief flat \
-font {Helvetica 12} -text "Delete a Stock" -height 1 -width 15
pack $w.delete.head -side left -padx 10 -pady 5
entry $w.delete.delete -relief sunken -bd 3 -width 6 \
-background #ffffff -font {Helvetica 12}
pack $w.delete.delete -side left -padx 10 -pady 5
bind $w.delete.delete <Key-Return> {edit_stock "delete"}
pack $w.delete -side top -padx 10
button $w.close \
-activebackground #ffffff -activeforeground #0000ff \
-background #eaeaea -foreground #0000ff \
-borderwidth 1 -relief solid -height 1 -width 26 \
-font {Helvetica 12} -text "CLOSE WINDOW" -command "destroy .$n"
pack $w.close -side bottom -pady 5
bind $w <Control-c> "destroy $w"
}
error - notice {
wm geometry $w +[expr {[winfo x .s]+50}]+[winfo y .s]
wm title $w "Error"
label $w.msg \
-background #eaeaea -foreground #000000 \
-borderwidth 0 -relief flat -font {Helvetica 12} \
-text $txt -width [expr {[string length $txt]+2}]
pack $w.msg -side top -padx 10 -pady 5
button $w.close \
-activebackground #ffffff -activeforeground #0000ff \
-background #eaeaea -foreground #0000ff \
-borderwidth 1 -relief solid -height 1 -width 4 \
-font {Helvetica 12} -text "OK" -command "destroy $w"
pack $w.close -side bottom -pady 5
bind $w <Control-c> "destroy $w"
}
default { destroy $w }
}
return
}
proc GUI {} {
global opt
wm withdraw .
set w .s
toplevel $w
$w configure -background $opt(gui,bg)
wm title $w "Stock Watcher"
wm deiconify $w
#####################
# MAIN MENU
menu $w.main -tearoff 0
$w.main configure -font {Helvetica 10}
set ma $w.main.file
menu $ma -tearoff 0
$ma configure -font {Helvetica 10}
$w.main add cascade -label "Menu" -menu $ma
$ma add separator
$ma add command -label "About" -command {pop_win "about" "About"}
$ma add command -label "Exit" -command {safe_exit}
$ma add separator
$w configure -cursor draft_small
#
# END MAIN MENU ###
####################
# WIDGETS
init_widgets
####################
# bind some Hotkeys
bind $w <Control-c> {safe_exit}
bind $w <Key-q> {safe_exit}
bind $w <ButtonPress-3> {tk_popup .s.main [expr [winfo pointerx .s] -5] [expr [winfo pointery .s] -5]}
### End GUI ##########
}
####################
# Get the show started
package require http
package require uri
GUI
update_clock
#devp_init
foreach stk $opt(stocks,watched) {
init_stock $stk
}
foreach f $stock(fields) {
.s.stocks.$f configure -text $stock([lindex $opt(stocks,watched) $opt(display,cur)],$f)
}
if {[is_market_open]} {
bimg(market,oc) configure -foreground #00ff00
} else {
bimg(market,oc) configure -foreground #ff0000
get_stocks
}
cycle_fetch
change_display forward
set opt(display,after) [after [expr {$opt(display,cycle)*1000}] cycle_display]Feb 27, 2004: Added copyright and GPL notice at the request of a groklaw member. March 4, 2004 Minor bug fix.
See also Tcl Ticker
