
# TkNap v@TKNAP_VERSION@
#
# Chat routines
#
# Copyright (C) 2000 Mats Peterson
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
#
# Please send any comments/bug reports to
# matsp888@yahoo.com  (Mats Peterson)
#


proc napS2W {s} {
    return [string map {. \000} $s]
}

proc napS2B {s} {
    return [string map {% %%} $s]
}


proc napAddText {w text} {
    if {([$w index end] != 2.0) || ([$w index 1.end] > 1.0)} {
	$w insert end "\n"
    }
    $w insert end $text
    if {[expr {int([$w index end])}] > 500} {
	$w delete 1.0 25.0
    }
    $w see end
    $w mark set insert end
}


proc napCalcPingTime {nick} {
    global nap

    if {! [info exists nap(pstart,$nick)]} return
    set ptime [expr {([clock clicks -milliseconds] - \
	    $nap(pstart,$nick)) / 1000}]
    catch {unset nap(pstart,$nick)}

    set ps "$ptime second"
    if {($ptime < 1) || ($ptime > 1)} {
	append ps "s"
    }
    return $ps
}


proc napRcvGlobal {type data} {
    global nap

    regexp {^([^ ]+) *(.*)$} $data match nick msg

    if {$type == 205} {
	set w .pw_[napS2W $nick]
    } else {
	set w $nap(curwin)
    }

    if {! [winfo exists $w]} {
	switch $type {
	    205 {				# private nessage
		napPrivWindow $nick
	    }
	    627 {				# operator message
		if {$nick != $nap(username)} {
		    napShowMiscInfo \
			    "OPERATOR MESSAGE from $nick: $msg" normal
		}
		return
	    }
	    628 {				# global message
		if {$nick != $nap(username)} {
		    napShowMiscInfo \
			    "GLOBAL MESSAGE from $nick: $msg" normal
		}
		return
	    }
	    751 {				# ping
		if {[catch {napSendMsg 752 $nick} r]} {
		    napDisconnect $r
		}
		return
	    }
	    752 {				# pong
		if {[set ps [napCalcPingTime $nick]] == ""} return
		napShowMiscInfo \
			"PONG received from $nick: $ps" normal
		return
	    }
	}
    }

    if {[regexp {^\.c} $w]} {
	    set textbox $w.boxes.in.text
    } else {
	    set textbox $w.in.text
    }

    switch $type {
	205 {				    # private message
	    napAddText $textbox "> $msg"
	}

	627 {				    # operator message
	    napAddText $textbox \
		    "*** OPERATOR MESSAGE from $nick: $msg"
	}

	628 {				    # global message
	    napAddText $textbox \
		    "*** GLOBAL MESSAGE from $nick: $msg"
	}

	751 {				    # ping
	    napAddText $textbox "*** $nick PING"
	    if {[catch {napSendMsg 752 $nick} r]} {
		napDisconnect $r
	    }
	}

	752 {				    # pong
	    if {[set ps [napCalcPingTime $nick]] == ""} return
	    napAddText $textbox \
		    "*** PONG received from $nick: $ps"
	}
    }
}


proc napRcvChannel {type data} {
    global nap
    
    regexp {^[^ ]+} $data c
    set w .cw_[napS2W $c]
    if {! [winfo exists $w]} return

    switch $type {
	403 {				    # public message
	    regexp {^([^ ]+) ([^ ]+) *(.*)$} $data \
		    match c nick text
	    napAddText $w.boxes.in.text "<$nick> $text"
	}
        
	410 {				    # channel topic
	    regexp {^([^ ]+) *(.*)$} $data match c topic
	    if {! [winfo exists $w]} return
	    set title $c
	    if [string length $topic] {
		append title "  $topic"
	    }
	    wm title $w $title
	}

	824 {				    # emote
	    regexp {^([^ ]+) ([^ ]+) "*(.*)"$} $data \
		    match c nick text
	    napAddText $w.boxes.in.text "* $nick $text"
	}
    }
}


proc napSendGlobal {type data} {
    global nap
    
    switch $type {
	205 {					# private message
	    if {! [regexp {^([^ ]+) *(.*)$} \
		    $data match nick msg]} {
		errmsg "Missing parameter"
		return
	    }

	    if {[catch {napSendMsg $type "$nick $msg"} r]} {
		napDisconnect $r
	    }
	}

	628 {					# global message
	    if {$data == ""} {
		errmsg "Missing parameter"
		return
	    }
	    if {[catch {napSendMsg $type $data} r]} {
		napDisconnect $r
	    }
	}

	751 {					# ping user
	    regexp {^[^ ]+} $data nick
	    if {[catch {napSendMsg $type $nick} r]} {
		napDisconnect $r
	    }
	}
    }
}


