#!../expectk -f # Name: tknewsbiff # Author: Don Libes # Version: 1.2b # Written: January 1, 1994 # Description: When unread news appears in your favorite groups, pop up # a little window describing which newsgroups and how many articles. # Go away when articles are no longer unread. # Optionally, run a UNIX program (to play a sound, read news, etc.) # Default config file in ~/.tknewsbiff[-host] # These two procedures are needed because Tk provides no command to undo # the "wm unmap" command. You must remember whether it was iconic or not. # PUBLIC proc unmapwindow {} { global _window_open switch [wm state .] \ iconic { set _window_open 0 } normal { set _window_open 1 } wm withdraw . } unmapwindow # window state starts out as "iconic" before it is mapped, Tk bug? # make sure that when we map it, it will be open (i.e., "normal") set _window_open 1 # PUBLIC proc mapwindow {} { global _window_open if $_window_open { wm deiconify . } else { wm iconify . } } proc _abort {msg} { global argv0 puts "$argv0: $msg" exit 1 } if [info exists env(DOTDIR)] { set home $env(DOTDIR) } else { set home [glob ~] } set delay 60 set width 27 set height 10 set _default_config_file $home/.tknewsbiff set _config_file $_default_config_file set _default_server news set server $_default_server set server_timeout 60 log_user 0 listbox .list -yscroll ".scrollbar set" -font "*-m-*" -setgrid 1 scrollbar .scrollbar -command ".list yview" -relief raised .list config -highlightthickness 0 -border 0 .scrollbar config -highlightthickness 0 pack .scrollbar -side left -fill y pack .list -side left -fill both -expand 1 while {[llength $argv]>0} { set arg [lindex $argv 0] if [file readable $arg] { if 0==[string compare active [file tail $arg]] { set active_file $arg set argv [lrange $argv 1 end] } else { # must be a config file set _config_file $arg set argv [lrange $argv 1 end] } } elseif {[file readable $_config_file-$arg]} { # maybe it's a hostname suffix for a newsrc file? set _config_file $_default_config_file-$arg set argv [lrange $argv 1 end] } else { # maybe it's just a hostname for regular newsrc file? set server $arg set argv [lrange $argv 1 end] } } proc _read_config_file {} { global _config_file argv0 watch_list ignore_list # remove previous user-provided proc in case user simply # deleted it from config file proc user {} {} set watch_list {} set ignore_list {} if [file exists $_config_file] { # uplevel allows user to set global variables if [catch {uplevel source $_config_file} msg] { _abort "error reading $_config_file\n$msg" } } if [llength $watch_list]==0 { watch * } } # PUBLIC proc watch {args} { global watch_list lappend watch_list $args } # PUBLIC proc ignore {ng} { global ignore_list lappend ignore_list $ng } # get time and server _read_config_file # if user didn't set newsrc, try ~/.newsrc-server convention. # if that fails, fall back to just plain ~/.newsrc if ![info exists newsrc] { set newsrc $home/.newsrc-$server if ![file readable $newsrc] { set newsrc $home/.newsrc if ![file readable $newsrc] { _abort "cannot tell what newgroups you read found neither $home/.newsrc-$server nor $home/.newsrc" } } } # PRIVATE proc _read_newsrc {} { global db newsrc if [catch {set file [open $newsrc]} msg] { _abort $msg } while {-1 != [gets $file buf]} { if [regexp "!" $buf] continue if [regexp "(\[^:]*):.*\[-, ](\[0-9]+)" $buf dummy ng seen] { set db($ng,seen) $seen } # only way 2nd regexp can fail is on lines # that have a : but no number } close $file } proc _unknown_host {} { global server _default_server if 0==[string compare $_default_server $server] { puts "tknewsbiff: default server <$server> is not known" } else { puts "tknewsbiff: server <$server> is not known" } puts "Give tknewsbiff an argument - either the name of your news server or active file. I.e., tknewsbiff news.nist.gov tknewsbiff /usr/news/lib/active If you have a correctly defined configuration file (.tknewsbiff), an argument is not required. See the man page for more info." exit 1 } # read active file # PRIVATE proc _read_active {} { global db server active_list active_file upvar #0 server_timeout timeout set active_list {} if [info exists active_file] { spawn -open [open $active_file] } else { spawn telnet $server nntp expect { "20*\n" { # should get 200 or 201 } "NNTP server*\n" { puts "tknewsbiff: unexpected response from server:" puts "$expect_out(buffer)" return 1 } "unknown host" { _unknown_host } timeout { close wait return 1 } eof { # loadav too high probably wait return 1 } } exp_send "list\r" expect "list\r\n" ;# ignore echo of "list" command expect -re "215\[^\n]*\n" ;# skip "Newsgroups in form" line } expect { -re "(\[^ ]*) 0*(\[^ ]+) \[^\n]*\n" { set ng $expect_out(1,string) set hi $expect_out(2,string) lappend active_list $ng set db($ng,hi) $hi exp_continue } ".\r\n" close ".\r\r\n" close timeout close eof } wait return 0 } # test in various ways for good newsgroups # return 1 if good, 0 if not good # PRIVATE proc _isgood {ng threshold} { global db seen_list ignore_list # skip if we don't subscribe to it if ![info exists db($ng,seen)] {return 0} # skip if the threshold isn't exceeded if {$db($ng,hi) - $db($ng,seen) < $threshold} {return 0} # skip if it matches an ignore command foreach igpat $ignore_list { if [string match $igpat $ng] {return 0} } # skip if we've seen it before if [lsearch -exact $seen_list $ng]!=-1 {return 0} # passed all tests, so remember that we've seen it lappend seen_list $ng return 1 } # return 1 if not seen on previous turn # PRIVATE proc _isnew {ng} { global previous_seen_list if [lsearch -exact $previous_seen_list $ng]==-1 { return 1 } else { return 0 } } # schedule display of newsgroup in global variable "newsgroup" # PUBLIC proc display {} { global display_list newsgroup lappend display_list $newsgroup } # PRIVATE proc _update_ngs {} { global watch_list active_list newsgroup foreach watch $watch_list { set threshold 1 set display display set new {} set ngpat [lindex $watch 0] set watch [lrange $watch 1 end] while {[llength $watch] > 0} { switch -- [lindex $watch 0] \ -threshold { set threshold [lindex $watch 1] set watch [lrange $watch 2 end] } -display { set display [lindex $watch 1] set watch [lrange $watch 2 end] } -new { set new [lindex $watch 1] set watch [lrange $watch 2 end] } default { _abort "watch: expecting -threshold -display or -new but found: [lindex $watch 0]" } } foreach ng $active_list { if [string match $ngpat $ng] { if [_isgood $ng $threshold] { if [llength $display] { set newsgroup $ng uplevel $display } if [_isnew $ng] { if [llength $new] { set newsgroup $ng uplevel $new } } } } } } } # initialize display set min_reasonable_width 8 wm minsize . $min_reasonable_width 1 wm maxsize . 999 999 if {0 == [info exists active_file] && 0 != [string compare $server $_default_server]} { wm title . "news@$server" wm iconname . "news@$server" } # PRIVATE proc _update_window {} { global server display_list height width min_reasonable_width if {0 == [llength $display_list]} { unmapwindow return } # make height correspond to length of display_list or # user's requested max height, whichever is smaller if {[llength $display_list] < $height} { set current_height [llength $display_list] } else { set current_height $height } # force reasonable min width if {$width < $min_reasonable_width} { set width $min_reasonable_width } wm geometry . ${width}x$current_height wm maxsize . 999 [llength $display_list] _display_ngs $width if [string compare [wm state .] withdrawn]==0 { mapwindow } } # actually write all newsgroups to the window # PRIVATE proc _display_ngs {width} { global db display_list set str_width [expr $width-7] .list delete 0 end foreach ng $display_list { .list insert end [format \ "%-$str_width.${str_width}s %5d" $ng \ [expr $db($ng,hi) - $db($ng,seen)]] } } # PUBLIC proc help {} { catch {destroy .help} toplevel .help message .help.text -aspect 400 -text \ {tknewsbiff - written by Don Libes, NIST, 1/1/94 tknewsbiff displays newsgroups with unread articles based on your .newsrc\ and your .tknewsbiff files.\ If no articles are unread, no window is displayed. Click mouse button 1 for this help,\ button 2 to force display to query news server immediately,\ and button 3 to remove window from screen until the next update. Example .tknewsbiff file:} message .help.sample -font "*-r-normal-*-m-*" \ -relief raised -aspect 10000 -text \ {set width 30 ;# max width, defaults to 27 set height 17 ;# max height, defaults to 10 set delay 120 ;# in seconds, defaults to 60 set server news.nist.gov ;# defaults to "news" set server_timeout 60 ;# in seconds, defaults to 60 set newsrc ~/.newsrc ;# defaults to ~/.newsrc ;# after trying ~/.newsrc-$server # Groups to watch. watch comp.lang.tcl watch dc.dining -new "play yumyum" watch nist.security -new "exec red-alert" watch nist.* watch dc.general -threshold 5 watch *.sources.* -threshold 20 watch alt.howard-stern -threshold 100 -new "play robin" # Groups to ignore (but which match patterns above). # Note: newsgroups that you don't read are ignored automatically. ignore *.d ignore nist.security ignore nist.sport # Change background color of newsgroup list .list config -bg honeydew1 # Play a sound file proc play {sound} { exec play /usr/local/lib/sounds/$sound.au }} message .help.end -aspect 10000 -text \ "Other customizations are possible. See man page for more information." button .help.ok -text "ok" -command {destroy .help} pack .help.text pack .help.sample pack .help.end -anchor w pack .help.ok -fill x -padx 2 -pady 2 } spawn cat -u; set _cat_spawn_id $spawn_id set _update_flag 0 # PUBLIC proc update-now {} { global _update_flag _cat_spawn_id if $_update_flag return ;# already set, do nothing set _update_flag 1 exp_send -i $_cat_spawn_id "\r" } bind .list <1> help bind .list <2> update-now bind .list <3> unmapwindow bind .list { scan [wm geometry .] "%%dx%%d" w h _display_ngs $w } # PRIVATE proc _sleep {timeout} { global _cat_spawn_id _update_flag set _update_flag 0 # restore to idle cursor .list config -cursor ""; update # sleep for a little while, subject to click from "update" button expect -i $_cat_spawn_id -re "...." ;# two crlfs # change to busy cursor .list config -cursor watch; update } set previous_seen_list {} set seen_list {} # PRIVATE proc _init_ngs {} { global display_list db global seen_list previous_seen_list set previous_seen_list $seen_list set display_list {} set seen_list {} catch {unset db} } for {} 1 {_sleep $delay} { _init_ngs _read_newsrc if [_read_active] continue _read_config_file _update_ngs user _update_window }