RssPoint
This application displays RSS news feeds in folders. Each of these items can be clicked and the corresponding webpage displayed in the browser.
NOTE: This application is MsWindows only as it uses optcl to embed MSIE as the web browser. It is based on code from WippleWobble - A Mini Web Browser (for Windows) and A little XML browser.
To download the current version, packaged as a starkit, use this link [L1 ]. To get the source code just scroll down a little bit.
Updated Build (11/04)
- Rss feeds updated every 30 minutes
- Force refresh of feeds (right click)
- Drag and drop a RSS link (from MSIE) onto tree to add a new news source
- Tree ballon help now displays when item was published
- Stores all RSS feeds in registry
- Delete news feeds (right click a item)
- Stores and Loads screen placement and state
- Display Unicode correctly in the Tree
- Performs a conditional http GET using store Last-Modified and ETag values
- Ballon help to give time since article published
- Ballon help to give article description if available
TO DOs:
- Under the News Feed have folder for Today and Old
- In tree, paint new posts blue, and visited ones purple
Source Code
# RssPoint by Michael P. Jacobson
# The One Line License (OLL) ~
# Get it, use it, share it, improve it, but don't blame me (or us).
set version 1.5
bind . <F1> [list console show]
package require Tk 8.4
package require BWidget
package require tdom
package require optcl
catch {package require tkdnd}
catch {package require Resizer}
package require autoproxy
package require http
package require registry
autoproxy::init
wm withdraw .
# RSS code by MPJ - works most of the time ;-)
proc Rss:Channel {name} {
global rss
foreach n [[lindex [$name childNodes] 0] childNodes] {
if {![string equal -nocase [string range [$n nodeName] 0 3] "item"]} {
if {[$n childNode] != "" && [llength [$n childNode]] == 1} {
if {[[$n childNode] nodeName]=="#text"} {
set rss($name,[$n nodeName]) [[$n childNode] nodeValue]
}
}
}
}
return $name
}
proc Rss:Items {name} {
global $name
set root $name
array unset $name
if {[string equal -nocase [$root nodeName] rss]} {
set root [lindex [$name childNodes] 0]
}
set count 0
foreach n [$root childNodes] {
if {[string equal -nocase [string range [$n nodeName] 0 3] "item"]} {
incr count
foreach o [$n childNodes] {
if {[$o childNode] != "" && [[$o childNode] nodeName]=="#text"} {
set [join "$name ($count,[$o nodeName])" {}] [string map {\n {}} [[$o childNode] nodeValue]]
}
}
}
}
return $count
}
# used for the initial update of the items then Rss:Update is callled (should be combined)
proc Rss:Site {name} {
global rss
set rawrss [fetch $name]
if {[catch {dom parse $rawrss rss(dom,$name)}]} {puts "Error on create";return -1}
catch {.tree delete t0}
$rss(dom,$name) documentElement rss(root,$name)
set fndnode [Rss:Channel $rss(root,$name)]
set fndcnt [Rss:Items $rss(root,$name)]
set rss(tree,$name) [.tree insert end root "t$::tc" -text [encoding convertfrom utf-8 $rss($fndnode,title)] \
-helptext $name \
-image [Bitmap::get folder] -open 1 -data $rss($fndnode,link)]
set count $::tc
for {set i 1} {$i <= $fndcnt} {incr i} {
set help ""
if {[info exist [join "::$fndnode ($i,pubDate)" {}]]} {
set help [set [join "::$fndnode ($i,pubDate)" {}]]
if {![catch {clock scan $help} sec]} {set help [clock format $sec]}
} elseif {[info exist [join "::$fndnode ($i,dc:date)" {}]]} {
set help [set [join "::$fndnode ($i,dc:date)" {}]]
if {![catch {clock scan $help} sec]} {set help [clock format $sec]}
}
if {[info exist [join "::$fndnode ($i,description)" {}]]} {
set help2 [set [join "::$fndnode ($i,description)" {}]]
set c 0
while {[set fnd [string range $help2 $c [incr c 40]]] != ""} {
set help "$help\n$fnd";incr c
}
}
if {![catch {clock scan $help} sec]} {set help [clock format $sec]}
.tree insert end "t$::tc" t[incr count] -text [encoding convertfrom utf-8 [set [join "::$fndnode ($i,title)" {}]]] \
-helptext $help \
-data [set [join "::$fndnode ($i,link)" {}]] \
-image [Bitmap::get file]
}
set ::tc [incr count]
}
proc Rss:Update {name} {
global rss
puts "Updating ... $name ... [clock format [clock second]]"
if {[set rawrss [fetch $name]] == ""} {puts " No News Updates Found";return 0}
if {[catch {dom parse $rawrss rss(dom,$name)}]} {puts "Error on update";return -1}
$rss(dom,$name) documentElement rss(root,$name)
#set fndnode [Rss:Channel $rss(root,$name)]
.tree delete [.tree nodes $rss(tree,$name)]
set fndnode $rss(root,$name)
set fndcnt [Rss:Items $rss(root,$name)]
set count $::tc
for {set i 1} {$i <= $fndcnt} {incr i} {
set help ""
if {[info exist [join "::$fndnode ($i,pubDate)" {}]]} {
set help [set [join "::$fndnode ($i,pubDate)" {}]]
if {![catch {clock scan $help} sec]} {set help [clock format $sec]}
} elseif {[info exist [join "::$fndnode ($i,dc:date)" {}]]} {
set help [set [join "::$fndnode ($i,dc:date)" {}]]
if {![catch {clock scan $help} sec]} {set help [clock format $sec]}
}
if {[info exist [join "::$fndnode ($i,description)" {}]]} {
set help2 [set [join "::$fndnode ($i,description)" {}]]
set c 0
while {[set fnd [string range $help2 $c [incr c 40]]] != ""} {
set help "$help\n$fnd";incr c
}
}
if {![catch {clock scan $help} sec]} {set help [clock format $sec]}
.tree insert end $rss(tree,$name) t[incr count] -text [string trim [encoding convertfrom utf-8 [set [join "::$fndnode ($i,title)" {}]]]] \
-helptext $help \
-data [set [join "::$fndnode ($i,link)" {}]] \
-image [Bitmap::get file]
}
set ::tc [incr count]
}
# http fetch and return stuff
proc fetch {url} {
global rss
if {[info exist rss(last,$url)]} {
set res [http::data [set tok [http::geturl $url \
-headers [list If-Modified-Since $rss(last,$url) If-None-Match $rss(etag,$url)]]]]
} else {
set res [http::data [set tok [http::geturl $url]]]
}
upvar #0 $tok state
foreach {key val} $state(meta) {
if {[string equal -nocase $key Last-Modified]} {set rss(last,$url) $val}
if {[string equal -nocase $key ETag]} {set rss(etag,$url) $val}
}
if {[http::ncode $tok] != 200} {set res ""}
http::cleanup $tok
return $res
}
# GPS code for WippleWobble (an IE COM in a Tk window)
proc forceFocus {win} {catch {focus -force $win}}
proc setOptions {} {
option add *Button.pady 0
option add *Button.padx 1
option add *Button.borderWidth 1
}
proc loadLocation {win} {
upvar #0 _${win}ar ar
if {[catch {$ar(htm) navigate $ar(location)} res]} {
return -code error $res
}
}
proc linkchanged {win id page} {
upvar #0 _${win}ar ar
$win.status config -text $page
}
proc pagebusy {win {waittime 250}} {
upvar #0 _${win}ar ar
set col [list green yellow]
$win.controls.busy config -bg [lindex $col [$ar(htm) : Busy]]
return [after $waittime "pagebusy $win"]
}
proc buildInterface {win location} {
upvar #0 _${win}ar ar
#The default for new instances
set ar(location) $location
frame $win -class RssPoint
pack [frame $win.controls] -fill x
pack [button $win.controls.backward -text "<<" \
-command "catch \"\[set ::_${win}ar(htm)\] goBack\""] -side left
pack [button $win.controls.forward -text ">>" \
-command "catch \"\[set ::_${win}ar(htm)\] goForward\""] -side left
pack [button $win.controls.print -text "Print" \
-command "\[set ::_${win}ar(htm)\] ExecWB OLECMDID_PRINT OLECMDEXECOPT_PROMPTUSER" -bg orange -fg white] -side left
pack [button $win.controls.stop -text "Stop" \
-command "\[set ::_${win}ar(htm)\] stop" -bg firebrick -fg white] -side left
pack [entry $win.controls.e \
-textvariable ::_${win}ar(location)] \
-side left -fill x -expand 1
bind $win.controls.e <Return> [list loadLocation $win]
pack [button $win.controls.go -text Go \
-command [list loadLocation $win] -bg darkgreen -fg white] -side left
pack [label $win.controls.space -width 2] -side left
pack [label $win.controls.busy -width 4 -bg green] -side left
set htm [optcl::new -window $win.htm Shell.Explorer.2]
pack $win.htm -fill both -side top -expand 1
set ar(htm) $htm
pack [label $win.status] -side bottom -anchor w
optcl::bind $htm StatusTextChange [list linkchanged $win]
$htm navigate $ar(location)
pagebusy $win
return $win
}
proc updateInterface { {mintime 30} } {
global rss
foreach a [array name rss root,*] {Rss:Update [lindex [split $a ,] 1]}
after [expr round($mintime*60000)] updateInterface
}
panedwindow .pane
frame .treeframe
Tree .tree -yscrollcommand [list .sbary set] -xscrollcommand [list .sbarx set]
.tree bindText <Double-1> [list tree_nav]
.tree bindText <Button-3> [list popup .tree .treemenu %X %Y]
catch {dnd bindtarget .tree UniformResourceLocator <Drop> {Rss:Site %D}}
menu .treemenu -tearoff 0 -activeborder 0
.treemenu add command -label "Move Up" -command [list move_selected -1]
.treemenu add command -label "Move Down" -command [list move_selected 1]
.treemenu add separator
.treemenu add command -label Update -command [list update_selected]
.treemenu add separator
.treemenu add command -label Delete -command [list delete_selected]
proc move_selected {direction} {
if {[set top [.tree parent [.tree selection get]]] == "root"} {
set top [.tree selection get]
}
set new [expr {[lsearch [.tree nodes root] $top] + $direction}]
if {$new >= 0 && $new < [llength [.tree nodes root]]} {
.tree move root $top $new
}
}
proc popup {frame win X Y pane} {
if {[string equal [$frame selection get] $pane]} {tk_popup $win $X $Y}
}
proc update_selected {} {
global rss
if {[set top [.tree parent [.tree selection get]]] == "root"} {
set top [.tree selection get]
}
foreach a [array name rss tree,*] {
set link [lindex [split $a ,] 1]
if {$rss(tree,$link) == $top} {Rss:Update $link}
}
}
proc delete_selected {} {
global rss
if {[set top [.tree parent [.tree selection get]]] == "root"} {
set top [.tree selection get]
}
foreach a [array name rss tree,*] {
set link [lindex [split $a ,] 1]
if {$rss(tree,$link) == $top} {
set dom $rss(root,$link)
array unset rss *,$link
array unset rss $dom,*
global $dom
array unset $dom
.tree delete $top
}
}
}
scrollbar .sbary -command [list .tree yview]
scrollbar .sbarx -orient horizontal -command [list .tree xview]
grid .tree .sbary -in .treeframe -sticky nsew
grid .sbarx -in .treeframe -sticky ew
grid columnconfigure .treeframe 0 -weight 1
grid rowconfigure .treeframe 0 -weight 1
set tc 1
.tree insert end root t0 -text "Now Retrieving Rss Data" \
-image [Bitmap::get file] -open 1 -data "https://wiki.tcl-lang.org/RssPoint"
proc tree_nav {page {win .htm}} {
upvar #0 _${win}ar ar
set ar(location) [.tree itemcget $page -data]
$ar(htm) navigate $ar(location)
}
buildInterface .htm "https://wiki.tcl-lang.org/RssPoint"
grid .pane -sticky news
.pane add .treeframe -sticky news
.pane add .htm -sticky news
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
catch {Resizer::resizer .resizer}
catch {raise .resizer}
bind all <Enter> {forceFocus %W}
bind all <ButtonPress-1> {forceFocus %W}
catch {wm geometry . [registry get "HKEY_CURRENT_USER\\Software\\RssPoint\\Gui" geometry]}
catch {wm state . [registry get "HKEY_CURRENT_USER\\Software\\RssPoint\\Gui" state]}
wm title . "RssPoint v$version"
wm deiconify .
if {[catch {registry get "HKEY_CURRENT_USER\\Software\\RssPoint\\Feeds" sites} sites]} {
Rss:Site https://wiki.tcl-lang.org/rss.xml
Rss:Site http://slashdot.org/slashdot.rss
wm geometry . 800x600
} else {
for {set i 1} {$i <= $sites} {incr i} {
Rss:Site [registry get "HKEY_CURRENT_USER\\Software\\RssPoint\\Feeds" site$i]
}
}
after [expr 1000*60*30] updateInterface ;# 1st update in 30 minutes
proc on_exit {} {
global rss
set c 0
registry set "HKEY_CURRENT_USER\\Software\\RssPoint\\Gui" geometry [wm geometry .]
registry set "HKEY_CURRENT_USER\\Software\\RssPoint\\Gui" state [wm state .]
registry set "HKEY_CURRENT_USER\\Software\\RssPoint\\Feeds" sites [llength [.tree nodes root]]
foreach ele [.tree nodes root] {
foreach a [array name rss tree,*] {
set link [lindex [split $a ,] 1]
if {$rss(tree,$link) == $ele} {
registry set "HKEY_CURRENT_USER\\Software\\RssPoint\\Feeds" site[incr c] $link
break
}
}
}
exit
}
wm protocol . WM_DELETE_WINDOW {on_exit}User Wishes:
- Saving the state of a node (opened/closed) to be restored when started the next time - by male, June 24th, 2004
- Reloading a loaded page belonging to feed leaf after a configurable duration (like in NewzPoint) or if the feed tells, that it has changed - by male, June 24th, 2004
- more key events in the tree, like <Prior>, <Next>, <Control-Home> and <Control-End> to move page wise and to the top or the bottom of the tree - by male, June 24th, 2004
- right-click in the tree to have a context menu, even if no tree node is selected! If a right-click selects an element like a left-click and than shows the context menu, than it would behave normal on MS Windows - by male, June 24th, 2004
- integration in NewzPoint??? - by male, June 24th, 2004
- mapping for HTML entities in the leaf names, like ", <, etc. - by male, June 24th, 2004
- the ability to disable the automatic update globally or per feed - by male, June 24th, 2004
- Some other means of doing the web pages, so that the application is cross platform.
- the ability to let the user name tree nodes by himself - by male, June 24th, 2004
- the ability to export the settings from the registry in a file to transport them to another computer. E.g. in a source-able tcl file with calls to the registry command adding all the extracted keys and values - by male, June 24th, 2004
- the balloon help over a leaf of the Tcler's Wiki feed could contain the last change, but the last changer too - by male, June 24th, 2004