abook.tcl

Linux下的MSN聊天程序源码

		
		fconfigure $file_id -encoding utf-8

		if { [string equal $type "amsn"] } {
			puts $file_id "<?xml version=\"1.0\" standalone=\"yes\" encoding=\"UTF-8\"?>"
			puts $file_id "<AMSN_AddressBook time=\"[clock seconds]\">"
			foreach user [array names users_data] {
				puts $file_id "<contact name=\"[::sxml::xmlreplace $user]\">"

				array set temp_array $users_data($user)
				foreach field [array names temp_array] {
					puts -nonewline $file_id "\t<$field>"
					puts -nonewline $file_id "[::sxml::xmlreplace $temp_array($field)]"	
					puts $file_id "</$field>"				
				}
				puts $file_id "</contact>"
				array unset temp_array
			}
			puts $file_id "</AMSN_AddressBook>"
		} elseif { [string equal $type "csv"] } {
			puts $file_id "email,name"
			foreach contact [::abook::getAllContacts] {
				if { [string last "FL" [::abook::getContactData $contact lists]] != -1 } {
					array set temp_array $users_data($contact)
					if { [info exists temp_array([array names temp_array "nick"])] } {
						puts $file_id "$contact,$temp_array([array names temp_array "nick"])"
					} else {
						puts $file_id "$contact,"
					}
				}
			}
		} elseif { [string equal $type "ctt"] } {
			puts $file_id "<?xml version=\"1.0\"?>\n<messenger>\n\t<service name=\".NET Messenger Service\">\n\t\t<contactlist>"
			foreach contact [::abook::getAllContacts] {
				if { [string last "FL" [::abook::getContactData $contact lists]] != -1 } {
					puts $file_id "\t\t\t<contact>$contact</contact>"
				}
			}
			puts $file_id "\t\t</contactlist>\n\t</service>\n</messenger>"
		}
			

		close $file_id
	}

	
	proc loadFromDisk { {filename ""} } {

		global HOME

		if {![LoginList lockexists "" [::config::getKey login]]} {
			file delete [file join $HOME abook.xml]
		}
		
		if { $filename == "" } {
			set filename [file join $HOME abook.xml]
		}
		
		if {[file readable $filename] == 0} {
			return -1
		}
		
		status_log "Loading address book data...\n" blue
		set abook_id [::sxml::init $filename]
		sxml::register_routine $abook_id "AMSN_AddressBook:contact" "::abook::loadXMLContact"
				
		set ret -1
		
		clearData
		
		catch {
			set ret [sxml::parse $abook_id]
		}
	
		sxml::end $abook_id			
		if { $ret < 0 } {
			clearData
			status_log "::abook::loadFromDisk Error\n" red
			return $ret
		} else {			
			status_log "Address book data loaded...\n" green
			setConsistent
			return 0
		}
	}
	
	proc loadXMLContact {cstack cdata saved_data cattr saved_attr args } {
		variable users_data
		upvar $saved_data sdata 
		upvar $saved_attr sattr
		
		array set attr $cattr
		
		set parentlen [string length $cstack]
		foreach child [array names sattr] {
			if { $child == "_dummy_" } {
				continue
			}
			set fieldname [string range $child [expr {$parentlen+1}] end]
			#Remove this. Only leave it for some days to remove old ::abook stored data
			if { $fieldname == "field" } {
				continue
			}
			setContactData $attr(name) $fieldname $sdata($child)
		}
		
		return 0	
		
	}
	
	
	proc importContact { } {
	
		set filename [chooseFileDialog]

		if { $filename != "" } {
			if { [string match -nocase "*.ctt" "$filename"] } {
				::abook::importContactctt $filename
			} elseif { [string match -nocase "*.csv" "$filename"] } {
				::abook::importContactcsv $filename
			}
		}
		
	}
	
	proc importContactcsv { filename } {
	
		set ImportedContact [list]
		
		set file_id [open $filename r]
		fconfigure $file_id -encoding utf-8
		set content [read $file_id]
		close $file_id
		set lines [split $content "\n"]
		
		foreach line $lines {
			if { [string first "@" $line] != -1 } {
				set coma [string first "," $line]
				set contact [string range $line 0 [expr {$coma - 1}]]
				set ImportedContact [lappend ImportedContact $contact]
			}
		}
		
		::abook::importContactList $ImportedContact
		
	}
	
	proc importContactctt { filename } {
	
		status_log "Salut\n" red
	
		set ImportedContact [list]
		
		set file_id [open $filename r]
		fconfigure $file_id -encoding utf-8
		set content [read $file_id]
		close $file_id
		set lines [split $content "\n"]
		
		status_log "$lines"
		
		foreach line $lines {
			set id1 [string first "<contact>" $line]
			set id2 [string first "</contact>" $line]
			if { $id1 != -1 && $id2 != -1 } {
				incr id1 9
				incr id2 -1
				set contact [string range "$line" $id1 $id2]
				set ImportedContact [lappend ImportedContact $contact]
			}
		}
		
		::abook::importContactList $ImportedContact

	}
	
	proc importContactList { ImportedContact } {
	
		foreach contact $ImportedContact {
			status_log "Importation of contacts : $contact\n" red
			if { [::config::getKey protocol] >= 11 } {
				::MSN::WriteSB ns "ADC" "FL N=$contact F=$contact"
			} else {
				::MSN::WriteSB ns "ADD" "FL $contact $contact 0"
			}
		}
				
	}

	

}

