amsn

Linux下的MSN聊天程序源码

#!/bin/bash
# \
exec wish $0

###
###
################################################################
###                                              ###############
###        Alvaro's Messenger - amsn             ###############
###                                              ###############
###       http://amsn.sourceforge.net            ###############
###     [e-mail]         ###############
###                                              ###############
################################################################
### airadier at users.sourceforge.net (airadier) ###############
### Universidad de Zaragoza                      ###############
### http://aim.homelinux.com                     ###############
################################################################
### [e-mail] (LordOfScripts)     ###############
### http://www.coralys.com/linux/                ###############
################################################################
### Original ccmsn                               ###############
### http://msn.CompuCreations.com/               ###############
### Dave Mifsud <dave at CompuCreations dot com> ###############
################################################################
###
###
### 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; version 2 of the License
###
### 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
###
###

############################################################
### Hide the window until it has been fully displayed
############################################################
package require Tk
wm state . withdraw


############################################################
### Some global variables
############################################################
# variable rcversion so autoupdate has no problems, version is used to be easier for users
# rcversion major.minor.patch, patch is 91,92 for RC's and after a release we put .svn
# behind the version (after 0.95.90 comes 0.95.90.svn, after 0.96 comes 0.96.90.svn)
set version "0.96rc1"
set rcversion "0.95.91"
set date "06/16/2006"
set weburl "http://amsn.sourceforge.net"
set program_dir "."
set HOME ""
set HOME2 ""

#=======================================================================


############################################################
### Look if we are launched from a link
### and set the correct working dir
############################################################

#Fixed by Tomasz Nguyen
set program_dir [file dirname [info script]]
set program [file tail [info script]]


while {[catch {file readlink [file join $program_dir $program]} program]== 0} {
	if {[file pathtype $program] == "absolute"} {
		set program_dir [file dirname $program]
	} else {
		set program_dir [file join $program_dir [file dirname $program]]
	}

	set program [file tail $program]
}

set starting_dir [pwd]
cd $program_dir
set program_dir [pwd]
unset program
#unset program_dir

############################################################
### Setup other important directory paths
### depending on the platform
############################################################

if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
	set HOME "[file join $env(HOME) Library/Application\ Support/amsn]"
} elseif {$tcl_platform(platform) == "unix"} {
   set HOME "[file join $env(HOME) .amsn]"
} elseif {$tcl_platform(platform) == "windows"} {
  if {[info exists env(USERPROFILE)]} {
     set HOME "[file join $env(USERPROFILE) amsn]"
  } else {
   set HOME "[file join [pwd] amsn_config]"
  }
} else {
   set HOME "[file join [pwd] amsn_config]"
}
set HOME2 $HOME

############################################################
### And setup where to find optional packages
############################################################

lappend auto_path [file join ${HOME} plugins]
#Specific folder to check for package on platforms
if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
	lappend auto_path [file join utils macosx]
} elseif {$tcl_platform(platform) == "windows"} {
	lappend auto_path [file join utils windows]
} elseif {$tcl_platform(platform) == "unix"} {
	lappend auto_path [file join utils linux]
}
lappend auto_path [file join utils]

set libtls ""

catch { source [file join $HOME tlsconfig.tcl] }

if { $libtls != "" && [lsearch $auto_path $libtls] == -1 } {
    lappend auto_path $libtls
}

#TODO: Move this from here ??
#///////////////////////////////////////////////////////////////////////
#Notebook Pages (Buddies,News,Calendar,etc.)
set pgBuddy ""
set pgNews  ""
#///////////////////////////////////////////////////////////////////////


############################################################
#### Load program modules
############################################################
set initialize_amsn 1

proc load_console {} {
	if { [info proc console] == "" && [info command console] == "" } {
		if { [file exists console.tcl] && [file readable console.tcl] } {
			uplevel \#0 {source console.tcl}
			console show
		}
	} else {
		console show
	}
}


