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 $argvescargo 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 30is 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 <b> 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 ]
