[Tkabber-dev] r382 - in trunk/plugins: . winup winup/msgs winup/pixmaps

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Sep 12 22:30:25 MSD 2010


Author: Rejjin
Date: 2010-09-12 22:30:25 +0400 (Sun, 12 Sep 2010)
New Revision: 382

Added:
   trunk/plugins/winup/
   trunk/plugins/winup/msgs/
   trunk/plugins/winup/msgs/ru.msg
   trunk/plugins/winup/pixmaps/
   trunk/plugins/winup/pixmaps/toolbar-disabled.gif
   trunk/plugins/winup/pixmaps/toolbar-enabled.gif
   trunk/plugins/winup/winup.tcl
Log:
winup - the manager notices. Already there are three themes. Settings/winup/themes windows/::Plugins::winup::theme automatically starts the demonstration window. The settings of each window allow you to configure in detail the style of notification. A button for quick mieny state plugin.

Added: trunk/plugins/winup/msgs/ru.msg
===================================================================
--- trunk/plugins/winup/msgs/ru.msg	                        (rev 0)
+++ trunk/plugins/winup/msgs/ru.msg	2010-09-12 18:30:25 UTC (rev 382)
@@ -0,0 +1,29 @@
+::msgcat::mcset ru "Winup options" "Winup настройки"
+::msgcat::mcset ru "Add to main toolbar button, for fast change state" "Добавляет кнопку на тулбар, для быстрой смены состояния плагина"
+::msgcat::mcset ru "Sleep of notify" "Задержка окна напоминания"
+::msgcat::mcset ru "Length of string for show in notify" "Максимальное количество символов для окна уведомления"
+::msgcat::mcset ru "Winup status options" "Winup настройки статуса"
+::msgcat::mcset ru "Use notifycation, if your status %s" "Включить плагин, если статус %s"
+::msgcat::mcset ru "Window themes" "Темы окна уведомления"
+::msgcat::mcset ru "Whether the Winup plugin is loaded" "Загружает/выгружает плагин Winup"
+::msgcat::mcset ru "Message from %s" "Сообщение от %s"
+::msgcat::mcset ru "Disable Winup" "отключить Winup"
+::msgcat::mcset ru "Enable Winup" "Включить Winup"
+::msgcat::mcset ru "Standart window theme" "Standart window тема"
+::msgcat::mcset ru "Using alpha for window" "Использовать прозрачность для окна уведомления"
+::msgcat::mcset ru "Alpha scale" "Уровень прозрачности"
+::msgcat::mcset ru "Background color (top part of window)" "Цвет заднего плана (верхняя часть окна)"
+::msgcat::mcset ru "Foreground color (top part of window)" "Цвет переднего плана (верхняя часть окна)"
+::msgcat::mcset ru "Background color (bottom part of window)" "Цвет заднего плана (нижняя часть окна)"
+::msgcat::mcset ru "Foreground color (bottom part of window)" "Цвет переднего плана (нижняя часть окна)"
+::msgcat::mcset ru "Font of header" "Шрифт заголовка"
+::msgcat::mcset ru "Font of message" "Шрифт сообщения"
+::msgcat::mcset ru "Mouse-window theme" "Mouse-window тема"
+::msgcat::mcset ru "Move window with mouse" "Передвигать окно вместе с курсором мыши"
+::msgcat::mcset ru "Floatinglog theme" "Floatinglog тема"
+::msgcat::mcset ru "Window position" "Позиция окна"
+::msgcat::mcset ru "Status font" "Шрифт статуса"
+::msgcat::mcset ru "Window type" "Тип окна"
+::msgcat::mcset ru "Header of window" "Заголовок окна"
+::msgcat::mcset ru "Message" "Сообщение"
+::msgcat::mcset ru "Status" "Статус"
\ No newline at end of file

Added: trunk/plugins/winup/pixmaps/toolbar-disabled.gif
===================================================================
(Binary files differ)


