loging.tcl

Linux下的MSN聊天程序源码

			$wname.top.date.list configure -editable false
			pack $wname.top.date.list -side right -expand true -fill both
			grid $wname.top.date -row 0 -column 1 -sticky news
		}

		UpdateSessionList $wname $email
		pack $wname.top.sessions.list -expand true -fill both
		grid $wname.top.sessions -row 1 -column 0 -columnspan 2 -sticky news
		grid columnconfigure $wname.top 0 -weight 1
		grid columnconfigure $wname.top 1 -weight 1
	}

	proc Fileexist {email date} {

		global logvar log_dir

		#Checks if the log exists
		if { [file exists [file join ${log_dir} $date ${email}.log]] == 1} {
			set id [open "[file join ${log_dir} $date ${email}.log]" r]
			fconfigure $id -encoding utf-8
			set logvar [read $id]
			close $id
		} else {
			set logvar "\|\"LRED[trans nologfile $email]"
		}
	}


	proc ResetSave {w email} {

		global logvar

		set name [::log::wname $email]

		#Redefined the command of the button according to the new contact logging
		$w.buttons.save configure -command "::log::SaveToFile ${name} ${email} [list ${logvar}]"

	}

	proc ResetCamSave {w email img exists} {

		#Redefined the command of the button according to the new contact logging
		$w.buttons.save configure -command "::CAMGUI::saveToImage $w" -state $exists

	}


	proc ResetDelete {w email} {
		
		global logvar

		set name [::log::wname $email]

		#Redefined the command of the button according to the new contact logging
		$w.buttons.clear configure -command	"if { !\[winfo exists $w.top.date.list\] } { \
							set date \".\" \
						} else {
							set date \[$w.top.date.list list get \[$w.top.date.list curselection\]\]\
						}
						if { \[::log::ClearLog $email \"\$date\"\] } { 
							destroy $w
						} "
	}

	proc ResetCamDelete {w email} {
		
		set name [::log::wname $email]

		#Redefined the command of the button according to the new contact logging
		$w.buttons.clear configure -command	"if { !\[winfo exists $w.top.date.list\] } { \
							set date \".\" \
						} else {
							set date \[$w.top.date.list list get \[$w.top.date.list curselection\]\]\
						}
						if { \[::log::ClearCamLog $email \"\$date\"\] } { 
							destroy $w
						} "
	}

	proc ChangeLogToDate { w email widget date } {

		global log_dir logvar

		status_log "Changing log for $email to $date\n" blue

		if { $date == "[trans currentdate]" } {
			set date "."
		}
		if { $date == "_ _ _ _ _" } {
			return
		}

		::log::Fileexist $email $date

		$w.blueframe.log.txt configure -state normal
		$w.blueframe.log.txt delete 0.0 end

		::log::ResetSave $w $email


		if { [file exists [file join ${log_dir} $date ${email}.log]] } {
			set size "[::amsn::sizeconvert [file size "[file join ${log_dir} $date ${email}.log]"]]o"
			wm title $w "[trans history] (${email} - $size)"
		} else {
			wm title $w "[trans history] (${email})"
		}


		ParseLog $w $logvar

	}


	proc ChangeCamLogToDate { w email widget date } {

		global webcam_dir

		status_log "Changing log for $email to $date\n\n"

		if { $date == "[trans currentdate]" } {
			set date "."
		}
		if { $date == "_ _ _ _ _" } {
			return
		}



		if { [file exists [file join ${webcam_dir} $date ${email}.cam]] } {
			set size "[::amsn::sizeconvert [file size "[file join ${webcam_dir} $date ${email}.cam]"]]o"
			set exists normal
		} else {
			set size "0Ko"
			set exists disabled
		}

		wm title $w "[trans history] (${email} - $size)"

		set img ${w}_img

		::CAMGUI::Stop $w

		::log::ResetCamSave $w $email $img $exists

		if { ![file exists [file join ${webcam_dir} $date ${email}.cam]] } {
			set whole_size 0
		} else {
			set whole_size [file size [file join ${webcam_dir} $date ${email}.cam]]
		}
		$w.position.slider configure -to $whole_size
		bind $w.position.slider <ButtonRelease-1> [list ::CAMGUI::Resume $w [file join ${webcam_dir} $date ${email}.cam]]

		if { $whole_size > 0 } {
			$w.slider.playbackspeed configure -state normal
			$w.position.slider configure -state normal
		} else {
			$w.slider.playbackspeed configure -state disabled
			$w.position.slider configure -state disabled
		}

		$w.buttons.play configure -state $exists \
		    -command [list ::CAMGUI::Play $w [file join ${webcam_dir} $date ${email}.cam]]
		
		$w.buttons.pause configure -command "::CAMGUI::Pause $w"  -state disabled
		$w.buttons.stop configure -command "::CAMGUI::Stop $w" -state disabled


		UpdateSessionList $w $email $date
	}

	proc ChangeLogWin {w contact widget email} {

		global log_dir logvar

		status_log "Switch to $email\n" blue

		::log::Fileexist $email "."

		$w.blueframe.log.txt configure -state normal
		$w.blueframe.log.txt delete 0.0 end
		if { [file exists [file join ${log_dir} ${email}.log]] } {
			set size "[::amsn::sizeconvert [file size "[file join ${log_dir} ${email}.log]"]]o"
			wm title $w "[trans history] (${email} - $size)"
		} else {
			wm title $w "[trans history] (${email})"
		}

		::log::LogsByDate $w $email "0"	

		::log::ResetSave $w $email
		::log::ResetDelete $w $email

		ParseLog $w $logvar

		catch {$w.top.date.list select 0}

	}	

	proc ChangeCamLogWin {w contact widget email} {

		global webcam_dir

		status_log "Switch to $email\n\n" blue

		if { [file exists [file join ${webcam_dir} ${email}.cam]] } {
			set size "[::amsn::sizeconvert [file size "[file join ${webcam_dir} ${email}.cam]"]]o"
			set exists normal
		} else {
			set exists disabled
			set size "0Ko"
		}


		wm title $w "[trans history] (${email} - $size)"

		::log::CamLogsByDate $w $email "0"	
		::log::ResetCamDelete $w $email

		set img ${w}_img

		::log::ResetCamSave $w $email $img $exists

		::CAMGUI::Stop $w

		if { ![file exists [file join ${webcam_dir} ${email}.cam]] } {
			set whole_size 0
		} else {
			set whole_size [file size [file join ${webcam_dir} ${email}.cam]]
		}
		$w.position.slider configure -to $whole_size
		bind $w.position.slider <ButtonRelease-1> [list ::CAMGUI::Resume $w [file join ${webcam_dir} ${email}.cam]]

		if { $whole_size > 0 } {
			$w.slider.playbackspeed configure -state normal
			$w.position.slider configure -state normal
		} else {
			$w.slider.playbackspeed configure -state disabled
			$w.position.slider configure -state disabled
		}

		$w.buttons.play configure -state $exists \
		    -command [list ::CAMGUI::Play $w [file join ${webcam_dir} ${email}.cam]]
		
		$w.buttons.pause configure -command "::CAMGUI::Pause $w"  -state disabled
		$w.buttons.stop configure -command "::CAMGUI::Stop $w" -state disabled


	}	
	#///////////////////////////////////////////////////////////////////////////////
	# ParseLog (wname logvar)
	# Decodes the log file and writes to log window
	#
	# wname : Log window
	# logvar : variable containing the whole log file (sure need to setup log file limits)

	proc ParseLog { wname logvar } {

		set aidx 0

		# Set up formatting tags
		${wname}.blueframe.log.txt tag configure red -foreground red
		${wname}.blueframe.log.txt tag configure RED -foreground red
		${wname}.blueframe.log.txt tag configure gray -foreground gray
		${wname}.blueframe.log.txt tag configure GRA -foreground gray
		${wname}.blueframe.log.txt tag configure normal -foreground black
		${wname}.blueframe.log.txt tag configure NOR -foreground black
		${wname}.blueframe.log.txt tag configure italic -foreground blue
		${wname}.blueframe.log.txt tag configure ITA -foreground blue
		${wname}.blueframe.log.txt tag configure GRE -foreground darkgreen

		set nbline 0

		set loglines [split $logvar "\n"]
		set result [list]
		foreach line $loglines {
			incr nbline
			set aidx 0
			while {$aidx != -1} {
				# Checks if the line begins by |"L (it happens when we go to the line in the chat window).
				# If not, use the tags of the previous line
				if { $aidx == 0 & [string range $line 0 2] != "\|\"L" } {
					set bidx -1
				} else {
					# If the portion of the line begins by |"LC, there is a color information.
					# The color is indicated by the 6 fingers after it
					if {[string index $line [expr {$aidx + 3}]] == "C"} {
						set color [string range $line [expr {$aidx + 4}] [expr {$aidx + 9}]]
						${wname}.blueframe.log.txt tag configure C_$nbline -foreground "#$color"
						set color "C_$nbline"
						incr aidx 10
						# Else, it is the system with LNOR, LGRA...
					} else {
						set color [string range $line [expr {$aidx + 3}] [expr {$aidx + 5}]]
						incr aidx 6
					}
					set bidx [string first "\|\"L" $line $aidx]
				}
				if { [string first "\|\"L" $line] == -1 } {
					set string [string range $line 0 end]
				} elseif { $bidx != -1 } {
					set string [string range $line $aidx [expr {$bidx - 1}]]
				} else {
					set string [string range $line $aidx end]
				}
				lappend result $string [list $color]
				set aidx $bidx
			}
			lappend result "\n" [list $color]
		}

		if {[llength $result] > 0} {
			eval [list ${wname}.blueframe.log.txt insert end] $result
		}
		${wname}.blueframe.log.txt yview moveto 1.0
		${wname}.blueframe.log.txt configure -state disabled
	}

	#///////////////////////////////////////////////////////////////////////////////
	# LogWriteWin (wname string color)
	# Writes each string to log window with given color/style and subs the smileys
	#
	# wname : Log window
	# string : variable containing the string to output
	# color : variable containing color/style information (RED, GRA, ITA, NOR)

	proc LogWriteWin { wname string color } {
		
		${wname}.blueframe.log.txt tag configure red -foreground red
		${wname}.blueframe.log.txt tag configure gray -foreground gray
		${wname}.blueframe.log.txt tag configure normal -foreground black
		${wname}.blueframe.log.txt tag configure italic -foreground blue

		switch $color {
			RED {
				${wname}.blueframe.log.txt insert end "$string" red
			}
			GRA {
				${wname}.blueframe.log.txt insert end "$string" gray
			}
			NOR {
				${wname}.blueframe.log.txt insert end "$string" normal
			}
			ITA {
				${wname}.blueframe.log.txt insert end "$string" italic
			}
		}

		# This makes rendering long log files slow, maybe should make it optional?
		#smile_subst ${wname}.blueframe.log.txt
	}


	#///////////////////////////////////////////////////////////////////////////////
	# SaveToFile (wname email logvar)
	# File name selection menu and calls ParseToFile
	#
	# wname : Log window
	# logvar : variable containing the whole log file (sure need to setup log file limits)

	proc SaveToFile { wname email logvar } {
		set wname [string range $wname 1 end]
		set w .form${wname}
		toplevel $w
		wm title $w \"[trans savetofile]\"
		label $w.msg -justify center -text "Please give a filename"
		pack $w.msg -side top

		frame $w.buttons -class Degt
		pack $w.buttons -side bottom -fill x -pady 2m
		button $w.buttons.dismiss -text Cancel -command "destroy $w"
		button $w.buttons.save -text Save -command "::log::ParseToFile [list ${logvar}] $w.filename.entry; destroy $w"
		pack $w.buttons.save $w.buttons.dismiss -side left -expand 1

		frame $w.filename -bd 2 -class Degt
		entry $w.filename.entry -relief sunken -width 40
		label $w.filename.label -text "Filename:"
		pack $w.filename.entry -side right 
		pack $w.filename.label -side left
		pack $w.msg $w.filename -side top -fill x
		focus $w.filename.entry

		chooseFileDialog $wname "" $w $w.filename.entry save
	}


	#///////////////////////////////////////////////////////////////////////////////
	# ParseToFile (logvar filepath)
	# Decodes the log file and writes to file
	#
	# wname : Log window
	# logvar : variable containing the whole log file (sure need to setup log file limits)

	proc ParseToFile { logvar filepath } {

		global langenc

		set fileid [open [${filepath} get] a+]
		fconfigure $fileid -encoding utf-8
		if { $fileid != 0 } {
			set aidx 0
			while {1} {
				if {[string index $logvar [expr {$aidx + 3}]] == "C"} {
					incr aidx 10
				} else {
					incr aidx 6
				}
				set bidx [string first "\|\"L" $logvar $aidx]
				if { $bidx != -1 } {
					puts -nonewline $fileid [string range $logvar $aidx [expr {$bidx - 1}]]
					set aidx $bidx
				} else {
					puts -nonewline $fileid [string range $logvar $aidx end]
					break
				}
			}
			close $fileid
		}
	}


	#///////////////////////////////////////////////////////////////////////////////
	# ClearLog (email)
	# Deletes the current log file
	#
	# email : email of log to delete

	proc ClearLog { email date } {


		status_log "ClearLog $email $date\n\n"
		if { $date == "[trans currentdate]" } {
			set date "."
		}
		if { $date == "_ _ _ _ _" } {
			return 0
		}


		set answer [::amsn::messageBox "[trans confirm]" yesno question [trans clearlog]]
		if {$answer == "yes"} {	
			global log_dir
			
			catch { file delete [file join ${log_dir} $date ${email}.log] }
		}
		return 1
	}

	proc ClearCamLog { email date } {


		status_log "ClearCamLog $email $date\n\n"
		if { $date == "[trans currentdate]" } {
			set date "."
		}
		if { $date == "_ _ _ _ _" } {
			return 0
		}


		set answer [::amsn::messageBox "[trans confirm]" yesno question [trans clearlog]]