#!/usr/bin/wish
#  Alicq ICQ client
#  Copyright (C) Ihar Viarheichyk 2001

#  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.

# search library also in script directory
lappend auto_path [file dirname [info script]]

package require icq

switch $tcl_platform(platform) {
	unix	{ set LIBS [list /usr/lib/alicq [file dirname [info script]]]
			  set SHARES [list /usr/share/alicq [file dirname [info script]]/GUI]
			}
	windows	{ set LIBS [file dirname [info script]]
			  set SHARES [file join [file dirname [info script]] GUI]
	  		}
}
set LOGLEVEL 1

set properties {visible invisible key encryption}

variable Hooks {}

# Global variables accessible from all modules
set encoding [encoding system]
array set Contacts {}

# Hook management commands
proc Hook {Name Handler} { lappend ::Hooks $Name $Handler }
proc RemoveHook {Name Hook} {
	set newHooks {}
	foreach {name hook} $::Hooks {
		if {$name!=$Name || $hook!=$Hook} {lappend newHooks $name $hook}
	}
	set ::Hooks $newHooks
}
proc RunHooks {Name args} {
	foreach {Hook Handler} $::Hooks {
		if {$Hook==$Name} { 
			set newargs [eval $Handler $args]
			if {[llength $newargs]==[llength $args]} { set args $newargs }
		}
	}
	return $args
}
# Logging
proc Log {level str} {
	if {$level>$::LOGLEVEL} return
	set fd [open $::LOGNAME a]
	set ln "\[[clock format [clock seconds] -format {%x %X}]\]: $str"
	puts $fd $ln
	close $fd
	RunHooks Log $ln
}
proc LogError {id {description "Unknown error"}} { Log 0 "ERROR $id \($description\)" }

# Contact list management commands 
proc ContactInfo {uin myref ref info} {
	if {$ref!=$myref} return
	foreach {key val} $info {
		if {$key=="Nick"} { set ::Contacts($uin:Alias) $val }
	}
	RemoveHook ContactInfo "ContactInfo $uin $ref"
}

proc ChangeInfo {file key newval} {
	set fd1 [open $file r]
	set fd2 [open ${file}.new w]
	seek $fd1 0
	set changed 0
	while {[gets $fd1 ln]!=-1} {
		if {[regexp $key $ln]} {
			 if {$newval!={}} {puts $fd2 $newval}
			 set changed 1
		} else { puts $fd2 $ln }
	}
	if {!$changed && $newval!={}} {puts $fd2 $newval }
	close $fd1
	close $fd2
	file rename -force ${file}.new $file	
}

proc PropertyChanged {uin property} {
	if {$property=="visible"||$property=="invisible"} {
		if [string is true $::Contacts($uin:Property_$property)] {
			 icq::AddToList $property $uin
		} else { icq::RemoveFromList $property $uin }
	}
}
proc ContactsChanged {name1 name2 op} {
	foreach {uin field} [split $name2 :] break
	if {$op=="u"} {
		if {$field!=""} return
		set value {}
	} else {
		if {![info exists ::Contacts($uin:Alias)] || \
	    	    ![info exists ::Contacts($uin:Groups)]} return
		set found 0
		foreach item {Alias Groups Property_*} {
			if [string match $item $field] {set found 1; break}	
		}
		if !$found return
		set value "Contact $uin \{$::Contacts($uin:Alias)\} \{$::Contacts($uin:Groups)\}"
		set prop {}
		foreach item $::properties {
			if [info exists ::Contacts($uin:Property_$item)] {
				append prop "$item=$::Contacts($uin:Property_$item) "
			}
			if {$field=="Property_$item"} { PropertyChanged $uin $item }
		}
		if {$prop!={}} {append value " {$prop}"}
	}
	set key "^\\s*Contact\\s*$uin"
	ChangeInfo $::ContactsFile $key $value
}
proc GroupsChanged {name1 name2 op} {
	set key "^\\s*Group\\s$name2"
	set value ""
	if {$op=="w"} {set value "Group $name2 \{$::Groups($name2)\}"}
	ChangeInfo $::ContactsFile $key $value
	if {$op=="u"} {
		foreach uin [EnumContacts] {
			set pos [lsearch $::Contacts($uin:Groups) $name2]
			if {$pos!=-1} {
				set ::Contacts($uin:Groups) [lreplace $::Contacts($uin:Groups)\
											 $pos $pos]
			}
		}
	}
}

proc AddGroup {name} { set ::Groups([clock seconds]) $name }

proc AddContact {uin groups alias} {
	Contact $uin $alias $groups
	icq::AddToList contacts [list $uin]
	set ref [expr [clock seconds] & 0xff]
	Hook ContactInfo "ContactInfo $uin $ref"
	icq::ShortInfoRequest $uin $ref
}
proc EnumContacts {} { return [array names ::Contacts *\[0-9\]] }