Property changes on: trunk/plugins/winup/pixmaps/toolbar-disabled.gif
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Added: trunk/plugins/winup/pixmaps/toolbar-enabled.gif
===================================================================
(Binary files differ)


Property changes on: trunk/plugins/winup/pixmaps/toolbar-enabled.gif
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Added: trunk/plugins/winup/winup.tcl
===================================================================
--- trunk/plugins/winup/winup.tcl	                        (rev 0)
+++ trunk/plugins/winup/winup.tcl	2010-09-12 18:30:25 UTC (rev 382)
@@ -0,0 +1,733 @@
+#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#
+#	Winup - small notify for incomming messages
+#	Author - < Renji >
+#	e-mail - < webrenji at gmail.com >
+#	xmpp - < rejjin at jabber.dk >
+#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#
+#	Please see readme
+#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#
+# 7:11 09.09.2010
+#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#	#
+
+
+namespace eval winup {
+	variable options
+	variable state_winup_button
+	variable button_index
+	
+	set options(cd) [file dirname [info script]]
+	
+	::msgcat::mcload [file join $options(cd) msgs]
+	
+	custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
+	-group Tkabber	
+	
+    custom::defgroup Winup [::msgcat::mc "Winup options"] \
+	-group Plugins	
+	
+	custom::defvar options(use_toolbar) 1 \
+	[::msgcat::mc "Add to main toolbar button, for fast change state"] \
+	-group Winup -type boolean
+	
+	custom::defvar options(sleep) 3 \
+	[::msgcat::mc "Sleep of notify"] \
+	-type integer -group Winup
+	
+	custom::defvar options(string_length) 100 \
+	[::msgcat::mc "Length of string for show in notify"] \
+	-type integer -group Winup
+	
+	custom::defgroup {Status options} \
+	[::msgcat::mc "Winup status options"] \
+	-group Winup
+
+	foreach status_type { available chat away xa dnd invisible } {
+		custom::defvar options(status-$status_type) 1 \
+		[::msgcat::mc "Use notifycation, if your status %s" $status_type] \
+		-group {Status options} -type boolean
+	}
+	
+	custom::defvar state_winup_button 1 {} \
+	-type boolean -group Hidden
+	
+	custom::defvar button_index 0 {} \
+	-type boolean -group Hidden
+	
+	custom::defgroup {Window themes} \
+	[::msgcat::mc "Window themes"] \
+	-group Winup
+	
+	if { [info commands ::plugins::is_registered] ne {} } {
+		if {![::plugins::is_registered winup]} {
+			::plugins::register winup \
+					-namespace [namespace current] \
+					-source [info script] \
+					-description [::msgcat::mc "Whether the Winup plugin is loaded"] \
+					-loadcommand [namespace code load] \
+					-unloadcommand [namespace code unload]
+			return
+		}
+	}
+}
+
+proc winup::load {} {
+	set ns [namespace current]
+	hook::add process_message_hook ${ns}::process_message 70
+	hook::add finload_hook ${ns}::toolbar_button_handle
+	${ns}::toolbar_button_handle
+}
+
+proc winup::unload {} {
+	set ns [namespace current]
+	hook::remove process_message_hook ${ns}::process_message 70
+	hook::remove finload_hook ${ns}::toolbar_button_handle
+	${ns}::delete_toolbar_button
+}
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+
+proc winup::process_message  { xlib from - type - subject body - - - x } {
+	variable options
+	
+	if { [get_button_state] == 0 } {
+		return
+	}
+
+	if { $body eq {} } {
+		return
+	}
+	
+	switch -- $type {
+		groupchat {
+			set chatid [chat::chatid $xlib [::xmpp::jid::stripResource $from]]
+		}
+		chat {
+			set chatid [chat::chatid $xlib $from]
+		}
+	}
+	
+	
+	if { [chat::is_opened $chatid] && [ifacetk::chat_window_is_active $chatid] } {
+		return
+	}
+	
+	if { $type eq "groupchat" && [::xmpp::delay::exists $x] } {
+		return 
+	}
+	
+	if { [info commands ::plugins::mucignore::is_ignored]  ne {} } {
+			if { [::plugins::mucignore::is_ignored $xlib $from $type] ne {}} {
+				return
+			}
+	}
+		
+	foreach st { available chat away xa dnd invisible } {
+		if { $::curuserstatus eq $st && $options(status-${st}) == 0 } {
+			return
+		}
+	}
+		
+	create_message $xlib $from $type $body
+}
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+
+proc winup::create_message	{ xlib from type body } {
+	variable options
+	
+	if { $type eq "chat" } {
+		set options(head) [::msgcat::mc "Message from %s" <[get_sender_from_chat $xlib $from]>]
+		set options(image) [get_status_icon [get_jid_status $xlib $from]]
+	} else {
+		set options(head) [::msgcat::mc "Message from %s" "[::xmpp::jid::stripResource $from] <[::xmpp::jid::resource $from]>"]
+		set options(image) {roster/conference/available}
+	}
+
+	
+	set options(chatid) [chat::chatid $xlib $from]
+	set options(body) [string range $body 0 $options(string_length) ]
+	set options(status) [get_user_status_desc $xlib $from]
+	set options(status_type) [get_jid_status $xlib $from]
+	
+	if { [string length [get_user_status_desc $xlib $from]] > 50 } {
+		set options(status) "[string range [get_user_status_desc $xlib $from] 0 50] ..."
+	}
+	
+	create_window
+}
+		
+proc winup::get_sender_from_chat { xlib from } {
+	set part [::xmpp::jid::stripResource $from]
+	set chatid [chat::chatid $xlib $part]
+	if { [chat::is_groupchat $chatid] } {
+		return [::xmpp::jid::resource $from]
+	}
+	return $part
+}
+	
+proc winup::get_status_icon { status } {
+	foreach part { available away chat dnd error \
+		invisible unavailable unsubscribed xa } {
+			if { $part eq $status } {
+				return "roster/user/$part"
+			}
+	}
+	return "roster/user/available"
+}
+ 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+ 
+proc winup::create_window { } {
+	variable options
+	
+	hook::run winup_window_types $options(chatid) \
+		$options(head) $options(image) $options(body) \
+		$options(status)
+}
+	
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+proc winup::toolbar_button_handle { } {
+	variable options 
+	variable button_index
+	
+	if { $options(use_toolbar) == 0 } {
+		return
+	}
+	
+    if {[catch {set bbox [.mainframe gettoolbar 0].bbox}] || \
+	    ![winfo exists $bbox]} {
+			return
+    }
+	
+	if { [winfo exist $bbox.b$button_index] } {
+		return
+	}
+	
+	image create photo {toolbar/winup-enabled} \
+	-file [file join $options(cd) pixmaps toolbar-enabled.gif]
+	
+	image create photo {toolbar/winup-disabled} \
+	-file [file join $options(cd) pixmaps toolbar-disabled.gif]	
+	
+	set ns [namespace current]
+	
+	set button_index [ifacetk::add_toolbar_button \
+		[get_button_icon] \
+			${ns}::change_button_state \
+				[get_button_text] ]
+}
+
+proc winup::delete_toolbar_button { } {
+	variable button_index
+	
+    if {[catch {set bbox [.mainframe gettoolbar 0].bbox}] || \
+	    ![winfo exists $bbox]} {
+			return 0
+    }
+	
+	if { [winfo exist $bbox.b$button_index] } {
+		ButtonBox::delete $bbox $button_index
+		ButtonBox::_redraw $bbox
+	}
+}
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+proc winup::get_button_state { } {
+	variable state_winup_button
+	return $state_winup_button
+}
+
+proc winup::change_button_state { } {
+	variable state_winup_button
+	set state_winup_button [expr {$state_winup_button == 0}]
+	change_button_icon
+	change_button_text
+}
+
+proc winup::change_button_text { } {
+	variable button_index
+	set bbox [.mainframe gettoolbar 0].bbox
+	$bbox.b$button_index configure -helptext [get_button_text]
+}
+
+proc winup::get_button_icon { } {
+	variable state_winup_button
+	if { $state_winup_button } {
+		return {toolbar/winup-enabled}
+	} else {
+		return {toolbar/winup-disabled}
+	}
+}
+
+proc winup::get_button_text { } {
+	variable state_winup_button
+	if { $state_winup_button } {
+		return [::msgcat::mc "Disable Winup"]
+	} else {
+		return [::msgcat::mc "Enable Winup"]
+	}
+}
+
+proc winup::change_button_icon { } {
+	variable button_index
+	ifacetk::set_toolbar_icon $button_index \
+	[namespace current]::get_button_icon
+}
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+
+
+	
+proc winup::time_sleep { time } {
+	set sleep -
+	after $time {set sleep +}
+	vwait sleep
+	catch {unset sleep}
+}
+
+proc winup::change_alpha { w x } {
+	time_sleep 20
+	update idletasks
+	if { [winfo exist $w] == 0 } { return }
+	wm attributes $w -alpha $x
+}
+
+proc winup::change_geometry { w x } {
+	time_sleep 2
+	update idletasks
+	if { [winfo exist $w] == 0 } { return }
+	wm geometry $w $x
+	update idletasks
+}
+
+proc winup::option_exist option {
+	return [expr {[lsearch -exact [wm attributes .] -$option] >= 0}]
+}
+
+###################################################################
+###################################################################
+###################################################################
+###################################################################
+###################################################################
+
+namespace eval winup {
+	variable options
+	
+	set group {Standart window theme}
+	
+	custom::defgroup $group [::msgcat::mc $group] -group {Window themes}
+	
+	custom::defvar options(standart_window,use_alpha) 1 \
+	[::msgcat::mc "Using alpha for window"] \
+	-group $group -type boolean
+	
+	custom::defvar options(standart_window,alpha_scale) 70 \
+	[::msgcat::mc "Alpha scale"] \
+	-group $group -type integer
+	
+	custom::defvar options(standart_window,background_color_top) {#555555} \
+	[::msgcat::mc "Background color (top part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(standart_window,foreground_color_top) {white} \
+	[::msgcat::mc "Foreground color (top part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(standart_window,background_color_bottom) {white} \
+	[::msgcat::mc "Background color (bottom part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(standart_window,foreground_color_bottom) {#555555} \
+	[::msgcat::mc "Foreground color (bottom part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(standart_window,head_font) {Tahoma 8 bold} \
+	[::msgcat::mc "Font of header"] \
+	-type font -group $group
+	
+	custom::defvar options(standart_window,body_font) {Tahoma 7} \
+	[::msgcat::mc "Font of message"] \
+	-type font -group $group	
+}
+
+proc winup::standart_window { chatid head image body status } {
+	variable options
+	variable theme
+	
+	if { $theme ne "standart_window" } {
+		return
+	}
+	
+	set w ._winup
+	
+	if { [winfo exist $w] } {
+		pop_down $w 8
+	}
+	
+	toplevel $w
+	
+	if { [option_exist topmost] } {
+		wm attributes $w -topmost 1
+	}
+	
+	if { [option_exist alpha] && $options(standart_window,use_alpha) } {
+		wm attributes $w -alpha 0.$options(standart_window,alpha_scale)
+	}
+	
+	catch { wm resizable $w 0 0 }
+	catch { wm overrideredirect $w 1 }
+	
+	set options(mw) [winfo screenwidth .]
+	set options(mh) [winfo screenheight .]
+	
+	set options(w) [expr {round($options(mw) / 4 + 20)}]
+	set options(h) [expr {round($options(mh) / 6 + 20)}]
+
+	set options(xp) [expr {round($options(mw) - $options(w))}] 
+	set options(yp) $options(mh)
+
+	wm geometry $w ${options(w)}x${options(h)}+${options(xp)}+${options(yp)}
+	
+	frame $w.frame -relief flat -background $options(standart_window,background_color_top)
+	frame $w.center -relief flat -background $options(standart_window,background_color_bottom)
+	pack $w.frame  $w.center -fill both -expand 1
+	
+	label $w.frame.icon -image $image -background $options(standart_window,background_color_top)
+	label $w.frame.header -text $head -font $options(standart_window,head_font) \
+		-foreground $options(standart_window,foreground_color_top) \
+		-background $options(standart_window,background_color_top)  -justify left
+	pack $w.frame.icon $w.frame.header -side left 
+
+	message  $w.center.text -text $body -font $options(standart_window,body_font) \
+		-foreground $options(standart_window,foreground_color_bottom) \
+		-background $options(standart_window,background_color_bottom)  -justify left -aspect 500
+	pack $w.center.text -side top -anchor nw -fill both -expand 1
+	
+	bind $w <1> [list [namespace current]::standart_window_to_chat $chatid $w]
+	bind $w <3> [list [namespace current]::pop_down $w 8]
+	
+	pop_up $w
+}
+
+proc winup::standart_window_to_chat { chatid w } {
+	catch { chat::activate $chatid }
+	pop_down $w 14
+}
+
+proc winup::pop_up w {
+	variable options 
+	
+	set options(yp) [expr {round($options(mh) - $options(h))}]
+
+	time_sleep 100
+	
+	for {set X $options(mh)} {$X >= $options(yp)} {incr X -4} {
+		change_geometry $w ${options(w)}x${options(h)}+${options(xp)}+${X}
+	}
+		
+	time_sleep 200
+	
+	if { [option_exist alpha] && $options(standart_window,use_alpha) } {
+		for {set X 80} {$X <= 90} {incr X 2} {
+			change_alpha $w [expr {$X / 100.0}]
+		}
+	}
+	
+	time_sleep [expr {$options(sleep)*1000}]
+	pop_down $w
+}
+
+proc winup::pop_down { w {speed 4} } {
+	variable options 
+	
+	if { [option_exist alpha] && $options(standart_window,use_alpha) } {
+		for {set X 90} {$X > 80} {incr X -[expr {$speed / 2}]} {
+			change_alpha $w [expr {$X / 100.0}]
+		}
+	}
+			
+	time_sleep 200
+	for {set X $options(yp)} {$X < $options(mh)} {incr X $speed} {
+		change_geometry $w ${options(w)}x${options(h)}+${options(xp)}+${X}
+	}
+		
+	destroy $w
+}
+
+hook::add winup_window_types [namespace current]::winup::standart_window		
+
+
+
+###################################################################
+
+namespace eval winup {
+	variable options
+	
+	set group {Mouse-window theme}
+	
+	custom::defgroup $group [::msgcat::mc $group] -group {Window themes}
+
+	custom::defvar options(mouse-window,use_alpha) 1 \
+	[::msgcat::mc "Using alpha for window"] \
+	-group $group -type boolean
+	
+	custom::defvar options(mouse-window,alpha_scale) 70 \
+	[::msgcat::mc "Alpha scale"] \
+	-group $group -type integer
+	
+	custom::defvar options(mouse-window,draw_with_mouse) 1 \
+	[::msgcat::mc "Move window with mouse"] \
+	-group $group -type boolean
+	
+	custom::defvar options(mouse-window,background_color_top) {#555555} \
+	[::msgcat::mc "Background color (top part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(mouse-window,foreground_color_top) {white} \
+	[::msgcat::mc "Foreground color (top part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(mouse-window,background_color_bottom) {white} \
+	[::msgcat::mc "Background color (bottom part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(mouse-window,foreground_color_bottom) {#555555} \
+	[::msgcat::mc "Foreground color (bottom part of window)"] \
+	-type string -group $group
+	
+	custom::defvar options(mouse-window,head_font) {Tahoma 8 bold} \
+	[::msgcat::mc "Font of header"] \
+	-type font -group $group
+	
+	custom::defvar options(mouse-window,body_font) {Tahoma 7} \
+	[::msgcat::mc "Font of message"] \
+	-type font -group $group	
+	
+}
+
+
+proc winup::mouse_window { chatid head image body status } {
+	variable options
+	variable theme
+	
+	if { $theme ne "mouse_window" } {
+		return
+	}
+	
+	set w ._winup
+	
+	if { [winfo exist $w] } {
+		destroy $w
+	}
+	
+	toplevel $w
+	
+	if { [option_exist topmost] } {
+		wm attributes $w -topmost 1
+	}
+	
+	if { [option_exist alpha] && $options(mouse-window,use_alpha) } {
+		wm attributes $w -alpha 0.$options(mouse-window,alpha_scale)
+	}
+
+	catch { wm resizable $w 0 0 }
+	catch { wm overrideredirect $w 1 }
+	
+	set options(mw) [winfo screenwidth .]
+	set options(mh) [winfo screenheight .]
+	
+	set options(w) [expr {round([winfo screenwidth .] / 4 + 20)}]
+	set options(h) [expr {round([winfo screenheight .] / 6 + 20)}]
+
+	set options(xp) [expr {[winfo pointerx .] - $options(w) / 2}]
+	set options(yp) [expr {[winfo pointery .] - $options(h) / 2}]
+	
+	wm geometry $w ${options(w)}x${options(h)}+${options(xp)}+${options(yp)}
+	
+	frame $w.frame -relief flat -background $options(mouse-window,background_color_top)
+	frame $w.center -relief flat -background $options(mouse-window,background_color_bottom)
+	pack $w.frame  $w.center -fill both -expand 1
+	
+	label $w.frame.icon -image $image -background $options(mouse-window,background_color_top)
+	label $w.frame.header -text $head -font $options(mouse-window,head_font) \
+		-foreground $options(mouse-window,foreground_color_top) \
+		-background $options(mouse-window,background_color_top)  -justify left
+	pack $w.frame.icon $w.frame.header -side left 
+
+	message  $w.center.text -text $body -font $options(mouse-window,body_font) \
+		-foreground $options(mouse-window,foreground_color_bottom) \
+		-background $options(mouse-window,background_color_bottom)  -justify left -aspect 500
+	pack $w.center.text -side top -anchor nw -fill both -expand 1
+	
+	bind $w <1> [list [namespace current]::mouse-window_to_chat $chatid $w]
+	bind $w <3> [list destroy $w]
+	
+	if {$options(mouse-window,draw_with_mouse)} {
+		bind $w <Any-Motion> [list [namespace current]::mouse-window_draw_window $w]
+	} else {
+		after [expr {$options(sleep) * 1000}] [list destroy $w] 
+	}
+}
+
+proc winup::mouse-window_draw_window { w } {
+	variable options
+	
+	set options(xp) [expr {[winfo pointerx .] - $options(w) / 2}]
+	set options(yp) [expr {[winfo pointery .] - $options(h) / 2}]
+	
+	wm geometry $w ${options(w)}x${options(h)}+${options(xp)}+${options(yp)}
+}
+
+proc winup::mouse-window_to_chat { chatid w } {
+	catch { chat::activate $chatid }
+	destroy $w
+}
+
+hook::add winup_window_types [namespace current]::winup::mouse_window	
+
+
+###################################################################
+
+namespace eval winup {
+	variable options
+	
+	set group {Floatinglog theme}
+
+	custom::defgroup $group [::msgcat::mc $group] -group {Window themes}
+	
+	custom::defvar options(floatinglog,use_alpha) 1 \
+	[::msgcat::mc "Using alpha for window"] \
+	-group $group -type boolean
+	
+	custom::defvar options(floatinglog,alpha_scale) 70 \
+	[::msgcat::mc "Alpha scale"] \
+	-group $group -type integer
+	
+	custom::defvar options(floatinglog,position) {-0-30} \
+	[::msgcat::mc "Window position"] \
+	-type string -group $group	
+	
+	custom::defvar options(floatinglog,head_font) {Tahoma 8 bold} \
+	[::msgcat::mc "Font of header"] \
+	-type font -group $group
+	
+	custom::defvar options(floatinglog,body_font) {Tahoma 7 bold} \
+	[::msgcat::mc "Font of message"] \
+	-type font -group $group	
+	
+	custom::defvar options(floatinglog,status_font) {Tahoma 7 bold} \
+	[::msgcat::mc "Status font"] \
+	-type font -group $group	
+}
+	
+proc winup::floatinglog { chatid head image body status } {
+	variable options
+	variable theme
+	
+	if { $theme ne "floatinglog" } {
+		return
+	}
+	
+	set w ._winup
+	
+	if { [winfo exist $w] } {
+		destroy $w
+	}
+	
+	toplevel $w -background #555555
+	
+	if { [option_exist topmost] } {
+		wm attributes $w -topmost 1
+	}
+	
+	if { [option_exist alpha] && $options(floatinglog,use_alpha) } {
+		wm attributes $w -alpha 0.$options(floatinglog,alpha_scale)
+	}
+	
+	catch { wm resizable $w 0 0 }
+	catch { wm overrideredirect $w 1 }
+	
+	wm geometry $w $options(floatinglog,position)
+	wm minsize $w 285 10
+	
+	set w [frame $w.frame -relief flat  -background #555555]
+	pack $w -expand 1 -fill both -anchor center
+
+	set ftop $w.top
+	frame $ftop -relief flat  -background #555555
+	pack $ftop -expand 0 -fill x -anchor n -side top
+
+	label $ftop.icon -image $image -background #555555
+	
+	label $ftop.title -text $head -font $options(floatinglog,head_font) \
+		-background #555555 -fg #cccccc
+		
+	pack $ftop.icon $ftop.title -anchor nw -side left
+
+	grid $ftop.icon -row 0 -column 0
+	grid $ftop.title -row 0 -column 1
+
+	set fcenter $w.center
+	frame $fcenter -relief flat
+	pack $fcenter -expand 1 -fill both -anchor center -padx 5
+	
+	label $fcenter.status -text $status -justify left -font $options(floatinglog,status_font)
+	pack $fcenter.status -anchor nw
+	
+	message $fcenter.message -text $body -justify left \
+	-relief solid -bd 0 -width 350 -font $options(floatinglog,body_font)
+	pack $fcenter.message -anchor nw -side bottom -fill x
+
+	grid $fcenter.status -row 1 -column 1 -sticky w
+	grid $fcenter.message -row 2 -column 1 -sticky w
+
+
+	set fbottom $w.bottom
+	frame $fbottom -relief flat -background #555555
+	pack $fbottom -expand 0 -fill x -anchor center -pady 2 -side bottom
+
+	bind $w <1> [list [namespace current]::floatinglog_to_chat $chatid]
+	bind $w <3> [list destroy %W]
+	
+	after [expr {$options(sleep)*1000}] [list destroy ._winup]
+}
+
+proc winup::floatinglog_to_chat { chatid } {
+	catch { chat::activate $chatid }
+	destroy ._winup
+}
+
+hook::add winup_window_types [namespace current]::winup::floatinglog	
+
+###################################################################
+###################################################################
+###################################################################
+###################################################################
+###################################################################
+
+proc winup::create_custom_options { } {
+	variable options
+	
+	foreach name $::hook::winup_window_types {
+		set hook_part [lindex $name 0]
+		set extension_name [namespace tail $hook_part]
+		lappend windows $extension_name $extension_name
+	}
+	    
+	custom::defvar theme [lindex $windows 0] \
+		[::msgcat::mc "Window type"] \
+		-type options -values $windows \
+		-group {Window themes} \
+		-command [namespace current]::demo
+}
+
+hook::add finload_hook [namespace current]::winup::create_custom_options 100
+
+proc winup::demo { who work val } {
+	upvar 1 $who window
+	
+	eval { [namespace current]::$window - \
+		[::msgcat::mc "Header of window"] \
+		{roster/user/available} \
+		[::msgcat::mc "Message"] \
+		[::msgcat::mc "Status"] }
+}
+#########################################################



More information about the Tkabber-dev mailing list