proc napSendChannel {c type data} {
    switch $type {
	402 {					# public message
	    if {[catch {napSendMsg $type "$c $data"} r]} {
		napDisconnect $r
	    }
	}

	824 {					# emote
	    if {[catch {napSendMsg $type "$c \"$data\""} r]} {
		napDisconnect $r
	    }
	}
    }
}


proc napListChannels {} {
    global nap

    simplemsg create {Getting channel list...}

    set nap(clist) {}
    set nap(cnamelen) 0

    if {[catch {napSendMsg 617 {}} r]} {
	napDisconnect $r
    }
}


proc napShowChannels {} {
    global nap

    simplemsg destroy

    if {! [llength $nap(clist)]} {
	infomsg "No channels exist"
	return
    }

    set nap(old_focus) [focus]
    catch {destroy .clwin}
    toplevel .clwin -relief raised -bd 2 -class Tknap
    wm geometry .clwin 75x20
    wm title .clwin "Channel List"

    frame .clwin.spacer -height 2m
    pack .clwin.spacer

    frame .clwin.titles
    pack .clwin.titles -padx 2m -fill x
    set n 0
    foreach i {Name Users Topic} {
	label .clwin.titles.title$n -text $i
	pack .clwin.titles.title$n -side left -expand yes
	incr n
    }

    frame .clwin.reslist
    pack .clwin.reslist -padx 2m -pady 2m -expand yes -fill both
    listscroll .clwin.reslist 75 1 1
    .clwin.reslist.list configure -selectmode extended \
	    -font $nap(monofont)

    frame .clwin.buttons
    pack .clwin.buttons -pady 2m
    button .clwin.buttons.join -default active -text Join -takefocus 0 \
	    -command {
		set e [lindex $nap(clist) [.clwin.reslist.list index active]]
		regexp {^[^ ]+} $e chn
		napJoinChannel $chn
	    }
    button .clwin.buttons.quit -text Quit -takefocus 0 \
	    -command {catch {focus $nap(old_focus)}; destroy .clwin}
    pack .clwin.buttons.join .clwin.buttons.quit \
	    -side left -padx 2m

    bind .clwin <Return> {
	set e [lindex $nap(clist) [.clwin.reslist.list index active]]
	regexp {^[^ ]+} $e chn
	napJoinChannel $chn
    }

    bind .clwin <q> {catch {focus $nap(old_focus)}; destroy .clwin}

    focus .clwin.reslist.list
    update idletasks

    set nap(clist) [lsort -dictionary $nap(clist)]
    set cnfmt "[expr {$nap(cnamelen) + 4}]s"
    
    foreach i $nap(clist) {
	regexp {^([^ ]+) ([0-9]+) *(.*)$} $i match chn users topic
	set entry [format "%-$cnfmt%-10s%s" $chn $users $topic]
	.clwin.reslist.list insert end $entry
    } 

    .clwin.reslist.list selection set 0 0
    .clwin.reslist.list activate 0
}


proc napQuickInfo {c nick} {
    global nap

    if {$nick == ""} {
	set nick [string trim [.cw_[napS2W $c].boxes.users.list get active]]
    } else {
	set n 0
	foreach i $nap(ulist,$c) {
	    set lnick [string trim $i]
	    if {[string equal -nocase $lnick $nick]} {
		set nick $lnick
		break
	    }
	    incr n
	}
	if {$n == [llength $nap(ulist,$c)]} {
	    errmsg "User $nick does not exist"
	    return
	}
    }

    set titles {{Shared Files} Connection}
    regexp {^(.+) (.+)$} $nap(uinfo,$c,$nick) match shared link
    set values [list $shared [lindex $nap(linkstr) $link]]
    showinfo .qiwin $nick $titles $values 12 10
}


proc napPopupMenu {menu} {
    set w [winfo parent $menu]
    tk_popup $menu [winfo pointerx $w] [winfo pointery $w]
}


