'''Another [NNTP] Reader''', by [PYK], initially based on [A little NNTP
reader], is a smallish NNTP reader that uses [tcllib]'s nntp module behind the
scenes.  I have some hope that its interface will prove usable under
[AndroWish] on small devices, but haven't tried it on that platform.  In the
next few days I plan to add the ability to post messages.
I'll be interested to hear if it works under [AndroWish], and what
interface changes would be needed to make it more usable.  I'm actively
soliciting constructive opinions on all aspects of the code below,
"constructive" being interpreted very loosely, so please let fly with the
comments and suggestions!

This program is configured by default to open [comp.lang.tcl]



** Features **

   * filesystem-backed

   * navigate threads (forward in thread, back in thread, first in thread, last in thread, previous thread, next thread)


** Changes **

   2014-05-06:   Closing in on ability to post messages.  Better behaviour all around.

   2014-05-03:   [PYK]: message navigation 

   2014-05-01:   [PYK]: first draft published



** Code **

======
#! /bin/env tclsh

foreach package {Tk mime nntp} {
    package require $package
}

namespace import ::tcl::mathfunc::*
namespace import ::tcl::mathop::*
namespace export *

proc activatev {listbox val} {
    set i 0
    foreach item [$listbox get 0 end] {
        if {$item eq $val} {
            $listbox activate $i
            return
        }
    }
    error [list {not found} $item]
}

proc cleansubject subject {
    regsub -nocase {^[[:space:]]*re:[[:space:]]*} $subject {}
}

proc comparesubject {newheaders subject} {
    set newsubject [cleansubject [dict get $newheaders Subject]]
    expr {[string first $subject $newsubject] >= 0 || [
        string first $newsubject $subject] >= 0}
}

proc comparereference {newheaders related} {
    if {[dict exists $newheaders References]} {
        set newreferences [split [dict get $newheaders References]]
    }
    lappend newreferences [dict get $newheaders Message-ID] 
    foreach reference $newreferences {
        if {$reference in $related} {return 1}
    }
    return 0
}

proc headfields headers {
    foreach header $headers {
        set val [string trim [join [lassign [split $header :] key] :]]
        lappend res $key $val
    }
    return $res
}

proc main argv {
    variable defaults
    if {[llength $argv]} {
        lappend cmdargs path [lindex $argv 0]
    }
    lappend cmdargs w [set frame [frame .[info cmdcount]]]
    pack $frame -fill both -expand 1
    set reader [reader]
    set ${reader}::defaults defaults
    $reader init $defaults {*}$cmdargs
    $reader ui
    $reader go
}

proc pforget w {foreach window [winfo children $w] {pack forget $window}}

proc labelentry {parent labeltext textvar bindings} {
    label $parent.label -text $labeltext
    entry $parent.entry -textvariable $textvar
    foreach {event action} $bindings {
        bind $parent.entry $event $action
    }
}

proc labelfocusconfig path {
    bind $path <FocusIn> [list $path configure -fg blue]
    bind $path <FocusOut> [list $path configure -fg [
        lindex [$path configure -fg] 3]]
}


proc labelitem {path text command} {
    label $path -takefocus 1 -text $text 
    labelfocusconfig $path 
    bind $path <Double-Button-1> $command 
    bind $path <Return> $command 
    bind $path <Down> [list event generate $path <Tab>]
    bind $path <Up> [list event generate $path <Shift-Tab>]
}

proc listboxentry {path entrytextvar entrybinding} {
    listbox [frame $path.listf].l
    scrolled $path.listf.l y
    entry $path.entry -textvar $entrytextvar
    foreach sequence {<Double-Button-1> <Return>} {
        bind $path.entry $sequence [namespace code $entrybinding]
    }
}

proc packlistbox path {
    pack $path -fill both -expand 1
    pack $path.y -fill y -side right
    pack $path.l -fill both -expand 1
    $path.l selection clear 0 end
    focus $path.l
    selection own $path.l
    $path.l selection set active
}

