abook.tcl

来自「Linux下的MSN聊天程序源码」· TCL 代码 · 共 1,548 行 · 第 1/4 页

				unset guid_contact($guid)
			}
		} else {
			set guid_contact($guid) $user_login
		}
	}

	proc getContactForGuid { guid } {
		variable guid_contact
		if { [info exists guid_contact($guid)] } {
			return $guid_contact($guid)
		} else {
			return ""
		}
	}

	proc setAtomicContactData { user_login fields_list data_list } {
		global pgc
		variable users_data

		set fields_list [string tolower $fields_list]

		if { [info exists users_data($user_login)] } {
			array set user_data $users_data($user_login)
		} else {
			array set user_data [list]
		}

		# This loop iterates over the lists of fields and data, so when it finds that one of
		# the fields has to do with visual information, it throws an event and breaks the loop
		foreach field $fields_list data $data_list {
			if { [lsearch -exact $::abook::VisualData $field] > -1 } {
				if { [info exists user_data($field)] && $user_data($field) != $data } {
					#puts stdout "ATTENTION! Visual Data has changed! Redraw CL! $field - $data"
					::Event::fireEvent contactDataChange abook $user_login
					break
				} elseif { ![info exists user_data($field)] && $data != ""} {
					#puts stdout "ATTENTION! Visual Data has changed! Redraw CL! $field - $data"
					::Event::fireEvent contactDataChange abook $user_login
					break
				}
			}
		}

		# This other loop iterates over the entire lists, replacing the value in user_data(array)
		# if needed. There are two different loops because this one cannot be broke.
		foreach field $fields_list data $data_list {
			if { $data == "" } {
				if { [info exists user_data($field)] } {
					unset user_data($field)
				}
			} else {
				#post event for amsnplus
				set evPar(data) data
				::plugins::PostEvent parse_nick evPar
				set user_data($field) $data
			}
		}

		set users_data($user_login) [array get user_data]
		set pgc 1
	}

	#Sets some volatile data to a user. Volatile data won't be written to disk
	#user_login: the user_login you want to set data to
	#field: the field you want to set
	#data: the data that will be contained in the given field
	proc setVolatileData { user_login field data } {
		variable users_volatile_data
		
		set field [string tolower $field]
		
		if { [info exists users_volatile_data($user_login)] } {
			array set volatile_data $users_volatile_data($user_login)
		} else {
			array set volatile_data [list]
		}
		
		if { $data == "" } {
			if { [info exists volatile_data($field)] } {
				unset volatile_data($field)
			}
		} else { 
			set volatile_data($field) $data
		}
		
		set users_volatile_data($user_login) [array get volatile_data]
	}
	
		
	#Returns some previously stored data from a user
	proc getContactData { user_login field {defaultval ""}} {
		variable users_data
		
		set field [string tolower $field]
		
		if { ![info exists users_data($user_login)] } {
			return $defaultval
		}

		array set user_data $users_data($user_login)

		if { ![info exists user_data($field)] } {
			return $defaultval
		}
		
		return $user_data($field)
		
	}

	#Returns some previously stored volatile data from a user		
	proc getVolatileData { user_login field {defaultval ""}} {
		variable users_volatile_data
		
		set field [string tolower $field]
		
		if { ![info exists users_volatile_data($user_login)] } {
			return $defaultval
		}

		array set user_data $users_volatile_data($user_login)	

		if { ![info exists user_data($field)] } {
			return $defaultval
		}
		
		return $user_data($field)
		
	}	
	
	#Return a list of all stored contacts
	proc getAllContacts { } {
		variable users_data
		return [array names users_data]
	}
	
	
	###########################################################################
	# Auxiliary functions, macros, or shortcuts
	###########################################################################

	#Returns the user nickname
	proc getNick { user_login } {
		set nick [::abook::getContactData $user_login nick]
		if { $nick == "" } {
			return $user_login
		}
		return $nick
	}

	proc getPassportfromContactguid { contactguid } {
		foreach contact [::abook::getAllContacts] {
			if { [::abook::getContactData $contact contactguid] == $contactguid } {
				return $contact
			}
		}
	}

	proc lastSeen { } {
		foreach contact [::abook::getAllContacts] {
			set user_state_code [::abook::getVolatileData $contact state FLN]
			if {$user_state_code != "FLN"} {
				::abook::setContactData $contact last_seen [clock format [clock seconds] -format "%D - %H:%M:%S"]
			}
		}
	}

	proc CreateCopyMenu { w } {
		set menu $w.copy
		menu $menu -tearoff 0 -type normal
		$menu add command -label [trans copy] \
			-command "::abook::copyFromText $w"

		return $menu
	}

	proc copyFromText { w } {

		set index [$w tag ranges sel]
		clipboard clear

		if { [llength $index] < 2 } {
			set index [list 0.0 end]
		}

		set dump [$w dump -text [lindex $index 0] [lindex $index 1]]
		foreach { text output index } $dump {
			clipboard append "$output"
		}

	}

	proc dateconvert {time} {
		set date [clock format [clock seconds] -format "%D"]
		if {$time == ""} {
			return ""
		} else {
			if {![catch {clock scan [string range $time 0 7]}]} {
				#Checks if the time is today, and in this case puts today instead of the date
				if {[clock scan $date] == [clock scan [string range $time 0 7]]} {
					return "[trans today][string range $time 8 end]"
					#Checks if the time is yesterday, and in this case puts yesterday instead of the date
				} elseif { [expr { [clock scan $date] - [clock scan [string range $time 0 7]] }] == "86400"} {
					return "[trans yesterday][string range $time 8 end]"
				} else {
					set month [string range $time 0 1]
					set day [string range $time 3 4]
					set year [string range $time 6 7]
					set end [string range $time 8 end]
					#Month/Day/Year
					if {[::config::getKey dateformat]=="MDY"} {
						return $time
					#Day/Month/Year
					} elseif {[::config::getKey dateformat]=="DMY"} {
						return "$day/$month/$year$end"
					#Year/Month/Day
					} elseif {[::config::getKey dateformat]=="YMD"} {
						return "$year$end/$month/$day"
					}
				}
			} else {
				return $time
			}
		}
	}


	#Parser to replace special characters and variables in the right way
	proc parseCustomNick { input nick user_login customnick {psm ""} } {
		#If there's no customnick set, default to user_login
		if { $customnick == "" } {
			if { [::config::getKey protocol] >= 11 && $psm != "" } {
				set customnick $user_login\n$psm
			} else {
				set customnick $user_login
			}
		}
		#By default, quote backslashes, angle brackets and variables
		set input [string map {"\\" "\\\\" "\$" "\\\$" "\(" "\\\("} $input]
		#Now, let's unquote the variables we want to replace
		set input [string map {"\\\$nick" "\${nick}" "\\\$user_login" "\${user_login}" "\\\$customnick" "\${customnick}" "\\\$psm" "\${psm}"} $input]
		#Return the custom nick, replacing backslashses and variables
		return [subst -nocommands $input]
	}
	
	#Returns the user nickname, or just email, or custom nick,
	#depending on configuration
	proc getDisplayNick { user_login } {
		if { [::config::getKey emailsincontactlist] } {
			return $user_login
		} else {
			set nick [::abook::getNick $user_login]
			set customnick [::abook::getContactData $user_login customnick]
			set globalnick [::config::getKey globalnick]
			set psm [::abook::getpsmmedia $user_login]
			
			if { [::config::getKey globaloverride] == 0 } {
				if { $customnick != "" } {
					return [parseCustomNick $customnick $nick $user_login $customnick $psm]
				} elseif { $globalnick != "" && $customnick == "" } {
					return [parseCustomNick $globalnick $nick $user_login $customnick $psm]
				} else {
					return $nick
				}
			} elseif { [::config::getKey globaloverride] == 1 } {
				if { $customnick != "" && $globalnick == "" } {
					return [parseCustomNick $customnick $nick $user_login $customnick $psm]
				} elseif { $globalnick != "" } {
					return [parseCustomNick $globalnick $nick $user_login $customnick $psm]
				} else {
					return $nick
				}
			}
		}
	}
	
	# Used to fetch the groups ID so that the caller can order by
	# group if needed. Returns -1 on error.
	# ::abook::getGroups [e-mail]    : returns group ids
	proc getGroups {passport} {
		return [getContactData $passport group]
	}

	proc getGroupsname {passport} {

		set groups ""
                foreach gid [::abook::getGroups $passport] {
                        set groups "$groups[::groups::GetName $gid], "
                }
                
                set groups [string range $groups 0 end-2]
		return $groups
	}

	

   
	proc addContactToGroup { email grId } {
		global pcc
		
		set groups [getContactData $email group]
		set idx [lsearch $groups $grId]
		if { $idx == -1 } {
			setContactData $email group [linsert $groups 0 $grId]
		}
		#we make this to notify preferences > groups to be refreshed
		set pcc 1
	}

	proc removeContactFromGroup { email grId } {
		global pcc
		
		set groups [getContactData $email group]
		set idx [lsearch $groups $grId]
		
		if { $idx != -1 } {
			setContactData $email group [lreplace $groups $idx $idx]
		}
		set pcc 1
	}	

	proc getLists {passport} {
		return [getContactData $passport lists]
	}
   
	proc addContactToList { email listId } {
		global pcc
		
		set lists [getContactData $email lists]
		set idx [lsearch $lists $listId]
		if { $idx == -1 } {
			setContactData $email lists [linsert $lists 0 $listId]
		}
		set pcc 1
	}

	proc removeContactFromList { email listId } {
		global pcc
		
		set lists [getContactData $email lists]
		set idx [lsearch $lists $listId]
		
		if { $idx != -1 } {
			setContactData $email lists [lreplace $lists $idx $idx]
		}
		set pcc 1
	}	
	
	proc setConsistent {} {
		variable consistent
		set consistent 1
	}
	
	proc unsetConsistent {} {
		variable consistent
		set consistent 0
	}
	
	
	proc isConsistent {} {
		variable consistent
		return $consistent
	}
	
	#Save the contactlist to disk
	#filename - the filename to save to
	#type - the type to save as
	#possible types: csv, amsn
	proc saveToDisk { {filename ""} {type "amsn"} } {
		
		if { ![isConsistent] || ![LoginList lockexists "" [::config::getKey login]] } {
			return
		}
	
		global HOME
		variable users_data
		
		if { $filename == "" } {
			set filename [file join $HOME abook.xml]
		}
		
		if {[catch { set file_id [open $filename w]} res ]} {
			status_log "::saveToDisk $res"
			msg_box "Can't save contact list, $res"
			return
		}