nudge.tcl

Linux下的MSN聊天程序源码

	################################################
	# ::Nudge::itemmenu event epvar                #
	# -------------------------------------------  #
	# "Send nudge" item, in the menu Actions       #
	# If you click on that menu item, you will send#
	# a nudge to the other contact                 #
	################################################	
	proc itemmenu { event evpar } {
		upvar 2 $evpar newvar
		#Add a separator to the menu
#		$newvar(menu_name).actions add separator
		#Add label in the menu
		$newvar(menu_name).actions add command -label "$::Nudge::language(send_nudge)" \
		-command "::Nudge::send_via_queue \[::ChatWindow::getCurrentTab $newvar(window_name)\]"
		::Nudge::log "Item Send Nudge added to actions menu of window $newvar(window_name)"
	}
	
	################################################
	# ::Nudge::add_command                         #
	# -------------------------------------------  #
	# Add irc command /nudge for amsnplus users    #
	# Need last update of aMSNPlus plugin +/- 2.3  #
	# Verify first if amsnplus plugin is loaded    #
	################################################
	proc add_command {event evpar} {
	
		#If amsnplus plugin is loaded, register the command
		if { [info commands ::amsnplus::add_command] != "" } {
			#Avoid a bug if someone use an older version of aMSNPlus
			catch {::amsnplus::add_command nudge ::Nudge::SendNudge 0 1}
			::Nudge::log "Register command nudge to amsnplus plugin"
		}
	}
	
	################################################
	# ::Nudge::clitemmenu event epvar      	       #
	# -------------------------------------------  #
	# "Send nudge" item, in the rightclick-menu in #
	# in the contact-list.                         #
	# If you click on that menu item, you will send#
	# a nudge to the other contact.                #
	################################################	
	proc clitemmenu { event evpar } {
		upvar 2 $evpar newvar

		if { $::Nudge::config(addclmenuitem) == 1 } {
			#Add separator and label in the menu
			if { [winfo exists ${newvar(menu_name)}.actions] } {
				${newvar(menu_name)}.actions add separator
				${newvar(menu_name)}.actions add command -label "$::Nudge::language(send_nudge)" \
				-command "::Nudge::ClSendNudge $newvar(user_login)"
			} else {
				

				$newvar(menu_name) insert [trans viewprofile] command -label "$::Nudge::language(send_nudge)" \
				-command "::Nudge::ClSendNudge $newvar(user_login)"
			}
			::Nudge::log "Create Send Nudge item in right click menu"
		}
	}

	################################################  
	# ::Nudge::ClSendNudge username                # 
	# -------------------------------------------  # 
	# Open the chatwindow to $username and send    # 
	# this contact a Nudge                         # 
	################################################
	proc ClSendNudge { username } {

		set lowuser [string tolower $username]
		set win_name [::ChatWindow::For $lowuser]	
		#Determine if a window with that user already exist (0=no window)
		if { $win_name == 0 } {
			::Nudge::log "We don't have any window with <[::abook::getDisplayNick $lowuser]> yet(via right-click menu)"
			#Start the conversation
			::amsn::chatUser $username
			#Now that we have a window, find the name of this new window
			set win_name [::ChatWindow::For $lowuser]
			#Send the nudge via the ChatQueue (to wait that connection is etablished before sending)
			::Nudge::send_via_queue $win_name
		} else {
			::Nudge::log "We already have a window with <[::abook::getDisplayNick $lowuser]> (via right click menu)"
			#If the window with the contact was already open
			#Send the nudge via the ChatQueue to reactive the conversation if it was closed
			::Nudge::send_via_queue $win_name
		}

		
	}
	
		
	############################################
	# ::Nudge::send_via_queue window_name      #
	# -----------------------------------------#
	# Send the Nudge via the ChatQueue         #
	# So, aMSN reconnect on user to send the   #
	# Nudge if the conversation was closed     #
	############################################
	proc send_via_queue {window_name} {
		set chatid [::ChatWindow::Name $window_name]
		::MSN::ChatQueue $chatid [list ::Nudge::SendNudge $window_name]
	}

	################################################
	# ::Nudge::SendNudge window_name               #
	# -------------------------------------------  #
	# Protocole code to send a nudge to someone    #
	# via the button or the menu Actions           #
	################################################
	proc SendNudge {window_name} {
	
		#Find the SB
		set chatid [::ChatWindow::Name $window_name]
		::Nudge::log "\nStart sending Nudge to <[::abook::getDisplayNick $chatid]>\n"
		#Check if the user can accept the nudge (MSN 7 protocol needed), if not, stop here.
		set theysupport 0

		set users [::MSN::usersInChat $chatid]
	
		foreach chatid2 $users {
			if {[::Nudge::check_clientid $chatid2]} {
				#This is what the official client does...
				#sends nudge to a multi-convo even when
				#not everyone supports it
				set theysupport 1
				break
			}
		}

		if { $theysupport == 0 } {
				::Nudge::winwrite $chatid \
				"$::Nudge::language(no_nudge_support)" nudgeoff red
				::Nudge::log "Can't send a Nudge to <[::abook::getDisplayNick $chatid]> because he doesn't use MSN 7 protocol"
				return
			}
	
		
		#If the user choosed to have the nudge notified in the window
		if { $::Nudge::config(notrecdinwin) == 1 } {
			::Nudge::winwrite $chatid "$::Nudge::language(nudge_sent)!" nudge
		}
		
		#If the user choosed to have a sound-notify
		if { $::Nudge::config(soundnotsend) == 1 } {
			::Nudge::sound
		}
		
		#Shake the window on sending if the user choosed it
		if { $::Nudge::config(shaketoo) == 1 } {
			::Nudge::shake $window_name $::Nudge::config(shakes)
		}
		
		#Send the packet of the nudge
		::Nudge::SendPacket $chatid
	}
	
	################################################
	# ::Nudge::SendPacket chatid                   #
	# -------------------------------------------  #
	# Protocole code to send a nudge to someone    #
	# via the button or the menu Actions           #		
	################################################
	proc SendPacket {chatid} {
		set sbn [::MSN::SBFor $chatid]
		
		#Write the packet
		set msg "MIME-Version: 1.0\r\nContent-Type: text/x-msnmsgr-datacast\r\n\r\nID: 1\r\n\r\n\r\n"
		set msg_len [string length $msg]

		#Send the packet
		::MSN::WriteSBNoNL $sbn "MSG" "U $msg_len\r\n$msg"
		::Nudge::log "Nudge packet sent"
		::Nudge::log "Finished sending Nudge to <[::abook::getDisplayNick $chatid]>"
	}
	
	######################################################
	# ::Nudge::winwrite chatid text iconname (color)     #
	# ---------------------------------------------------#
	# Use ::amsn::WinWrite to add text in a chat         #
	# window when we send/receive a nudge                #	
	# Add a seperation of "-" before and & after the text#	
	# 0.95 use the skinnable separation instead of "--"  # 
	######################################################
	proc winwrite {chatid text iconname {color "green"} } {
		#Look at the version of aMSN to know witch kind of separation we use
		if {[::Nudge::version_094]} {
			amsn::WinWrite $chatid "\n----------\n" $color 
			amsn::WinWriteIcon $chatid $iconname 3 2
			amsn::WinWrite $chatid "[timestamp] $text\n----------" $color
		} else {
			SendMessageFIFO [list ::Nudge::winwriteWrapped $chatid $text $iconname $color] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
		}
	}

	proc winwriteWrapped {chatid text iconname {color "green"} } {
		amsn::WinWrite $chatid "\n" $color
		amsn::WinWriteIcon $chatid greyline 3
		amsn::WinWrite $chatid "\n" $color
		amsn::WinWriteIcon $chatid $iconname 3 2
		amsn::WinWrite $chatid "[timestamp] $text\n" $color
		amsn::WinWriteIcon $chatid greyline 3
		::Nudge::log "Seperation and message wrote in chatwindow"
	}
	
	############################################
	# ::Nudge::check_clientid email            #
	# -----------------------------------------#
	# Verify in abook if the other contact use #
	# protocol MSN 7                           #
	# Boolean answer                           #
	############################################
	proc check_clientid {email} {
		::Nudge::log "Verify if contact is using MSN 7.0 protocol"

		set supportedclients [list 1073741824 1342177280]

		set clientid [::abook::getContactData $email clientid]

		status_log "Clientid is $clientid"
	
		if { $clientid == "" } {
			return 0
		}
	
		foreach bit $supportedclients {
			status_log "Bitmask is $bit"
			if {($clientid & $bit) == $bit} {
				::Nudge::log "He uses MSN 7.0 or greater protocol"
				return 1
			}
		}

		::Nudge::log "He doesn't use MSN 7.0 or greater protocol"
		return 0
	}
	
	############################################
	# ::Nudge::log message                     #
	# -----------------------------------------#
	# Add a log message to plugins-log window  #
	# Type Alt-P to get that window            #
	# Not compatible with 0.94                 #
	############################################
	proc log {message} {
		if {[::Nudge::version_094]} {
			return
		} else {
			plugins_log Nudge $message
		}
	}
		
	############################################
	# ::Nudge::sound                           #
	# -----------------------------------------#
	# Play sound message                       #
	# When we send and/or receive a nudge      #
	# Real sound from MSN 7                    #
	############################################
	proc sound {} {
		set dir [::config::getKey nudgepluginpath]
		play_sound $dir/nudge.wav 1
		::Nudge::log "Play sound for nudge, Directory: [::config::getKey nudgepluginpath]"
	}
	
	############################################
	# ::Nudge::version_094                     #
	# -----------------------------------------#
	# Verify if the version of aMSN is 0.94    #
	# Useful if we want to keep compatibility  #
	############################################
	proc version_094 {} {
		global version
		scan $version "%d.%d" y1 y2;
		if { $y2 == "94" } {
			return 1
		} else {
			return 0
		}
	}
	############################################
	# ::Nudge::setPixmap                       #
	# -----------------------------------------#
	# Define the nudge pixmaps from the skin   #
	############################################	
	proc setPixmap {} {
			::skin::setPixmap nudge nudge.gif
			::skin::setPixmap nudgeoff nudgeoff.gif
			::skin::setPixmap nudgebutton nudgebutton.gif
			::skin::setPixmap nudgebutton_hover nudgebutton_hover.gif
	}

	################################################
	# ::Nudge::blockbutton event epvar             #
	# -------------------------------------------  #
	# Button to add in the chat window             #
	# When we click on that button,we block/deblock#
	# Nudge ability for that contact               #
	################################################	
	proc blockbutton { event evpar } {
		if { $::Nudge::config(addbutton) == 1 } {
			upvar 2 $evpar newvar
			set nudgebutton $newvar(bottom).nudgeblock
			set chatid [::ChatWindow::Name $newvar(window_name)]
			if {[::abook::getContactData $chatid auth_nudge] == "0"} {
				set nudgeimg "nudgeoff"
			} else {
				set nudgeimg "nudge"
			}
			#Create the button with an actual Pixmap
			#Use after 1 to avoid a bug on Mac OS X when we close the chatwindow before the end of the nudge
			#Keep compatibility with 0.94 for the getColor
			if {[::Nudge::version_094]} {
				label $nudgebutton -image [::skin::loadPixmap $nudgeimg] -relief flat -padx 0 \
				-background [::skin::getColor background2] -highlightthickness 0 -borderwidth 0 \
				-highlightbackground [::skin::getColor background2] -activebackground [::skin::getColor background2]\
			} else {
				label $nudgebutton -image [::skin::loadPixmap $nudgeimg] -relief flat -padx 0 \
				-background [::skin::getKey buttonbarbg] -highlightthickness 0 -borderwidth 0 \
				-highlightbackground [::skin::getKey buttonbarbg] -activebackground [::skin::getKey buttonbarbg]\
			}
			bind $nudgebutton <<Button1>> "after 1 ::Nudge::blocknudge $chatid $nudgebutton"
			
			#Define baloon info
			set_balloon $nudgebutton "$::Nudge::language(block_nudge)"
		
			#Pack the button in the right area
			pack $nudgebutton -side right
			::Nudge::log "Nudge block button added the new window: $newvar(window_name)"
		}
	}

	##############################################
	# ::Nudge::blocknudge                        #
	# -------------------------------------------#
	# Set/Unset nudge authorization for a contact#
	# Change picture in the chat window according#
	# to the state.                              #
	##############################################
	proc blocknudge {chatid button} {
			if {[::abook::getContactData $chatid auth_nudge] == "1"} {
				::abook::setContactData $chatid auth_nudge 0
				$button configure -image [::skin::loadPixmap nudgeoff]
			} else {
				::abook::setContactData $chatid auth_nudge 1
				$button configure -image [::skin::loadPixmap nudge]
			}			
		}
}