#
#  Popup showing nntp transfer  progress
#
proc nntp_lmsg {cnt} {
    global Config
    if {![winfo exists .nntpm]} {
	toplevel .nntpm
	wm transient .nntpm .
	label .nntpm.l -text  $cnt
	pack .nntpm.l -padx 20 -pady 10 -expand yes
	wm minsize .nntpm 0 0
	wm geometry  .nntpm $Config(.nntpm)
    } else {
	.nntpm.l configure -text $cnt
    }
    update
}

proc nntp_kmsg {} {
    catch {destroy .nntpm}
}
    
#
#  Posting PoPup
#
# Pass values in global variables because they may have arbitrary
# characters in them
#
proc post_Make {already increment imessage args} {
    global Config has_exmh
    toplevel .post
    frame .post.s
    pack .post.s

    set n 0
    foreach x $args {
	global post_$x
	frame .post.s.f$n
	label .post.s.f$n.l -text $x
	pack .post.s.f$n.l -side left -expand yes -fill x
	entry .post.s.f$n.e  -width 60
	.post.s.f$n.e delete 0 999
	.post.s.f$n.e insert 0 [set post_$x]
	pack   .post.s.f$n.e -side right
	pack .post.s.f$n -fill x
	incr n
    }

    if {$increment == "1"} {
	frame .post.i -borderwidth 2  -relief ridge
	checkbutton .post.i.b -variable post_include -text $imessage -relief flat
	global post_include
	set post_include 1
	pack .post.i.b
	pack .post.i -expand yes -fill x
    }

    frame .post.x -relief sunken -borderwidth 2
    if {$already != -1} {
	if {$already == 1} {
	    set xedit x
	} else {
	    set xedit s
	}
	button .post.x.go -text "  Do  " -command "post_do $xedit $n"
	button .post.x.exit  -text "Exit" -command "post_exit"
	pack .post.x.go  .post.x.exit -side left -padx 25m -pady 5m
    } else {
	if {$has_exmh} {
	    button .post.x.edit -text "simple editor" -command "post_do  s $n"
	} else {
	    button .post.x.edit -text "simple editor" -command "post_do  s $n" -state disabled
	}
	button .post.x.xt -text "external editor" -command "post_do x $n" 
	button .post.x.exit  -text "Exit" -command "post_exit"

	pack .post.x.edit .post.x.xt .post.x.exit -side left -padx 12m -pady 5m
    }
    pack .post.x -side top -fill both -expand yes

    wm geometry  .post $Config(.post)
    wm minsize .post 0 0
}

proc post_do {c n} {

    if {$n > 0} {
	for {set i 0} {$i < $n} {incr i} {
	    set var [lindex [.post.s.f$i.l configure -text] 4]
	    global post_$var
	    set post_$var  [.post.s.f$i.e get]
	}
    }

    if {![info exists post_Subject] || $post_Subject != ""} {
	put_key $c
	destroy .post
    } else {
	msg_tmp "You must enter a subject"
    }
}

proc post_exit {} {
    put_key  e
    destroy .post
}

#
# message - popup
#
proc msg_Make {mess} {
    catch {destroy .msg}
    toplevel .msg
    wm transient .msg .
    wm geometry .msg +300+300

    message .msg.m -text $mess -aspect 800

    pack .msg.m -side left -expand yes -fill both
}

proc msg_tmp {mess} {
    msg_Make $mess
    after 5000 {catch {destroy .msg}}
}

#
#	Group cascading menus
# 
#		pass group selection to nn
proc gg {grp {menu ""}} {
    global grp_x grp_y
    global gm_type ev_param ev_type ev_input 
    global EV_FUNCT token

    if {$menu != ""} {
#	puts [winfo rootx .top.m.menu.$menu]
#	puts [winfo rooty .top.m.menu.$menu]
	scan  "[winfo geometry  .top.m.menu.$menu]" "%dx%d+%d+%d" sx sy x y
	set ya [.top.m.menu.$menu yposition active]
    } else {
	scan  "[winfo geometry  .top.m.menu]" "%dx%d+%d+%d" sx sy x y
	set ya [.top.m.menu yposition active]
    }

    set grp_x [expr $sx/2+$x]
    set grp_y [expr $y+$ya-6]
    set gm_type "m"
    set ev_param $grp
    ev_type_menu
    rec_c $EV_FUNCT $token(K_SEL_GROUP)
}

