chatwindow.tcl

Linux下的MSN聊天程序源码

		foreach win_name [array names ::ChatWindow::chat_ids] {
			lappend chatids [::ChatWindow::Name $win_name]
		}
		return $chatids
	}


	#///////////////////////////////////////////////////////////////////////////////
	# ::ChatWindow::Open () 
	# Creates a new chat window and returns its name (.msg_n - Where n is winid)
	proc Open { {container ""} } {
		global  HOME tcl_platform


		if { [UseContainer] == 0 || $container == "" } {
			set w [CreateTopLevelWindow]
	
			set mainmenu [CreateMainMenu $w]
			$w conf -menu $mainmenu
			bind $w <Control-m> "::ChatWindow::ShowHideChatWindowMenu $w $mainmenu"

			#Send a postevent for the creation of menu
			set evPar(window_name) "$w"
			set evPar(menu_name) "$mainmenu"
			::plugins::PostEvent chatmenu evPar

			#bind on configure for saving the window shape
			bind $w <Configure> "::ChatWindow::Configured %W"


			wm state $w withdraw

		} else {
			set w [CreateTabbedWindow $container]
		} 

		set copypastemenu [CreateCopyPasteMenu $w]
		set copymenu [CreateCopyMenu $w]


		# Create the window's elements
		set top [CreateTopFrame $w]
		set statusbar [CreateStatusBar $w]
		set paned [CreatePanedWindow $w]

		# Pack them

		if {[::skin::getKey chat_show_topframe]} {
			pack $top -side top -expand false -fill x -padx [::skin::getKey chat_top_padx]\
				 -pady [::skin::getKey chat_top_pady]
		}

		if {[::skin::getKey chat_show_statusbarframe]} {
			pack $statusbar -side bottom -expand false -fill x\
				-padx [::skin::getKey chat_status_padx] -pady [::skin::getKey chat_status_pady]
		}
		pack $paned -side top -expand true -fill both -padx [::skin::getKey chat_paned_padx]\
		 -pady [::skin::getKey chat_paned_pady]

		focus $paned

		# Sets the font size to the one stored in our configuration file
		change_myfontsize [::config::getKey textsize] $w


		# Set the properties of this chat window in our ::ChatWindow namespace
		# variables to be accessible from other procs in the namespace
		set ::ChatWindow::titles($w) ""
		set ::ChatWindow::first_message($w) 1
		set ::ChatWindow::recent_message($w) 0
		lappend ::ChatWindow::windows "$w"


		# PostEvent 'new_chatwindow' to notify plugins that the window was created
		set evPar(win) "$w"
		::plugins::PostEvent new_chatwindow evPar

		if { !([UseContainer] == 0 || $container == "" )} {
			AddWindowToContainer $container $w
		} else {
			if { ![catch {tk windowingsystem} wsystem] && $wsystem == "aqua" } {
				lower $w
				::ChatWindow::MacPosition $w
			}
		}

		return "$w"
	}
	#///////////////////////////////////////////////////////////////////////////////

	
	proc CloseTabInContainer { container } {
		set win [::ChatWindow::GetCurrentWindow $container]
		set tab [set ::ChatWindow::win2tab($win)]
		::ChatWindow::CloseTab $tab
		
	}

	proc CreateNewContainer { } { 
		
		set container [CreateContainerWindow]
		set mainmenu [CreateMainMenu $container]
		$container configure -menu $mainmenu
		bind $container <Control-m> "::ChatWindow::ShowHideChatWindowMenu $container $mainmenu"
		
		#Change Close item menu because the behavior is not the same with tabs
		$container.menu.msn delete "[trans close]"
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			$container.menu.msn add command -label "[trans close]" \
				-command "::ChatWindow::CloseTabInContainer $container" -accelerator "Command-W"
		} else {
			$container.menu.msn add command -label "[trans close]" \
				-command "::ChatWindow::CloseTabInContainer $container"
		}
		

		#we bind <Escape> to close the current tab
		#set current [GetCurrentWindow $container]
		#set currenttab [set win2tab($current)]
		#bind $container <<Escape>> "::ChatWindow::CloseTab \[set ::ChatWindow::win2tab(\[::ChatWindow::GetCurrentWindow $container\])\]"
		bind $container <<Escape>> [list ::ChatWindow::CloseTabInContainer $container]
		
		#Send a postevent for the creation of menu
		set evPar(window_name) "$container"
		set evPar(menu_name) "$mainmenu"
		::plugins::PostEvent chatmenu evPar
		
		
		#bind on configure for saving the window shape
		
		bind $container <Configure> "::ChatWindow::ContainerConfigured %W"

		set tabbar [CreateTabBar $container] 
		pack $tabbar -side top -fill both -expand false

		return $container

	}


	proc CreateTabBar { w } {
		set bar $w.bar
		::skin::setPixmap tab tab.gif
		::skin::setPixmap tab_close tab_close.gif

		::skin::setPixmap tab_close_hover tab_close_hover.gif
		::skin::setPixmap tab_hover tab_hover.gif

		::skin::setPixmap tab_current tab_current.gif
		::skin::setPixmap tab_flicker tab_flicker.gif
		::skin::setPixmap moretabs moretabs.gif
		::skin::setPixmap lesstabs lesstabs.gif

		frame $bar -class Amsn -relief solid -bg [::skin::getKey tabbarbg] -bd 0

		if { $::tcl_version >= 8.4 } {
			$bar configure  -padx [::skin::getKey chat_tabbar_padx] -pady [::skin::getKey chat_tabbar_pady]
		}

		return $bar
	}

	###################################################
	# CreateContainerWindow
	# This proc should create the toplevel window for a chat window
	# container and configure it and then return it's pathname
	#
	proc CreateContainerWindow { } {
		global tcl_platform
			
		set w ".container_$::ChatWindow::containerid"
		incr ::ChatWindow::containerid
			
		chatwindow $w -background [::skin::getKey chatwindowbg]	-borderwidth 0
#		::Event::registerEvent messageReceived all $w
		
		# If there isn't a configured size for Chat Windows, use the default one and store it.
		if {[catch { wm geometry $w [::config::getKey wincontainersize] } res]} {
			wm geometry $w 350x390
			::config::setKey wincontainersize 350x390
			status_log "No config(winchatsize). Setting default size for chat window\n" red
		}

		if {$tcl_platform(platform) == "windows"} {
			wm geometry $w +0+0
		}

		if { [winfo exists .bossmode] } {
			set ::BossMode($w) "iconic"
			wm state $w withdraw
		} else {
			wm state $w iconic
		}

		wm title $w "[trans chat]"
		wm group $w .

		# If the platform is NOT windows, set the windows' icon to our xbm
		if {$tcl_platform(platform) != "windows"} {
			catch {wm iconbitmap $w @[::skin::GetSkinFile pixmaps amsn.xbm]}
			catch {wm iconmask $w @[::skin::GetSkinFile pixmaps amsnmask.xbm]}
		}


		# Create the necessary bindings
		bind $w <<Cut>> "status_log cut\n;tk_textCut \[::ChatWindow::GetCurrentWindow $w\]"
		bind $w <<Copy>> "status_log copy\n;tk_textCopy \[::ChatWindow::GetCurrentWindow $w\]"
		bind $w <<Paste>> "status_log paste\n;tk_textPaste \[::ChatWindow::GetCurrentWindow $w\]"

		# Change shortcut for history and find on Mac OS X
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			bind $w <Command-Option-h> \
				"::amsn::ShowChatList \"[trans history]\" \[::ChatWindow::GetCurrentWindow $w\] ::log::OpenLogWin"
			# Control-w for closing current tab not implemented on Mac (germinator)
                        bind $w <Command-Next> "::ChatWindow::GoToNextTab $w"
                        bind $w <Command-Prior> "::ChatWindow::GoToPrevTab $w"
		} else {
			bind $w <Control-h> \
				"::amsn::ShowChatList \"[trans history]\" \[::ChatWindow::GetCurrentWindow $w\] ::log::OpenLogWin"
			bind $w <Control-H> \
				"::amsn::ShowChatList \"[trans history]\" \[::ChatWindow::GetCurrentWindow $w\] ::log::OpenLogWin"
			bind $w <Control-w> "::ChatWindow::CloseTab \[set ::ChatWindow::win2tab(\[::ChatWindow::GetCurrentWindow $w\])\]"
			bind $w <Control-W> "::ChatWindow::CloseTab \[set ::ChatWindow::win2tab(\[::ChatWindow::GetCurrentWindow $w\])\]"
			bind $w <Control-Next> "::ChatWindow::GoToNextTab $w"
			bind $w <Control-Prior> "::ChatWindow::GoToPrevTab $w"
		}

		searchdialog $w.search
		$w.search hide
		$w.search bindwindow $w

		bind $w <<Escape>> "::ChatWindow::ContainerClose $w; break"
		bind $w <Destroy> "::ChatWindow::DetachAll %W; global ${w}_show_picture; catch {unset ${w}_show_picture}"


		#Different shortcuts on Mac OS X
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			bind $w <Command-,> "Preferences"
			bind $w <Command-m> "catch {carbon::processHICommand mini $w}"
			bind $w <Command-M> "catch {carbon::processHICommand mini $w}"
		}


		# These bindings are handlers for closing the window (Leave the SB, store settings...)
		wm protocol $w WM_DELETE_WINDOW "::ChatWindow::ContainerClose $w"


		return $w
	}


	proc CreateTabbedWindow { container } {

		global tcl_platform

		set w "${container}.msg_${::ChatWindow::winid}"
		incr ::ChatWindow::winid

		status_log "tabbed window is : $w\n" red

		frame $w -background [::skin::getKey chatwindowbg] -relief solid -bd 0
    
    if { $::tcl_version >= 8.4 } {
        $w configure -padx 0 -pady 0
    }

		# If the platform is NOT windows, set the windows' icon to our xbm
		if {$tcl_platform(platform) != "windows"} {
			catch {wm iconbitmap $w @[::skin::GetSkinFile pixmaps amsn.xbm]}
			catch {wm iconmask $w @[::skin::GetSkinFile pixmaps amsnmask.xbm]}
		}


		# Create the necessary bindings
		bind $w <<Cut>> "status_log cut\n;tk_textCut $w"
		bind $w <<Copy>> "status_log copy\n;tk_textCopy $w"
		bind $w <<Paste>> "status_log paste\n;tk_textPaste $w"

		#Change shortcut for history on Mac OS X
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			bind $w <Command-Option-h> \
				"::amsn::ShowChatList \"[trans history]\" $w ::log::OpenLogWin"
		} else {
			bind $w <Control-h> \
				"::amsn::ShowChatList \"[trans history]\" $w ::log::OpenLogWin"
		}
		#I think it's not needed because the container already have <<escape>> binding
		#bind $w <<Escape>> "::ChatWindow::Close $w; break"
		bind $w <Destroy> "window_history clear %W; ::ChatWindow::Closed $w %W"


		return $w
	
	}
	###################################################
	# CreateTopLevelWindow
	# This proc should create the toplevel window for a chat window
	# configure it and then return it's pathname
	#
	proc CreateTopLevelWindow { } {
		global tcl_platform
		
		set w ".msg_$::ChatWindow::winid"
		incr ::ChatWindow::winid
			
		toplevel $w -class Amsn -background [::skin::getKey chatwindowbg]	
		
		# If there isn't a configured size for Chat Windows, use the default one and store it.
		if {[catch { wm geometry $w [::config::getKey winchatsize] } res]} {
			wm geometry $w 350x390
			::config::setKey winchatsize 350x390
			status_log "No config(winchatsize). Setting default size for chat window\n" red
		}

		if {$tcl_platform(platform) == "windows"} {
			wm geometry $w +0+0
		}

		if { [winfo exists .bossmode] } {
			set ::BossMode($w) "iconic"
			wm state $w withdraw
		} else {
			wm state $w iconic
		}

		wm title $w "[trans chat]"
		wm group $w .

		# If the platform is NOT windows, set the windows' icon to our xbm
		if {$tcl_platform(platform) != "windows"} {
			catch {wm iconbitmap $w @[::skin::GetSkinFile pixmaps amsn.xbm]}
			catch {wm iconmask $w @[::skin::GetSkinFile pixmaps amsnmask.xbm]}
		}


		# Create the necessary bindings
		bind $w <<Cut>> "status_log cut\n;tk_textCut $w"
		bind $w <<Copy>> "status_log copy\n;tk_textCopy $w"
		bind $w <<Paste>> "status_log paste\n;tk_textPaste $w"

		#Change shortcut for history on Mac OS X
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			bind $w <Command-Option-h> \
				"::amsn::ShowChatList \"[trans history]\" $w ::log::OpenLogWin"
		} else {
			bind $w <Control-h> \
				"::amsn::ShowChatList \"[trans history]\" $w ::log::OpenLogWin"
		}

		bind $w <<Escape>> "::ChatWindow::Close $w; break"
		bind $w <Destroy> "window_history clear %W; ::ChatWindow::Closed $w %W"

		#Different shortcuts on Mac OS X
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			bind $w <Command-,> "Preferences"
			bind $w <Command-m> "catch {carbon::processHICommand mini $w}"
			bind $w <Command-M> "catch {carbon::processHICommand mini $w}"
		}


		# These bindings are handlers for closing the window (Leave the SB, store settings...)
		wm protocol $w WM_DELETE_WINDOW "::ChatWindow::Close $w"


		return $w

	}

	proc ShowHideChatWindowMenu { window menu } {
		if { [string length [$window cget -menu]] > 0 } {
			$window configure -menu {}
		} else {
			$window configure -menu $menu
		}
	}

	#############################################
	# CreateMainMenu $w
	# This proc should create the main menu of the chat window
	# it only creates the menu supposed to appear in the menu bar actually
	#
	proc CreateMainMenu { w } {

		set mainmenu $w.menu	

		if { [package provide pixmapmenu] != "" } {
			pack [menubar $mainmenu] -fill x -side top
		} else {
			menu $mainmenu -tearoff 0 -type menubar -borderwidth 0 -activeborderwidth -0