[NEM] - A little fun project to create a news/stock ticker widget, and here's the result. I used [Snit's Not Incr Tcl] to make it act like a real Tk widget, but it's pure Tk code apart from that. Basically, the widget is a single line display (like a label), which you can add messages to. The messages scroll across the widget one after the other in order. You can click on a message and a procedure will be run, so you could have the messages as articles from slashdot and the procedure would launch a browser to the appropriate page. There are a couple of bugs with the implementation, but it's good enough for my purposes. The main bug is that if you resize the widget (making it smaller) then the items can screw up and become overlapped. You can workaround by deleting all items and then re-adding them on a resize, but a real fix would be better. ('''Update''' - I think I've fixed most of the bugs now and it seems pretty useable). Anyway - the package (need's Tcl 8.4 as I use [lset]): # Defines a snit widget type for a ticker. package provide ticker 0.1 package require Tcl 8.4 package require Tk package require snit snit::widget ticker { option -scrollstep -2 option -scrollinterval 20 option -font {Helvetica 12 bold} variable event "" variable items [list] variable newitems [list] variable messagelength 0 constructor {args} { component hull is [canvas $self] $self configurelist $args set height [font metrics $options(-font) -linespace] $self configure -height [expr {$height + 4}] $self resume } method dummy {args} {} method add {text command} { # Append a new item to the ticker, and register a callback on it set id [$self create text 2000 2 -anchor nw -text $text \ -fill #efeb90 -font $options(-font)] $self bind $id [list $self Enter $id] $self bind $id [list $self Leave $id] $self bind $id [concat $command $id] set width [font measure $options(-font) $text] if {![llength $items]} { set insertpos [winfo width $self] } lappend newitems $id $width return $id } method remove {id} { $self delete $id if {$id eq "all"} { set items [list] } elseif {[set idx [lsearch $items $id]] != -1} { set width [lindex $items [expr {$idx + 1}]] set items [lreplace $items $idx [expr {$idx + 2}]] incr messagelength -$width incr messagelength -20 # We need to adjust the position of all items after this one: for {set i [expr {$idx + 2}]} {$i < [llength $items]} {incr i 3} { lset items $i [expr {[lindex $items $i] - ($width + 20)}] } } if {![llength $items]} { set messagelength 0 $self stop } } method Enter {id} { $self itemconfigure $id -fill red $self stop } method Leave {id} { $self itemconfigure $id -fill #efeb90 $self resume } method Scroll {} { # Moves all the items along, and keeps track of everything. $self stop ;# Fixes a bizarre bug where we have too many events set idx 0 set flag 1 set pos [winfo width $self] set width 0 foreach {id width pos} $items { incr pos $options(-scrollstep) if {($pos + $messagelength) < 0} { set pos [winfo width $self] set flag 1 } else { set flag 0 } $self coords $id $pos 2 lset items [expr {$idx + 2}] $pos incr idx 3 } set insertpos [expr {$pos + $width + 20}] if {$flag && [llength $newitems]} { # We have just wrapped around the last item, so it is safe to # append new items now: foreach {item width} $newitems { lappend items $item $width $insertpos incr insertpos $width incr insertpos 20 incr messagelength $width incr messagelength 20 } set newitems [list] } lappend event [after $options(-scrollinterval) [list $self Scroll]] } method stop {} { foreach id $event { after cancel $id } set event [list] } method resume {} { lappend event [after $options(-scrollinterval) [list $self Scroll]] } delegate method * to hull delegate option * to hull destructor { # Nothing } } The basic usage is: ticker .t set id [.t add ] .t add .... . . .t remove $id .t remove all You can specify the amount of pixels each item should move per cycle (-scrollstep), the time interval between each cycle (-scrollinterval, in milliseconds), and the font to use for drawing the messages (-font). The widget is a wrapper round a canvas so you can also use all the canvas configuration options and commands. The ids returned from the ".t add" method are real canvas ids, so you can bind to them etc (note that the widget already defines some bindings on the ids). A little demo (fetches news articles from USENET and displays them in the ticker): '''Screenshots''' [http://tallniel.port5.com/images/news.gif] [http://tallniel.port5.com/images/news_msg.gif] '''Code''' #!/bin/sh # Next line restarts with wish \ exec wish "$0" ${1+"$@"} # Alter these settings for your setup set Server news.ntlworld.com ;# NNTP server set Port 119 ;# NNTP port set Groups [list comp.lang.tcl] ;# list of groups to check set NumArticles 30 ;# Articles per group to get set Interval 45 ;# Refresh interval (mins) lappend auto_path . package require nntp package require ticker # Parse the NNTP message headers into an array proc parse {header} { array set ret {} foreach line $header { if {[regexp {(.*?): (.*)$} $line -> name value]} { set ret([string trim [string tolower $name]]) $value } } array get ret } # Fetch the most recent articles from the group proc get {news group} { global NumArticles $news group $group array set articles {} foreach article [$news listgroup] { array unset fields array set fields [parse [$news head $article]] set date $fields(date) regsub {[\+]\d\d\d\d} $date {} date if {[catch {clock scan $date} date]} { puts "Skip $date"; continue } while {[info exists articles($date)]} { incr date } set articles($date) $article } set ids [lrange [lsort -decreasing [array names articles]] 0 \ [expr {$NumArticles - 1}]] set ret [list] foreach id $ids { lappend ret $articles($id) } return $ret } # Fetch the news proc getnews {} { global Server Port Groups Interval if {[catch {nntp::nntp $Server $Port} news] == 1} { return } set cur [. cget -cursor] . configure -cursor watch .t configure -cursor watch .t remove all set pid [.t create text 2 2 -text "Please wait..." -fill white \ -font {Helvetica 12 bold} -anchor nw] update idletasks foreach group $Groups { set ids [get $news $group] foreach id $ids { array set fields [parse [$news head $id]] .t add "$fields(subject) ($fields(from))" \ [list show [array get fields] [join [$news body $id] \n]] .t add "***" dummy } } .t delete $pid # Make sure it is running correctly: .t stop .t resume # Cleanup nntp connection $news quit after [expr {$Interval * 60000}] getnews . configure -cursor $cur .t configure -cursor $cur } # Clicking on the *** separator does nothing proc dummy {args} {} # Clicking on a message pops up a nice box to view it in set topid 0 proc show {head msg id} { array set fields $head set t [toplevel .msg[incr ::topid]] wm title $t $fields(subject) wm geom $t +50+50 frame $t.header -borderwidth 2 -bg black label $t.header.subject \ -font {Helvetica 9 bold} \ -fg white -bg navy -anchor w \ -width 100 -borderwidth 2 \ -text $fields(subject) pack $t.header.subject -fill x -expand 1 foreach {name title value} [subst { from From [list $fields(from)] group Groups [list $fields(newsgroups)] date Date [list $fields(date)] }] { set f [frame $t.header.$name] label $f.l -font {Helvetica 9 bold} \ -fg black -bg #cccccc -anchor w -width 10 \ -text ${title}: label $f.v -font {Helvetica 9} \ -fg navy -bg #cccccc -anchor w -width 90 \ -text $value pack $f.l -side left pack $f.v -side left -fill x -expand 1 pack $f -fill x -expand 1 } pack $t.header -fill x -side top -anchor n -padx 5 -pady 5 frame $t.b text $t.b.body -font {Helvetica 10} -yscrollcommand [list $t.b.vsb set] scrollbar $t.b.vsb -orient vertical -command [list $t.b.body yview] $t.b.body insert end $msg $t.b.body configure -state disabled pack $t.b.vsb -side right -fill y -anchor e pack $t.b.body -side left -fill both -expand 1 pack $t.b -side bottom -fill both -expand 1 } proc move {t dir} { if {$dir eq "left"} { $t configure -scrollstep -20 } else { $t configure -scrollstep 20 } after 500 [list $t configure -scrollstep -2] } proc config {} { tk_messageBox -icon info -title "Tk News Ticker (c) 2003 Neil Madden" \ -message "Tk News Ticker V1.0\nBy Neil Madden.\nThis code is public domain." } wm withdraw . # Create the ticker ticker .t -bg navy -relief sunken # Make the ticker look nice . configure -relief raised -borderwidth 4 pack [button .left -text "<" -font {Helvetica 12 bold} \ -command {move .t left} -padx 0 -pady 0] \ -side left -expand 0 -padx 0 -pady 0 pack [button .close -text "X" -font {Helvetica 12 bold} \ -command {destroy .} -padx 0 -pady 0] \ -side right -expand 0 -padx 0 -pady 0 pack [button .config -text "?" -font {Helvetica 12 bold} \ -command {config} -padx 0 -pady 0] \ -side right -expand 0 -padx 0 -pady 0 pack [button .right -text ">" -font {Helvetica 12 bold} \ -command {move .t right} -padx 0 -pady 0] \ -side right -expand 0 -padx 0 -pady 0 pack .t -fill x -expand 1 # Show the window wm overrideredirect . 1 # Place it across the top of the screen wm geometry . [winfo screenwidth .]x30+0+0 update idletasks wm deiconify . update # Get the news getnews That's all folks! Could do with a bit more polish, but it's useable. ---- [Category Widget]