#		display group jump menu
proc gr_Make {} {
    global tk_version grp_x grp_y
    global list_cnt first_menu

    incr list_cnt

    if {[winfo exists .gr-popup]} {
	destroy .gr-popup
    }
    menu .gr-popup
    .gr-popup add command -label "Enter Group"
    .gr-popup add separator
    foreach i {"j)jump" "J)Jump read" "a)all"  "s)subject" "n)name" "e)either" \
		   "u)unread" "@)archive"} {
	set a [string index $i 0]
	set i [string range $i 2 end]
	.gr-popup add command -label $i -accelerator $a -command "gr_select $a"
    }

    if {![info exists grp_x]} {
	if {[info exists .menu]} {
	    set grp_x [winfo rootx .menu]
	    set grp_y [winfo rooty .menu]
	}
    }
    if {[info exists grp_x]} {
	if {$tk_version >= 4.0} {
	    .gr-popup configure -tearoff no
	    tk_popup .gr-popup $grp_x [expr $grp_y-35]
	    grab release .gr-popup
	    if {![info exists first_menu]} {
		tkMenuBind .gr-popup Enter
		set first_menu 1
	    }
	} else {
	    .gr-popup post $grp_x [expr $grp_y-35]
	    grab .gr-popup
	    grab release .gr-popup
	}
	
	unset grp_x grp_y
	update
    }
}

#		group jump menu selection
proc gr_select {x} {
    global ev_input  ev_type EV_CHAR 
    global list_cnt      

    rec_c $EV_CHAR $x
    .gr-popup unpost
    destroy .gr-popup
    set list_cnt 0
}

proc gr_del {} {
    global list_cnt      
    #   fudgy variable to make sure window
    #   isn't destroyed if it has to be reposted

    if {$list_cnt <= 1} {
	if {[winfo exists .gr-popup]} {
	    destroy  .gr-popup
	}
    }
    incr list_cnt -1
}

#
#	Group List
#

#		pass group list selection to nn
proc list_select {grp y} {
    global gm_type ev_param ev_input ev_type 
    global EV_FUNCT token
    global tk_version

    set gm_type 'g'
    if {$tk_version >= 4.0} {
	$grp.list selection set $y
    } else {
	$grp.list select from $y
    }
    set t [$grp.list get $y]
    set l [expr [string first " " $t]-1]
    if { $l > 0 } {
	set t [string range $t 0 $l]
    }
    #   puts stderr "$grp $y $t"
    set ev_param $t
    if {$grp == ".folders"} {
	set ev_param "+$ev_param"
    }
    ev_type_menu 
    rec_c $EV_FUNCT $token(K_SEL_GROUP)
}

#		replace a group list entry
proc list_update {ent n} {
    global Config

    set n [expr $n-1]
    if {$n >= 0} {
	.groups.list delete $n
	.groups.list insert $n $ent
    }
}

proc group_save {n} {
    global gpos_save
    set gpos_save $n
}

proc group_ret {} {
    global gpos_save
    list_sel $gpos_save
}

proc list_clear {} {
    if {[winfo exists .groups] != 0} {
	catch {
	    set n [.groups.list get [.groups.list curselection]]
	    scan $n "%s" name
	}
	.groups.list delete 0 end
	grp_list
	catch {list_sel [lookup_group_pos $name]}
    }
}

proc list_reset {} {
    if {[winfo exists .groups] != 0} {
	catch {
	    set n [.groups.list get [.groups.list curselection]]
	    scan $n "%s" name
	}
	destroy .groups
	list_Make .groups grp_list
	catch {list_sel [lookup_group_pos $name]}
    }
}

#		mark current group 
proc list_sel {y} {
    global tk_version
    if {[winfo exists .groups] != 0} {
	if {$y > 0} {
	    if {$tk_version >= 4.0} {
		.groups.list selection clear 0 end
		.groups.list selection set [expr $y-1]
	    } else {
		.groups.list select from [expr $y-1]
	    }
	    .groups.list yview [expr $y-4]
	}
    }
}

