• 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

1. Under the News Feed have folder for Today and Old
2. In tree, paint new posts blue, and visited ones purple

 # 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 "http://wiki.tcl.tk/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 "http://wiki.tcl.tk/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 http://wiki.tcl.tk/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}

1. Saving the state of a node (opened/closed) to be restored when started the next time - by male, June 24th, 2004
2. 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
3. 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
4. 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
5. integration in NewzPoint??? - by male, June 24th, 2004
6. mapping for HTML entities in the leaf names, like &quot;, &lt;, etc. - by male, June 24th, 2004
7. the ability to disable the automatic update globally or per feed - by male, June 24th, 2004
8. Some other means of doing the web pages, so that the application is cross platform.
9. the ability to let the user name tree nodes by himself - by male, June 24th, 2004
10. 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
11. 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

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References