proc packlistboxentry path {
    pack $path -fill both -expand 1
    packlistbox $path.listf
    pack $path.entry -fill x
    if {[$path.listf.l index end] == 0} {
        focus $path.entry
        selection own $path.entry
    }
}

proc reader args {
    if {[llength $args]} {
        set args [lassign $args id]
    } else {
        set id [info cmdcount]
    }
    object $id
}

proc scrolled {widget dim} {
    set parent [winfo parent $widget]
    foreach dim1 $dim {
        scrollbar $parent.$dim1 -command [list $widget yview]
        $widget configure -${dim1}scrollc [list $parent.$dim1 set]
    }
    return $widget
}

proc textwrapper w {
    rename $w [set wrapped [info cmdcount]]
    proc $w {arg1 args} [string map [list {{{wrapped}}} [list $wrapped]] {
        if {[string tolower $arg1] eq {|}} {
            return [{{wrapped}} {*}$args]
        }
        switch -exact $arg1 {
            insert - delete - replace {}
            default {
                return [{{wrapped}} $arg1 {*}$args]
            }
        }
    }]
    return $wrapped
}


proc object id {
    if {[string first :: $id] != 0} {
        set id [string trimright [uplevel namespace current] :]::$id
    }
    namespace eval $id {
        namespace ensemble create
        namespace export -clear
        namespace ensemble configure [namespace current] -unknown [
            list apply [list args {
                return [lindex $args 0]::[lindex $args 1]
            } [namespace current]]
        ]
    }
    namespace eval $id [list namespace import [namespace current]::*]
    return $id
}

proc method {name argspec attributes body} {
    set script [string map [list {{{attributes}}} [list $attributes]] {
        set id [namespace qualifiers [lindex [info level 0] 0]]
        foreach varname [set attributes {{attributes}}] {
            upvar 0 ${id}::$varname $varname
        }
    }]
    proc $name $argspec $script$body
}

method body {} {host group body msg msgselection n seencolor w} {
    if {[set msgselection [$w.group.l index active]] ne {}} {
        set msg [lindex [$w.group.l get $msgselection] 0]
        $id ds h $host g $group m $msg seen 1
        $w.group.l itemconfigure $msgselection -foreground $seencolor 
        set body [$n body $msg]
    }
}

method composedone {} {w} {
    $w.compose.text
}

method composesave {} {w} {
    set text [$w.compose.text get 1.0 end]
}

method connect {} {data host lasthost n username password status w} {
    $id ds h $host username $username
    $id ds h $host password $password
    set status Connecting...
    set failed 0
    if {$n eq {} || $lasthost ne $host} {
        if {[llength $host] == 1} {
            lappend host 119
        }
        set n [nntp::nntp {*}$host]
        #issue one command to make sure the server dosn't time out
        if {$username ne {}} {
            if {[catch {$n authinfo $username $password} cres copts]} {
                $n quit
                set n {}
                if {[lindex $cres 1] eq {501}} {
                    set status $cres
                    return
                } else {
                    return -options $copts $cres
                }
            }
        }
        set lasthost $host
        $n date
    }
    set status {}
    $id uido ui_groups
}

method d args data {
    dict get $data {*}$args
}

method d? args data {
    dict exists $data {*}$args
}

method dk args data {
    set dict [dict get $data {*}[lrange $args 0 end-1]]
    dict keys $dict [lindex $args -1]
}

method ds args data {
    dict set data {*}$args
}

method display {} {body fromcolor group host msg replycolor
    subjectcolor w} {
    $w.msgh.t | delete 1.0 end
    foreach {key val} [$id d h $host g $group m $msg h] {
        set color [switch $key {
            Subject {lindex $subjectcolor}
            From {lindex $fromcolor}
            default {lindex {}}
        }]
        $w.msgh.t | insert end $key $color { } {} $val\n
    }
    $w.msgh.t mark set insert 1.0

    $w.msg.t | delete 1.0 end
    foreach line $body {
        $w.msg.t | insert end $line\n [
            if {[string first > [string trim $line]] == 0} {
            lindex $replycolor
        }]
    }
    $w.msg.t mark set insert 1.0
    focus $w.msg.t
}