# 		create group list
proc list_Make {grp flist} {
    if {[winfo exists $grp] == 0} {
	list_mk $grp
	$flist
    }
}

proc group-search {grp} {
    global grp_x grp_y

    set l [$grp.list size]
    set srch [$grp.search.txt get]
    set n [$grp.list curselection]
    for {set i [incr n 1]} {$i < $l} {incr i} {
	set t [$grp.list get $i]
	if {[string first $srch $t] >= 0} {
	    list_select $grp $i
	    list_sel [incr i]
	    set grp_x [expr [winfo rootx $grp.search.bt]+15]
	    set grp_y [winfo rooty $grp.search.bt] 
	    return
	}
    }
    msg_Make "Group no found"
    after 5000 {catch {destroy .msg}}
}

proc group-search-b {grp} {
    global grp_x grp_y

    set l [$grp.list size]
    set srch [$grp.search.txt get]
    set n [$grp.list curselection]
    for {set i [incr n -1]}	{$i >= 0} {incr i -1} {
	set t [$grp.list get $i]
	if {[string first $srch $t] >= 0} {
	    list_select $grp $i
	    list_sel [incr i]
	    set grp_x [expr [winfo rootx $grp.search.bf]+15]
	    set grp_y [winfo rooty $grp.search.bf] 
	    return
	}
    }
    msg_Make "Group no found"
    after 5000 {catch {destroy .msg}}
}

proc group-srch {grp} {
    frame $grp.search
    button $grp.search.bt -text "/" -command "group-search $grp" -bd 2 \
	-relief raised
    button $grp.search.bf -text "\\" -command "group-search-b $grp" -bd 2 \
	-relief raised
    entry $grp.search.txt -relief sunken 
    pack $grp.search.bt $grp.search.txt $grp.search.bf -side left

    bind $grp.search.txt <Return> "group-search $grp"
}

proc list_press {grp window x y} {
    global grp_x grp_y

    list_select $grp [$window nearest $y]
    set x [expr [winfo rootx $window]+$x]
    set y [expr [winfo rooty $window]+$y]
    set grp_x $x
    set grp_y $y 
}

proc list_mk {grp} {
    global  tk_version color_w Config 

    if {$grp == ".groups"} {
	if {$Config(single_main)} {
	    frame  $grp -relief ridge -borderwidth 2
	} else {
	    toplevel $grp
	}
	set geom $Config(.groups)
    } else {
	toplevel $grp
	set geom $Config(.folders)
    }

    group-srch $grp

    scrollbar $grp.scroll -command "$grp.list yview"
    listbox $grp.list -yscroll "$grp.scroll set"  -relief raised -borderwidth 1 \
	-cursor left_ptr 

    bind $grp.list <Button-1> "list_press $grp %W %x %y"
    bind $grp.list <B1-Motion> {  }

    pack $grp.search -side bottom
    pack $grp.scroll -side right -fill y
    pack $grp.list -side left -expand yes -fill both
    if {!$Config(single_main) || $grp !=  ".groups"} {
	$grp.list configure -exportselection 0 -setgrid 1 
	wm geometry $grp $geom
    } else {
	$grp.list configure -exportselection 0 -setgrid 0 
	pack $grp  -fill y -side left -padx 4 -before .top
    }
    if {$tk_version >= 4.0} {
	$grp.list configure -selectmode single
	$grp.list configure -width $Config(group_list_width)
    } else {
	$grp.list configure -geometry $Config(group_list_width)x15
    }
}

#
#       Yes/No popup
#
proc y_prompt {} {
    global prompt_buf
    toplevel .yp 
    regsub -all "\\1" $prompt_buf "" prompt_buf
    regsub -all \x0d $prompt_buf "" prompt_buf
    regsub -all \x01 $prompt_buf "" prompt_buf
    wm transient .yp .
    wm geometry .yp +300+300
    message .yp.t -text $prompt_buf -aspect 1500
    frame .yp.f -relief sunken -borderwidth 2
    button .yp.f.yes -text "YES" -command "prompt_r y"
    button .yp.f.no -text "NO" -command "prompt_r n"

    pack .yp.f.no -side left -padx 10m -pady 5m 
    pack .yp.f.yes -side right -padx 10m -pady 5m
    pack .yp.t -side top -expand yes -fill x
    pack .yp.f -side top -fill both

    grab set .yp
    focus .yp
    bind .yp y {prompt_r y}
    bind .yp Y {prompt_r y}
    bind .yp n {prompt_r n}
    bind .yp N {prompt_r n}
    bind .yp escape {prompt_r n}
    bind .yp <Key-Return> {prompt_r y}
}

