URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [expect/] [example/] [tknewsbiff] - Blame information for rev 1778

Go to most recent revision | Details | Compare with Previous | View Log


#!../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] &&
 
        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
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [expect/] [example/] [tknewsbiff] - Blame information for rev 1778

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