Updated 2006-07-19 13:43:46

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.

Here's a screenshot of it looking all lovely on MacOS X:

Update - here is version 0.2. Quite a few improvements. The article widget has been factored out into a separate package, and now uses a canvas (and looks very nice, if I do say so myself ;). So, here's that file first (save it as article.tcl):
 # Defines an "article" widget - for creating/displaying email
 # messages/newsgroup posts etc. Probably needs a better name :)
 package require Tcl 8.4
 package require Tk 8.4
 package require snit 0.91
 package provide article 0.1

 # Namespace... TODO

 image create photo AquaPinstripe
 # Create an image for the background
 AquaPinstripe put {{#ececec} {#ececec} {#f0f0f0} {#f0f0f0}} -to 0 0 1000 200

 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
 }

 # 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 -headercolor #000000
    option -headerfont {Helvetica 10}
    # Width of header name field in pixels
    option -headersize 70

    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} {
        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]
        frame $win.h -borderwidth 2 -background black
        canvas $win.h.c -borderwidth 0 -background black -height 50
        $win.h.c create image 0 0 -anchor nw -image AquaPinstripe
        # Create the title - this always exists
        install title using label $win.h.title \
            -anchor w -borderwidth 2 -padx 5
        pack $win.h.title  -fill x -expand 1
        pack $win.h.c -fill both -expand 1 -padx 0 -pady 0
        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
        set c $win.h.c
        set ypos 5
        set yheight [font metrics $hfont1 -displayof $win -linespace]
        # Add a bit...
        incr yheight 4
        $c delete HeaderLabel HeaderValue
        foreach {name value} $headers {
            regsub {\s+} $name {_} wname
            set wname [string tolower $wname]
            set disp ${name}
            while {[font measure $hfont1 -displayof $win $disp] >
                    $options(-headersize)} {
                set disp [string range $disp 0 end-1]
            }
            $c create text $options(-headersize) $ypos \
                -font $hfont1 \
                -anchor ne -text ${disp}: -tags HeaderLabel
            $c create text [expr {$options(-headersize)+5}] $ypos \
                -font $hfont2 \
                -anchor nw -text $value -tags HeaderValue
            incr ypos $yheight
        }
        $c configure -height $ypos
    }
 }

And here's the rest of the app (news.tcl) - Note this now uses tablelist rather than mclistbox:
 # 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.
 #   I may add support for fancy things like RSS and threaded reading at some
 #   point.
 #
 # Copyright (c) 2004 Neil Madden.
 # License: Tcl/BSD Style.
 lappend auto_path /usr/local/lib
 package require Tcl 8.4
 package require Tk 8.4
 package require snit 0.91
 package require nntp
 package require http
 package require tablelist 3.4

 source [file join [file dirname [info script]] article.tcl]
 #lappend auto_path [file dirname [info script]]
 package require article

 set NEWSSERVER "localhost"
 set NEWSPORT 119
 #set USER "foo"
 #set PASSWORD "sekret"

 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 $::NEWSSERVER $::NEWSPORT]
    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
    # The following code is broken - removing until I come up with a proper fix.
    #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 {} {
    global art_body
    set index [.main.l.list curselection]
    if {![llength $index]} { return }
    set index [lindex $index 0]
    set headers [.main.l.list get $index]
    foreach {id from subject date} $headers { break }
    # This needs to display the actual group headers, but unfortunately XOVER
    # doesn't seem to return them, so I'll have to move to a different method
    # if I want them...
    .main.body configure \
        -headers [list From $from Date $date Groups comp.lang.tcl]
    .main.body configure -title $subject
    if {[info exists art_body($id)]} {
        .main.body Delete 1.0 end
        .main.body Insert end $art_body($id)
        .main.body see 1.0
    } else {
        set nntp [nntp::nntp $::NEWSSERVER $::NEWSPORT]
        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
        set art_body($id) $body
    }
 }

 proc sortDate {item1 item2} {
    return [expr {[clock scan $item1] - [clock scan $item2]}]
 }

 proc formatdate {secs} {
    # Formats a the date as something nice:
    #   Today   23:08 (for posts made today)
    #   Yesterday 23:08 (posts yesterday, clearly)
    #   19 March 2005 23:08 (all others)
    set today [clock scan "today 00:00:00"]
    set yesterday [clock scan "yesterday 00:00:00"]
    if {$secs >= $today} {
        return "Today [clock format $secs -format %H:%M:%S]"
    } elseif {$secs >= $yesterday} {
        return "Yesterday [clock format $secs -format %H:%M:%S]"
    } else {
        return [clock format $secs -format "%e %B %Y %H:%M:%S"]
    }
 }

 proc main {argv} {
    # Launch da code...
    wm title . "Tk News Reader V0.2"
    # 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
    tablelist::tablelist .main.l.list \
        -columns {0 "Id"
                  0 "From"
                  0 "Subject"
                  0 "Date"} \
        -labelcommand tablelist::sortByColumn \
        -height 10 -width 80 -stretch all\
        -xscrollcommand [list .main.l.hsb set] \
        -yscrollcommand [list .main.l.vsb set] \
        -background #f3f3f3 \
        -stripebackground #e0e8f0 \
        -selectbackground #000066 \
        -selectforeground white \
        -activestyle frame \
        -selectmode single

    bind .main.l.list <<ListboxSelect>> [list updatepreview]

    .main.l.list columnconfigure 0 -hide 1
    .main.l.list columnconfigure 1 -maxwidth 30
    .main.l.list columnconfigure 2 -maxwidth 30
    .main.l.list columnconfigure 3 -maxwidth 20 -sortmode command \
        -sortcommand sortDate

    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 ""} \
            -height 10

    .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}]
        # Normalize the date
        set date [formatdate $secs]
        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