proc reload_files { } {
    uplevel \#0 {
	
	source ctthemes.tcl
	source progressbar.tcl	;# Progressbar Megawidget
	source migmd5.tcl
	source des.tcl		;# DES encryption
	source sxml.tcl   	;# Simple XML parser
#	source combobox.tcl	;# The all mighty combobox is here! (B. Oakley)
	package require combobox	
	source mutex.tcl
	source lang.tcl
	source automsg.tcl
	source smileys.tcl
	source skins.tcl	;# Used for skinning purposes
	source remote.tcl	;# The remote control procedures
	source chatwindow.tcl	;# Abstracted Chat Window code (::ChatWindow namespace)
	source picture.tcl ; #Tkcximage procs
	source gui.tcl		;#gui.tcl must be at the beginning to make msg_box procedure available for errors
	source abook.tcl	;# Handle buddy address book    
	source protocol.tcl
	source plugins.tcl	;# Plugins system must be loaded before config
	source pluginslog.tcl
	source config.tcl	;# config needs to be loaded before pluginslog for translations
	source proxy.tcl
	source msnp2p.tcl
	source msncam.tcl
#	source ctadverts.tcl
	source preferences.tcl
	source hotmail.tcl
	source groups.tcl	;# Handle buddy groups


	if {$tcl_platform(os) == "Darwin"} {
		source [file join utils macosx applescript ae.tcl];#AppleEvent support
	}
	source alarm.tcl	;# Alarms code (Burger)
	source dock.tcl		;# Docking routines
	source trayicon.tcl	;# Docking routines for freedesktop system tray compliant docks
	source loging.tcl	;# Euh yeh it's for loging :P
	source searchdialog.tcl ;# Search dialog widget

	source balloon.tcl	;# For the balloons tooltip
	source autoupdate.tcl   ;# AUTOUPDATE!!!!!!!!!! :@
	source notes.tcl
	
	source guicontactlist.tcl ;# New contact list (uses canvas)
	source bugs.tcl 	;#bug reporting
    }
}




proc after_info { } {
	foreach f [after info] {
		status_log "After $f : [after info $f]\n" red
	}
}


if { $::tcl_version < 8.4 } {
	proc K {a b} {return $a}
	proc lset_r {list args val} {
		if { [llength $args] == "0" } {
			return $val
		} else {
			return [lreplace $list [lindex $args 0] [lindex $args 0] [lset_r [lindex $list [lindex $args 0]] [lrange $args 1 end] $val]]
		}
	}
	proc lset {listName args} {
		upvar $listName list
		set list [lset_r [K $list [set list {}]] [lrange $args 0 end-1] [lindex $args end]]
	}
}

reload_files

set initialize_amsn 0
#///////////////////////////////////////////////////////////////////////

if { [catch {package require tls}] } {
    # Either tls is not installed, or $auto_path does not point to it.
    # Should now never happen; the check for the presence of tls is made
    # before this point.
#    status_log "Could not find the package tls on this system.\n"
    set tlsinstalled 0
} else {
    set tlsinstalled 1
}

#create_dir $HOME
set log_dir "[file join ${HOME} logs]"
set webcam_dir "[file join ${HOME} webcam]"
create_dir $log_dir
create_dir $webcam_dir

NS create ns -stat d -server [split [::config::getKey start_ns_server] ":"]

set family [lindex [::config::getGlobalKey basefont] 0]
set size [lindex [::config::getGlobalKey basefont] 1]

::themes::Init
if { $family == "" } { set family "Helvetica"}
if { $size == "" } { set size "11"}
::amsn::initLook $family $size [::config::getKey backgroundcolor]


set ::auto_encoding [encoding system]

if { [::config::getKey encoding] != "auto" } {
  set_encoding [::config::getKey encoding]
}

cmsn_draw_main

bind all <KeyPress> "set idletime 0"

idleCheck

degt_protocol_win
degt_ns_command_win

#after 500 proc_ns
#after 750 proc_sb

if {$version != [::config::getGlobalKey last_client_version]} {
   ::amsn::aboutWindow
   catch {file delete [file join $HOME2 bugreport.amsn]}
   #Force to change to Lucida Grande 12 on OS X, just one time when we switch version
   if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
	   ::config::setGlobalKey basefont [list {Lucida Grande} 12 normal]
	}
}

update idletasks

if { [::config::getKey autoconnect] == 1 } {
  ::MSN::connect
}

if { [::config::getKey autocheckver] == 1 } {
    set new [::autoupdate::check_version_silent]
}


init_dock

if {[::config::getKey startontray]} {
	if {[::config::getKey dock]!=0} {
		wm state . withdraw
		set ishidden 1
	} else {
		wm state . iconic
	}
} else {
	wm state . normal
}

vwait events