# Actions base
proc Action {Type Name cmd} { set ::Actions($Type:$Name) $cmd }
# Status handling
proc ChangeStatus {uin status args} { 
	if {![info exists $::Contacts($uin:Status)] ||\
				$::Cnotacts($uin:Status)!=$status} {
		set ::Contacts($uin:Status) $status }
	if {[llength $args]} {
		set ip [lindex $args 0]
		set ::Contacts($uin:IP) [expr ($ip>>24)&255].[expr ($ip>>16)&255].[expr ($ip>>8)&255].[expr $ip&255]
	} else {set ::Contacts($uin:IP) "unknown" }
}

proc ChangeMyStatus {status} {
	if {$status=="offline"} {
		foreach uin [EnumContacts] { RunHooks ContactStatus $uin offline }
	}
}
# this is a stub for further module parameters support
proc parameter {name args} { uplevel 1 "variable $name $args" }

# Startup file commands
proc Module {fname} { 
	global modname name
	set search_path [concat {{}} $::LIBS]
	foreach item $search_path {
		set chk_name [file join $item $fname]	
		if {![file exists $chk_name]} {
			Log 0 "Can't find module $chk_name"
		} else {
			set fname $chk_name
			Log 0 "Module found at $fname"
			break
		}
	}
	set modname $fname
	set name [file rootname [file tail $fname]]
	if {[catch {
		namespace eval $name { source $modname }
	} Val]} {
		 Log 0 "Error loading module $modname: $Val"
		 return -code ok "Module loading failed"
	} else { Log 1 "Loaded module \"$name\"" }
}
proc Contact {uin alias groups {properties {}}} {
	global Contacts
	set Contacts($uin) 0
	set Contacts($uin:Alias) $alias
	set Contacts($uin:Status) offline
	if {![llength $groups]} {lappend groups other}
	set Contacts($uin:Groups) $groups
	foreach prop $properties {
			foreach {key value} [split $prop =] break
			set Contacts($uin:Property_$key) $value
	}
}
proc Group {gid alias} { set ::Groups($gid) $alias }

proc SourceConfig {} {
	switch -exact $::tcl_platform(platform) {
		unix  {set flist {~/.alicq/alicqrc ~/.alicqrc}}
  	     windows {  if {[info exists ::env(USERPROFILE)]} {
  				set flist [list [file join $::env(USERPROFILE) alicq alicq.cfg]]
  			} else {set flist {}}
  			lappend flist [file join [file dirname [info script]] alicq.cfg ]
		     }
	}
	foreach fname $flist {
		Log 3 "Checking startup file $fname"
		if {[file exists $fname]} {
			set config_exists 1
			Log 3 "Startup file $fname found"
			set ::BASE [file dirname $fname]
			uplevel #0 "source \{$fname\}"
			return 1
		}
	}
	return 0
}

#################### Alicq data #######################
switch $tcl_platform(platform) {
	unix {set LOGNAME "~/.alicq/alicq.log"}
	windows {set LOGNAME [file join [file dirname [info script]] alicq.log]}
}
if {![file exist [file dirname $::LOGNAME]]} {file mkdir [file dirname $::LOGNAME]}
if {[file exists $::LOGNAME]} {file delete $::LOGNAME}
Log 1 "Alicq started"
Hook Error LogError
# If config file was not found, using default module set
if {![SourceConfig]} {
	Log 3 "Startup file was not found, using default values"
	set modlist [list [file join modules encoding] [file join GUI base]]
	if {$::tcl_platform(platform)=="unix"} {
		lappend modlist [file join modules licq]
	}	
	foreach module $modlist { Module $module.tcl }
}
set Groups(other) "Other"

foreach var {Uin Password Alias} {
	if {[info exists $var]} { set Contacts(me:$var) [set $var] }
}

if {![info exists Contacts(me:Uin)] || ![info exists Contacts(me:Password)]} {
	RunHooks Error 0:20 "Either UIN or password is not set. Can't continue."
	exit 0
}

if {![info exists Contacts(me:Alias)]} {
	set Contacts(me:Alias) $Contacts(me:Uin) 
}

Hook ContactStatus ChangeStatus
Hook MyStatus ChangeMyStatus

if {[info exists ContactsFile] && $ContactsFile!=""} {
	trace variable Contacts wu ContactsChanged
	trace variable Groups wu GroupsChanged
}
set cmd [list -uin $Contacts(me:Uin) -password $Contacts(me:Password) \
	      -encoding $encoding -eventproc ::RunHooks -logproc ::Log]
foreach opt {server port reconnect status proxy_server proxy_port\
	     proxy_user proxy_password} {
	if {[info exists $opt]} { lappend cmd "-$opt" [set $opt] }
}
#lappend cmd -register pupkin
eval icq::icq $cmd

foreach uin [EnumContacts] {
	icq::AddToList contacts $uin
	if {[info exists ::Contacts($uin:Property_visible)] &&\
		[string is true $::Contacts($uin:Property_visible)]} {
			icq::AddToList visible $uin
	}
}
unset cmd

