#
# 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
# mats_peterson@swipnet.se  (Mats Peterson)
#


proc napRcvGlobal {type data} {
    global nap

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

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

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

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

    switch $type {
	205 {				    # private message
	    $textbox insert end "\n> $msg"
	}

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

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

	751 {				    # ping
	    $textbox insert end "\n*** $nick PING"
	    if {[catch {napSendMsg 752 $nick} r]} {
		napDisconnect $r
	    }
	}

	752 {				    # pong
	    $textbox insert end \
		    "\n*** PONG received from $nick"
	}
    }

    if {[expr {int([$textbox index end])}] > 500} {
	$textbox delete 0.0 25.0
    }
    $textbox see end
}


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

    switch $type {
	403 {				    # public message
	    regexp {^([[:graph:]]+) ([[:graph:]]+) *(.*)$} $data \
		    match c nick text
	    $w.boxes.in.text insert end "\n<$nick> $text"
	}
        
	406 {				    # user joined channel
	    regexp {^(.+) (.+) (.+) (.+)$} $data \
		    match c nick shared link
	    $w.boxes.in.text insert end \
		    "\n*** $nick has joined channel $c"
	    napUpdateUserList $c $nick $shared $link
	}
        
	407 {				    # user left channel
	    regexp {^(.+) (.+) (.+) (.+)$} $data \
		    match c nick shared link
	    $w.boxes.in.text insert end \
		    "\n*** $nick has left channel $c"
	    napUpdateUserList $c $nick
	}

	410 {				    # channel topic
	    regexp {^([[:graph:]]+) (.+)$} $data match c topic

	    if {! [winfo exists $w]} return    
	    wm title $w "$c  $topic"
	}

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

    if {[expr {int([$w.boxes.in.text index end])}] > 500} {
	$w.boxes.in.text delete 0.0 25.0
    }
    $w.boxes.in.text see end
}


