smileys.tcl

Linux下的MSN聊天程序源码

	#
	# This is the GUI proc for editing custom smileys
	proc editCustomEmotion { name } {
		global custom_emotions new_custom_cfg
		
		catch { event generate .smile_selector <Leave> }
		
		array set emotion $custom_emotions($name)
		
		foreach element [list name file animated sound casesensitive] {
			if {[info exists emotion($element)]} {
				set new_custom_cfg($element) $emotion($element)
			} else {
				set new_custom_cfg($element) ""
			}
		}
		set new_custom_cfg(text) [join $emotion(text)]
		
		if { "$new_custom_cfg(sound)" != "" } {
			set new_custom_cfg(enablesound) 1
		} else {
			set new_custom_cfg(enablesound) 0
		}

		newCustomEmoticonGUI $name

	}
	
	#///////////////////////////////////////////////////////////////////////////////
	# proc NewCustomEmoticonFromGUI { edit}
	#
	# this saves what was entered in the GUI for creating new custom smiley or edits
	# previously saved options
	proc NewCustomEmoticonFromGUI { {name ""} } {
		global custom_emotions new_custom_cfg HOME
		
		set w .new_custom

		if { $name == "" } {
			if { [catch {set name $new_custom_cfg(name)} ] } {
				#User entered no description
				msg_box "[trans wrongfields [trans description] [trans triggers] [trans smilefile] ]"
				return -1
			} elseif { [info exists custom_emotions($name)] } {
				#Smiley exists
				msg_box "[trans smileyexists]"
				return -1
			}
			#set name "[string map { "\[" "\\\[" "\]" "\\\]" } $new_custom_cfg(name)]"
			set edit 0
		} else {
			set edit 1
			array set emotion $custom_emotions($name)
		}

		#Check for needed fields
		if { $name == "" || $new_custom_cfg(file) == "" || $new_custom_cfg(text) == "" } {
			msg_box "[trans wrongfields [trans description] [trans triggers] [trans smilefile] ]"
			return -1
		}
		
		#Check for sound, and copy it
		if { $new_custom_cfg(enablesound) && $new_custom_cfg(sound) != "" } {
			set filename [getfilename [::skin::GetSkinFile sounds $new_custom_cfg(sound)]]
			if { $filename == "null" } {
				#if { [info exists custom_emotions(${name}_sound)] } {unset custom_emotions(${name}_sound)}
				msg_box "[trans invalidfile [trans soundfile] \"$new_custom_cfg(sound)\"]"
				return -1
			} else {
				create_dir [file join $HOME sounds]
				catch { file copy [::skin::GetSkinFile sounds "$new_custom_cfg(sound)"] [file join $HOME sounds]}
			}
			set emotion(sound) $filename
			#set custom_emotions(${name}_sound) "$filename"
		} else {
			#if { [info exists custom_emotions(${name}_sound)] } {unset custom_emotions(${name}_sound)}
			#Delete sound settings if it existed before
			if { [info exists emotion(sound)] } { unset emotion(sound) }
		}
		
		set filename [getfilename [::skin::GetSkinFile smileys $new_custom_cfg(file)]]
		if { $filename == "null" } {
			msg_box "[trans invalidfile [trans smilefile] \"$new_custom_cfg(file)\"]"
			return -1
		} 
		
		create_dir [file join $HOME smileys]
		
		#Check for animation
		if { [ catch {set emotion(animated) [::picture::IsAnimated [::skin::GetSkinFile smileys "$new_custom_cfg(file)"] ] } res ] } {
			#There is an error with the file, wront format or doesn't exist
			msg_box "$res"
			return -1
		}
		if { $emotion(animated) == 0 } { unset emotion(animated) }
		
		if { ![info exists emotion(animated)] || $emotion(animated) == 0 } {
			if { $edit == 1 } {
				set titleid custom_edit
			} else {
				set titleid custom_new
			}
			image create photo tmp -file [::skin::GetSkinFile smileys "$new_custom_cfg(file)"]
			
			set filetail_noext [filenoext [file tail "$new_custom_cfg(file)"]]
			set destfile [file join $HOME smileys $filetail_noext]
			
			if { [image width tmp] > 19 || [image height tmp] > 19 } {
				#Smiley is static and bigger than 19x19 we ask for resizing
				if { [::amsn::messageBox "[trans smiletoobig]" yesno question "[trans $titleid ]"] == "yes" } {
					#The user wants resize it
					set file [convert_image_plus [::skin::GetSkinFile smileys "$new_custom_cfg(file)"] smileys 19x19]
				} else {
					if { [image width tmp] > 50 || [image height tmp] > 50 } {
						#MSN can't show static smileys which are bigger than 50x50 so we resize it
						set file [convert_image_plus [::skin::GetSkinFile smileys "$new_custom_cfg(file)"] smileys 50x50]
					} else {
						#The smiley has size between 19x19 and 50x50 and user doesn't want to resize it so we just convert it to PNG
						set filetail_noext [filenoext [file tail "$new_custom_cfg(file)"]]
						set destfile [file join $HOME smileys $filetail_noext]
						::picture::Convert [::skin::GetSkinFile smileys "$new_custom_cfg(file)"] "${destfile}.png"
						set file "${destfile}.png"
					}
				}
			} else {
				#The file is good so we just convert it to PNG
				set filetail_noext [filenoext [file tail "$new_custom_cfg(file)"]]
				set destfile [file join $HOME smileys $filetail_noext]
				::picture::Convert [::skin::GetSkinFile smileys "$new_custom_cfg(file)"] "${destfile}.png"
				set file "${destfile}.png"
			}
			if { ![file exists $file] } { set file "" }
		} else {
			#We convert animated smiley to animated gif even if we can just load animated gif and save to animated gif
			#Don't care of extension : as the smiley is animated TkCximage will save to GIF format
			set filetail_noext [filenoext [file tail "$new_custom_cfg(file)"]]
			set destfile [file join $HOME smileys $filetail_noext]
			::picture::Convert [::skin::GetSkinFile smileys "$new_custom_cfg(file)"] "${destfile}.png"
			set file "${destfile}.png"
			if { ![file exists $file] } { set file "" }
		}
		
		if { $file == "" } {
			return -1
		}
		
		set emotion(file) $file
		set emotion(name) $name
		
		#Create a list of symbols
		set emotion(text) [list]
		foreach symbol [split $new_custom_cfg(text)] {
			if { $symbol != "" } {
				lappend emotion(text) $symbol
			}
		}
		
		#foreach element [list casesensitive animated] {
		#	if { $new_custom_cfg($element) == 1} {
		#		set emotion($element) 1
		#	} else {
		#		if { [info exist emotion($element)] } {unset emotion($element)}
		#	}
		#}
		
		if { $new_custom_cfg(casesensitive) == 1} {
			set emotion(casesensitive) 1
		} else {
			if { [info exist emotion(casesensitive)] } {unset emotion(casesensitive)}
		} 
		
		
		
		set emotion(image_name) [image create photo emoticonCustom_std_$emotion(text) -file $emotion(file) -format cximage]
		set custom_emotions($name) [array get emotion]

		#load_smileys
		#::skin::reloadSkinSettings [::config::getGlobalKey skin]
		if { [winfo exists .smile_selector]} {destroy .smile_selector}

		#After modifying, clear sortedemotions, could need sorting again
		variable sortedemotions
		if {[info exists sortedemotions]} { unset sortedemotions }
		
				
		#Immediately save settings.xml
		save_config
	}
	
	proc addSmileyFromTW { file text } {
		set text [string map {"\\\\" "\\"} $text]
		global new_custom_cfg
		if { [winfo exists .new_custom] } {
			raise .new_custom
			return
		}
		set new_custom_cfg(text) $text
		set new_custom_cfg(file) [::skin::GetSkinFile smileys "cache/${file}.png"]
		newCustomEmoticonGUI
	}
	
			
	#///////////////////////////////////////////////////////////////////////////////
	# proc ValueForSmiley { emotion var } 
	#
	# A useful function that we'll use to get every single variable for an emoticon
	# you call it with the name of the emoticon you want and the variable you want 
	# (for example [ValueForSmiley "000 smile" text] and it returns ":) :-)" something like that..
	# if the variable doesn't exist, it returns an empty string
	# If the returned value must be boolean, set boolean parameter to 1
	proc ValueForSmiley { name var {boolean 0}} {
		global emotions_data
		
		set value ""
		
		#If the smiley is not defined
		if { ![info exists emotions_data($name)] } {
			status_log "Smiley $name is not defined!\n" red
		} else {
			array set emotion $emotions_data($name)	
			if { [info exists emotion($var)] } {
				set value $emotion($var)
			}
		}
		
		#The returned value must be boolean
		if { $boolean == 1 } {
			if { $value == 1 || $value == "true" || $value == "yes" || $value == "y"} {
				return 1
			} else {
				return 0
			}
		} else { return $value }
	}
	
	#///////////////////////////////////////////////////////////////////////////////
	# proc CompareSmileyLength { a_name b_name } 
	#
	# Is used to sort the smileys with the longest length first
	# this is necessary to avoid replacing smaller smileys that may be included inside longer one
	# for example <:o) (party) may be considered as a :o smiley between < and ) ... 
	proc CompareSmileyLength { a b } {
	
	#Get just the symbol (first element), not the type
	set a [lindex $a 0]
	set b [lindex $b 0]
	
	if { [string length $a] > [string length $b] } {
		return -1
	} elseif { [string length $a] < [string length $b] } {
		return 1
	}
	return 0
	
	}
}




