Version 3 of Simple Newsreader
Updated 2004-03-15 21:51:51NEM 15Mar04 - I was recently working on code for a simple newsreader in Tcl/Tk, so that I could read comp.lang.tcl (didn't like any of the Mac newsreaders I downloaded). It's far from complete (you can't post yet), and not very well coded (little caching, doesn't reuse connections etc). However, as I'm unlikely to finish it off any time soon, I thought I'd dump the code up here to see if anyone else wants to finish it off, or use some of the code. See also A Snit News ticker widget, which I wrote a while ago, and which some of this code is based on. There is a reusable "article" widget in here, for displaying messages, which people may find useful. I'm planning on working that up into something better and submitting it to tklib.
Here's a screenshot of it looking all lovely on MacOS X:
# news.tcl --
#
# A NNTP newsreader written in Tcl/Tk. I got fed up looking for decent
# newsreaders, so I thought I'd write my own.
#
# Copyright (c) 2004 Neil Madden.
# License: Tcl/BSD Style.
package require Tcl 8.4
package require Tk 8.4
package require snit 0.91
package require nntp
#package require http
package require mclistbox
set HOST "localhost"
set PORT 119
#set USER "username"
#set PASSWORD "password"
# Create some useful widgets
# article --
#
# This widget is used for displaying/composing an article. It is basically a
# text widget, with some extra stuff at the top which displays headers - a
# title, and then some name/value pairs of headers.
snit::widget article {
option -headers [list]
option -headerbackground #eeeeee
option -headerforeground #000000
option -headerfont {Helvetica 10}
delegate option -title to title as -text
delegate option -titlebackground to title as -background
delegate option -titlebg to title as -background
delegate option -titleforeground to title as -foreground
delegate option -titlefg to title as -foreground
delegate option -titlefont to title as -font
delegate option * to body
delegate method * to body
# Vars to hold fonts created for headers
variable hfont1
variable hfont2
constructor {args} {
install bframe using frame $win.b
install body using rotext $win.b.body \
-yscrollcommand [list $win.b.vsb set]
scrollbar $win.b.vsb -orient vertical \
-command [list $win.b.body yview]
install header using frame $win.h \
-borderwidth 2 -background black
# Create the title - this always exists
install title using label $win.h.title \
-anchor w -borderwidth 2
pack $win.h.title -fill x -expand 1
pack $win.h -fill x -side top -anchor n -padx 5 -pady 5
# Pack the text widget
pack $win.b.vsb -side right -fill y -anchor e
pack $win.b.body -side left -fill both -expand 1
pack $win.b -side bottom -fill both -expand 1
# Apply defaults for delegated options
$self configure -title "<no subject>"
$self configure -titlebackground #000066
$self configure -titleforeground #ffffff
$self configure -titlefont {Helvetica 10 bold}
# Set up header fonts
set hfont1 [font create -family Helvetica \
-size 10 -weight bold]
set hfont2 [font create -family Helvetica \
-size 10 -weight normal]
# Apply options passed at creation time
$self configurelist $args
}
destructor {
# Clean up fonts
font delete $hfont1
font delete $hfont2
}
onconfigure -headerfont {font} {
set options(-headerfont) $font
set opts [font actual $font]
eval [list font configure $hfont1] $opts [list -weight bold]
eval [list font configure $hfont2] $opts
}
onconfigure -headers {headers} {
# First - update the options array
set options(-headers) $headers
catch {destroy $win.h.h}
set top [frame $win.h.h]
# Now, create the widgets
foreach {name value} $headers {
regsub {\s+} $name {_} wname
set wname [string tolower $wname]
set f [frame $top.$wname]
label $f.l -font $hfont1 \
-foreground [$self cget -headerforeground] \
-background [$self cget -headerbackground] \
-anchor w -width 10 -text ${name}:
label $f.v -font $hfont2 \
-foreground [$self cget -headerforeground] \
-background [$self cget -headerbackground] \
-anchor w -text $value
pack $f.l -side left
pack $f.v -side left -fill x -expand 1
pack $f -fill x -expand 1
}
pack $top -fill x -expand 1
}
}
snit::widgetadaptor rotext {
constructor {args} {
installhull using text -insertwidth 0
$self configurelist $args
}
method insert {args} {}
method delete {args} {}
delegate method Insert to hull as insert
delegate method Delete to hull as delete
delegate method * to hull
delegate option * to hull
}
proc loadnews {} {
set news [list]
if {[file exists ~/.tclnews] && [file readable ~/.tclnews]} {
set fid [open ~/.tclnews]
set news [lsort -integer -index 0 [read $fid]]
close $fid
}
set nntp [nntp::nntp $::HOST $::PORT]
if {[info exists ::USER]} {
$nntp authinfo $::USER $::PASSWORD
}
foreach {num first last} [$nntp group comp.lang.tcl] { break }
# Check headers to see whether there is new news...
set oldfirst [lindex $news 0 0]
set oldlast [lindex $news end 0]
if {$oldfirst eq ""} { set oldfirst 0 }
if {$oldlast eq "" } { set oldlast 0 }
if {$last > $oldlast} {
foreach item [$nntp xover [expr {$oldlast + 1}] $last] {
lappend news [split $item \t]
}
}
$nntp quit
if {$first > $oldfirst} {
set news [lrange $news [expr {$first - $oldfirst}] end]
}
set fid [open ~/.tclnews w]
puts $fid $news
close $fid
return $news
}
proc updatepreview {args} {
if {![llength $args]} { return }
set index [lindex $args 0]
set headers [.main.l.list get $index]
foreach {id from subject date} $headers { break }
.main.body configure \
-headers [list From $from Date $date Groups comp.lang.tcl]
.main.body configure -title $subject
update
set nntp [nntp::nntp $::HOST $::PORT]
if {[info exists ::USER]} {
$nntp authinfo $::USER $::PASSWORD
}
$nntp group comp.lang.tcl
set body [join [$nntp body $id] \n]
.main.body Delete 1.0 end
.main.body Insert end $body
.main.body see 1.0
$nntp quit
}
proc main {argv} {
# Launch da code...
wm title . "Tk News Reader V0.1"
# Create some fonts
font create List -family {Lucida Grande} -size 12
font create ListHeader -family {Lucida Grande} -size 12 -weight bold
font create Body -family Optima -size 12
panedwindow .main -orient vertical
frame .main.l
mclistbox::mclistbox .main.l.list -fillcolumn subject \
-columnborderwidth 2 \
-labelanchor nw \
-labelbackground #cccccc \
-labelfont ListHeader \
-labelrelief raised \
-selectcommand [list updatepreview] \
-xscrollcommand [list .main.l.hsb set] \
-yscrollcommand [list .main.l.vsb set] \
-width 100
.main.l.list column add id -visible 0
.main.l.list column add from -label "From"
.main.l.list column add subject -label "Subject"
.main.l.list column add date -label "Date"
.main.l.list configure -fillcolumn subject
scrollbar .main.l.vsb -command [list .main.l.list yview] -orient vertical
scrollbar .main.l.hsb -command [list .main.l.list xview] -orient horizontal
grid .main.l.list -column 0 -row 0 -sticky news
grid .main.l.vsb -column 1 -row 0 -sticky ns
grid .main.l.hsb -column 0 -row 1 -sticky ew
grid columnconfigure .main.l 0 -weight 1
grid rowconfigure .main.l 0 -weight 1
article .main.body \
-titlefont ListHeader \
-headerfont List \
-font Body \
-headers {From "" Subject "" Date ""}
.main add .main.l .main.body -sticky news
pack .main -fill both -expand 1
update
array set items {}
foreach item [loadnews] {
foreach {msgid subject from date idstring bodysize headersize xref} \
$item { break }
flush stdout
regexp {(.*)[\+\-](\d{4})} $date -> rest offset
if {[catch {clock scan $rest} secs]} {
puts "Skipping $date"
continue
}
set offset [string trimleft $offset 0]
regexp {0*(\d*)(\d\d)$} $offset -> hours mins
if {![string length $hours]} { set hours 0 }
incr secs [expr {$hours * 3600}]
incr secs [expr {$mins * 60}]
while {[info exists items($secs)]} {
incr secs
}
set items($secs) [list $msgid $from $subject $date]
}
foreach item [lsort -integer -decreasing [array names items]] {
.main.l.list insert end $items($item)
}
}
main $argv