proc napSendGlobal {type data} {
    global nap
    
    switch $type {
	205 {					# private message
	    if {! [regexp {^([[:graph:]]+) *(.*)$} \
		    $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 {^[[:graph:]]+} $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
    
    set nap(old_focus) [focus]
    catch {destroy .clwin}
    toplevel .clwin -relief raised -bd 2 -class Channels
    wm geometry .clwin 75x20
    wm title .clwin "Channel List"
   
    frame .clwin.reslist -bd 3m
    pack .clwin.reslist -expand yes -fill both
    listscroll .clwin.reslist 75 1 1
    .clwin.reslist.list configure -selectmode extended \
	    -font {lucidatypewriter 12 bold}

    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 {^[[:graph:]]+} $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 {^[[:graph:]]+} $e chn
	napJoinChannel $chn
    }

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

    focus .clwin.reslist.list
    update idletasks

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


proc napQuickInfo {c nick} {
    global nap

    if {$nick == ""} {
	set nick [string trim [.cw_$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 napUserMenu {c} {
    global nap

    set w .cw_$c
    tk_popup $w.cmenu [winfo pointerx $w] [winfo pointery $w]
}


proc napChannelWindow {c} {
    global nap

    set w .cw_$c
    set nap(old_focus) [focus]
    catch {destroy $w}
    toplevel $w -relief raised -bd 2 -class Channel
    wm geometry $w 45x15
    wm title $w $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 45 1 0
    $f.in.text configure -font variable -wrap word -spacing3 2 \
	    -takefocus 0
       
    frame $f.users
    pack $f.users -side left -expand yes -fill both
    listscroll $f.users 12 1 1
    $f.users.list configure \
	    -font {lucidatypewriter 12 bold} -listvar nap(ulist,$c)
    $f.users.xscroll configure -takefocus 0
    $f.users.yscroll configure -takefocus 0

    entry $w.out
    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 {qinfo whois browse ping muzzle unmuzzle kick kill ban} {
	if {$i == "qinfo"} {
	    set title "Quick Info"
	    set cmd [list napQuickInfo $c {}]
	} else {
	    set title [string totitle $i]
	    set cmd [list napMenuCmd $c $i]
	}
	$w.cmenu add command -label $title -command $cmd
    }

    proc napChanSendText {c} {
	set w .cw_$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 $c]

    bind $w <Control-p> [list napPartChannel $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 <i> [list napQuickInfo $c {}]
    bind $f.users.list <w> [list napMenuCmd $c whois]
    bind $f.users.list <b> [list napMenuCmd $c browse]
    bind $f.users.list <p> [list napMenuCmd $c ping]
    bind $f.users.list <Control-m> [list napMenuCmd $c muzzle]
    bind $f.users.list <Control-u> [list napMenuCmd $c unmuzzle]
    bind $f.users.list <Control-k> [list napMenuCmd $c kick]
    bind $f.users.list <Control-l> [list napMenuCmd $c kill]
    bind $f.users.list <Control-b> [list napMenuCmd $c ban]
    bind $f.users.list <Button-3> [list napUserMenu $c]
    bind $w <FocusIn> [list set nap(curwin) $w]

    proc napUnsetUsers {c} {
	global nap
	unset nap(ulist,$c)
	array unset nap "uinfo,$c,*"
    }
    bind $w.out <Destroy> [list napUnsetUsers $c]

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


proc napJoinChannel {c} {
    global nap
    
    simplemsg create "Joining $c..."
    
    if {[catch {napSendMsg 400 $c} r]} {
	napDisconnect $r
	return
    }
    
    set nap(firstuser) 1
    set nap(joined) {}
    waitvar nap(joined) $nap(timeout)

    if {$nap(joined) == "Timeout"} {
	simplemsg destroy
	errmsg "Timeout"
	return
    }

    if {$nap(joined) == ""} {
	simplemsg destroy
	return
    }

    set c $nap(joined)

    set nap(ulistend,$c) 0
    waitvar nap(ulistend,$c) $nap(timeout)

    simplemsg destroy
    if {$nap(ulistend,$c) == "Timeout"} {
	errmsg "Timeout"
	return
    }

    napChannelWindow $c
    lappend nap(cwinlist) .cw_$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_$c}

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


proc napPrivWindow {nick} {
    global nap

    set w .pw_$nick
    set nap(old_focus) [focus]
    catch {destroy $w}
    toplevel $w -relief raised -bd 2 -class Private
    wm geometry $w 45x15
    wm title $w $nick
   
    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 variable -wrap word -spacing3 2 \
	    -takefocus 0
                  
    entry $w.out
    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

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

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

	napSendGlobal 205 "$nick $text"
	$w.in.text insert end "\n$text"
	if {[expr {int([$w.in.text index end])}] > 500} {
	    $w.in.text delete 0.0 25.0
	}
	$w.in.text see end
    }
    bind $w.out <Return> "napPrivSendText $nick"

    bind $w <Control-c> [list napClosePriv $w]
    
    bind $w <Shift-Page_Up> [list $w.in.text yview scroll -1 pages]
    bind $w <Shift-Page_Down> [list $w.in.text yview scroll 1 pages]
    
    bind $w <FocusIn> [list set nap(curwin) $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 {c nick {shared ""} {link ""}} {
    global nap
    
    if {! [winfo exists .cw_$c]} return

    if {$shared != ""} {
	lappend nap(ulist,$c) "$nick "
	set nap(uinfo,$c,$nick) "$shared $link"
    } else {
	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"
	    return
	}
    }
}


proc napUserListEntry {data} {
    global nap

    set data [napListMap $data]
    set c [lindex $data 0]
    set nick [lindex $data 1]

    lappend nap(ulist,$c) "$nick "
    set nap(uinfo,$c,$nick) [lrange $data 2 end]
}


proc napUserListEnd {data} {
    global nap

    set c [string trim $data]
    set nap(ulistend,$c) 1
}


proc napMenuCmd {c cmd} {
    global nap

    set nick [string trim [.cw_$c.boxes.users.list get active]]
    set chn {}

    switch $cmd {
	whois {
	    set prm $nick
	}

	browse {
	    set prm $nick
	}

	ping {
	    set prm $nick
	}

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

	unmuzzle {
	    set prm $nick
	}

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

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

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

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