[Tkabber-dev] r1622 - in trunk/tkabber: . plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Dec 15 16:03:18 MSK 2008


Author: sergei
Date: 2008-12-15 16:03:17 +0300 (Mon, 15 Dec 2008)
New Revision: 1622

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/general/sound.tcl
Log:
	* plugins/general/sound.tcl: Fixed resource leak when every time a
	  sound is played using snack the new sound object were created. Also,
	  moved snack to a separate thread (if Thread package is available) to
	  make sound better because snack uses Tcl event loop which can be busy
	  in the main thread.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-12-14 15:09:54 UTC (rev 1621)
+++ trunk/tkabber/ChangeLog	2008-12-15 13:03:17 UTC (rev 1622)
@@ -1,3 +1,11 @@
+2008-12-15  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/general/sound.tcl: Fixed resource leak when every time a
+	  sound is played using snack the new sound object were created. Also,
+	  moved snack to a separate thread (if Thread package is available) to
+	  make sound better because snack uses Tcl event loop which can be busy
+	  in the main thread.
+
 2008-12-14  Sergei Golovan  <sgolovan at nes.ru>
 
 	* login.tcl: Since logout can be called before a connection is

Modified: trunk/tkabber/plugins/general/sound.tcl
===================================================================
--- trunk/tkabber/plugins/general/sound.tcl	2008-12-14 15:09:54 UTC (rev 1621)
+++ trunk/tkabber/plugins/general/sound.tcl	2008-12-15 13:03:17 UTC (rev 1622)
@@ -2,12 +2,20 @@
 
 namespace eval ::sound {
 
-    set snack 1
-    if {[catch { package require snack 2.0 }]} {
-	debugmsg tkabber \
-	    "Unable to load the Snack package, so no sound support!\
-The Snack package is available at http://www.speech.kth.se/snack/index.html"
-	set snack 0
+    if {![catch {package require Thread 2.0}]} {
+	variable SoundThread [thread::create]
+	if {![catch {thread::send $SoundThread {package require snack 2.0}}]} {
+	    set snack 2
+	} else {
+	    set snack 0
+	    thread::release $SoundThread
+	}
+    } else {
+	if {![catch {package require snack 2.0}]} {
+	    set snack 1
+	} else {
+	    set snack 0
+	}
     }
 
     custom::defgroup Sound [::msgcat::mc "Sound options."] -group Tkabber
@@ -20,95 +28,120 @@
 	set vfs 0
     }
 
+    variable mute 0
+
     custom::defvar options(mute) 0 \
 	[::msgcat::mc "Mute sound notification."] \
-	-type boolean -group Sound
+	-type boolean \
+	-group Sound
     custom::defvar options(notify_online) 1 \
 	[::msgcat::mc "Use sound notification only when being available."] \
-	-type boolean -group Sound
-    variable mute 0
+	-type boolean \
+	-group Sound
     custom::defvar options(mute_groupchat_delayed) 1 \
-	[::msgcat::mc "Mute sound when displaying delayed groupchat messages."] \
-	-type boolean -group Sound
+	[::msgcat::mc "Mute sound when displaying delayed groupchat\
+		       messages."] \
+	-type boolean \
+	-group Sound
     custom::defvar options(mute_chat_delayed) 0 \
-	[::msgcat::mc "Mute sound when displaying delayed personal chat messages."] \
-	-type boolean -group Sound
+	[::msgcat::mc "Mute sound when displaying delayed personal chat\
+		       messages."] \
+	-type boolean \
+	-group Sound
     custom::defvar options(mute_if_focus) 0 \
 	[::msgcat::mc "Mute sound if Tkabber window is focused."] \
-	-type boolean -group Sound
+	-type boolean \
+	-group Sound
+
     # One could use external play program instead of Snack
     custom::defvar options(external_play_program) "" \
-	[::msgcat::mc "External program, which is to be executed to play sound.\
-		       If empty, Snack library is used (if available) to play sound."] \
-	-type string -group Sound
-    # Params for external play program
+	[::msgcat::mc "External program, which is to be executed to play\
+		       sound. If empty, Snack library is used (if available)\
+		       to play sound."] \
+	-type string \
+	-group Sound
+
+    # Command line options for external play program
     custom::defvar options(external_play_program_options) "" \
 	[::msgcat::mc "Options for external play program"] \
-	-type string -group Sound
+	-type string \
+	-group Sound
 
     custom::defvar options(connected_sound) \
 	[fullpath sounds default connected.wav] \
 	[::msgcat::mc "Sound to play when connected to Jabber server."] \
-	-command [list [namespace current]::load_sound_file connected] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file connected]] \
+	-type file \
+	-group Sound
     custom::defvar options(disconnected_sound) \
 	[fullpath sounds default disconnected.wav] \
 	[::msgcat::mc "Sound to play when disconnected from Jabber server."] \
