[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]: [http://mod3.net/~nem/tknewsreader.jpg] 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 {{#f3f3f3} {#f3f3f3} {#f6f6f6} {#f6f6f6}} -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 "" $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 <> [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 [http://www.forteinc.com/main/homepage.php] 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. ---- [[ [Category Application] | [Category Internet] ]]