escargo 22 Mar 2004 - I'm trying to get this running on my Windows XP Pro laptop with ActiveState 8.4.4. I ran into two problems so far. The article code above does a package require Tk 8.5, which seems to be a straightforward typographical error. The harder problem is that in main,
 .main.l.list columnconfigure 1 -maxwidth 30

is getting a bad option response, with no -maxwidth option being in the list of available options. When I do a package require tablelist in wish, I get a response of 3.3. No particular version is required in the news.tcl code above. Any idea where the real error is?

NEM OK, fixed both. Tk version required is 8.4 not 8.5 (not sure if I actually need 8.4, but snit requires Tcl 8.4 IIRC). I use tablelist 3.4 which has the -maxwidth option, so I guess this is the requirement there. I've added a "3.4" to the package require tablelist. Either update, or remove the -maxwidth lines (it looked horrible without them, though, I seem to remember).

escargo - I have downloaded the newer tablelist version (which is 3.4 as of 23 Mar 2004), and re-enabled the original code that called it. My first reaction, now that I have it working (with comp.lang.tcl.announce, since it has fewer postings in it), is that the delay between clicking on a tablelist entry and the entry appearing to be selected is a major annoyance. A busy cursor that would appear while the newsgroup is being loaded and when a news article is being loaded would make the interface a lot more user friendly. It's still a good piece of work.

NEM Thanks! Yes, I am aware of the many limitations of the current code. The busy cursor is good to note though. I'm getting too used to MacOS X which automatically changes to a busy cursor if an app becomes unresponsive (usually after a second or so). It could be a lot more intelligent downloading articles, needs lots more GUI work, ability to post news, etc etc. Part of the problem is that the current nntp package in tcllib doesn't support async downloading. I've submitted a feature request for this, and may do it myself. But, still quite a way to go before this is trully useful (it's not bad now - I use it for reading clt).

escargo - I use Forte Agent [1] as my normal news reader. It is an interesting contrast.

NEM Heh! Give me two months, and I'll have you weaned off that! ;)

While working on this, I had a need for a Multiline expanding entry widget, so I built one.

SS NEM: while you are at early stages of development you may abstract the NNTP access code to support a generic 'group' interface. So it will be possible to write an interface for IMAP, POP3, and even for plain mbox files without to touch the rest of the code.

NEM Yup, that's always a good idea. The code base is growing somewhat, so the next release will probably be via a starkit rather than a wiki. I have the beginnings of news posting code, and a gorgeous "compose" window (if any of you use Apple's Mail.app, that is what I've loosely modelled it on).

Up above, you mention RSS as a possibility as well. Is that something that seriously might make it in? I still don't know if I know of any Tcl and/or Tk based RSS aggregators.

NEM Well, I'm seriously considering it. Whether or not that amounts to it actually getting done is another thing. Handling the various different RSS formats would be a bit of work, but it's doable within a weekend, I'd say. The main problem is that many feeds contain embedded HTML (stuff like &lt;b&gt; etc - with all the &..; nonsense), which is disgusting. I'm not planning on supporting HTML in feeds, so I could either strip stuff which looks like HTML or just display it as plain text (so you'd see the tags). Anyway, I'm not going to give a date as to when this will happen. At the moment this is evolving as and when I feel like adding stuff. I've done a bit more work on the UI, and I'm thinking of sorting out the nntp implementation next. Then I'll probably make a starkit release and put the code up somewhere (like sourceforge).

DKF: Here's a challenge for you. Come up with a decent solution for threading. Maybe using tktreectrl would be a first step, but that is still not a perfect solution. Sometimes, especially on a busy group, you need to see far more of a thread than a standard explorer-like tree view would show you. Naturally, you have to sacrifice things like the amount of detail shown per message, but this is often an acceptable trade-off in practice.

For your information, the trn newsreader shows threads like this:
 [1]+-[1]--[1]--[1]
    +-[1]+-[1]+-[1]
    |    |    \-[2]
    |    \-[3]--[3]
    \-[1]+-[1]--[1]
         \-[4]--[4]

Where each distinct number corresponds to a distinct subject line (after allowing for 'Re:', of course.)

Having the ability to catch-up and junk threads is very useful. As is being able to killfile a user.

[ Category Application | Category Internet ]