#///////////////////////////////////////////////////////////////////////////////
# proc is_true { data }
#
# is used to see if a value is true or false while creating the emoticon
# we need it to simplify the source code because we may need to see an XML value
# before we create our smiley (for example to verify if smiley is disabled) so we can't use
# the procedure "valueforemot"

proc is_true { data } {

    set value [string trim $data]
    if { $value == 1 || $value  == "true" || $value == "yes" || $value == "y" } {return 1} else {return 0}
}



proc custom_smile_subst { chatid tw {textbegin "0.0"} {end "end"} } {
	upvar #0 [string map {: _} ${chatid} ]_smileys emotions
	
	set scrolling [::ChatWindow::getScrolling $tw]
	
	if { ![info exists emotions] } { return }

	#status_log "Parsing text for [array names emotions] with tw = $tw, textbegin = $textbegin and end = $end\n"
	#status_log "text to parse : [$tw get $textbegin $end]\n"

	foreach symbol [array names emotions] {
		set chars [string length $symbol]
		set file [::MSNP2P::GetFilenameFromMSNOBJ $emotions($symbol)]
		if { $file == "" } { continue }
		
		#status_log "Got file $file for symbol -$symbol-\n" red
		
		set start $textbegin
		
		# TODO this still needs to be fixed by using [$tw get $start $end] and searching in the text/removing what we found
		# in the text, because tk 8.4 has a bug with elided text, it's fixed in 8.5, I'll fill a bug report soon and 
		# add it in the comments...
		while {[set pos [$tw search -exact -elide -- $symbol $start $end]] != ""} {
			set start ${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 compare [$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
			}

			$tw tag configure smiley -elide true
			$tw tag add smiley $pos $endpos
			
			set twTag "emoticonCustom_std_$file"
			set copyMenu "${tw}.emoticonCustom_std_$file"
			if { ![winfo exists $copyMenu] } {
				menu $copyMenu -tearoff 0 -type normal
				$copyMenu add command -label "[trans emoticon_steal] ($symbol)" -command "::smiley::addSmileyFromTW {$file} {[string map {"\\" "\\\\"} $symbol]}"
				$tw tag bind $twTag <Enter> "$tw configure -cursor hand2"
				$tw tag bind $twTag <Leave> "$tw configure -cursor xterm"
				$tw tag bind $twTag <<Button1>> "tk_popup $copyMenu %X %Y"
		    }
			
			set smileyIdx [$tw image create $endpos -image "emoticonCustom_std_$file" -padx 0 -pady 0]
			$tw tag add $twTag $smileyIdx
			$tw tag remove smiley $endpos
		    
	    }
    }

	#unset emotions
    
    if { $scrolling } { ::ChatWindow::Scroll $tw }
}

#Called from the protocol layer to parse a x-mms-emoticon message
proc parse_x_mms_emoticon { data chatid } {
    upvar #0 [string map {: _} ${chatid} ]_smileys smile


    #Line below changed from != -1 to == 0 because -1 means
    #"enabled but imagemagick unavailable"
    if { [::config::getKey getdisppic] == 0 } { return }

    set start 0
    while { $start < [string length $data]} {
	set end [string first "	" $data $start]
	set symbol [encoding convertfrom identity [string range $data $start [expr {$end - 1}]]]
	set start [expr {$end + 1}]
	set end [string first "	" $data $start]
	set msnobj [string range $data $start [expr {$end - 1}]]
	set start [expr {$end + 1}]

	set smile($symbol) "$msnobj"
    }
	
    status_log "Got smileys : [array names smile]\n" 

}

proc process_custom_smileys_SB { txt {animated 0} } {
	global custom_emotions
	
	set msg ""
	
	set txt2 [string toupper $txt]

	#Try to find used smileys in the message	
	foreach name [array names custom_emotions] {
	
		if { ![info exists custom_emotions($name)] } {
			status_log "process_custom_smileys_SB: Custom smiley $name doesn't exist in custom_emotions array!!\n" red
			continue
		}
		
		array set emotion $custom_emotions($name)
		foreach symbol $emotion(text) {
			set symbol2 [string toupper $symbol]
		
			set file $emotion(file)
			if { ($animated && ([ info exists emotion(animated) ] && [ is_true $emotion(animated) ])) ||
			     (!$animated && (! [ info exists emotion(animated) ] || ! [ is_true $emotion(animated) ]))} {
				if { [info exists emotion(casesensitive)] && [is_true $emotion(casesensitive)] } {
					if {  [string first $symbol $txt] != -1 } {
						append msg "$symbol	[create_msnobj [::config::getKey login] 2 [::skin::GetSkinFile smileys [filenoext $file].png]]	"
					}
				} else {
					set msnobj ""
					set startidx 0
					while {  [string first $symbol2 $txt2 $startidx] != -1 } {
						if { $msnobj == "" } {
							set msnobj [create_msnobj [::config::getKey login] 2 [::skin::GetSkinFile smileys [filenoext $file].png]]
						}
						
						set idx [string first $symbol2 $txt2 $startidx]
						set startidx [expr {$idx + [string length $symbol2]}]
						set symbol [string range $txt $idx [expr {$startidx - 1}]]
						append msg "$symbol	$msnobj	"
					}
				}
			}
		}
	}
	
	return $msg
}



proc process_custom_animated_smileys_SB { txt } {
	return [process_custom_smileys_SB $txt 1]
}