method groups_entry_update {} {w group} {
    if {[set idx [$w.groups.listf.l curselection]] ne {}} {
        set group [lindex [$w.groups.listf.l get $idx] 0]
        $id uido ui_group 
    }
}

method getgroups {} {n status w} {
    $w.groups.listf.l delete 0 end
    after idle [list $id getgroups2]
}

method getgroups2 {} n {
    $id populategroups [lsort [$n list]]
}

method go {} {data w} {
    $id uido ui_intro
}

method goback {} winstack {
    lassign [lrange $winstack end-1 end] prev current
    set winstack [lrange $winstack[set winstack {}] 0 end-2]
    after idle [namespace code [list $id uido $prev]]
}

method group {} {body busy data firstload group lastgroup host lasthost
    load loaded loadnext msgfirst msglast n num w} {
    if {$num eq {}} {
    } else {
        after cancel $busy
    }
    if {$lastgroup ne $group || $lasthost ne $host} {
        if {$num ne {}} {
            foreach varname {load loadnext num msgfirst msglast} {
                $id ds h $host g $lastgroup $varname [set $varname] 
                set $varname {}
            }
            $w.group.l delete 0 end
            set body [set loadnext [set loaded {}]]
        }
        if {$group ne {}} {
            lassign [$n group $group] num msgfirst msglast
            set load $firstload 
            set loadnext $msglast
            if {[$id d? h $host g $group m]} {
                set zub [$id d h $host g $group]
                foreach varname load {
                    set $varname [$id d h $host g $group $varname]
                }
            }
        }
    }
    set lastgroup $group
    if {$group ne {}} {
        $id messages
    }
}

method header_entry_update path {w group} {
    if {[set idx [$w.headers.listf.l curselection]] ne {}} {
        set header [$w.header.listf.l get $idx]
    }
    switch $path $w.headers.listf.l {
        set ${id}::header $val [$id d headers $header $val]
    } $w.headers.entry {
        $id ds headers $header [$w.headers.entry get]
    }
}

method hosts_entry_update {} {host w} {
    if {[set idx [$w.hosts.listf.l curselection]] ne {}} {
        set host [$w.hosts.listf.l get $idx]
        $id uido ui_authentication
    }
}

variable attributes {
    busy
    data 
    deadhosts 
    displayheaders
    firstload
    fromcolor
    group
    groups
    host
    hosts
    lastgroup
    lasthost
    lbwidth
    load
    loaded
    loadnext
    msgfirst
    msglast
    n
    newcolor
    blanksubject
    num
    password
    path
    port
    replycolor
    seencolor
    setting
    status
    subject
    subjectcolor
    username
    w
    winstack
}

method authentication {} {host password username w} {
    if {![$id d? h $host]} {
        $id ds h $host groups {} 
        $id ds h $host username {}
        $id ds h $host password {}
    }
    set username [$id d h $host username]
    set password [$id d h $host password]
}

method init {defaults args} $attributes {
    variable headers
    #attributes is provided by the "method" proc
    foreach varname $attributes {set $varname {}}
    dict with defaults {dict with args {}}
    set blanksubject -1
    foreach {key val} $headers {
        foreach val $val {
            $id ds headers $val {}
        }
    }
    if {[info exists path] && [file exists $path/data]} {
        $id load
        if {[$id d? attributes]} {
            dict for {key val} [$id d attributes] {
                set ${id}::$key $val
            }
        }
    }
    set load $firstload
}

method initwindow w {} {
    $id keys_common $w
}

