1#!/bin/sh 2# -*- tcl -*- 3# The next line is executed by /bin/sh, but not tcl \ 4exec tclsh "$0" ${1+"$@"} 5 6package require Expect 7package require Tk 8 9# Name: tknewsbiff 10# Author: Don Libes 11# Version: 1.2b 12# Written: January 1, 1994 13 14# Description: When unread news appears in your favorite groups, pop up 15# a little window describing which newsgroups and how many articles. 16# Go away when articles are no longer unread. 17# Optionally, run a UNIX program (to play a sound, read news, etc.) 18 19# Default config file in ~/.tknewsbiff[-host] 20 21# These two procedures are needed because Tk provides no command to undo 22# the "wm unmap" command. You must remember whether it was iconic or not. 23# PUBLIC 24proc unmapwindow {} { 25 global _window_open 26 27 switch [wm state .] \ 28 iconic { 29 set _window_open 0 30 } normal { 31 set _window_open 1 32 } 33 wm withdraw . 34} 35unmapwindow 36# window state starts out as "iconic" before it is mapped, Tk bug? 37# make sure that when we map it, it will be open (i.e., "normal") 38set _window_open 1 39 40# PUBLIC 41proc mapwindow {} { 42 global _window_open 43 44 if {$_window_open} { 45 wm deiconify . 46 } else { 47 wm iconify . 48 } 49} 50 51proc _abort {msg} { 52 global argv0 53 54 puts "$argv0: $msg" 55 exit 1 56} 57 58if {[info exists env(DOTDIR)]} { 59 set home $env(DOTDIR) 60} else { 61 set home [glob ~] 62} 63 64set delay 60 65set width 27 66set height 10 67set _default_config_file $home/.tknewsbiff 68set _config_file $_default_config_file 69set _default_server news 70set server $_default_server 71set server_timeout 60 72 73log_user 0 74 75listbox .list -yscroll ".scrollbar set" -font "*-m-*" -setgrid 1 76scrollbar .scrollbar -command ".list yview" -relief raised 77.list config -highlightthickness 0 -border 0 78.scrollbar config -highlightthickness 0 79pack .scrollbar -side left -fill y 80pack .list -side left -fill both -expand 1 81 82while {[llength $argv]>0} { 83 set arg [lindex $argv 0] 84 85 if {[file readable $arg]} { 86 if {0==[string compare active [file tail $arg]]} { 87 set active_file $arg 88 set argv [lrange $argv 1 end] 89 } else { 90 # must be a config file 91 set _config_file $arg 92 set argv [lrange $argv 1 end] 93 } 94 } elseif {[file readable $_config_file-$arg]} { 95 # maybe it's a hostname suffix for a newsrc file? 96 set _config_file $_default_config_file-$arg 97 set argv [lrange $argv 1 end] 98 } else { 99 # maybe it's just a hostname for regular newsrc file? 100 set server $arg 101 set argv [lrange $argv 1 end] 102 } 103} 104 105proc _read_config_file {} { 106 global _config_file argv0 watch_list ignore_list 107 108 # remove previous user-provided proc in case user simply 109 # deleted it from config file 110 proc user {} {} 111 112 set watch_list {} 113 set ignore_list {} 114 115 if {[file exists $_config_file]} { 116 # uplevel allows user to set global variables 117 if {[catch {uplevel source $_config_file} msg]} { 118 _abort "error reading $_config_file\n$msg" 119 } 120 } 121 122 if {[llength $watch_list]==0} { 123 watch * 124 } 125} 126 127# PUBLIC 128proc watch {args} { 129 global watch_list 130 131 lappend watch_list $args 132} 133 134# PUBLIC 135proc ignore {ng} { 136 global ignore_list 137 138 lappend ignore_list $ng 139} 140 141# get time and server 142_read_config_file 143 144# if user didn't set newsrc, try ~/.newsrc-server convention. 145# if that fails, fall back to just plain ~/.newsrc 146if {![info exists newsrc]} { 147 set newsrc $home/.newsrc-$server 148 if {![file readable $newsrc]} { 149 set newsrc $home/.newsrc 150 if {![file readable $newsrc]} { 151 _abort "cannot tell what newgroups you read 152found neither $home/.newsrc-$server nor $home/.newsrc" 153 } 154 } 155} 156 157# PRIVATE 158proc _read_newsrc {} { 159 global db newsrc 160 161 if {[catch {set file [open $newsrc]} msg]} { 162 _abort $msg 163 } 164 while {-1 != [gets $file buf]} { 165 if {[regexp "!" $buf]} continue 166 if {[regexp "(\[^:]*):.*\[-, ](\[0-9]+)" $buf dummy ng seen]} { 167 set db($ng,seen) $seen 168 } 169 # only way 2nd regexp can fail is on lines 170 # that have a : but no number 171 } 172 close $file 173} 174 175proc _unknown_host {} { 176 global server _default_server 177 178 if {0==[string compare $_default_server $server]} { 179 puts "tknewsbiff: default server <$server> is not known" 180 } else { 181 puts "tknewsbiff: server <$server> is not known" 182 } 183 184 puts "Give tknewsbiff an argument - either the name of your news server 185or active file. I.e., 186 187 tknewsbiff news.nist.gov 188 tknewsbiff /usr/news/lib/active 189 190If you have a correctly defined configuration file (.tknewsbiff), 191an argument is not required. See the man page for more info." 192 exit 1 193} 194 195# read active file 196# PRIVATE 197proc _read_active {} { 198 global db server active_list active_file 199 upvar #0 server_timeout timeout 200 201 set active_list {} 202 203 if {[info exists active_file]} { 204 spawn -open [open $active_file] 205 } else { 206 spawn telnet $server nntp 207 expect { 208 "20*\n" { 209 # should get 200 or 201 210 } "NNTP server*\n" { 211 puts "tknewsbiff: unexpected response from server:" 212 puts "$expect_out(buffer)" 213 return 1 214 } "unknown host" { 215 _unknown_host 216 } timeout { 217 close 218 wait 219 return 1 220 } eof { 221 # loadav too high probably 222 wait 223 return 1 224 } 225 } 226 exp_send "list\r" 227 expect "list\r\n" ;# ignore echo of "list" command 228 expect -re "215\[^\n]*\n" ;# skip "Newsgroups in form" line 229 } 230 231 expect { 232 -re "(\[^ ]*) 0*(\[^ ]+) \[^\n]*\n" { 233 set ng $expect_out(1,string) 234 set hi $expect_out(2,string) 235 lappend active_list $ng 236 set db($ng,hi) $hi 237 exp_continue 238 } 239 ".\r\n" close 240 ".\r\r\n" close 241 timeout close 242 eof 243 } 244 245 wait 246 return 0 247} 248 249# test in various ways for good newsgroups 250# return 1 if good, 0 if not good 251# PRIVATE 252proc _isgood {ng threshold} { 253 global db seen_list ignore_list 254 255 # skip if we don't subscribe to it 256 if {![info exists db($ng,seen)]} {return 0} 257 258 # skip if the threshold isn't exceeded 259 if {$db($ng,hi) - $db($ng,seen) < $threshold} {return 0} 260 261 # skip if it matches an ignore command 262 foreach igpat $ignore_list { 263 if {[string match $igpat $ng]} {return 0} 264 } 265 266 # skip if we've seen it before 267 if {[lsearch -exact $seen_list $ng]!=-1} {return 0} 268 269 # passed all tests, so remember that we've seen it 270 lappend seen_list $ng 271 return 1 272} 273 274# return 1 if not seen on previous turn 275# PRIVATE 276proc _isnew {ng} { 277 global previous_seen_list 278 279 if {[lsearch -exact $previous_seen_list $ng]==-1} { 280 return 1 281 } else { 282 return 0 283 } 284} 285 286# schedule display of newsgroup in global variable "newsgroup" 287# PUBLIC 288proc display {} { 289 global display_list newsgroup 290 291 lappend display_list $newsgroup 292} 293 294# PRIVATE 295proc _update_ngs {} { 296 global watch_list active_list newsgroup 297 298 foreach watch $watch_list { 299 set threshold 1 300 set display display 301 set new {} 302 303 set ngpat [lindex $watch 0] 304 set watch [lrange $watch 1 end] 305 306 while {[llength $watch] > 0} { 307 switch -- [lindex $watch 0] \ 308 -threshold { 309 set threshold [lindex $watch 1] 310 set watch [lrange $watch 2 end] 311 } -display { 312 set display [lindex $watch 1] 313 set watch [lrange $watch 2 end] 314 } -new { 315 set new [lindex $watch 1] 316 set watch [lrange $watch 2 end] 317 } default { 318 _abort "watch: expecting -threshold -display or -new but found: [lindex $watch 0]" 319 } 320 } 321 322 foreach ng $active_list { 323 if {[string match $ngpat $ng]} { 324 if {[_isgood $ng $threshold]} { 325 if {[llength $display]} { 326 set newsgroup $ng 327 uplevel $display 328 } 329 if {[_isnew $ng]} { 330 if {[llength $new]} { 331 set newsgroup $ng 332 uplevel $new 333 } 334 } 335 } 336 } 337 } 338 } 339} 340 341# initialize display 342 343set min_reasonable_width 8 344 345wm minsize . $min_reasonable_width 1 346wm maxsize . 999 999 347if {0 == [info exists active_file] && 348 0 != [string compare $server $_default_server]} { 349 wm title . "news@$server" 350 wm iconname . "news@$server" 351} 352 353# PRIVATE 354proc _update_window {} { 355 global server display_list height width min_reasonable_width 356 357 if {0 == [llength $display_list]} { 358 unmapwindow 359 return 360 } 361 362 # make height correspond to length of display_list or 363 # user's requested max height, whichever is smaller 364 365 if {[llength $display_list] < $height} { 366 set current_height [llength $display_list] 367 } else { 368 set current_height $height 369 } 370 371 # force reasonable min width 372 if {$width < $min_reasonable_width} { 373 set width $min_reasonable_width 374 } 375 376 wm geometry . ${width}x$current_height 377 wm maxsize . 999 [llength $display_list] 378 379 _display_ngs $width 380 381 if {[string compare [wm state .] withdrawn]==0} { 382 mapwindow 383 } 384} 385 386# actually write all newsgroups to the window 387# PRIVATE 388proc _display_ngs {width} { 389 global db display_list 390 391 set str_width [expr $width-7] 392 393 .list delete 0 end 394 foreach ng $display_list { 395 .list insert end [format \ 396 "%-$str_width.${str_width}s %5d" $ng \ 397 [expr $db($ng,hi) - $db($ng,seen)]] 398 } 399} 400 401# PUBLIC 402proc help {} { 403 catch {destroy .help} 404 toplevel .help 405 message .help.text -aspect 400 -text \ 406{tknewsbiff - written by Don Libes, NIST, 1/1/94 407 408tknewsbiff displays newsgroups with unread articles based on your .newsrc\ 409and your .tknewsbiff files.\ 410If no articles are unread, no window is displayed. 411 412Click mouse button 1 for this help,\ 413button 2 to force display to query news server immediately,\ 414and button 3 to remove window from screen until the next update. 415 416Example .tknewsbiff file:} 417 message .help.sample -font "*-r-normal-*-m-*" \ 418 -relief raised -aspect 10000 -text \ 419{set width 30 ;# max width, defaults to 27 420set height 17 ;# max height, defaults to 10 421set delay 120 ;# in seconds, defaults to 60 422set server news.nist.gov ;# defaults to "news" 423set server_timeout 60 ;# in seconds, defaults to 60 424set newsrc ~/.newsrc ;# defaults to ~/.newsrc 425 ;# after trying ~/.newsrc-$server 426# Groups to watch. 427watch comp.lang.tcl 428watch dc.dining -new "play yumyum" 429watch nist.security -new "exec red-alert" 430watch nist.* 431watch dc.general -threshold 5 432watch *.sources.* -threshold 20 433watch alt.howard-stern -threshold 100 -new "play robin" 434 435# Groups to ignore (but which match patterns above). 436# Note: newsgroups that you don't read are ignored automatically. 437ignore *.d 438ignore nist.security 439ignore nist.sport 440 441# Change background color of newsgroup list 442.list config -bg honeydew1 443 444# Play a sound file 445proc play {sound} { 446 exec play /usr/local/lib/sounds/$sound.au 447}} 448 message .help.end -aspect 10000 -text \ 449"Other customizations are possible. See man page for more information." 450 451 button .help.ok -text "ok" -command {destroy .help} 452 pack .help.text 453 pack .help.sample 454 pack .help.end -anchor w 455 pack .help.ok -fill x -padx 2 -pady 2 456} 457 458spawn cat -u; set _cat_spawn_id $spawn_id 459set _update_flag 0 460 461# PUBLIC 462proc update-now {} { 463 global _update_flag _cat_spawn_id 464 465 if {$_update_flag} return ;# already set, do nothing 466 set _update_flag 1 467 468 exp_send -i $_cat_spawn_id "\r" 469} 470 471bind .list <1> help 472bind .list <2> update-now 473bind .list <3> unmapwindow 474bind .list <Configure> { 475 scan [wm geometry .] "%%dx%%d" w h 476 _display_ngs $w 477} 478 479# PRIVATE 480proc _sleep {timeout} { 481 global _cat_spawn_id _update_flag 482 483 set _update_flag 0 484 485 # restore to idle cursor 486 .list config -cursor ""; update 487 488 # sleep for a little while, subject to click from "update" button 489 expect -i $_cat_spawn_id -re "...." ;# two crlfs 490 491 # change to busy cursor 492 .list config -cursor watch; update 493} 494 495set previous_seen_list {} 496set seen_list {} 497 498# PRIVATE 499proc _init_ngs {} { 500 global display_list db 501 global seen_list previous_seen_list 502 503 set previous_seen_list $seen_list 504 505 set display_list {} 506 set seen_list {} 507 508 catch {unset db} 509} 510 511for {} {1} {_sleep $delay} { 512 _init_ngs 513 514 _read_newsrc 515 if {[_read_active]} continue 516 _read_config_file 517 518 _update_ngs 519 user 520 _update_window 521} 522