Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / sam-t2 / devtools / v9 / bin / tknewsbiff
CommitLineData
920dae64
AT
1#!/bin/sh
2# \
3exec 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
20proc 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}
31unmapwindow
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")
34set _window_open 1
35
36# PUBLIC
37proc mapwindow {} {
38 global _window_open
39
40 if {$_window_open} {
41 wm deiconify .
42 } else {
43 wm iconify .
44 }
45}
46
47proc _abort {msg} {
48 global argv0
49
50 puts "$argv0: $msg"
51 exit 1
52}
53
54if {[info exists env(DOTDIR)]} {
55 set home $env(DOTDIR)
56} else {
57 set home [glob ~]
58}
59
60set delay 60
61set width 27
62set height 10
63set _default_config_file $home/.tknewsbiff
64set _config_file $_default_config_file
65set _default_server news
66set server $_default_server
67set server_timeout 60
68
69log_user 0
70
71listbox .list -yscroll ".scrollbar set" -font "*-m-*" -setgrid 1
72scrollbar .scrollbar -command ".list yview" -relief raised
73.list config -highlightthickness 0 -border 0
74.scrollbar config -highlightthickness 0
75pack .scrollbar -side left -fill y
76pack .list -side left -fill both -expand 1
77
78while {[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
101proc _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
124proc watch {args} {
125 global watch_list
126
127 lappend watch_list $args
128}
129
130# PUBLIC
131proc 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
142if {![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
148found neither $home/.newsrc-$server nor $home/.newsrc"
149 }
150 }
151}
152
153# PRIVATE
154proc _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
171proc _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
181or active file. I.e.,
182
183 tknewsbiff news.nist.gov
184 tknewsbiff /usr/news/lib/active
185
186If you have a correctly defined configuration file (.tknewsbiff),
187an argument is not required. See the man page for more info."
188 exit 1
189}
190
191# read active file
192# PRIVATE
193proc _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
248proc _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
272proc _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
284proc display {} {
285 global display_list newsgroup
286
287 lappend display_list $newsgroup
288}
289
290# PRIVATE
291proc _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
339set min_reasonable_width 8
340
341wm minsize . $min_reasonable_width 1
342wm maxsize . 999 999
343if {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
350proc _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
384proc _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
398proc 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
404tknewsbiff displays newsgroups with unread articles based on your .newsrc\
405and your .tknewsbiff files.\
406If no articles are unread, no window is displayed.
407
408Click mouse button 1 for this help,\
409button 2 to force display to query news server immediately,\
410and button 3 to remove window from screen until the next update.
411
412Example .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
416set height 17 ;# max height, defaults to 10
417set delay 120 ;# in seconds, defaults to 60
418set server news.nist.gov ;# defaults to "news"
419set server_timeout 60 ;# in seconds, defaults to 60
420set newsrc ~/.newsrc ;# defaults to ~/.newsrc
421 ;# after trying ~/.newsrc-$server
422# Groups to watch.
423watch comp.lang.tcl
424watch dc.dining -new "play yumyum"
425watch nist.security -new "exec red-alert"
426watch nist.*
427watch dc.general -threshold 5
428watch *.sources.* -threshold 20
429watch 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.
433ignore *.d
434ignore nist.security
435ignore nist.sport
436
437# Change background color of newsgroup list
438.list config -bg honeydew1
439
440# Play a sound file
441proc 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
454spawn cat -u; set _cat_spawn_id $spawn_id
455set _update_flag 0
456
457# PUBLIC
458proc 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
467bind .list <1> help
468bind .list <2> update-now
469bind .list <3> unmapwindow
470bind .list <Configure> {
471 scan [wm geometry .] "%%dx%%d" w h
472 _display_ngs $w
473}
474
475# PRIVATE
476proc _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
491set previous_seen_list {}
492set seen_list {}
493
494# PRIVATE
495proc _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
507for {} {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}