smileys.tcl

Linux下的MSN聊天程序源码

				if { [string match {(%)} $symbol] != 0 } {
					bind $w.c.$temp <Button1-ButtonRelease> "catch {$text insert insert \{(%%)\}; wm state $w withdrawn} res"
				} else {
					bind $w.c.$temp <Button1-ButtonRelease> "catch {[list $text insert insert $symbol]\; wm state $w withdrawn} res" 
				}
			}
			
			incr temp
		}
		
		#Now add custom emotions bindings
		global custom_emotions
		foreach name [array names custom_emotions] {
			array set emotion $custom_emotions($name)
			set symbol [lindex $emotion(text) 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?
				if { [string match {(%)} $symbol] != 0 } {
					bind $w.c.$temp <Button1-ButtonRelease> "catch {$text insert insert \{(%%)\}; wm state $w withdrawn} res"
				} else {
					bind $w.c.$temp <Button1-ButtonRelease> "catch {[list $text insert insert $symbol]\; wm state $w withdrawn} res" 
				}
				#Add binding for custom emoticons
				if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
					
					bind $w.c.$temp <Button2-ButtonRelease> [list ::smiley::editCustomEmotion $name]
					bind $w.c.$temp <Control-ButtonRelease> [list ::smiley::editCustomEmotion $name]
				} else {
					bind $w.c.$temp <Button3-ButtonRelease> [list ::smiley::editCustomEmotion $name]
				}
			}
			
			incr temp
		}
		
		event generate $w <Enter>
	
	}


	#//////////////////////////////////////////////////////////////////
	#proc that changes a string into a list with seperated text/smileys
	proc parseMessageToList { name {contact_list 0} {include_custom 0} } {
		global emotions
		global custom_emotions
		variable sortedemotions

		#This is a poor place for sort smileys should be done only when adding new smileys to the list?
		#SortSmileys

		set l [list [ list "text" "$name" ]]
		set llength 1

		#Search for all possible emotions, after they are sorted by symbol length
		SortSmileys
		foreach emotion_data [concat $sortedemotions [list [list "\n" "newline"]]] {

			#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
				}
		
			} elseif { $smiley_type == "newline" } {
				set emotion_name "newline"
				set nocase "-exact"
				set animated 0
				set sound ""
				set image_name "__newline__"
				set image_file ""
			} 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 listpos 0
			#Keep searching until no matches
#TODO: make it not case sensitive
			while { $listpos < $llength } {
				if { ([lindex $l $listpos 0] != "text") } {
					incr listpos
					continue
				}
				
				if {[set pos [string first $symbol [lindex $l $listpos 1]]] != -1 } {
					set p1 [string range [lindex $l $listpos 1] 0 [expr {$pos - 1}]]
					set p2 $image_name
					set p3 [string range [lindex $l $listpos 1] [expr {$pos + [string length $symbol]}] end]

#TODO: #need to change for an 'in-place' lreplace (here and below)
					if { $p2 == "__newline__" } {
						set l [lreplace $l $listpos $listpos [list text $p1] [list "newline"] [list text $p3] ]
					} else {
						set l [lreplace $l $listpos $listpos [list text $p1] [list smiley $p2 $symbol] [list text $p3] ]
					}

					incr llength 2
					
					if { $p3 == "" } {
						set listpos2 [expr {$listpos + 2}]
						set l [lreplace $l $listpos2 $listpos2]
						incr llength -1
					}
					if { $p1 == "" } {
						set l [lreplace $l $listpos $listpos]
						incr llength -1
						incr listpos -1
					}
				}
				#text can never be followed by another set of text
				incr listpos 2
			}
		}