proc y_destroy {} {
    if {[winfo exists .yp]} {
	destroy .yp
    }
}

proc prompt_r {c} {
    destroy .yp
    put_key $c
}

#
#	Prompting popup
#
proc prompt_Make {} {
    global color_w Config
    global tk_version

    toplevel .prompt
    
    wm title .prompt "NN Prompt"
    
    text .prompt.pr1 -relief raised -bd 2 -setgrid true \
	-height 1
    text .prompt.pr2 -relief raised -bd 2 -setgrid true \
	-height 1
    text .prompt.pr3 -relief raised -bd 2 -setgrid true \
	-height 1
    pack .prompt.pr1 .prompt.pr2 .prompt.pr3 -side top \
	-fill both -expand yes

    if {$tk_version >= 4.0} {
	bind .prompt.pr1 <ButtonRelease-2> break
	bind .prompt.pr2 <ButtonRelease-2> break
	bind .prompt.pr3 <ButtonRelease-2> break
    } 
    bind .prompt <Destroy> prompt_d
    bind .prompt.pr1 <2> prompt_insert
    text_bindings .prompt.pr1
    bind .prompt.pr2 <2> prompt_insert
    text_bindings .prompt.pr2
    bind .prompt.pr3 <2> prompt_insert
    text_bindings .prompt.pr3

    wm geometry  .prompt $Config(.prompt)
}

proc prompt_insert {} {
    catch {set t [selection get]}
    set n [string length $t]
    for {set i 0} {$i < $n} {incr i} {
	put_key [string index $t $i]
    }
}

proc prompt_clear {} {
    catch {
	.prompt.pr1 delete 0.0 end
	.prompt.pr2 delete 0.0 end
	.prompt.pr3 delete 0.0 end
	wm withdraw .prompt
    }
}

proc prompt_restore {} {
    if {[winfo exists .prompt] == 0} {
	prompt_Make
    } else {
	wm deiconify .prompt
    }
}

proc prompt_d {} {
    prompt_delete
} 
#
#	display popup
#
proc display_l {} {
    global display_l_t
    global tk_version

    set x $display_l_t
    scan [.display.t index end] "%d." l
    if {$tk_version >= 4.0} {
	incr l -1
    } 
    set offset 0

    while {[regexp -indices "\01(\[^\01\]+)\01" $x pos]} {
	scan $pos "%d %d" s f
	set xt [string range $x 0 $f]
	regsub -all \x01 $xt "" xt
	.display.t insert end $xt
	if {$tk_version <  4.0} {
	    .display.t tag remove out $l.$offset end
	}
	.display.t tag add out $l.[expr $offset+$s] $l.[expr $offset+$f-1]
	set x [string range $x [expr $f+1] 999]
	incr offset [expr $f-1]
    }
    regsub -all \x01 $x "" x
    if {$tk_version <  4.0} {
	set n [.display.t index end]
    }
    .display.t insert end $x
    if {$tk_version <  4.0} {
	.display.t tag remove out $n end
    }
}

proc display_Make {} {
    global color_w Config
    
    if {[winfo exists .display] == 0} {
	toplevel .display
	
	text .display.t -relief raised -bd 2 -setgrid true \
	    -height 25 -width 80  -yscrollcommand ".display.s set" \
	    -wrap none
	scrollbar .display.s -command ".display.t yview"
	pack .display.t -side left -expand yes -fill both
	pack .display.s -side left -fill y
        .display.t tag configure out -background black -foreground white
	wm title .display "NN help"
	wm geometry .display $Config(.display)
    } else {
	.display.t delete 0.0 end
    }
}