namespace eval ::abookGui {
   namespace export Init showEntry

    if { $initialize_amsn == 1 } {

	#
	# P R I V A T E
	#
	variable bgcol #ABC8CE;	# Background color used in MSN Messenger
    }

   #
   # P R O T E C T E D
   #
    proc updatePhones { t h w m p} {
	set phome [urlencode [$t.$h get]]
	set pwork [urlencode [$t.$w get]]
	set pmobile [urlencode [$t.$m get]]
	::abook::setPhone home $phome
	::abook::setPhone work $pwork
	::abook::setPhone mobile $pmobile
	::abook::setPhone pager N
    }

   #
   # P U B L I C
   #
   	proc Init {} {
		variable bgcol
		::themes::AddClass ABook * {-background $bgcol} 90
		::themes::AddClass ABook Label {-background $bgcol} 90
		::themes::AddClass NoteBook * {-background $bgcol} 90
	}
   

	proc userDPs_raise_cmd { nb email } { 
		package require dpbrowser
		set nbIdent [$nb getframe userDPs]
		
		if { ![winfo exists $nbIdent.otherpics]} {
			::dpbrowser $nbIdent.otherpics -user $email
			pack $nbIdent.otherpics -expand true -fill both
		}
	}
		  



	proc showUserProperties { email } {
		global colorval_$email showcustomsmileys_$email ignorecontact_$email
		set w ".user_[::md5::md5 $email]_prop"
		if { [winfo exists $w] } {
			raise $w
			return
		}
		toplevel $w
		wm title $w [trans userproperties $email]
		
		NoteBook $w.nb
		$w.nb insert 0 userdata -text [trans userdata]
		$w.nb insert 1 usersettings -text [trans usersettings]
		$w.nb insert 2 alarms -text [trans alarms]
		$w.nb insert 3 userDPs -text [trans userdps] \
			-raisecmd [list ::abookGui::userDPs_raise_cmd $w.nb $email]

		##############
		#Userdata page
		##############
		set nbIdent [$w.nb getframe userdata]
		ScrolledWindow $nbIdent.sw
		set sw $nbIdent.sw
		ScrollableFrame $nbIdent.sw.sf -constrainedwidth 1
		$nbIdent.sw setwidget $nbIdent.sw.sf
		set nbIdent [$nbIdent.sw.sf getframe]
		
		labelframe $nbIdent.fBasicInfo -relief groove -text [trans identity]
		
		label $nbIdent.fBasicInfo.displaypic -image [::skin::getDisplayPicture $email] -highlightthickness 2 -highlightbackground black -borderwidth 0
		
		set nick [::abook::getNick $email]
		set h [expr {[string length $nick]/50 +1}]
		text $nbIdent.fBasicInfo.h1 -font bigfont -fg blue -height $h -wrap word -bd 0
		$nbIdent.fBasicInfo.h1 delete 0.0 end
		$nbIdent.fBasicInfo.h1 insert 0.0 $nick
		$nbIdent.fBasicInfo.h1 configure -state disabled
		set h1copymenu [::abook::CreateCopyMenu $nbIdent.fBasicInfo.h1]
		bind $nbIdent.fBasicInfo.h1 <Button3-ButtonRelease> "tk_popup $h1copymenu %X %Y"
		
		if { [::config::getKey protocol] >= 11 } {
			set psm [::abook::getVolatileData $email PSM]
			set h [expr {[string length $psm]/50 +1}]
			text $nbIdent.fBasicInfo.psm1 -font sitalf -fg blue -height $h -wrap word -bd 0
			$nbIdent.fBasicInfo.psm1 delete 0.0 end
			$nbIdent.fBasicInfo.psm1 insert 0.0 $psm
			$nbIdent.fBasicInfo.psm1 configure -state disabled
			set psm1copymenu [::abook::CreateCopyMenu $nbIdent.fBasicInfo.psm1]
			bind $nbIdent.fBasicInfo.psm1 <Button3-ButtonRelease> "tk_popup $psm1copymenu %X %Y"
		}

		set h [expr {[string length $email]/50 +1}]
		text $nbIdent.fBasicInfo.e1 -font splainf -fg blue -height $h -wrap word -bd 0
		$nbIdent.fBasicInfo.e1 delete 0.0 end
		$nbIdent.fBasicInfo.e1 insert 0.0 $email
		$nbIdent.fBasicInfo.e1 configure -state disabled
		set e1copymenu [::abook::CreateCopyMenu $nbIdent.fBasicInfo.e1]
		bind $nbIdent.fBasicInfo.e1 <Button3-ButtonRelease> "tk_popup $e1copymenu %X %Y"
		
		frame $nbIdent.fBasicInfo.fGroup
		label $nbIdent.fBasicInfo.fGroup.g -text "[trans group]:" -font splainf
		label $nbIdent.fBasicInfo.fGroup.g1 -text "[::abook::getGroupsname $email]" -font splainf -fg blue -justify left -wraplength 300
		pack $nbIdent.fBasicInfo.fGroup.g -side left
		pack $nbIdent.fBasicInfo.fGroup.g1 -side left
		
		grid $nbIdent.fBasicInfo.displaypic -row 0 -column 0 -sticky nwe -rowspan 4 -padx {0 8}
		grid $nbIdent.fBasicInfo.h1 -row 0 -column 1 -sticky w
		if { [::config::getKey protocol] >= 11 } {
			grid $nbIdent.fBasicInfo.psm1 -row 1 -column 1 -sticky w
		}
		grid $nbIdent.fBasicInfo.e1 -row 2 -column 1 -sticky w
		grid $nbIdent.fBasicInfo.fGroup -row 3 -column 1 -sticky w
		grid columnconfigure $nbIdent.fBasicInfo 1 -weight 1

		labelframe $nbIdent.fPhone -text [trans phones]
		label $nbIdent.fPhone.phh -text "[trans home]:" 
		label $nbIdent.fPhone.phh1 -font splainf -text [::abook::getVolatileData $email phh] -fg blue \
		-justify left -wraplength 300 
		label $nbIdent.fPhone.phw -text "[trans work]:"
		label $nbIdent.fPhone.phw1 -font splainf -text [::abook::getVolatileData $email phw] -fg blue \
			-justify left -wraplength 300 
		label $nbIdent.fPhone.phm -text "[trans mobile]:" 
		label $nbIdent.fPhone.phm1 -font splainf -text [::abook::getVolatileData $email phm] -fg blue \
		-justify left -wraplength 300 
		label $nbIdent.fPhone.php -text "[trans pager]:" 
		label $nbIdent.fPhone.php1 -font splainf -text [::abook::getVolatileData $email mob] -fg blue \
		-justify left -wraplength 300 

		grid $nbIdent.fPhone.phh -row 0 -column 0 -sticky e
		grid $nbIdent.fPhone.phh1 -row 0 -column 1 -sticky w
		grid $nbIdent.fPhone.phw -row 1 -column 0 -sticky e
		grid $nbIdent.fPhone.phw1 -row 1 -column 1 -sticky w
		grid $nbIdent.fPhone.phm -row 2 -column 0 -sticky e
		grid $nbIdent.fPhone.phm1 -row 2 -column 1 -sticky w
		grid $nbIdent.fPhone.php -row 3 -column 0 -sticky e
		grid $nbIdent.fPhone.php1 -row 3 -column 1 -sticky w
		grid columnconfigure $nbIdent.fPhone 1 -weight 1

		labelframe $nbIdent.fStats -text [trans others]
		label $nbIdent.fStats.lastlogin -text "[trans lastlogin]:"
		label $nbIdent.fStats.lastlogin1 -text [::abook::dateconvert "[::abook::getContactData $email last_login]"] -font splainf -fg blue 
		
		label $nbIdent.fStats.lastlogout -text "[trans lastlogout]:"
		label $nbIdent.fStats.lastlogout1 -text [::abook::dateconvert "[::abook::getContactData $email last_logout]"] -font splainf -fg blue 

		label $nbIdent.fStats.lastseen -text "[trans lastseen]:"
		if { [::abook::getVolatileData $email state] == "FLN" || [lsearch [::abook::getContactData $email lists] "FL"] == -1} {
			label $nbIdent.fStats.lastseen1 -text [::abook::dateconvert "[::abook::getContactData $email last_seen]"] -font splainf -fg blue
		} elseif { [::abook::getContactData $email last_seen] == "" } {		
			label $nbIdent.fStats.lastseen1 -text "" -font splainf -fg blue
		} else {
			label $nbIdent.fStats.lastseen1 -text [trans online] -font splainf -fg blue
		}
		
		label $nbIdent.fStats.lastmsgedme -text "[trans lastmsgedme]:"
		label $nbIdent.fStats.lastmsgedme1 -text [::abook::dateconvert "[::abook::getContactData $email last_msgedme]"] -font splainf -fg blue
		#Client-name of the user (from Gaim, dMSN, etc)
		label $nbIdent.fStats.clientname -text "[trans clientname]:"
		label $nbIdent.fStats.clientname1 -text "[::abook::getContactData $email clientname] ([::abook::getContactData $email client])" -font splainf -fg blue
		
		#Does the user record the conversation or not
		if { [::abook::getContactData $email chatlogging] eq "Y" } {
			set chatlogging [trans yes]
		} elseif { [::abook::getContactData $email chatlogging] eq "N" } {
			set chatlogging [trans no]
		} else {
			set chatlogging [trans unknown]
		}
		
		label $nbIdent.fStats.chatlogging -text "[trans logschats]:"
		label $nbIdent.fStats.chatlogging1 -text $chatlogging -font splainf -fg blue
		grid $nbIdent.fStats.lastlogin -row 0 -column 0 -sticky e
		grid $nbIdent.fStats.lastlogin1 -row 0 -column 1 -sticky w
		grid $nbIdent.fStats.lastlogout -row 1 -column 0 -sticky e
		grid $nbIdent.fStats.lastlogout1 -row 1 -column 1 -sticky w
		grid $nbIdent.fStats.lastmsgedme -row 2 -column 0 -sticky e
		grid $nbIdent.fStats.lastmsgedme1 -row 2 -column 1 -sticky w
		grid $nbIdent.fStats.lastseen -row 3 -column 0 -sticky e
		grid $nbIdent.fStats.lastseen1 -row 3 -column 1 -sticky w
		grid $nbIdent.fStats.clientname -row 4 -column 0 -sticky e
		grid $nbIdent.fStats.clientname1 -row 4 -column 1 -sticky w
		grid $nbIdent.fStats.chatlogging -row 5 -column 0 -sticky e
		grid $nbIdent.fStats.chatlogging1 -row 5 -column 1 -sticky w
		grid columnconfigure $nbIdent.fStats 1 -weight 1
		
		grid $nbIdent.fBasicInfo -row 0 -column 0 -sticky nwse -columnspan 2 -ipadx 4 -ipady 4