method keys_common w {} {
    #these may be set on an entry widget, so are limited to non-entry keys
    bind $w <Escape> [namespace code [list $id goback]]
    bind $w <Control-`> [namespace code [list uido ui_settings]]
    return $w
}

method lbconfig {path data activated updater} lbwidth {
    set max $lbwidth
    foreach data1 $data {
        $path insert end $data1
        set max [max [string length $data1] $max]
        if {$activated eq $data1} {
            $path activate end
        }
    }
    $path configure -width $max
    foreach sequence {<Double-Button-1> <Return>} {
        bind $path $sequence [namespace code $updater]
    }
    return $path
}

method mylistboxentry {path entryvarname entrybinding} {} {
    listboxentry $path $entryvarname $entrybinding
    $id keys_common $path.listf.l
    $id keys_common $path.entry
}

method load {} {data path} {
    set data [read [set chan [open $path/data]]][close $chan]
}

method messages {} {busy group host load loaded loadnext n 
    msgfirst msglast newcolor num seencolor status w} {
    if {[llength $loaded] >= $load || $loadnext == $msgfirst} {
        set status {}
        return
    } 
    set status [list $host $group [list retrieving record $loadnext]]
    if {$loadnext ni $loaded} {
        if {[$id d? h $host g $group m $loadnext h]} {
            set head [$id d h $host g $group m $loadnext h]
        } elseif {![catch {set head [headfields [$n head $loadnext]]}]} {
            $id ds h $host g $group m $loadnext h $head
        }
        if {[info exists head]} {
            set msgdict [$id d h $host g $group m $loadnext]
            $w.group.l insert 0 [
                list $loadnext [dict get $head Date] [
                dict get $head Subject] [dict get $head From]]
            if {[dict exists $msgdict $loadnext seen] && [
                dict get $messages $loadnext seen] == 1} {
                $w.group.l itemconfigure 0 -foreground $seencolor
            } else {
                $w.group.l itemconfigure 0 -foreground $newcolor
            }
            if {[$w.group.l index active] eq {}} {
                $w.group.l activate 0
            }
            $w.group.l see end
            lappend loaded $loadnext
        }
    }
    incr loadnext -1
    set busy [after idle [list $id messages]]
}

method moremessages {} {load loaded} {
    set load [+ [llength $loaded] [entier [* [llength $loaded] .25]]]
    $id messages
}

method myexit {} {group n path} {
    if {$n ne {}} {
        set group {}
        $id group
    }
    if {[info exists path]} {
        $id save
    }
    exit 
}

method nextmessage {} {msgselection w} {
    if {$msgselection >= [$w.group.l index end]} return 
    $w.group.l activate [incr msgselection]
    $id ui_message
}

method populategroups groups {data host lbwidth status w} {
    set max $lbwidth
    foreach group $groups {
        set max [max [string length $group] $max]
        $w.groups.listf.l insert end $group
        lappend groups $group
    }
    $id ds h $host groups $groups
    $w.groups.listf.l activate 0
    if {[string first $w.groups [selection own]] == 0} {
        $w.groups.listf.l selection set 0
    }
    $w.groups.listf.l configure -width $max
    foreach sequence {<Double-Button-1> <Return>} {
        bind $w.groups.listf.l $sequence [list $id groups_entry_update]
    }
    set status {}
}


method prevmessage {} {msgselection w} {
    if {$msgselection == 0} return 
    $w.group.l activate [incr msgselection -1]
    $id ui_message
    $id display
}

method save {} {data path} {
    upvar 0 [namespace current]::attributes myattributes
    foreach myattribute $myattributes {
        if {$myattribute ni {busy n w}} {
            $id ds attributes $myattribute [set ${id}::$myattribute] 
        }
    }
    if {![file exists $path]} {
        file mkdir $path
    }
    while {[file exists $path/[set uniq [clock clicks]]]} {} 
    file mkdir $path/$uniq
    set chan [open $path/$uniq/data w]
    close $chan[puts $chan $data]
    file rename -force $path/$uniq/data $path/data
    file delete -force $path/$uniq
}

method send {} {blanksubject n status subject w} {
    if {$subject eq {}} {
        if {$blanksubject == -1} {
            after idle [list $id uido ui_blanksubject]
            return
        } elseif {$blanksubject == 0} {
            after idle [list $id uido ui_subject]
            return
        }
    }
    set body [$w.compose.text get 1.0 end]
    set bodypart [mime::initialize -canonical text/plain -string $body]

    set token [::mime::initialize -canonical multipart/mixed -parts [
        list $bodypart]]
    foreach {key val} [$id d headers] {
        ::mime::setheader $token $key $val
    }

    set status {Sent!}
    set blanksubject -1
    after idle [list $id goback]
}

method setback {varname value} {} {
    set ${id}::$varname $value
    $id goback
}

#forward back next prev first last
method threadmove mode {w group host msg msgselection} {
    switch $mode {
        forward - next - last {
            set direction 1
            set last [$w.group.l index end]
        }
        back - prev - first {
            set direction -1
            set last -1
        }
    }
    set headers [$id d h $host g $group m $msg h]
    set subject [cleansubject [dict get $headers Subject]]
    if {[dict exists $headers References]} {
        set related [split [dict get $headers References]]
    }
    set messageid [dict get $headers Message-ID]
    lappend related $messageid

    set found 0
    while {[set newselection [+ $msgselection [incr i $direction]]] != $last} {
        set newmsg [lindex [$w.group.l get $newselection] 0]
        set newheaders [$id d h $host g $group m $newmsg h]
        switch $mode {
            forward - back {
                if {[comparereference $newheaders $related] || [
                    comparesubject $newheaders $subject]} {
                    set found 1
                    break
                }
            }
            next - prev - first - last {
                if {![comparereference $newheaders $related] && ![
                    comparesubject $newheaders $subject]} {
                    switch $mode {
                        next {
                            set found 1
                            break
                        }
                        prev {
                            $w.group.l activate $newselection 
                            $id body
                            tailcall $id threadmove first
                        }
                        first - last {
                            set found 1
                            incr newselection [* $direction -1]
                            break
                        }
                    }
                }
                continue
            }
        }
    }
    if {$found} {
        $w.group.l activate $newselection
        $id ui_message
    }
}

method ui {} {data fromcolor headers host hosts replycolor subjectcolor w} {
    text [frame $w.intro].msg
    foreach phrase {
        {{A little NNTP Reader} bold \n\n}
        {Invocation: bold \n\n}
        {programname overstrike { dirname} italic \n}
        {{dirname} italic {
            is the name of a directory that can be used exclusively by the
            program for data storage
        } {} \n}
        {Authentication bold \n\n}
        {{Leave username field blank for an anonynomous session} {} \n\n}
        {{General Keys:} bold  \n\n}
        {{Escape {return to previous screen}} {} \n}
        {{Return continue} {} \n\n}
        {{Message List Keys:} bold  \n\n}
        {{c {compose new message}} {} \n}
        {{m {load more messages}} {} \n\n}
        {{Message Keys:} bold \n\n}
        {{h {view headers}} {} \n} 
        {{n {next mesage}} {} \n}
        {{N {next thread}} {} \n}
        {{p {previous mesage}} {} \n}
        {{P {previous thread}} {} \n}
        {{b {backward in thread}} {} \n}
        {{B {beginning of thread}} {} \n}
        {{f {forward in thread}} {} \n}
        {{F {end of thread}} {} \n}
        {\n {} {Compose Keys:} bold \n\n}
        {{Control-d done (send)} {} \n}
        {{Control-f from} {} \n}
        {{Control-h manage headers} {} \n}
        {{Control-s subject} {} \n}
    } {
        $w.intro.msg insert end {*}$phrase
    }
    $w.intro.msg mark set insert 1.0
    $w.intro.msg tag configure bold -font bold
    $id keys_common $w.intro.msg 
    bind $w.intro.msg <Return> [list $id uido ui_hosts]
    textwrapper $w.intro.msg

    $id mylistboxentry [frame $w.hosts] ${id}::host [
        list uido $id ui_authentication]
    $id lbconfig $w.hosts.listf.l $hosts $host [list $id hosts_entry_update]

    labelentry [frame [frame $w.authentication].username] username \
        ${id}::username [list <Return> [list $id connect]]
    $id keys_common $w.authentication.username.entry
    labelentry [frame $w.authentication.password] \
        password ${id}::password [list <Return> [list $id connect]]
    $id keys_common $w.authentication.password.entry
    $w.authentication.password.entry configure -show *

    $id mylistboxentry [frame $w.groups] ${id}::group [list $id uido ui_group]
    $id lbconfig $w.groups.listf.l {} {} [list $id getgroups] 

    scrolled [$id lbconfig [listbox [frame $w.group].l] {} {} [
        list $id uido ui_message]] y
    $id keys_common $w.group.l
    bind $w.group.l m [list $id moremessages] 
    bind $w.group.l c [list $id uistack ui_compose ui_subject [
        list ui_setting From]] 

    set textopts {-wrap word -padx 5 -pady 3 -height 12 -font {Helvetica 9}}

    foreach i {msgh msg} {
        scrolled [text [frame $w.$i].t {*}$textopts] y
        textwrapper $w.$i.t
        foreach color [list $fromcolor $replycolor $subjectcolor] {
            $w.$i.t tag configure $color -foreground $color
        }
    }

    $id keys_common $w.msg.t
    bind $w.msg.t h [list $id uido ui_header]
    bind $w.msg.t n [list $id nextmessage] 
    bind $w.msg.t p [list $id prevmessage] 
    bind $w.msg.t b [list $id threadmove back] 
    bind $w.msg.t f [list $id threadmove forward] 
    bind $w.msg.t B [list $id threadmove first] 
    bind $w.msg.t F [list $id threadmove last] 
    bind $w.msg.t N [list $id threadmove next] 
    bind $w.msg.t P [list $id threadmove prev] 

    labelentry [frame $w.subject] subject ${id}::subject [
        list <Return> [list $id goback]]
    $id keys_common $w.subject.entry

    label [frame $w.blanksubject].label -text {Leave subject blank?}
    labelitem $w.blanksubject.no no [list $id setback blanksubject 0]
    labelitem $w.blanksubject.yes yes [list $id setback blanksubject 1]

    scrolled [text [frame $w.compose].text] y
    $id keys_common $w.compose.text
    bind $w.compose.text <Control-d> [list $id composedone]
    bind $w.compose.text <Control-f> [list $id uido [list ui_setting from]]
    bind $w.compose.text <Control-h> [list $id uido [list ui_headers]]
    bind $w.compose.text <Control-s> [list $id uido ui_subject]

    $id mylistboxentry [frame $w.headers] ${id}::header [
        list uido $id header_entry_update %W] 
    $id lbconfig $w.headers.listf.l {} {} [list $id uido header_entry_update %W]
    
    scrolled [$id lbconfig [listbox [frame [frame $w.settings].listf].l] {
        from
    } {} [list <Return> [list $id uido ui_setting]]] y
    $id keys_common $w.settings.listf.l

    labelentry [frame $w.setting] {} ${id}::setting [
        list <Return> [list $id update_setting]]
    $id keys_common $w.setting.entry 

    label $w.status -textvariable ${id}::status
}

method ui_authentication {} {w status winstack} {
    $id authentication
    set status {}
    pack $w.authentication {*}[winfo children $w.authentication] {*}[
        winfo children $w.authentication.username] {*}[
        winfo children $w.authentication.password] 
    focus $w.authentication.username.entry
    selection own $w.authentication.username.entry
}

method ui_blanksubject {} w {
    pack $w.blanksubject {*}[winfo children $w.blanksubject] 
    focus $w.blanksubject.no
}

method ui_compose {} {from blanksubject subject w} {
    pack $w.compose $w.compose.text -fill both -expand 1
    focus $w.compose.text
}

method ui_groups {} {host data host status w} {
    if {[$w.groups.listf.l index end] == 0} {
        if {[$id d h $host groups] eq {}} {
            $w.groups.listf.l insert end {double-click to load groups}
            set cmd ui_groups3
        } else {
            set status {loading saved groups...}
            set cmd ui_groups2
        }
        bind $w.groups.listf.l <Configure> [list $id $cmd]
    }
    packlistboxentry $w.groups
}

method ui_groups2 {} {host} {
    $id populategroups [$id d h $host groups]
    after idle [list $id ui_groups3]
}

method ui_groups3 {} {data host status w} {
    packlistboxentry $w.groups
    bind $w.groups.listf.l <Configure> {}
    set status {}
}

method ui_group {} w {
    packlistbox $w.group
    $id group
}

method ui_header {} {displayheaders w winstack} {
    set displayheaders [! $displayheaders]
    $id goback
}

method ui_headers {} {w} {
    packlistboxentry $w.headers
}

method ui_hosts {} w {
    packlistboxentry $w.hosts
}

method ui_intro {} {w winstack} {
    pack $w.intro {*}[winfo children $w.intro] -fill both -expand 1
    selection own $w.intro
    focus $w.intro.msg
}

method ui_message {} {displayheaders w} {
    if {$displayheaders} {
        pack $w.msgh -fill both
        pack $w.msgh.y -fill y -side right
        pack $w.msgh.t -fill both
    }
    pack $w.msg -fill both -expand 1
    pack $w.msg.y -fill y -side right
    pack $w.msg.t -fill both -expand 1 -side right
    focus $w.msg.t
    $id body
    $id display
}

method ui_send {} {status} {
    set status Connecting...
    $id send
}

method ui_setting setting w {
    $w.setting.label configure -text $setting
    pack $w.setting $w.setting.label $w.setting.entry
    focus $w.setting.entry
}

method ui_setting_active {} w {
    $id ui_setting [$w.settings.listf.l get active]
}

method ui_settings {} w {
    packlistbox $w.settings.listf
}

method ui_subject {} {blanksubject w} {
    set blanksubject -1
    pack $w.subject {*}[winfo children $w.subject]
    focus $w.subject.entry
}

method uido args {w winstack} {
    $id uipush $args
    pforget $w
    pack $w.status -side bottom -fill x
    $id {*}$args
}

method uipush {args} {winstack} {
    lappend winstack $args
}

method uistack args winstack {
    set args [lreverse [lassign [lreverse $args[set args {}]] last]]
    foreach arg $args {
        lappend winstack $arg
    }
    $id uido {*}$last
}

method update_setting {} w {
    set setting [$w.settings.listf.l get active]
    if {$setting eq {}} {
        error [list {no setting active}]
    }
    set val [$w.setting.entry get]
    set ${id}::$setting $val
    $id goback
}

variable defaults {
    hosts {
        {freenews.netfront.net 119}
        {textnews.news.cambrium.nl 119}
        {news.vsi.ru 119}
        {news.grc.com 119}
        {news.amu.edu.pl 119}
        {news.eternal-september.org 119}
        {news.eternal-september.org 563}
        {nntp.aioe.org 119}
        {reader.albasani.net 119}
        {medium.com 119}
    }
    deadhosts {
        {aioe.cjb.net 119}
        {allnews.readfreenews.net 119}
        {dp-news.maxwell.syr.edu 119}
        {freetext.usenetserver.com 119}
        {news.f.de.plusline.net 119}
        {news.readfreenews.net 119}
        {pubnews.gradwell.net 119}
        {w3bhost.de 119}
    }
    group comp.lang.tcl
    host textnews.news.cambrium.nl
    firstload 64 loaded {} 
    fromcolor blue subjectcolor red seencolor gray newcolor blue
    lbwidth 20
    replycolor brown
    sort threads
    displayheaders 1
    winstack myexit
}

variable headers {
    mandatory {From Date Newsgroups Subject Message-ID Path}

    optional {Followup-To Expires Reply-To Sender References Control
        Distribution Keywords Summary Approved Lines Xref Organization} 

    custom {
    }
}

bind . <F1> {console show}
wm attributes . -fullscreen 1
#wm geometry . [entier [winfo screenwidth .]]x[entier [winfo screenheight .]]
#wm geometry . 600x[entier [* [winfo screenheight .] .90]]
main $argv
======

<<categories>> NNTP