#!/bin/bash # the next line restarts using wish \ exec /usr/bin/wish "$0" "$@" # ################################# # copyright 2004 Mike Tuxford (aka moogyCode[TM]) # [email protected] # 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