#TODO: also parse newlines as [list newline]

		return $l
	}


	
	#Create ONE smiley in the smileys menu
	proc CreateSmileyInMenu {w cols rows smiw smih emot_num name symbol image file animated} {
		catch {
			#number of menu-item in name as I'm usure about the name being unique and the quoting of the symbol
			set resized [image create photo emoticonAll_tny_${emot_num}_small]
			$resized copy $image
			if {[image width $image] > 22 && [image height $image] > 22} {
				::picture::ResizeWithRatio $resized 22 22
			}
			label $w.$emot_num -image $resized -background [$w cget -background]
			bind $w.$emot_num <Destroy> "image delete $resized"
	
			$w.$emot_num configure -cursor hand2 -borderwidth 1 -relief flat
			
			#Bindings for raise/flat on mouse over
			bind $w.$emot_num <Enter>  [list $w.$emot_num configure -relief raised]
			bind $w.$emot_num <Leave> [list $w.$emot_num configure -relief flat]

			#Tooltip
			if { [::config::getKey tooltips] } {set_balloon $w.$emot_num "$name\n[trans triggers]: $symbol" "$image"}
			set xpos [expr {($emot_num % $cols)* $smiw}]
			set ypos [expr {($emot_num / $cols) * $smih}]
			$w create window $xpos $ypos -window $w.$emot_num -anchor nw -width $smiw -height $smih
		}
	}

	#///////////////////////////////////////////////////////////////////////////////
	# proc CreateSmileyMenu { {x 0} {y 0} }
	#
	# Create the smile menu... it first calls [calcul_geometry_smileys]
	# To get the width and height of the menu, then it creates the menu withdrawn with 
	# the animated smileys and static smileys in the correct order
	proc CreateSmileyMenu { } {
		global emotions emotions_names custom_emotions

		set w .smile_selector
		if {[catch {[toplevel $w]} res]} {
			destroy $w
			toplevel $w
		}
		
		#Calculate the total number of smileys (including custom ones)
		set emoticon_number [llength $emotions_names]
		incr emoticon_number [llength [array names custom_emotions]]
		
		#Fixed smiley size
		set smiw 26
		set smih 26
	
		
		#We want to keep a certain ratio:
		# cols/(rows+1) = 4/3
		# we know cols*rows>=emoticon_number
		#This is the solution of solving that equation system
		set ratio [expr {4.0/3.0}]
		set cols [expr {ceil(($ratio+sqrt(($ratio*$ratio)+4.0*$ratio*$emoticon_number))/2.0)}]
		set rows [expr {ceil(double($emoticon_number) / $cols)+1}]

		#status_log "Smileys: $emoticon_number. Cols: $cols. Rows: $rows\n" white
		set cols [expr {int($cols)}]
		set rows [expr {int($rows)}]
		
		set x_geo [expr {$smiw*$cols + 2} ]
		set y_geo [expr {$smih*$rows + 2} ]
		
		
		wm state $w withdrawn
		wm geometry $w ${x_geo}x${y_geo}
		wm title $w "[trans msn]"
		wm overrideredirect $w 1
		wm transient $w
		
		
		canvas $w.c -background white -borderwidth 0 -relief flat \
			-selectbackground white -selectborderwidth 0 
		pack $w.c -expand true -fill both
		
		#Add standard smileys
		set emot_num 0
		foreach name $emotions_names {
			set hiden [ValueForSmiley $name hiden 1]
			if { $hiden} {continue}
			
			set symbol [lindex [ValueForSmiley $name symbols] 0]
			set file [ValueForSmiley $name file]
			set animated [expr {[ValueForSmiley $name animated 1] && [::config::getKey animatedsmileys 0]}]
			
			CreateSmileyInMenu $w.c $cols $rows $smiw $smih \
				$emot_num $name $symbol [::skin::loadPixmap $symbol smileys] [::skin::GetSkinFile smileys ${file}] $animated

			incr emot_num
		
		}
		
		#Now add custom emotions
		global custom_emotions
		foreach name [array names custom_emotions] {
		
			array set emotion $custom_emotions($name)
			if {![info exists emotion(animated)]} { set emotion(animated) 0 }
			set animated [expr {$emotion(animated) && [::config::getKey animatedsmileys 0]}]
			
			CreateSmileyInMenu $w.c $cols $rows $smiw $smih \
				$emot_num $name [lindex $emotion(text) 0] $emotion(image_name) $emotion(file) $animated
	
			incr emot_num
		}

		#Add the create custom smiley button	
		label $w.c.custom_new -text "[trans custom_new]"  -background [$w.c cget -background] -font sboldf
		bind $w.c.custom_new <Enter> [list $w.c.custom_new configure -relief raised]
		bind $w.c.custom_new <Leave> [list $w.c.custom_new configure -relief flat]
		bind $w.c.custom_new <Button1-ButtonRelease> "::smiley::newCustomEmoticonGUI; event generate $w <Leave>"
		
		set ypos [expr {(($rows-1)*$smih + ($smih/2))}]
		$w.c create window  0 $ypos -window $w.c.custom_new -width [expr {$x_geo - 2}] -height $smih -anchor w
		
		
		bind $w <Enter> "bind $w <Leave> \"bind $w <Leave> \\\"wm state $w withdrawn\\\"\""
	}
	
	
	#///////////////////////////////////////////////////////////////////////////////
	# proc newCustomEmoticonGUI {}
	#
	# This is the GUI proc for adding custom smileys
	proc newCustomEmoticonGUI {{name ""}} {
		global new_custom_cfg
		
		if { [winfo exists .new_custom] } {
			raise .new_custom
			return
		}

		toplevel .new_custom
		
		set w [labelframe .new_custom.lfname -text [trans smileconfig] -font splainf]
		#pack $w -anchor n -side top -expand 1 -fill x
		
		frame .new_custom.1 -class Degt
		label .new_custom.1.smile -image [::skin::loadPixmap smile]
		pack .new_custom.1.smile -side left -anchor nw
		
		label $w.lname -text "[trans description]" -font splainf
		entry $w.name -textvariable new_custom_cfg(name) -background white -font splainf
		
		label $w.ltext -text "[trans triggers]" -font splainf
		entry $w.text -textvariable new_custom_cfg(text)  -background white -font splainf
		
		label $w.lfile -text "[trans smilefile]" -font splainf
		entry $w.file -textvariable new_custom_cfg(file)  -background white -font splainf
		button $w.browsefile -text "[trans browse]" -command [list chooseFileDialog "" "" .new_custom $w.file open  \
				[list [list [trans imagefiles] [list *.gif *.GIF *.jpg *.JPG *.bmp *.BMP *.png *.PNG]] [list [trans allfiles] *]]] -width 10 
		
		label $w.lsound -text "[trans soundfile]" -font splainf
		entry $w.sound -textvariable new_custom_cfg(sound)  -background white -font splainf
		button $w.browsesound -text "[trans browse]" -command [list chooseFileDialog "" "" .new_custom $w.sound open \
			[list [list [trans soundfiles] [list *.wav *.mp3 *.au *.ogg]] [list [trans allfiles] *]]] -width 10 
		checkbutton $w.enablesound -text "[trans enablesound]" -onvalue 1 -offvalue 0 -variable new_custom_cfg(enablesound) -command ::smiley::UpdateEnabledSoundSmileys -font sboldf
		checkbutton $w.casesensitive -text "[trans casesensitive]" -onvalue 1 -offvalue 0 -variable new_custom_cfg(casesensitive) -font sboldf
		
		frame .new_custom.buttons -class Degt
		
		
		if { $name == "" } {
			wm title .new_custom "[trans custom_new]"
			label .new_custom.1.intro -text "[trans smileintro]" -font splainf
			button .new_custom.buttons.ok -text "[trans ok]" -command ::smiley::NewCustomEmoticonGUI_Ok -padx 10
			button .new_custom.buttons.delete -text "[trans delete]" -command "" -state disabled -padx 11
		} else {
			wm title .new_custom "[trans custom_edit]"
			label .new_custom.1.intro -text "[trans smileintro2]" -font splainf
			button .new_custom.buttons.ok -text "[trans ok]" -command [list ::smiley::NewCustomEmoticonGUI_Ok $name] -padx 10
			button .new_custom.buttons.delete -text "[trans delete]" -command [list ::smiley::NewCustomEmoticonGUI_Delete $name] -padx 11
			$w.name configure -state disabled
		}
		
		button .new_custom.buttons.cancel -text "[trans cancel]" -command [list destroy .new_custom] -padx 10

		pack .new_custom.buttons.ok -side right -padx 5
		pack .new_custom.buttons.cancel -side right -padx 5
		pack .new_custom.buttons.delete -side left -padx 5
		pack .new_custom.buttons -side bottom -fill x -expand false -padx 5 -pady 5

		pack .new_custom.1.intro -fill both -side left

		grid columnconfigure $w 1 -weight 1
		
		grid $w.lname -row 1 -column 0 -padx 2 -pady 2 -sticky w
		grid $w.name -row 1 -column 1 -padx 2 -pady 2 -sticky w
		
		grid $w.ltext -row 2 -column 0 -padx 2 -pady 2 -sticky w
		grid $w.text -row 2 -column 1 -padx 2 -pady 2 -sticky w
		
		grid $w.lfile -row 3 -column 0 -padx 2 -pady 2 -sticky w
		grid $w.file -row 3 -column 1 -padx 2 -pady 2 -sticky we
		grid $w.browsefile -row 3 -column 2 -padx 2 -pady 2 -sticky w
		
		grid $w.lsound -row 4 -column 0 -padx 2 -pady 2 -sticky w
		grid $w.sound -row 4 -column 1 -padx 2 -pady 2 -sticky we
		grid $w.browsesound -row 4 -column 2 -padx 2 -pady 2 -sticky w
		
		grid $w.enablesound -row 5 -column 1 -columnspan 2 -padx 2 -pady 2 -sticky w
		
		grid $w.casesensitive -row 7 -column 1 -columnspan 2 -padx 2 -pady 2 -sticky w
		
		
		pack .new_custom.1 -expand false -fill x -side top -pady 5 -padx 5
		pack .new_custom.lfname -expand 1 -fill both -side top -pady 5 -padx 5
		
		UpdateEnabledSoundSmileys
		
		bind .new_custom <Destroy> "catch {unset new_custom_cfg}"
		moveinscreen .new_custom 30
		catch {[focus .new_custom]}
		
	}
	
	proc NewCustomEmoticonGUI_Ok { {name ""}} {
		if { [NewCustomEmoticonFromGUI $name] != -1 } {
			destroy .new_custom
		}
	}
	

	proc NewCustomEmoticonGUI_Delete { name } {
		global custom_emotions
		
		catch {image delete $name}

		unset custom_emotions($name)
		if { [winfo exists .smile_selector]} {destroy .smile_selector}
		
		#After modifying, clear sortedemotions, could need sorting again
		variable sortedemotions
		if {[info exists sortedemotions]} { unset sortedemotions }

		destroy .new_custom

	}

	proc UpdateEnabledSoundSmileys { } {
		global new_custom_cfg
		
		set w .new_custom.lfname
		
		if { $new_custom_cfg(enablesound) == 1 } {
			$w.sound configure -state normal
			$w.browsesound configure -state normal
		} else {
			$w.sound configure -state disabled
			$w.browsesound configure -state disabled
		}
	}
	
		
	#///////////////////////////////////////////////////////////////////////////////
	# proc editCustomEmotion {}