# SlashMeat Monitoring Package
####
### updated by GFT - GReggFT
####
### 010216 - added handspringnews
### 010301 - added mandrake
### 010302 - fix special characters for palmstation
### 010302 - added php
### 010305 - added handspringrumor
### 010309 - added editorial for palm
### 010411 - added editorial for slashdot
### 010424 - added trgnews for palm
### 010911 - changed from ultramode.txt to slashdot.xml
### 011018 - changed freshmeat to use the xml file, also put more in the popup
### This requires an update to the popup.tcl file!
### 020212 - added fm:changes
### 020215 - added security icon for slashdot
### 020218 - added hp icon for slashdot
### 020224 - added X
### 020403 - added apache topic - also fixed some special character...
####
#
# This is a proof of concept module. We just fetch the slashdot
# and freshmeat data from their web page.
#
# All packages must be inside a namespace with the
# same name as the file name.
# Copyright (c) 1998-9 America Online, Inc. All Rights Reserved.
#
# 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; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# Set VERSION and VERSDATE using the CVS tags.
namespace eval slashmeat {
regexp -- {[0-9]+\.[0-9]+} {@(#)TiK SlashMeat package $Revision: 1.20 $} \
::slashmeat::VERSION
regexp -- { .* } {:$Date: 1999/05/10 11:40:26 $} \
::slashmeat::VERSDATE
}
package require http 2.0
# Options the user might want to set. A user should use
# set ::TIK(options,...), not the tik_default_set
#
tik_default_set options,SlashMeat,SlashDot 1
tik_default_set options,SlashMeat,FreshMeat 0
tik_default_set options,SlashMeat,PalmStation 0
tik_default_set options,SlashMeat,update 1800000
tik_default_set options,SlashMeat,mirror /
namespace eval slashmeat {
variable info
variable ps_icons
# Must export at least: load, unload, goOnline, goOffline
namespace export load unload goOnline goOffline
# All packages must have a load routine. This should do most
# of the setup for the package. Called only once.
proc load {} {
if {$::TIK(options,SlashMeat,update) < 1800000} {
set ::TIK(options,SlashMeat,update) 1800000
}
set slashmeat::info(timer) ""
menu .slashmeatMenu -tearoff 0
.toolsMenu add cascade -label "SlashMeat Monitor" -menu .slashmeatMenu
.slashmeatMenu add command -label "Update Now" -command slashmeat::doUpdate
menu .slashmeatIMenu -tearoff 0
.slashmeatMenu add cascade -label "Update Interval" -menu .slashmeatIMenu
menu .slashmeatMMenu -tearoff 0
.slashmeatMenu add cascade -label "Freshmeat Mirror" -menu .slashmeatMMenu
.slashmeatIMenu add radiobutton -label "30 Minutes" -value 1800000 \
-variable ::TIK(options,SlashMeat,update) -command slashmeat::doUpdate
.slashmeatIMenu add radiobutton -label "60 Minutes" -value 3600000 \
-variable ::TIK(options,SlashMeat,update) -command slashmeat::doUpdate
.slashmeatIMenu add radiobutton -label "90 Minutes" -value 4800000 \
-variable ::TIK(options,SlashMeat,update) -command slashmeat::doUpdate
.slashmeatIMenu add radiobutton -label "120 Minutes" -value 7200000 \
-variable ::TIK(options,SlashMeat,update) -command slashmeat::doUpdate
.slashmeatMMenu add radiobutton -label "Original @RedHat" -value / \
-variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "California US" \
-value /ca.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Connecticut US" \
-value /ct.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Deutschland" \
-value /de.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Denmark" \
-value /dk.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Espa\xF1ia" \
-value /es.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Greece" \
-value /gr.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "IS South Africa" \
-value /is.za.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Massachusetts, US" \
-value /ma.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Maryland, US" \
-value /md.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Minnesota, US" \
-value /mn.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "North Carolina, US" \
-value /nc.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Nederlands" \
-value /nl.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Queensland, AU" \
-value /qld.au.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Russia" \
-value /ru.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Slovakia" \
-value /sk.eu.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMMenu add radiobutton -label "Texas, US" \
-value /tx.us.mirrors. -variable ::TIK(options,SlashMeat,mirror)
.slashmeatMenu add checkbutton -label "Display Freshmeat" \
-variable ::TIK(options,SlashMeat,FreshMeat) \
-command slashmeat::doUpdate
.slashmeatMenu add checkbutton -label "Display Slashdot" \
-variable ::TIK(options,SlashMeat,SlashDot) \
-command slashmeat::doUpdate
.slashmeatMenu add checkbutton -label "Display PalmStation" \
-variable ::TIK(options,SlashMeat,PalmStation) \
-command slashmeat::doUpdate
catch {
foreach topic { amiga gimp netscape apple gnome news be gnustep \
pilot beos hardware redhat caldera humor science \
comdex ibm slashdot corel intel starwars debian \
kde sun digital linux suse encryption money us \
enlightenment movies wine freebsd ms aol bug \
cda dog doj enlightenment eplus games gnu ie \
internet java microsoft ms quake \
spam tech tech2 tv unix x xmas sgi music compaq \
privacy space amd censorship slashback \
programming media mozilla toys va turbolinux \
bsd anime ed announcements quickies \
transmeta perl patents linuxbiz upgrades \
links graphics3 ximian mandrake php \
editorial security hp aposx apache } {
image create photo $topic -file media/slash${topic}.gif
}
image create photo freshmeat -file media/freshmeat.gif
foreach topic {newhardware hardwarereview hardwareupdate \
softwarenew softwarereview softwareupdate \
news rumor question editorial \
palmnews palmrumor \
handspringnews handspringrumor \
trgnews trgrumor \
} {
lappend slashmeat::ps_icons palm${topic}
eval image create photo palm${topic} -file media/ps_palm${topic}.gif
}
}
catch {
lappend slashmeat::ps_icons palmstation
image create photo palmstation -file media/ps_logo.gif
}
}
proc doubleClick {name slashmeat} {
tik_show_url SlashMeat $::BUDDIES([normalize $slashmeat],url)
}
# All pacakges must have goOnline routine. Called when the user signs
# on, or if the user is already online when packages loaded.
proc goOnline {} {
lappend ::BUDDYLIST SlashMeat
set ::GROUPS(SlashMeat,people) ""
set ::GROUPS(SlashMeat,type) SlashMeat
set ::GROUPS(SlashMeat,online) 0
set ::GROUPS(SlashMeat,total) 0
set ::GROUPS(SlashMeat,collapsed) T
tik_draw_list T
after 10000 slashmeat::doUpdate
}
# All pacakges must have goOffline routine. Called when the user signs
# off. NOT called when the package is unloaded.
proc goOffline {} {
}
# All packages must have a unload routine. This should remove everything
# the package set up. This is called before load is called when reloading.
proc unload {} {
catch {after cancel $slashmeat::info(timer)}
.toolsMenu delete "SlashMeat Monitor"
destroy .slashmeatIMenu
destroy .slashmeatMenu
destroy .slashmeatMMenu
set i [lsearch -exact $::BUDDYLIST SlashMeat]
if {$i != -1} {
set ::BUDDYLIST [lreplace $::BUDDYLIST $i $i]
}
tik_draw_list T
set slashmeat::ps_icons [list]
}
proc doUpdate {} {
catch {after cancel $slashmeat::info(timer)}
set slashmeat::info(timer) [after $::TIK(options,SlashMeat,update) slashmeat::doUpdate]
# if {($::USEPROXY != "None") && !$::TIK(options,HTTPProxy,enable)} {
# return
# }
set ::GROUPS(SlashMeat,people) ""
set ::GROUPS(SlashMeat,total) 0
set ::GROUPS(SlashMeat,online) 0
if {$::TIK(options,SlashMeat,FreshMeat)} {
# set furl "http:/$::TIK(options,SlashMeat,mirror)freshmeat.net/backend/recentnews.txt"
set furl "http:/$::TIK(options,SlashMeat,mirror)freshmeat.net/backend/fm-newsletter.rdf"
catch {::http::geturl $furl \
-command slashmeat::freshmeatDataAvailable}
}
if {$::TIK(options,SlashMeat,SlashDot)} {
set surl "http://slashdot.org/slashdot.xml"
catch {::http::geturl $surl \
-command slashmeat::slashdotDataAvailable}
}
if {$::TIK(options,SlashMeat,PalmStation)} {
set purl "http://www.palmstation.com/headline_server.asp?nocomment=1"
catch {::http::geturl $purl \
-command slashmeat::palmstationDataAvailable}
}
}
proc formattext {token linesize} {
set tok ""
set line ""
set first 1
foreach word [split $token " "] {
set lword [string length $word]
set lline [string length $line]
if { [expr $lword + $lline] > $linesize } {
if { $first==0 } {
append tok "\n"
} else {
set first 0
}
append tok $line
append tok " "
set line ""
}
append line $word
append line " "
}
append tok "\n"
append tok $line
set token $tok
return $token
}
# Callback when there is data available from the url we have requested.
proc freshmeatDataAvailable {token} {
upvar #0 $token state
set i [string first "- " $state(body)]
set body [string range $state(body) [expr $i] [expr $l + 7] ]
regsub -all -- "(<|\n" $body "\001" body
regsub -all -- "\n( )+" $body "\n" body
foreach item [split $body "\001"] {
set i [ string first "\n" $item ]
set item [ string range $item [expr $i + 1] end]
regsub -all -- "( )*<(title|link|description|dc:date|dc:creator|fm:license|fm:changes)>" $item "" item
regsub -all -- "\n" $item "\002" item
foreach {title url description date creator license changes} [split $item "\002"] {
set title [string trim $title]
set url [string trim $url]
set description [string trim $description]
set date [string trim $date]
set creator [string trim $creator]
set license [string trim $license]
set changes [string trim $changes]
set linesize [string length $title]
set lnsz [string length $url]
if {$lnsz > $linesize} {
set linesize $lnsz
}
set lnsz [string length $date]
if {$lnsz > $linesize} {
set linesize $lnsz
}
set lnsz [string length $creator]
if {$lnsz > $linesize} {
set linesize $lnsz
}
set lnsz [string length $license]
if {$lnsz > $linesize} {
set linesize $lnsz
}
regsub -all -- "\n" $description " " description
regsub -all -- "( )+" $description " " description
set desc ""
set line ""
set first 1
foreach word [split $description " "] {
set lword [string length $word]
set lline [string length $line]
if { [expr $lword + $lline] > $linesize } {
if { $first==0 } {
append desc "\n"
} else {
set first 0
}
append desc $line
append desc " "
set line ""
}
append line $word
append line " "
}
append desc "\n"
append desc $line
set description $desc
set changes [formattext $changes $linesize]
set ntitle [normalize $title]
if {$ntitle == ""} {
continue
}
lappend ::GROUPS(SlashMeat,people) $ntitle
incr ::GROUPS(SlashMeat,online)
incr ::GROUPS(SlashMeat,total)
set ::BUDDIES($ntitle,online) T
set ::BUDDIES($ntitle,name) $title
set ::BUDDIES($ntitle,type) SlashMeat
set ::BUDDIES($ntitle,icon) "freshmeat"
set ::BUDDIES($ntitle,otherString) ""
if {[regexp {http://freshmeat.net} $url]} {
regsub {http://} $url "http:/$::TIK(options,SlashMeat,mirror)" url
}
set ::BUDDIES($ntitle,url) $url
set ::BUDDIES($ntitle,indexs) ""
set ::BUDDIES($ntitle,doubleClick) slashmeat::doubleClick
set ::BUDDIES($ntitle,popupText) [list \
Title: $title \
URL: $url \
Desc: $description \
Date: $date \
Creator: $creator \
License: $license \
Changes: $changes ]
}
}
tik_draw_list T
catch {uplevel #0 unset $token}
set state(-command) ""
}
# Callback when there is data available from the url we have requested.
proc palmstationDataAvailable {token} {
upvar #0 $token state
set slashmeat::info(Palmstation,size) $state(currentsize)
set body [string trim $state(body)]
####
### Fix special characters
####
regsub -all "'(;)?" $body "'" body
regsub -all ""(;)?" $body "\"" body
foreach item [split $body "\n"] {
if {[string index $item 0] == "#"} {
continue
}
if {[string length $item] == 0} { continue }
if {"$item" == "--++"} {
append data "\n"
} else {
append data "$item\001"
}
}
foreach item [split $data "\n"] {
foreach {title article_id category subcat} [split $item "\001"] {
if {[string length "$title"] == 2} {
continue
}
set url "http://www.palmstation.com/view_article.asp?article=${article_id}"
set ntitle [normalize $title]
lappend ::GROUPS(SlashMeat,people) $ntitle
incr ::GROUPS(SlashMeat,online)
incr ::GROUPS(SlashMeat,total)
set ::BUDDIES($ntitle,online) T
set ::BUDDIES($ntitle,name) $title
set ::BUDDIES($ntitle,type) SlashMeat
set iconname [normalize "${category}${subcat}"]
if {[lsearch $slashmeat::ps_icons $iconname] != "-1"} {
set ::BUDDIES($ntitle,icon) $iconname
} else {
set ::BUDDIES($ntitle,icon) palmstation
}
set ::BUDDIES($ntitle,otherString) ""
set ::BUDDIES($ntitle,url) $url
set ::BUDDIES($ntitle,indexs) ""
set ::BUDDIES($ntitle,doubleClick) slashmeat::doubleClick
set ::BUDDIES($ntitle,popupText) [list \
Title: $title \
Category: $category:$subcat \
URL: $url]
}
}
tik_draw_list T
catch {uplevel #0 unset $token}
set state(-command) ""
}
# Callback when there is data available from the url we have requested.
proc slashdotDataAvailable {token} {
upvar #0 $token state
### set i [string first "%%\n" $state(body)]
set i [string first "" $state(body)]
### set body [string range $state(body) [expr $i+3] end]
set body [string range $state(body) [expr $i] end]
### regsub -all -- "%%\n" $body "\001" body
regsub -all -- "<I>" $body "\"" body
regsub -all -- "</I>" $body "\"" body
regsub -all -- " " $body "" body
regsub -all -- "(<|\n" $body "\001" body
regsub -all -- "" $body "" body
foreach item [split $body "\001"] {
regsub -all -- "\t\t<(title|url|time|author|department|topic|comments|section|image)>" $item "" item
regsub -all -- "\n" $item "\n" item
foreach {title link time author dept topic numcomments \
storytype imagename } [split $item "\n"] {
set ntitle [normalize $title]
if {$ntitle == ""} {
continue
}
lappend ::GROUPS(SlashMeat,people) $ntitle
incr ::GROUPS(SlashMeat,online)
incr ::GROUPS(SlashMeat,total)
set ::BUDDIES($ntitle,online) T
set ::BUDDIES($ntitle,name) $title
set ::BUDDIES($ntitle,type) SlashMeat
if {![regexp "topic(\[^\.]*).(gif|jpg)" $imagename x ::BUDDIES($ntitle,icon)]} {
set ::BUDDIES($ntitle,icon) slashdot
}
set ::BUDDIES($ntitle,otherString) "($numcomments comments)"
set ::BUDDIES($ntitle,url) $link
set ::BUDDIES($ntitle,indexs) ""
set ::BUDDIES($ntitle,doubleClick) slashmeat::doubleClick
set ::BUDDIES($ntitle,popupText) [list \
Title: $title \
Date: $time \
Author: $author \
Dept: $dept \
Topic: $topic \
Comments: $numcomments \
StoryType: $storytype \
URL: $link]
}
}
tik_draw_list T
catch {uplevel #0 unset $token}
set state(-command) ""
}
}
(
geocities.com/greggft/TiK) (
geocities.com/greggft)