-	-command [list [namespace current]::load_sound_file disconnected] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file disconnected]] \
+	-type file \
+	-group Sound
     custom::defvar options(presence_available_sound) \
 	[fullpath sounds default presence_available.wav] \
 	[::msgcat::mc "Sound to play when available presence is received."] \
-	-command [list [namespace current]::load_sound_file presence_available] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file presence_available]] \
+	-type file \
+	-group Sound
     custom::defvar options(presence_unavailable_sound) \
 	[fullpath sounds default presence_unavailable.wav] \
 	[::msgcat::mc "Sound to play when unavailable presence is received."] \
-	-command [list [namespace current]::load_sound_file presence_unavailable] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file presence_unavailable]] \
+	-type file \
+	-group Sound
     custom::defvar options(chat_my_message_sound) \
 	[fullpath sounds default chat_my_message.wav] \
 	[::msgcat::mc "Sound to play when sending personal chat message."] \
-	-command [list [namespace current]::load_sound_file chat_my_message] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file chat_my_message]] \
+	-type file \
+	-group Sound
     custom::defvar options(chat_their_message_sound) \
 	[fullpath sounds default chat_their_message.wav] \
 	[::msgcat::mc "Sound to play when personal chat message is received."] \
-	-command [list [namespace current]::load_sound_file chat_their_message] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file chat_their_message]] \
+	-type file \
+	-group Sound
     custom::defvar options(groupchat_server_message_sound) \
 	[fullpath sounds default groupchat_server_message.wav] \
 	[::msgcat::mc "Sound to play when groupchat server message is received."] \
-	-command [list [namespace current]::load_sound_file groupchat_server_message] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file groupchat_server_message]] \
+	-type file \
+	-group Sound
     custom::defvar options(groupchat_my_message_sound) \
 	[fullpath sounds default groupchat_my_message.wav] \
 	[::msgcat::mc "Sound to play when groupchat message from me is received."] \
-	-command [list [namespace current]::load_sound_file groupchat_my_message] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file groupchat_my_message]] \
+	-type file \
+	-group Sound
     custom::defvar options(groupchat_their_message_sound) \
 	[fullpath sounds default groupchat_their_message.wav] \
 	[::msgcat::mc "Sound to play when groupchat message is received."] \
-	-command [list [namespace current]::load_sound_file groupchat_their_message] \
-	-type file -group Sound
+	-command [namespace code [list load_sound_file groupchat_their_message]] \
+	-type file \
+	-group Sound
     custom::defvar options(groupchat_their_message_to_me_sound) \
 	[fullpath sounds default chat_their_message.wav] \
 	[::msgcat::mc "Sound to play when highlighted (usually addressed personally)\
-groupchat message is received."] \
-	-command [list [namespace current]::load_sound_file groupchat_their_message_to_me] \
-	-type file -group Sound
+		       groupchat message is received."] \
+	-command [namespace code [list load_sound_file groupchat_their_message_to_me]] \
+	-type file \
+	-group Sound
     
-
     variable play_id ""
     variable play_priority 0
+
     # Do not allow play sound very often
     custom::defvar options(delay) 200 \
-	[::msgcat::mc "Time interval before playing next sound (in milliseconds)."] \
-	-type integer -group Sound
+	[::msgcat::mc "Time interval before playing next sound\
+		       (in milliseconds)."] \
+	-type integer \
+	-group Sound
 
     hook::add finload_hook [namespace current]::setup_menu
     hook::add on_change_user_presence_hook \