proc napChannelWindow {c} {
    global nap

    set w .cw_[napS2W $c]

    set nap(old_focus) [focus]
    catch {destroy $w}
    toplevel $w -relief raised -bd 2 -class Tknap
    wm geometry $w 42x16
    wm title $w $c
    wm protocol $w WM_DELETE_WINDOW [list napPartChannel $c]
   
    set f $w.boxes
    frame $f
    pack $f -padx 2m -pady 2m -expand yes -fill both
 
    frame $f.in
    pack $f.in -side left -expand yes -fill both
    textscroll $f.in 1 1 0
    $f.in.text configure -font $nap(monofont) -wrap word \
	    -spacing2 3 -spacing3 3 -takefocus 0

    frame $f.users
    pack $f.users -side left -fill both
    listscroll $f.users 12 1 1
    $f.users.list configure -font $nap(propfont) -listvar nap(ulist,$c)
    $f.users.xscroll configure -takefocus 0
    $f.users.yscroll configure -takefocus 0

    entry $w.out -font $nap(monofont)
    pack $w.out -padx 2m -pady 2m -fill x
    
    frame $w.buttons
    pack $w.buttons -pady 3m

    button $w.buttons.part -text Part -width 4 -takefocus 0 \
	    -command [list napPartChannel $c]
    pack $w.buttons.part -side left -padx 4m

    menu $w.cmenu -tearoff no

    foreach i {msg qinfo whois browse ping op deop muzzle unmuzzle \
	    kick kill ban} \
	    title {Message {Quick Info} Whois Browse Ping Op DeOp \
	    Muzzle Unmuzzle Kick Kill Ban} {
	if {$i == "qinfo"} {
	    set cmd [list napQuickInfo $c {}]
	} else {
	    set cmd [list napMenuCmd $c $i 1]
	}
	$w.cmenu add command -label $title -command $cmd
    }

    proc napChanSendText {c} {
	set w .cw_[napS2W $c]
	set text [$w.out get]
	$w.out delete 0 end

	if {[regexp {^/} $text]} {
	    napProcessCmd $c $text
	    return
	}
	napSendChannel $c 402 $text
    }

    bind $w.out <Return> [list napChanSendText [napS2B $c]]

    bind $w <Control-p> [list napPartChannel [napS2B $c]]
    
    bind $w <Shift-Page_Up> [list $f.in.text yview scroll -1 pages]
    bind $w <Shift-Page_Down> [list $f.in.text yview scroll 1 pages]
    
    bind $f.users.list <m> [list napMenuCmd [napS2B $c] msg 1]
    bind $f.users.list <i> [list napQuickInfo [napS2B $c] {}]
    bind $f.users.list <w> [list napMenuCmd [napS2B $c] whois 1]
    bind $f.users.list <b> [list napMenuCmd [napS2B $c] browse 1]
    bind $f.users.list <p> [list napMenuCmd [napS2B $c] ping 1]
    bind $f.users.list <Control-o> [list napMenuCmd [napS2B $c] op 1]
    bind $f.users.list <Control-d> [list napMenuCmd [napS2B $c] deop 1]
    bind $f.users.list <Control-m> [list napMenuCmd [napS2B $c] muzzle 1]
    bind $f.users.list <Control-u> [list napMenuCmd [napS2B $c] unmuzzle 1]
    bind $f.users.list <Control-k> [list napMenuCmd [napS2B $c] kick 1]
    bind $f.users.list <Control-l> [list napMenuCmd [napS2B $c] kill 1]
    bind $f.users.list <Control-b> [list napMenuCmd [napS2B $c] ban 1]
    bind $f.users.list <Button-3> [list napPopupMenu [napS2B $w].cmenu]
    bind $w <FocusIn> [list set nap(curwin) [napS2B $w]]

    proc napUnsetUsers {c} {
	global nap

	unset nap(ulist,$c)
	array unset nap "uinfo,$c,*"
    }

    bind $w.out <Destroy> [list napUnsetUsers [napS2B $c]]

    set nap(curwin) $w
    focus $w.out
    update idletasks
}


proc napJoinChannel {c} {
    global nap
    
    if {[catch {napSendMsg 400 $c} r]} {
	napDisconnect $r
	return
    }
}


proc napDoJoinChannel {c} {
    global nap

    set c [string trim $c]
    set nap(ulist,$c) [lsort -dictionary $nap(ulist,$c)]
    napChannelWindow $c
    lappend nap(cwinlist) .cw_[napS2W $c]
}


proc napPartChannel {c} {
    simplemsg create "Leaving $c..."
    if {[catch {napSendMsg 401 $c} r]} {
	napDisconnect $r
    }
}


proc napDoPartChannel {c} {
    global nap

    simplemsg destroy
    catch {focus $nap(old_focus)}
    catch {destroy .cw_[napS2W $c]}

    if {[set i [lsearch -exact $nap(cwinlist) .cw_[napS2W $c]]] == -1} {
	napDebug "napPartChannel: Can't find window .cw_[napS2W $c]"
    } else {
	set nap(cwinlist) [lreplace $nap(cwinlist) $i $i]
    }
}


