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