[NEM] '''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. # 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 "" $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 ---- [[ [Category Application] ]]