proc napPrivWindow {nick} {
    global nap

    set w .pw_[napS2W $nick]
    set nap(old_focus) [focus]
    catch {destroy $w}
    toplevel $w -relief raised -bd 2 -class Tknap
    wm geometry $w 45x16
    wm title $w $nick
    wm protocol $w WM_DELETE_WINDOW [list napClosePriv [napS2B $w]]
   
    frame $w.in
    pack $w.in -expand yes -fill both -padx 2m -pady 2m
    textscroll $w.in 45 1 0
    $w.in.text configure -font $nap(monofont) -wrap word \
	    -spacing2 3 -spacing3 3 -takefocus 0
                  
    entry $w.out -font $nap(monofont)
    pack $w.out -padx 2m -pady 2m -fill x
    
    frame $w.buttons
    pack $w.buttons -pady 3m

    button $w.buttons.close -text Close -width 4 -takefocus 0 \
	    -command [list napClosePriv $w]
    pack $w.buttons.close -side left -padx 4m

    menu $w.pmenu -tearoff no

    foreach i {whois browse ping muzzle unmuzzle kill ban} \
	    title {Whois Browse Ping Muzzle Unmuzzle Kill Ban} {
	$w.pmenu add command -label $title \
		-command [list napMenuCmd $nick $i 0]
    }

    proc napPrivSendText {nick} {
	set w .pw_[napS2W $nick]
	set text [$w.out get]
	$w.out delete 0 end

	if {[regexp {^/} $text]} {
	    napProcessCmd {} $text
	    return
	}

	napSendGlobal 205 "$nick $text"
	napAddText $w.in.text $text
    }
    bind $w.out <Return> "napPrivSendText $nick"

    bind $w <Control-c> [list napClosePriv [napS2B $w]]
    
    bind $w <Shift-Page_Up> \
	    [list [napS2B $w].in.text yview scroll -1 pages]
    bind $w <Shift-Page_Down> \
	    [list [napS2B $w].in.text yview scroll 1 pages]

    bind $w <Button-3> [list napPopupMenu [napS2B $w].pmenu]
    
    bind $w <FocusIn> [list set nap(curwin) [napS2B $w]]
  
    set nap(curwin) $w
    focus $w.out
    update idletasks
    lappend nap(pwinlist) $w
}


proc napClosePriv {w} {
    global nap

    catch {focus $nap(old_focus)}
    catch {destroy $w}

    if {[set i [lsearch -exact $nap(pwinlist) $w]] == -1} {
	napDebug "napClosePriv: Can't find window $w"
    } else {
	set nap(pwinlist) [lreplace $nap(pwinlist) $i $i]
    }
}


proc napUpdateUserList {type data} {
    global nap

    regexp {^([^ ]+) ([^ ]+) (.+)$} $data match c nick uinfo

    set w .cw_[napS2W $c]
    if {($type != 408) && (! [winfo exists $w])} return

    if {($type == 406) || ($type == 408)} {
	lappend nap(ulist,$c) "$nick "
	set nap(uinfo,$c,$nick) $uinfo
	if {$type == 406} {
	    set nap(ulist,$c) [lsort -dictionary $nap(ulist,$c)]
	    napAddText $w.boxes.in.text \
		    "*** $nick has joined channel $c"
	}
    } else {
	napAddText $w.boxes.in.text \
		"*** $nick has left channel $c"
	set n [lsearch -exact $nap(ulist,$c) "$nick "]
	if {$n == -1} {
	    napDebug "napUpdateUserList: user $nick not in list"
	    return
	}
	set nap(ulist,$c) [lreplace $nap(ulist,$c) $n $n]
	if {[catch {unset nap(uinfo,$c,$nick)}]} {
	    napDebug "napUpdateUserList: unset $nick error"
	}
    }
}


proc napMenuCmd {c cmd cmenu} {
    global nap

    if {$cmenu} {
	set nick [string trim [.cw_[napS2W $c].boxes.users.list get active]]
    } else {
	set nick $c
    }

    set chn {}

    switch $cmd {
	msg {
	    set msg [get_input {} Message 40]
	    if {$msg == ""} return
	    set prm "$nick $msg"
	}
	
	whois {
	    set prm $nick
	}

	browse {
	    set prm $nick
	}

	ping {
	    set prm $nick
	}

	op {
	    set chn $c
	    set prm $nick
	}

	deop {
	    set chn $c
	    set prm $nick
	}

	muzzle {
	    set reason [get_input {} Reason 40]
	    set prm "$nick $reason"
	}

	unmuzzle {
	    set prm $nick
	}

	kick {
	    set reason [get_input {} Reason 40]
	    set chn $c
	    set prm "$nick $reason"
	}

	kill {
	    set reason [get_input {} Reason 40]
	    set prm "$nick $reason"
	}

	ban {
	    set reason [get_input {} Reason 40]
	    set prm "$nick $reason"
	}
    }

    napProcessCmd $chn "/$cmd $prm"
}
.