-	[namespace current]::presence_notify 100
+	      [namespace current]::presence_notify 100
     hook::add change_our_presence_post_hook [namespace current]::mute_setup 100
     hook::add connected_hook [namespace current]::connected_notify 100
     hook::add disconnected_hook [namespace current]::disconnected_notify
@@ -121,31 +154,40 @@
 
     if {![cequal $::interface tk] && ![cequal $::interface ck]} return
 
-    catch {
-	set m [.mainframe getmenu tkabber]
-	set ind [expr {[$m index [::msgcat::mc "Chats"]] + 1}]
+    set m [.mainframe getmenu tkabber]
+    set ind [$m index [::msgcat::mc "Chats"]]
+    incr ind
 
-	set mm .sound_menu
-	menu $mm -tearoff $::ifacetk::options(show_tearoffs)
-	$mm add checkbutton -label [::msgcat::mc "Mute sound"] \
-	    -variable [namespace current]::options(mute)
-	$mm add checkbutton -label [::msgcat::mc "Notify only when available"] \
-	    -variable [namespace current]::options(notify_online)
+    set mm .sound_menu
+    menu $mm -tearoff $::ifacetk::options(show_tearoffs)
+    $mm add checkbutton -label [::msgcat::mc "Mute sound"] \
+			-variable [namespace current]::options(mute)
+    $mm add checkbutton -label [::msgcat::mc "Notify only when available"] \
+			-variable [namespace current]::options(notify_online)
 
-	$m insert $ind cascade -label [::msgcat::mc "Sound"] \
-	    -menu $mm
-    }
+    $m insert $ind cascade -label [::msgcat::mc "Sound"] \
+			   -menu $mm
 }
 
 proc ::sound::load_sound_file {name args} {
     variable snack
     variable options
     variable sounds
+    variable SoundThread
 
     if {[file exist $options(${name}_sound)]} {
 	set sounds($name) $options(${name}_sound)
-	if {$snack} {
-	    catch { snack::sound $sounds($name) -file $sounds($name) }
+	switch -- $snack {
+	    1 {
+		catch {$sounds($name) destroy}
+		catch {snack::sound $sounds($name) -file $sounds($name)}
+	    }
+	    2 {
+		thread::send $SoundThread \
+		    [list catch [list $sounds($name) destroy]]
+		thread::send $SoundThread \
+		    [list catch [list snack::sound $sounds($name) -file $sounds($name)]]
+	    }
 	}
     } else {
 	set sounds($name) ""
@@ -173,8 +215,9 @@
     variable options
     variable play_id
     variable play_priority
+    variable SoundThread
 
-    if {($name == "")} return
+    if {$name == ""} return
 
     if {$play_id != ""} {
 	if {$priority >= $play_priority} {
@@ -184,17 +227,25 @@
 	}
     }
     if {$options(delay) > 0} {
-	set play_id [after $options(delay) [list set [namespace current]::play_id {}]]
+	set play_id \
+	    [after $options(delay) [list set [namespace current]::play_id {}]]
     }
     set play_priority $priority
 
     if {$options(external_play_program) == ""} {
-	if {![info exist $name]} {
-	    catch { snack::sound $name -file $name }
-        }
-	catch { $name play -block 0 }
+	switch -- $snack {
+	    1 {
+		catch {$name play -block 0}
+	    }
+	    2 {
+		thread::send -async $SoundThread \
+			     [list catch [list $name play -block 0]]
+	    }
+	}
     } else {
-	catch { eval "exec $options(external_play_program) $options(external_play_program_options) [list $name] &" }
+	catch {eval "exec $options(external_play_program)\
+			  $options(external_play_program_options)\
+			  [list $name] &"}
     }
 }
 
@@ -305,7 +356,7 @@
     variable options
     variable mute
     
-    expr {(($options(external_play_program) == "") && !$snack) || \
+    expr {($options(external_play_program) == "" && $snack == 0) || \
 	  $options(mute) || \
 	  $mute || \
 	  ($options(mute_if_focus) && [focus -displayof .] != "")}



More information about the Tkabber-dev mailing list