smileys.tcl

Linux下的MSN聊天程序源码

#
# $Id: smileys.tcl 6829 2006-06-12 15:27:52Z billiob $
#

if { $initialize_amsn == 1 } {
	global smileys_drawn
	set smileys_drawn 0
}


namespace eval ::smiley {

	#Used variables:
	#---------------
	#
	# array emotions(SYMBOL) - contains the smiley NAME for every SYMBOL.
	#                          SYMBOL is the smiley trigger
	#
	# list emotions_names    - a list of all smiley NAMES, sorted as defined
	#                          in the settings.xml file
	#
	# array emotions_data(NAME) - an array containing an array with all info
	#                          about a given smiley NAME. To retrieve this
	#                          data, better use [ValueForSmiley NAME FIELD]
	#                          instead of accessing this variable
	#
	# array custom_emotions(NAME) - Similar to emotions_data, but used for
	#                          storing information about your custom smileys
	

	#///////////////////////////////////////////////////////////////////////////////
	# proc newEmoticon {cstack cdata saved_data cattr saved_attr args}
	#
	# This is the main procedure for creating our emoticons, it gets data from the XML
	# parser (don't know what all args are made for) and retrieves the data we need and
	# creates the arrays we need.
	# For every new emoticon, we add it's name to emotions_names (preceded by a number for
	# having the correct order in the menu) then we add the elements in the array emotions
	proc newEmoticon {cstack cdata saved_data cattr saved_attr args} {
		
		global emotions emotions_data emotions_names emotions_cleared
		upvar $saved_data sdata
		
		#Check if no important fields are missing, or emoticon is disabled
		#The fields name, text, and file must be present
		if { ! [info exists sdata(${cstack}:name)] } { return 0 }
		if { ! [info exists sdata(${cstack}:text)] } { return 0 }
		if { ! [info exists sdata(${cstack}:file)] } { return 0 }
		if { [info exists sdata(${cstack}:disabled)] && [is_true $sdata(${cstack}:disabled)] } { return 0 }

                if { [::skin::getKey ignoredefaultsmileys] == 1 && ! [info exists emotions_cleared] } {
                        set emotions_cleared 1
                        unset emotions_data
                        unset emotions_names
                        unset emotions
                }
		
		#Get the smiley info: name, text and file, and other
		#existing fields, like sound or animated. Store them
		#in the local array emotion(field_name)
		foreach field [array names sdata] {
			set field_sort [string trim [string map [list "${cstack}:" "" ] $field]]
			if { $field_sort == "_dummy_" } {continue}
			set emotion($field_sort) [string trim $sdata($field)]
		}
		
		#Try to load the image. If we can't load the image, forget it
		#This is only checked if ::loading_skin is set. Otherwise we're
		#loading the default skin to get the standard smileys
		if { [info exists ::loading_skin] } {
			set realfile [::skin::GetSkinFile smileys $emotion(file) $::loading_skin]
			if { [file tail $realfile] == "null" } {
				status_log "Missing $emotion(file) from skin $::loading_skin. Using default\n" red
				return 0
			}
			#Mark this smiley as belonging to this skin
			set emotion(skin) $::loading_skin
		}
		
		#Text can be more then one symbol. Split and apply for all symbols
		set emotion(symbols) [list]
		set texts [split $emotion(text)]
		foreach text $texts {
			#Trim text (remove " ") and ignore empty strings
			if { $text == "" } { continue }
			set text [string trim $text \"]

			#some smileys are case sensitive, like the moon!
			if { ![info exists emoticon(casesensitive)] ||
			     ([info exists emoticon(casesensitive)] && [is_false $emoticon(casesensitive)]) } {
				set text [string tolower $text]
			}
			
			#Delete any previous ocurrence of this smiley if this existed and skin
			#propertie was set to "" (loaded when loading default skin first)
			if { [info exists emotions($text)] && [info exists emotions_data($emotions($text))] && [ValueForSmiley $emotions($text) skin] == "" } {
				#status_log "Replacing emoticon $emotions($text)\n" blue
				
				set name $emotions($text)
				#Remove all other symbols from that smiley
				array set emotion_data $emotions_data($name)
				set symbols $emotion_data(symbols)
				foreach symbol $symbols {
					if {[info exists emotions($symbol)]} {
						unset emotions($symbol)
					}
				}
				#Remove the old smiley daya
				unset emotions_data($name)
				
				#Remove from emotions_names
				set idx [lsearch -exact $emotions_names $name]
				set emotions_names [lreplace $emotions_names $idx $idx]
			}
			
			#Associate this symbol to this smiley name
			set emotions($text) $emotion(name)
			
			#Also add to the emotions data a list of triggers
			lappend emotion(symbols) $text
			
			
			#Associate this symbol to this file for skin reloading
			::skin::setPixmap $text $emotion(file) smileys
		}
		
		#Store the smiley fields in the emotions_data array
		set emotions_data($emotion(name)) [array get emotion]
		

		#If it's not a hidden emoticon, add it to the emoticons list
		if { ! ([info exists sdata(${cstack}:hiden)] && [is_true $sdata(${cstack}:hiden)]) } {
			#incr emoticon_number
			lappend emotions_names $emotion(name)
		}
		
		variable sortedemotions
		if {[info exists sortedemotions]} { unset sortedemotions }
		
		return 0

	
	}
	
		
	#///////////////////////////////////////////////////////////////////////////////
	# proc newCustomEmoticonXML {cstack cdata saved_data cattr saved_attr args}
	#
	# This is the same procedure as newEmoticon
	# the only difference is that it is used for custom emoticons..
	# we need to do it that way since after calling "load_smileys" it erases the
	# emotions list...
	proc newCustomEmoticonXML {cstack cdata saved_data cattr saved_attr args} {
		global custom_emotions
		
		upvar $saved_data sdata
		
		#Check if no important fields are missing, or emoticon is disabled
		#The fields name, text, and file must be present		
		if { ! [info exists sdata(${cstack}:name)] } { return 0 }
		if { ! [info exists sdata(${cstack}:text)] } { return 0 }
		if { ! [info exists sdata(${cstack}:file)] } { return 0 }
		if { [info exists sdata(${cstack}:disabled)] && [is_true $sdata(${cstack}:disabled)] } { return 0 }
		
		#Get the smiley info: name, text and file, and other
		#existing fields, like sound or animated. Store them
		#in the local array emotion(field_name)
		foreach field [array names sdata] {
			set field_sort [string trim [string map [list "${cstack}:" "" ] $field]]
			if { $field_sort == "_dummy_" } {continue}
			set emotion($field_sort) [string trim $sdata($field)]
		}


		#Create the image now and store it   ;# $emotion(name) is unique as we store the emoticon in the array under this name (cfr infra)
		if { [catch { image create photo emoticonCustom_std_$emotion(text) -file $emotion(file) -format cximage } emotion(image_name) ] } {
			status_log "Error when creating image for emoticon $emotion(name) : $emotion(image_name)"
			#Error when creating smiley's image so we don't add it
			return 0
		}
		
		#Store the emoticon data in the custom_emoticons array
		set custom_emotions($emotion(name)) [array get emotion]

		variable sortedemotions
		if {[info exists sortedemotions]} { unset sortedemotions }
		
		
		return 0
	}
	

	
	#///////////////////////////////////////////////////////////////////////////////
	# proc SortSmileys
	#
	# Create a list of available smileys, sorted by symbol length
	proc SortSmileys {} {
		global emotions
		global custom_emotions
			
		variable sortedemotions
		
		#If no sorted list exists, create it...
		if { ![info exists sortedemotions]} {
			set unsortedemotions [list]
			
			#Add standard smileys. We just add the symbol, and keyword "standard"
			foreach name [array names emotions] {
				lappend unsortedemotions [list $name standard]
			}
			
			#Add our custom smileys. For custom smileys we also add
			#the smiley name associated to that symbol
			foreach name [array names custom_emotions] {
			
				if { ![info exists custom_emotions($name)] } {
					status_log "substYourSmileys: Custom smiley $name doesn't exist in custom_emotions array!!\n" red
					continue
				}
			
				array set emotion $custom_emotions($name)
				foreach symbol $emotion(text) {
					lappend unsortedemotions [list $symbol custom $name]
				}
			}
			
#TODO: Add SB smileys?

			#Now, sort this list			
			set sortedemotions [lsort -command ::smiley::CompareSmileyLength $unsortedemotions]
		}
	}

	#///////////////////////////////////////////////////////////////////////////////
	# proc substSmileys { tw {start "0.0"} {end "end"} {contact_list 0} }
	#
	# Main function... it substitutes smileys patterns into an image in any text widget
	# tw variable is the text widget
	# start is the starting point for which we scan the text for any smiley to change
	# contact_list is used to specify if we should play sounds if we find emotisound
	# this is used to avoid playing sounds when contact list is refreshed
	# the function scans the text widget (from the $start variable to the end) and
	# replaces any smileys pattern by the appropriate image (animated or not) and plays
	# a sound if necessary, etc... It scans the widget for every smiley that exists
	proc substSmileys {tw {textbegin "0.0"} {end "end"} {contact_list 0} {include_custom 0}} {
		global emotions
		global custom_emotions
		variable sortedemotions
				
		SortSmileys
		
		set scrolling [::ChatWindow::getScrolling $tw]
			
		#Search for all possible emotions, after they are sorted by symbol length
		foreach emotion_data $sortedemotions {
		
			#Symbol is first element
			set symbol [lindex $emotion_data 0]
			#Type is second element
			set smiley_type [lindex $emotion_data 1]
			
			if { $smiley_type == "custom" } {
				#If smiley type is custom, replace or ignore it depending on call parameter
				if { $include_custom == 0} {
					continue
				} else {
					#Get name. It will be 3rd element on the list
					set name [lindex $emotion_data 2]
					
					#Get all emoticon data from custom_emotions array
					array set emotion $custom_emotions($name)
					
					if { [info exists emotion(casesensitive)] && [is_true $emotion(casesensitive)]} {
						set nocase "-exact"
					} else {
						set nocase "-nocase"
					}
					
					set animated [expr {[info exists emotion(animated)] && [is_true $emotion(animated)]}]
					if { $contact_list == 0 && [info exists emotion(sound)] && $emotion(sound) != "" } {
						set sound $emotion(sound)
					} else { set sound "" }
					set image_name $emotion(image_name)
					set image_file $emotion(file)
					
					
					array unset emotion
				}
				
			} else {
				#Get the name for this symbol
				set emotion_name $emotions($symbol)
	
				if { [ValueForSmiley $emotion_name casesensitive 1] } {
					set nocase "-exact"
				} else {
					set nocase "-nocase"
				}
				
				set animated [ValueForSmiley $emotion_name animated 1]			
				if { $contact_list == 0 && [ValueForSmiley $emotion_name sound] != "" } {
					set sound [ValueForSmiley $emotion_name sound]
				} else { set sound "" }
				set image_name [::skin::loadPixmap $symbol smileys]
				set image_file [ValueForSmiley $emotion_name file]
				
				set start $textbegin

			}

			
			#Keep searching until no matches
			set start $textbegin
			while {[set pos [$tw search -exact $nocase -- $symbol $start $end]] != "" } {
				set start [$tw index ${pos}+1c]
				set endpos [$tw index $pos+[string length $symbol]c]

				#set skip 0
				# used to avoid invalid search caused by elided text, such as in ::op
				if { [string equal -nocase [$tw get $pos $endpos]  $symbol] == 0} {
					continue
				#} else {
				#	for { set i $pos } {$i <= $endpos && !$skip} {set i [$tw index $i+1c]} {
				#		set tags [$tw tag names $i]
				#		foreach tag_name $tags {
				#			set elided [$tw tag cget $tag_name -elide]
				#			if {$elided != "" && $elided} {
				#				set skip 1
				#				break;
				#			}
				#		}
				#	}
				}
				
				#if { $skip } {
				#	continue
				#}

				set start [::smiley::SubstSmiley $tw $pos $symbol $image_name $image_file $animated $sound]
				#If SubstSmiley returns -1, start from beggining.
				#See why in SubstSmiley. This is a fix
				if { $start == -1 } { set start $textbegin }
				
		
			}
			
			
			
			
		}
		
		if { $scrolling } { ::ChatWindow::Scroll $tw }
	
	}
	
	#//////////////////////////////////////////////////////////////////////
	# proc SubstSmiley {tw pos symbol image file animated sound }
	#
	# Replace one smiley in the given $tw (text window)
	proc SubstSmiley { tw pos symbol image file animated { sound "" }} {

		set chars [string length $symbol]

		set posyx [split $pos "."]
		set endpos "[lindex $posyx 0].[expr {[lindex $posyx 1] + $chars}]"
	
		if { [lsearch -exact [$tw tag names $pos] "dont_replace_smileys"] != -1 } {
			return $endpos
		}

		$tw tag configure smiley -elide true
		$tw tag add smiley $pos $endpos
	
		$tw image create $endpos -image $image -pady 0 -padx 0
		$tw tag remove smiley $endpos

		if { [::config::getKey emotisounds] == 1 && $sound != "" } {
			play_sound $sound
		}
		
		#If I return $pos and there's a smiley next to the replaced one,
		#it won't be replaced!! is this a tk error?? We return -1,
		#so we restart from beginning
		return -1
	}
		
	
	#///////////////////////////////////////////////////////////////////////////////
	# proc smileyMenu { {x 0} {y 0} {text text}}
	#
	# Displays the smileys menu at the position where the mouse is and refreshes
	# all the bindings on the smileys in the menu to the correct widget
	# so that when you click on a smiley, it inserts its symbol into your text 
	# if the smile menu doesn't exist it created it first with [create_smile_menu $x $y]
	proc smileyMenu { {x 0} {y 0} {text text}} {
		global emotions_names
		
		set w .smile_selector
		
		
		if { ! [winfo exists $w]} { CreateSmileyMenu }
		
		wm state $w normal
		set x [expr {$x - 15}]
		set y [expr {$y + 15 - [winfo reqheight $w]}]
		wm geometry $w +$x+$y
		#It won't work on Windows without this
		update idletasks
		
		
		#It won't work on Windows without this
		raise $w
		
		#Add bindings for standard emotions
		set temp 0
		foreach name $emotions_names {
			if { [ValueForSmiley $name hiden 1] } {continue}
		
			#Get the first symbol for that smiley
			set symbol [lindex [ValueForSmiley $name symbols] 0]
			
			#This must be cached due to a race condition (if you double click
			#the smileys menu for first time, the second click can launch
			#this procedure without all smileys having been created
			catch { 
				#TODO: Improve this now we know about quoting a bit more?