Show gui.tcl syntax highlighted
::Version::setSubversionId {$Id: gui.tcl 8984 2007-09-03 23:35:50Z kakaroto $}
if { $initialize_amsn == 1 } {
if {![::picture::Loaded]} {
if { [OnDarwin] } {
tk_messageBox -default ok -message "There's a problem loading a module of aMSN (TkCxImage) on this \
computer. You need to update your system to Mac OS 10.3.9" -icon warning
} else {
tk_messageBox -default ok -message "Loading TkCximage failed. This module is needed to run \
aMSN. Please compile aMSN first, instructions on how to compile are located in the file INSTALL" \
-icon warning
}
exit
}
package require BWidget
source BWidget_mods.tcl
if {[catch {package require tkdnd}] } {
proc dnd { args } {}
proc shape { args } {}
}
#package require pixmapbutton
if { [OnMac] } {
# Use brushed metal style windows on Mac OS X.
catch {package require tkUnsupported}
#Use tclCarbonHICommand for window utilities
catch {package require tclCarbonHICommand}
catch {package require QuickTimeTcl}
catch {load utils/macosx/Quicktimetcl3.1/quicktimetcl3.1.dylib}
} else {
package require pixmapscroll
}
::skin::setKey mainwindowbg #7979f2
::skin::setKey contactlistbg #ffffff
::skin::setKey topcontactlistbg #ffffff
::skin::setKey bannerbg #ffffff
::skin::setKey contact_mobile #404040
::skin::setKey chatwindowbg #EAEAEA
::skin::setKey loginbg #ffffff
::skin::setKey loginwidgetbg #ffffff
::skin::setKey loginfg #000000
::skin::setKey loginurlfg #0000ff
::skin::setKey logincheckfg #ffffff
::skin::setKey loginbuttonbg #c3c2d2
::skin::setKey loginbuttonfg black
::skin::setKey loginbuttonfghover black
::skin::setKey tabbarbg "[::skin::getKey chatwindowbg]"
::skin::setKey tabfg #000000
::skin::setKey tab_text_x 5
::skin::setKey tab_text_y 5
::skin::setKey tab_text_width 80
::skin::setKey tab_close_x 85
::skin::setKey tab_close_y 5
::skin::setKey chat_tabbar_padx 0
::skin::setKey chat_tabbar_pady 0
::skin::setKey buttonbarbg #eeeeff
::skin::setKey sendbuttonbg #c3c2d2
::skin::setKey sendbuttonfg black
::skin::setKey sendbuttonfghover black
::skin::setKey topbarbg #5050e5
::skin::setKey topbarbg_sel #d3d0ce
::skin::setKey topbartext #ffffff
::skin::setKey topbarborder #000000
::skin::setKey topbarawaybg #00AB00
::skin::setKey topbarawaybg_sel #d3d0ce
::skin::setKey topbarawaytext #000000
::skin::setKey topbarawayborder #000000
::skin::setKey topbarbusybg #CF0000
::skin::setKey topbarbusybg_sel #d3d0ce
::skin::setKey topbarbusytext #000000
::skin::setKey topbarbusyborder #000000
::skin::setKey topbarofflinebg #404040
::skin::setKey topbarofflinebg_sel #d3d0ce
::skin::setKey topbarofflinetext #ffffff
::skin::setKey topbarofflineborder #000000
::skin::setKey topbarpadx 6
::skin::setKey topbarpady 6
::skin::setKey loginbuttonx 6
::skin::setKey loginbuttony 6
::skin::setKey sendbuttonx 6
::skin::setKey sendbuttony 6
::skin::setKey chat_top_pixmap 0
::skin::setKey statusbarbg #eeeeee
::skin::setKey statusbarbg_sel #d3d0ce
::skin::setKey statusbartext #000000
::skin::setKey groupcolorextend #000080
::skin::setKey groupcolorcontract #000080
::skin::setKey chat_top_padx 0
::skin::setKey chat_top_pady 0
::skin::setKey chat_paned_padx 0
::skin::setKey chat_paned_pady 0
::skin::setKey chat_output_padx 0
::skin::setKey chat_output_pady 0
::skin::setKey chat_buttons_padx 0
::skin::setKey chat_buttons_pady 0
::skin::setKey chat_input_padx 0
::skin::setKey chat_input_pady 0
::skin::setKey chat_dp_padx 0
::skin::setKey chat_dp_pady 0
::skin::setKey chat_leftframe_padx 0
::skin::setKey chat_leftframe_pady 0
::skin::setKey chat_sendbutton_padx 0
::skin::setKey chat_sendbutton_pady 0
::skin::setKey chat_status_padx 0
::skin::setKey chat_status_pady 0
::skin::setKey chat_sash_width 2
::skin::setKey chat_sash_relief raised
::skin::setKey chat_sash_showhandle 0
::skin::setKey chat_sash_pady 0
::skin::setKey chat_status_border_color #000000
::skin::setKey chat_output_border_color #000000
::skin::setKey chat_output_back_color #ffffff
::skin::setKey chat_input_border_color #000000
::skin::setKey chat_input_back_color #ffffff
::skin::setKey chat_buttons_border_color #000000
::skin::setKey chat_dp_border_color #000000
::skin::setKey chat_top_border 0
::skin::setKey chat_output_border 0
::skin::setKey chat_buttons_border 0
::skin::setKey chat_input_border 0
::skin::setKey chat_status_border 0
::skin::setKey chat_dp_border 1
::skin::setKey chat_show_sendbuttonframe 1
::skin::setKey chat_show_statusbarframe 1
::skin::setKey chat_show_topframe 1
::skin::setKey menuforeground #000000
::skin::setKey menuactivebackground #565672
::skin::setKey menuactiveforeground #ffffff
::skin::setKey mystatus grey
::skin::setKey buddylistpad 4
::skin::setKey showdisplaycontactlist 0
::skin::setKey emailabovecolorbar 0
::skin::setKey underline_contact 0
::skin::setKey underline_group 0
::skin::setKey changecursor_contact 1
::skin::setKey changecursor_group 1
::skin::setKey bigstate_xpad 0
::skin::setKey bigstate_ypad 0
::skin::setKey mystatus_xpad 3
::skin::setKey mystatus_ypad 0
::skin::setKey mailbox_xpad 2
::skin::setKey mailbox_ypad 2
::skin::setKey contract_xpad 8
::skin::setKey contract_ypad 6
::skin::setKey expand_xpad 8
::skin::setKey expand_ypad 6
::skin::setKey x_dp_top 4
::skin::setKey y_dp_top 4
::skin::setKey balloonbackground #daeefe
::skin::setKey balloonborderwidth 1
::skin::setKey balloonborder #2e8afe
::skin::setKey balloontext #0000dd
::skin::setKey buddy_xpad 15
::skin::setKey buddy_ypad 3
::skin::setKey notifwidth 150
::skin::setKey notifheight 100
::skin::setKey notifyfg black
::skin::setKey x_notifyclose 140
::skin::setKey y_notifyclose 2
::skin::setKey x_notifydp 1
::skin::setKey y_notifydp 22
::skin::setKey x_notifytext 55
::skin::setKey y_notifytext 22
::skin::setKey width_notifytext 93
::skin::setKey notify_font sboldf
::skin::setKey notify_dp_border 0
if { [OnMac] } {
::skin::setKey balloonbackground #ffffca
::skin::setKey menubackground #ECECEC
} else {
::skin::setKey balloonbackground #ffffaa
::skin::setKey menubackground #eae7e4
}
::skin::setKey balloonfont sboldf
::skin::setKey balloonborder #000000
::skin::setKey assistanttitleheight 50
::skin::setKey assistanttitlefg #FFFFFF
::skin::setKey assistanttitlebg #565672
#Virtual events used by Button-click
#On Mac OS X, Control emulate the "right click button"
#On Mac OS X, there's a mistake between button2 and button3
if { [OnMac] } {
event add <<Button1>> <Button1-ButtonRelease>
event add <<Button2>> <Button3-ButtonRelease>
event add <<Button2-Press>> <ButtonPress-3>
event add <<Button2-Motion>> <B3-Motion>
event add <<Button3>> <Control-ButtonRelease>
event add <<Button3>> <Button2-ButtonRelease>
event add <<Button3-Press>> <ButtonPress-2>
event add <<Escape>> <Command-w> <Command-W>
event add <<Paste>> <Command-v> <Command-V>
event add <<Copy>> <Command-c> <Command-C>
event add <<Cut>> <Command-x> <Command-X>
} else {
event add <<Button1>> <Button1-ButtonRelease>
event add <<Button2>> <Button2-ButtonRelease>
event add <<Button2-Press>> <ButtonPress-2>
event add <<Button2-Motion>> <B2-Motion>
event add <<Button3>> <Button3-ButtonRelease>
event add <<Button3-Press>> <ButtonPress-3>
event add <<Button3-Motion>> <B3-Motion>
event add <<Escape>> <Escape>
event add <<Paste>> <Control-v> <Control-V>
event add <<Copy>> <Control-c> <Control-C>
event add <<Cut>> <Control-x> <Control-X>
}
#Set the default option for canvas -highlightthickness
option add *Canvas.highlightThickness 0
if { [OnLinux] } {
#Mappings for Shift-BackSpace
bind Entry <Terminate_Server> [bind Entry <BackSpace>]
bind Text <Terminate_Server> [bind Text <BackSpace>]
}
#To avoid a bug inside panedwindow, by Youness
rename ::tk::panedwindow::Cursor ::tk::panedwindow::Original_Cursor
proc ::tk::panedwindow::Cursor { args } {
catch { eval ::tk::panedwindow::Original_Cursor $args }
}
#For proc WinWrite
namespace eval ::amsn {
variable urlcount 0
set urlstarts { "http://" "https://" "ftp://" "www." }
}
#For idle checking
global idletime oldmousepos autostatuschange
set idletime 0
set oldmousepos [list]
set autostatuschange 0
}
namespace eval ::amsn {
namespace export initLook aboutWindow showHelpFile errorMsg infoMsg \
blockUnblockUser blockUser unblockUser deleteUser removeUserFromGroup \
fileTransferRecv fileTransferProgress \
errorMsg notifyAdd initLook messageFrom userJoins userLeaves \
updateTypers ackMessage nackMessage chatUser
##PUBLIC
proc initLook { family size bgcolor} {
font create menufont -family $family -size $size -weight normal
font create sboldf -family $family -size $size -weight bold
font create splainf -family $family -size $size -weight normal
font create sunderf -family $family -size $size -weight normal -underline yes
font create sboldunderf -family $family -size $size -weight bold -underline yes
font create sbolditalf -family $family -size $size -weight bold -slant italic
font create sitalf -family $family -size $size -slant italic
font create macfont -family [list {Lucida Grande}] -size 13 -weight normal
if { [::config::getKey strictfonts] } {
font create bboldf -family $family -size $size -weight bold
font create bboldunderf -family $family -size $size -weight bold -underline true
font create bplainf -family $family -size $size -weight normal
font create bigfont -family $family -size $size -weight bold
font create examplef -family $family -size $size -weight normal
} else {
font create bboldf -family $family -size [expr {$size+1}] -weight bold
font create bboldunderf -family $family -size [expr {$size+1}] -weight bold -underline true
font create bplainf -family $family -size [expr {$size+1}] -weight normal
font create bigfont -family $family -size [expr {$size+2}] -weight bold
font create examplef -family $family -size [expr {$size-2}] -weight normal
}
catch {tk_setPalette [::skin::getKey menubackground]}
option add *Menu.font menufont
option add *selectColor #DD0000
option add *Photo.format cximage widgetDefault
if { ![catch {tk windowingsystem} wsystem] && $wsystem == "x11" } {
option add *background [::skin::getKey menubackground]
option add *borderWidth 1 widgetDefault
option add *activeBorderWidth 1 widgetDefault
option add *selectBorderWidth 1 widgetDefault
option add *Listbox.background white widgetDefault
option add *Listbox.selectBorderWidth 0 widgetDefault
option add *Listbox.selectForeground white widgetDefault
option add *Listbox.selectBackground #4a6984 widgetDefault
option add *Entry.background white widgetDefault
option add *Entry.borderWidth 1 widgetDefault
option add *Entry.foreground black widgetDefault
option add *Entry.selectBorderWidth 0 widgetDefault
option add *Entry.selectForeground white widgetDefault
option add *Entry.selectBackground #4a6984 widgetDefault
option add *Entry.padX 2 widgetDefault
option add *Entry.padY 4 widgetDefault
option add *Text.background white widgetDefault
option add *Text.selectBorderWidth 0 widgetDefault
option add *Text.selectForeground white widgetDefault
option add *Text.selectBackground #4a6984 widgetDefault
option add *Text.padX 2 widgetDefault
option add *Text.padY 4 widgetDefault
option add *Menu.activeBorderWidth 0 widgetDefault
option add *Menu.highlightThickness 0 widgetDefault
option add *Menu.borderWidth 1 widgetDefault
option add *Menu.background [::skin::getKey menubackground]
option add *Menu.foreground [::skin::getKey menuforeground]
option add *Menu.activeBackground [::skin::getKey menuactivebackground]
option add *Menu.activeForeground [::skin::getKey menuactiveforeground]
option add *Menubutton.activeBackground #4a6984 widgetDefault
option add *Menubutton.activeForeground white widgetDefault
option add *Menubutton.activeBorderWidth 0 widgetDefault
option add *Menubutton.highlightThickness 0 widgetDefault
option add *Menubutton.borderWidth 0 widgetDefault
option add *Menubutton.padX 2 widgetDefault
option add *Menubutton.padY 4 widgetDefault
option add *Labelframe.borderWidth 2 widgetDefault
option add *Frame.borderWidth 2 widgetDefault
option add *Labelframe.padY 8 widgetDefault
option add *Labelframe.padX 12 widgetDefault
option add *highlightThickness 0 widgetDefault
option add *troughColor #c3c3c3 widgetDefault
option add *Scrollbar.width 10
option add *Scrollbar.borderWidth 1
option add *Scrollbar.highlightThickness 0 widgetDefault
option add *Button.activeForeground #5b76c6 userDefault
}
option add *Font splainf userDefault
#Use different width for scrollbar on Mac OS X
#http://wiki.tcl.tk/12987
if { [OnMac] } {
option add *background #ECECEC
option add *highlightbackground #ECECEC
option add *Scrollbar.width 16 userDefault
option add *Button.Font macfont userDefault
option add *Button.highlightBackground #ECECEC userDefault
} elseif { [OnWin] } {
option add *background [::skin::getKey menubackground]
option add *Scrollbar.width 14 userDefault
option add *Button.Font sboldf userDefault
} else {
option add *background [::skin::getKey menubackground]
option add *Scrollbar.width 12 userDefault
option add *Button.Font sboldf userDefault
}
#option add *Scrollbar.borderWidth 1 userDefault
set Entry {-bg #FFFFFF -foreground #000000}
set Label {-bg #FFFFFF -foreground #000000}
::themes::AddClass Amsn Entry $Entry 90
::themes::AddClass Amsn Label $Label 90
::abookGui::Init
#Register events
::Event::registerEvent loggedIn all loggedInGuiConf
::Event::registerEvent loggedOut all loggedOutGuiConf
}
#///////////////////////////////////////////////////////////////////////////////
# Draws the about window
proc aboutWindow {} {
global langenc date weburl
set filename "[file join docs README[::config::getGlobalKey language]]"
set current_enc $langenc
if {![file exists $filename]} {
status_log "File $filename NOT exists!!\n\tUsing english one instead." red
set filename README
set current_enc "iso8859-1"
if {![file exists $filename]} {
status_log "no english README either .. Houston, we have a problem, you ***'ed up your aMSN install!"
msg_box "[trans transnotexists]"
return
}
}
if { [winfo exists .about] } {
raise .about
return
}
toplevel .about
wm title .about "[trans aboutamsn]"
ShowTransient .about
wm state .about withdrawn
#Top frame (Picture and name of developers)
set developers "Didimo Grimaldo\n Alvaro J. Iradier\n Khalaf Philippe\n Alaoui Youness\n Dave Mifsud\n..."
label .about.image -image [::skin::loadPixmap msndroid]
label .about.title -text "aMSN $::version ([::abook::dateconvert $date])" -font bboldf
label .about.what -text "[trans whatisamsn]\n"
pack .about.image .about.title .about.what -side top
#names-frame
frame .about.names -class Amsn
label .about.names.t -font splainf -text "[trans broughtby]:\n$developers"
pack .about.names.t -side top
pack .about.names -side top
#Middle frame (About text)
frame .about.middle
frame .about.middle.list -class Amsn -borderwidth 0
text .about.middle.list.text -background white -width 80 -height 10 -wrap word \
-yscrollcommand ".about.middle.list.ys set" -font splainf
scrollbar .about.middle.list.ys -command ".about.middle.list.text yview"
pack .about.middle.list.ys -side right -fill y
pack .about.middle.list.text -side left -expand true -fill both
pack .about.middle.list -side top -expand true -fill both -padx 1 -pady 1
label .about.middle.url -text $weburl -font bplainf -fg blue
pack .about.middle.url -side top -pady 3
bind .about.middle.url <Enter> ".about.middle.url configure -font bboldf "
bind .about.middle.url <Leave> ".about.middle.url configure -font bplainf"
bind .about.middle.url <Enter> "+.about.middle.url configure -cursor hand2"
# bind .about.middle.url <Leave> ".about.middle.url configure -cursor left_ptr"
bind .about.middle.url <Button1-ButtonRelease> "launch_browser $weburl"
#Bottom frame (Close button)
frame .about.bottom -class Amsn
button .about.bottom.close -text "[trans close]" -command "destroy .about"
bind .about <<Escape>> "destroy .about"
button .about.bottom.credits -text "[trans credits]..." -command [list ::amsn::showHelpFileWindow CREDITS [trans credits]]
pack .about.bottom.close -side right
pack .about.bottom.credits -side left
pack .about.bottom -side bottom -fill x -pady 3 -padx 5
pack .about.middle -expand true -fill both -side top
#Insert the text in .about.middle.list.text
set id [open $filename r]
fconfigure $id -encoding $current_enc
.about.middle.list.text insert 1.0 [read $id]
close $id
.about.middle.list.text configure -state disabled
update idletasks
wm state .about normal
set x [expr {([winfo vrootwidth .about] - [winfo width .about]) / 2}]
set y [expr {([winfo vrootheight .about] - [winfo height .about]) / 2}]
wm geometry .about +${x}+${y}
moveinscreen .about 30
#Should we disable resizable? Since when we make the windows smaller (in y), we lost the "Close button"
#wm resizable .about 0 0
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# showHelpFileWindow(file, windowtitle, ?english?)
proc showHelpFileWindow {file title {english 0}} {
global langenc
set langcode [::config::getGlobalKey language]
set encoding $langenc
if {$english == 1} {
set langcode "en"
set encoding "iso8859-1"
}
set filename [file join "docs" "${file}$langcode"]
if {$langcode == "en"} {
set filename $file
}
if {![file exists $filename]} {
status_log "File $filename NOT exists!!\n\tOpening English one instead." red
set filename "${file}"
set langcode "en"
set encoding "iso8859-1"
if {![file exists $filename]} {
status_log "Couldn't open $filename!" red
msg_box "[trans transnotexists]"
return
}
}
if {$file == "CREDITS"} {
set encoding "utf-8"
}
if {$langcode == "en"} {
set w help${filename}en
} else {
set w help${filename}
}
status_log "filename: $filename"
# Used to avoid a bug for dbusviewer where the $filename points to /home/user/.amsn the dot makes
# tk think it's a window's path separator and it says that the window .help/home/user/ doesn't exit (for .amsn to be its child)
set w ".[string map {. "_" " " "__"} $w]"
if { [winfo exists $w] } {
raise $w
return
}
toplevel $w
wm title $w "$title"
ShowTransient $w
#Top frame (Help text area)
frame $w.info
frame $w.info.list -class Amsn -borderwidth 0
text $w.info.list.text -background white -width 80 -height 30 -wrap word \
-yscrollcommand "$w.info.list.ys set" -font splainf
scrollbar $w.info.list.ys -command "$w.info.list.text yview"
pack $w.info.list.ys -side right -fill y
pack $w.info.list.text -expand true -fill both -padx 1 -pady 1
pack $w.info.list -side top -expand true -fill both -padx 1 -pady 1
pack $w.info -expand true -fill both -side top
#Bottom frame (Close button)
button $w.close -text "[trans close]" -command "destroy $w"
button $w.eng -text "English version" -command [list ::amsn::showHelpFileWindow $file "$title - English version" 1]
bind $w <<Escape>> "destroy $w"
pack $w.close
if {$langcode != "en" && $english != 1} {
pack $w.eng -side right -anchor e -padx 5 -pady 3
}
pack $w.close -side right -anchor e -padx 5 -pady 3
#Insert FAQ text
set id [open $filename r]
fconfigure $id -encoding $encoding
$w.info.list.text insert 1.0 [read $id]
close $id
$w.info.list.text configure -state disabled
update idletasks
set x [expr {([winfo vrootwidth $w] - [winfo width $w]) / 2}]
set y [expr {([winfo vrootheight $w] - [winfo height $w]) / 2}]
wm geometry $w +${x}+${y}
#Should we disable resizable? Since when we make the windows smaller (in y), we lost the "Close button"
#wm resizable .about 0 0
return $w
}
#///////////////////////////////////////////////////////////////////////////////
proc messageBox { message type icon {title ""} {parent ""}} {
#If we are on MacOS X, don't put the box in the parent because there are some problems
if { [OnMac] } {
set answer [tk_messageBox -message "$message" -type $type -icon $icon]
} else {
if { $parent == ""} {
set parent [focus]
if { $parent == "" } { set parent "." }
}
set answer [tk_messageBox -message "$message" -type $type -icon $icon -title $title -parent $parent]
}
return $answer
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc customMessageBox { message type {icon ""} {title ""} {parent ""} {askRememberAnswer 0} {modal 0}} {
# This tracker is so we can TkWait. It needs to be global so that the buttons can modify it.
global customMessageBoxAnswerTracker
# This is the tracker for the checkbox.
# It needs to be an array because we may have more than one message box open (hence the unique index).
global customMessageBoxRememberTracker
set unique [clock seconds]
set w ".messagebox_$unique"
if { [winfo exists $w] } {
raise $w
return
}
set w [toplevel $w]
if {$title == ""} {
set title [trans title]
}
wm title $w $title
wm group $w .
wm resizable $w 0 0
#Create the 2 frames
frame $w.top
frame $w.buttons
if {$icon == ""} {
label $w.top.bitmap -image [::skin::loadPixmap warning]
} else {
label $w.top.bitmap -bitmap $icon
}
pack $w.top.bitmap -side left -pady 0 -padx [list 0 12 ]
label $w.top.message -text $message -wraplength 400 -justify left
pack $w.top.message -pady 0 -padx 0 -side top
if {$askRememberAnswer} {
checkbutton $w.top.remember -variable customMessageBoxRememberTracker($unique) -text [trans remembersetting] -anchor w -state normal
pack $w.top.remember -pady 5 -padx 10 -side bottom -fill x
}
switch $type {
abortretryignore {
set buttons [list [list "abort" [trans abort]] [list "retry" [trans retry]] [list "ignore" [trans ignore]]]
}
ok {
set buttons [list [list "ok" [trans ok]]]
}
okcancel {
set buttons [list [list "ok" [trans ok]] [list "cancel" [trans cancel]]]
}
retrycancel {
set buttons [list [list "retry" [trans retry]] [list "cancel" [trans cancel]]]
}
yesno {
set buttons [list [list "yes" [trans yes]] [list "no" [trans no]]]
}
yesnocancel {
set buttons [list [list "yes" [trans yes]] [list "no" [trans no]] [list "cancel" [trans cancel]]]
}
deletecancel {
set buttons [list [list "delete" [trans delete]] [list "cancel" [trans cancel]]]
}
deleteblockcancel {
set buttons [list [list "delete" [trans delete]] [list "deleteblock" [trans deleteblock]] [list "cancel" [trans cancel]]]
}
default {
set buttons [list [list "ok" [trans ok]]]
}
}
set customMessageBoxAnswerTracker($unique) ""
#Create the buttons
foreach button $buttons {
set buttonName [lindex $button 0]
set buttonLabel [lindex $button 1]
button $w.buttons.$buttonName -text $buttonLabel -command [list set customMessageBoxAnswerTracker($unique) $buttonName]
pack $w.buttons.$buttonName -pady 0 -padx 0 -side right
}
#Pack frames
pack $w.top -pady 12 -padx 12 -side top
pack $w.buttons -pady 12 -padx 12 -fill x
moveinscreen $w 30
bind $w <<Escape>> "destroy $w"
wm protocol $w WM_DELETE_WINDOW [list set customMessageBoxAnswerTracker($unique) ""]
if { $modal } {
grab set $w
}
tkwait variable customMessageBoxAnswerTracker($unique)
catch { destroy $w }
if {$askRememberAnswer} {
set answer [list $customMessageBoxAnswerTracker($unique) $customMessageBoxRememberTracker($unique)]
unset customMessageBoxAnswerTracker($unique)
unset customMessageBoxRememberTracker($unique)
} else {
set answer $customMessageBoxAnswerTracker($unique)
unset customMessageBoxAnswerTracker($unique)
}
return $answer
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# Shows the error message specified by "msg"
proc errorMsg { msg } {
::amsn::messageBox $msg ok error "[trans title] Error"
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# Shows the error message specified by "msg"
proc infoMsg { msg {icon "info"} } {
::amsn::messageBox $msg ok $icon [trans title]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc blockUnblockUser { user_login } {
if { [::MSN::userIsBlocked $user_login] } {
unblockUser $user_login
} else {
blockUser $user_login
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc blockUser {user_login} {
set answer [::amsn::messageBox "[trans confirmbl] ($user_login)" yesno question [trans block]]
if { $answer == "yes"} {
set name [::abook::getNick ${user_login}]
::MSN::blockUser ${user_login} [urlencode $name]
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc unblockUser {user_login} {
set name [::abook::getNick ${user_login}]
::MSN::unblockUser ${user_login} [urlencode $name]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc removeUserFromGroup {user_login grId} {
::MSN::removeUserFromGroup $user_login $grId
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
#Delete user window, user can choose to delete user, cancel the action or block and delete the user
proc deleteUser { user_login } {
if {[lsearch [::abook::getLists $user_login] BL] == -1} {
# User is not blocked.
set answer [customMessageBox [trans confirmdu] deleteblockcancel "" "[trans delete] - $user_login" "." 0]
} else {
# User is already blocked.
set answer [customMessageBox [trans confirmdu] deletecancel "" "[trans delete] - $user_login" "." 0]
}
if {$answer == "deleteblock"} {
# Delete the user and block.
::amsn::deleteUserAction $user_login 1
} elseif {$answer == "delete"} {
# Only delete the user.
::amsn::deleteUserAction $user_login 0
}
}
#///////////////////////////////////////////////////////////////////////////////
# deleteUserAction {user_login answer grId block}
# Action to do when someone click delete a user
proc deleteUserAction {user_login {block 0}} {
#If the user wants to delete AND block a user
if { $block == 1 } {
set name [::abook::getNick ${user_login}]
::MSN::blockUser ${user_login} [urlencode $name]
}
::MSN::deleteUser ${user_login}
::abook::setContactData $user_login alarms ""
return
}
proc InkSend { win_name filename {friendlyname ""}} {
set chatid [::ChatWindow::Name $win_name]
if { $chatid == 0 } {
status_log "VERY BAD ERROR in ::amsn::InkSend!!!\n" red
return 0
}
#Blank ink
if {$filename == ""} { return 0 }
if { $friendlyname != "" } {
set nick $friendlyname
set p4c 1
} elseif { [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] != ""} {
set friendlyname [::abook::parseCustomNick [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] [::abook::getPersonal MFN] [::abook::getPersonal login] "" [::abook::getpsmmedia] ]
set nick $friendlyname
set p4c 1
} elseif { [::config::getKey p4c_name] != ""} {
set nick [::config::getKey p4c_name]
set p4c 1
} else {
set nick [::abook::getPersonal MFN]
set p4c 0
}
#Postevent when we send a message
set evPar(nick) nick
set evPar(ink) filename
set evPar(chatid) chatid
set evPar(win_name) win_name
::plugins::PostEvent chat_ink_send evPar
#Draw our own message
#Does this image ever gets destroyed ? When destroying the chatwindow it's embeddeed in it should I guess ? This is not the leak I'm searching for though as I'm not sending inks...
set img [image create photo [TmpImgName] -file $filename]
SendMessageFIFO [list ::amsn::ShowInk $chatid [::abook::getPersonal login] $nick $img ink $p4c] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
::MSN::ChatQueue $chatid [list ::MSN::SendInk $chatid $filename]
::plugins::PostEvent chat_ink_sent evPar
}
proc FileTransferSend { win_name {filename ""} } {
if {![winfo exists $win_name] } {
set win_name [::amsn::chatUser $win_name]
}
global starting_dir
# set filename [ $w.top.fields.file get ]
if { $filename == "" } {
set filename [chooseFileDialog "" [trans sendfile] $win_name]
status_log $filename
}
if { $filename == "" } { return }
#Remember last directory
set starting_dir [file dirname $filename]
if {![file readable $filename]} {
msg_box "[trans invalidfile [trans filename] $filename]"
return
}
if { [::config::getKey autoftip] } {
set ipaddr [::config::getKey myip]
} else {
set ipaddr [::config::getKey manualip]
}
if { [catch {set filesize [file size $filename]} res]} {
::amsn::errorMsg "[trans filedoesnotexist]"
#::amsn::fileTransferProgress c $cookie -1 -1
return 1
}
set chatid [::ChatWindow::Name $win_name]
status_log "chatid:=$chatid" red
set users [::MSN::usersInChat $chatid]
foreach chatid $users {
chatUser $chatid
#Calculate a random cookie
set cookie [expr {([clock clicks]) % (65536 * 8)}]
set txt "[trans ftsendinvitation [::abook::getDisplayNick $chatid] $filename [::amsn::sizeconvert $filesize]]"
status_log "Random generated cookie: $cookie\n"
SendMessageFIFO [list ::amsn::WinWriteFTSend $chatid $txt $cookie] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
::MSN::ChatQueue $chatid [list ::MSNFT::sendFTInvitation $chatid $filename $filesize $ipaddr $cookie]
#::MSNFT::sendFTInvitation $chatid $filename $filesize $ipaddr $cookie
::log::ftlog $chatid $txt
# Postevent when we send a file transfer invitation
set evPar(chatid) $chatid
set evPar(filename) $filename
::plugins::PostEvent sent_ft_invite evPar
}
return 0
}
proc WinWriteFTSend { chatid txt cookie } {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid "$txt " green
WinWriteClickable $chatid "[trans cancel]" \
"::amsn::CancelFTInvitation $chatid $cookie" ftno$cookie
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
}
proc DisableCancelText { cookie chatid } {
set win_name [::ChatWindow::For $chatid]
if { [winfo exists $win_name] } {
[::ChatWindow::GetOutText ${win_name}] tag configure ftno$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftno$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftno$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftno$cookie <Button1-ButtonRelease> ""
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm
}
}
proc CancelFTInvitation { chatid cookie } {
#::MSNFT::acceptFT $chatid $cookie
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
::MSNFT::cancelFTInvitation $chatid $cookie
DisableCancelText $cookie $chatid
set txt [trans invitationcancelled]
SendMessageFIFO [list ::amsn::WinWriteCancelFT $chatid $txt] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc WinWriteCancelFT {chatid txt} {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid ftreject 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
}
proc acceptedFT { chatid who filename } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set txt [trans ftacceptedby [::abook::getDisplayNick $chatid] $filename]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc rejectedFT { chatid who filename } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set txt [trans ftrejectedby [::abook::getDisplayNick $chatid] $filename]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid " \n" green
WinWriteIcon $chatid ftreject 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
#////////////////////////////////////////////////////////////////////////////////
# GotFileTransferRequest ( chatid dest branchuid cseq uid sid filename filesize)
# This procedure is called when we receive an MSN6 File Transfer Request
proc GotFileTransferRequest { chatid dest branchuid cseq uid sid filename filesize} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set fromname [::abook::getDisplayNick $dest]
set txt [trans ftgotinvitation $fromname '$filename' [::amsn::sizeconvert $filesize] [::config::getKey receiveddir]]
set win_name [::ChatWindow::MakeFor $chatid $txt $dest]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid " \n" green
if { [::skin::loadPixmap "FT_preview_${sid}"] != "" } {
WinWriteIcon $chatid FT_preview_${sid} 5 5
WinWrite $chatid "\n" green
}
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid $txt green
WinWrite $chatid " - (" green
WinWriteClickable $chatid "[trans accept]" [list ::amsn::AcceptFT $chatid -1 [list $dest $branchuid $cseq $uid $sid $filename]] ftyes$sid
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans saveas]" [list ::amsn::SaveAsFT $chatid -1 [list $dest $branchuid $cseq $uid $sid $filename]] ftsaveas$sid
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans reject]" [list ::amsn::RejectFT $chatid -1 [list $sid $branchuid $uid]] ftno$sid
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
::log::ftlog $dest $txt
if { ![file writable [::config::getKey receiveddir]]} {
WinWrite $chatid "\n[trans readonlywarn [::config::getKey receiveddir]]\n" red
WinWriteIcon $chatid greyline 3
}
if { [::config::getKey ftautoaccept] == 1 } {
WinWrite $chatid "\n[trans autoaccepted]" green
::amsn::AcceptFT $chatid -1 [list $dest $branchuid $cseq $uid $sid $filename]
}
}
#Message shown when receiving a file
proc fileTransferRecv {filename filesize cookie chatid fromlogin} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set fromname [::abook::getDisplayNick $fromlogin]
set txt [trans ftgotinvitation $fromname '$filename' [::amsn::sizeconvert $filesize] [::config::getKey receiveddir]]
set win_name [::ChatWindow::MakeFor $chatid $txt $fromlogin]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid $txt green
WinWrite $chatid " - (" green
WinWriteClickable $chatid "[trans accept]" \
"::amsn::AcceptFT $chatid $cookie" ftyes$cookie
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans saveas]" \
"::amsn::SaveAsFT $chatid $cookie" ftsaveas$cookie
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans reject]" \
"::amsn::RejectFT $chatid $cookie" ftno$cookie
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
::log::ftlog $fromlogin $txt
if { ![file writable [::config::getKey receiveddir]]} {
WinWrite $chatid "\n[trans readonlywarn [::config::getKey receiveddir]]\n" red
WinWriteIcon $chatid greyline 3
}
if { [::config::getKey ftautoaccept] == 1 } {
WinWrite $chatid "\n[trans autoaccepted]" green
::amsn::AcceptFT $chatid $cookie
}
}
proc AcceptFTOpenSB { chatid cookie {varlist ""} } {
#::amsn::RecvWin $cookie
if { $cookie != -1 } {
::MSNFT::acceptFT $chatid $cookie
} else {
::MSN6FT::AcceptFT $chatid [lindex $varlist 0] [lindex $varlist 1] [lindex $varlist 2] [lindex $varlist 3] [lindex $varlist 4] [lindex $varlist 5]
set cookie [lindex $varlist 4]
}
}
proc AcceptFT { chatid cookie {varlist ""} } {
foreach var $varlist {
status_log "Var: $var\n" red
}
set chatid [::MSN::chatTo $chatid]
::MSN::ChatQueue $chatid [list ::amsn::AcceptFTOpenSB $chatid $cookie $varlist]
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
if { $cookie == -1 } {
set cookie [lindex $varlist 4]
}
[::ChatWindow::GetOutText ${win_name}] tag configure ftyes$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Button1-ButtonRelease> ""
[::ChatWindow::GetOutText ${win_name}] tag configure ftsaveas$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Button1-ButtonRelease> ""
DisableCancelText $cookie $chatid
set txt [trans ftaccepted]
SendMessageFIFO [list ::amsn::WinWriteAcceptFT $chatid $txt] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc WinWriteAcceptFT {chatid txt} {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
}
proc SaveAsFT {chatid cookie {varlist ""} } {
global HOME
if {$cookie != -1} {
set initialfile [::MSNFT::getFilename $cookie]
} {
set initialfile [lindex $varlist 5]
}
if {[catch {set filename [tk_getSaveFile -initialfile $initialfile -initialdir [::config::getKey receiveddir]]} res]} {
status_log "Error in SaveAsFT: $res \n"
set filename [tk_getSaveFile -initialfile $initialfile -initialdir [set HOME]]
}
if {$filename != ""} {
AcceptFT $chatid $cookie [list [lindex $varlist 0] [lindex $varlist 1] [lindex $varlist 2] [lindex $varlist 3] [lindex $varlist 4] "$filename"]
} {return}
}
proc RejectFT {chatid cookie {varlist ""} } {
if { $cookie != -1 && $cookie != -2 } {
::MSNFT::rejectFT $chatid $cookie
} elseif { $cookie == - 1 } {
::MSN6FT::RejectFT $chatid [lindex $varlist 0] [lindex $varlist 1] [lindex $varlist 2]
set cookie [lindex $varlist 0]
} elseif { $cookie == -2 } {
set cookie [lindex $varlist 0]
set txt [trans filetransfercancelled]
}
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
[::ChatWindow::GetOutText ${win_name}] tag configure ftyes$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Button1-ButtonRelease> ""
[::ChatWindow::GetOutText ${win_name}] tag configure ftsaveas$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Button1-ButtonRelease> ""
DisableCancelText $cookie $chatid
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm
if { [info exists txt] == 0 } {
set txt [trans ftrejected]
}
SendMessageFIFO [list ::amsn::WinWriteRejectFT $chatid $txt] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc WinWriteRejectFT {chatid txt} {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid ftreject 3 2
WinWrite $chatid "$txt\n" green
WinWriteIcon $chatid greyline 3
}
# TODO it would be best to make it "[$extratitle] - $file - [trans filetranser]"
proc setFTWinTitle { w cookie filename {extratitle ""} } {
variable ftwin_filename
if { ![info exists ftwin_filename($w,$cookie)] } {
set file ""
if { $filename != ""} {
set file [getfilename $filename]
set ftwin_filename($w,$cookie) $file
}
} else {
set file [set ftwin_filename($w,$cookie)]
}
set title "$extratitle"
if {$title != "" } {
append title " - "
}
append title "$file - [trans filetransfer]"
if { [string compare [wm title $w] "$title" ] } {
wm title $w "$title"
}
# if { [::MSNFT::getTransferType $cookie] == "received" } {
# wm title $w "$filename - [trans receivefile]"
# } else {
# wm title $w "$filename - [trans sendfile]"
# }
}
#PRIVATE: Opens Receiving Window
proc FTWin {cookie filename user {chatid 0}} {
status_log "Creating receive progress window\n"
if { [string range $filename [expr {[string length $filename] - 11}] [string length $filename]] == ".incomplete" } {
set filename [filenoext $filename]
}
# Set appropriate Cancel command
if { [::MSNP2P::SessionList get $cookie] == 0 } {
set cancelcmd "::MSNFT::cancelFT $cookie"
} else {
set cancelcmd "::MSN6FT::CancelFT $chatid $cookie"
}
set w .ft$cookie
set lastfocus [focus]
toplevel $w
wm group $w .
#wm geometry $w 360x170
#frame $w.f -class amsnChatFrame -background [::skin::getKey chatwindowbg] -borderwidth 0 -relief flat
#set w $ww.f
label $w.user -text "[trans user]: $user" -font splainf
pack $w.user -side top -anchor w
label $w.file -text "[trans filename]: $filename" -font splainf
pack $w.file -side top -anchor w
pack [::dkfprogress::Progress $w.prbar] -fill x -expand 0 -padx 5 -pady 5 -side top
label $w.progress -text "" -font splainf
label $w.time -text "" -font splainf
pack $w.progress $w.time -side top
checkbutton $w.ftautoclose -text "[trans ftautoclose]" -onvalue 1 -offvalue 0 -variable [::config::getVar ftautoclose]
pack $w.ftautoclose -side top
#Specify the path to the file
set filepath [file join [::config::getKey receiveddir] $filename]
set filedir [file dirname $filepath]
#Open directory and Open picture button
button $w.close -text "[trans cancel]" -command $cancelcmd
button $w.open -text "[trans opendir]" -state normal -command [list launch_filemanager $filedir]
button $w.openfile -text "[trans openfile]" -state disable -command [list open_file $filepath]
pack $w.close $w.open $w.openfile -side right -pady 5 -padx 10
setFTWinTitle $w $cookie $filename
bind $w <<Escape>> $cancelcmd
wm protocol $w WM_DELETE_WINDOW $cancelcmd
moveinscreen $w 30
::dkfprogress::SetProgress $w.prbar 0
update idletasks
catch {focus $lastfocus}
}
#Updates filetransfer progress window/Bar
#fileTransferProgress mode cookie filename bytes filesize
# mode: a=Accepting invitation
# c=Connecting
# w=Waiting for connection
# e=Connect error
# i=Identifying/negotiating
# l=Connection lost
# ca=Cancel
# s=Sending
# r=Receiving
# fr=finish receiving
# fs=finish sending
# cookie: ID for the filetransfer
# bytes: bytes sent/received ( > filesize if finished / -1 if cancelling )
# filesize: total bytes in the file
# chatid: used for through server transfers
#####
proc FTProgress {mode cookie filename {bytes 0} {filesize 1000} {chatid 0}} {
variable firsttimes ;# Array. Times in ms when the FT started.
variable ratetimer
if { [info exists ratetimer($cookie)] } {
after cancel $ratetimer($cookie)
}
set w .ft$cookie
if { ([winfo exists $w] == 0) && ($mode != "ca")} {
#set filename2 [::MSNFT::getFilename $cookie]
if { $filename == "" } {
FTWin $cookie [::MSNFT::getFilename $cookie] [::MSNFT::getUsername $cookie] $chatid
} else {
FTWin $cookie $filename $bytes $chatid
}
}
if {[winfo exists $w] == 0} {
return -1
}
switch $mode {
a {
$w.progress configure -text "[trans ftaccepting]..."
setFTWinTitle $w $cookie $filename
::dkfprogress::SetProgress $w.prbar 0 1000
}
c {
$w.progress configure -text "[trans ftconnecting $bytes $filesize]..."
setFTWinTitle $w $cookie $filename
::dkfprogress::SetProgress $w.prbar 0 1000
}
w {
$w.progress configure -text "[trans listeningon $bytes]..."
setFTWinTitle $w $cookie $filename
::dkfprogress::SetProgress $w.prbar 0 1000
}
e {
$w.progress configure -text "[trans ftconnecterror]"
$w.close configure -text "[trans close]" -command "destroy $w"
wm protocol $w WM_DELETE_WINDOW "destroy $w"
setFTWinTitle $w $cookie $filename "[trans error]"
}
i {
# This means it's connected and it tries to authenticate the user...
#$w.progress configure -text "[trans ftconnecting]"
setFTWinTitle $w $cookie $filename
}
l {
$w.progress configure -text "[trans ftconnectionlost]"
$w.close configure -text "[trans close]" -command "destroy $w"
wm protocol $w WM_DELETE_WINDOW "destroy $w"
bind $w <<Escape>> "destroy $w"
setFTWinTitle $w $cookie $filename "[trans error]"
}
r -
s {
#Calculate how many seconds has transmission lasted
if {![info exists firsttimes] || ![info exists firsttimes($cookie)]} {
set firsttimes($cookie) [clock seconds]
set difftime 0
} else {
set difftime [expr {[clock seconds] - $firsttimes($cookie)}]
}
if { $difftime == 0 || $bytes == 0} {
set rate "???"
set timeleft "-"
} else {
#Calculate rate and time
set rate [format "%.1f" [expr {(1.0*$bytes / $difftime) / 1024.0 } ]]
set secleft [expr {int(((1.0*($filesize - $bytes)) / $bytes) * $difftime)} ]
set t1 [expr {$secleft % 60 }] ;#Seconds
set secleft [expr {int($secleft / 60)}]
set t2 [expr {$secleft % 60 }] ;#Minutes
set secleft [expr {int($secleft / 60)}]
set t3 $secleft ;#Hours
set timeleft [format "%02i:%02i:%02i" $t3 $t2 $t1]
}
if {$mode == "r"} {
$w.progress configure -text \
"[trans receivedbytes [::amsn::sizeconvert $bytes] [::amsn::sizeconvert $filesize]] ($rate KB/s)"
} elseif {$mode == "s"} {
$w.progress configure -text \
"[trans sentbytes [::amsn::sizeconvert $bytes] [::amsn::sizeconvert $filesize]] ($rate KB/s)"
}
$w.time configure -text "[trans timeremaining] : $timeleft"
set percent [expr {int(double($bytes)/ (double($filesize)/100.0))}]
set ratetimer($cookie) [after 1000 [list ::amsn::FTProgress $mode $cookie $filename $bytes $filesize $chatid]]
setFTWinTitle $w $cookie $filename "${percent}%"
if { $filesize != 0 } {
::dkfprogress::SetProgress $w.prbar $bytes $filesize
}
}
ca {
$w.progress configure -text "[trans filetransfercancelled]"
$w.close configure -text "[trans close]" -command "destroy $w"
wm protocol $w WM_DELETE_WINDOW "destroy $w"
bind $w <<Escape>> "destroy $w"
setFTWinTitle $w $cookie $filename "[trans cancelled]"
}
fs -
fr {
::dkfprogress::SetProgress $w.prbar 100
$w.progress configure -text "[trans filetransfercomplete]"
$w.close configure -text "[trans close]" -command "destroy $w"
$w.openfile configure -state normal
wm protocol $w WM_DELETE_WINDOW "destroy $w"
bind $w <<Escape>> "destroy $w"
setFTWinTitle $w $cookie $filename "[trans done]"
::dkfprogress::SetProgress $w.prbar 1000 1000
}
}
switch $mode {
e -
l -
ca -
fs -
fr {
# Whenever a file transfer is terminated in a way or in another,
# remove the counters for this cookie.
if {[info exists firsttimes($cookie)]} { unset firsttimes($cookie) }
if {[info exists ratetimer($cookie)]} { unset ratetimer($cookie) }
variable ftwin_filename
if {[info exists ftwin_filename($w,$cookie)]} { unset ftwin_filename($w,$cookie) }
}
}
# Close the window if the filetransfer is finished
if {($mode == "fr" || $mode == "fs") && [::config::getKey ftautoclose]} {
destroy $w
}
}
#Converts filesize in KBytes or MBytes
proc sizeconvert {filesize} {
#Converts in KBytes
set filesizeK [expr {int($filesize/1024)}]
#Converts in MBytes
set filesizeM [expr {int($filesize/1048576)}]
#If the sizefile is bigger than 1Mo
if {$filesizeM != 0} {
set filesizeM2 [expr {int((($filesize/1048576.) - $filesizeM)*100)}]
if {$filesizeM2 < 10} {
set filesizeM2 "0$filesizeM2"
}
set filesizeM "$filesizeM,$filesizeM2"
return "${filesizeM}M"
#Elseif the filesize is bigger than 1Ko
} elseif {$filesizeK != 0} {
return "${filesizeK}K"
} else {
return "$filesize"
}
}
#///////////////////////////////////////////////////////////////////////////////
# PUBLIC messageFrom(chatid,user,msg,type,[fontformat])
# Called by the protocol layer when a message 'msg' arrives from the chat
# 'chatid'.'user' is the login of the message sender, and 'user' can be "msg" to
# send special messages not prefixed by "XXX says:". 'type' can be a style tag as
# defined in the ::ChatWindow::Open proc, or just "user". If the type is "user",
# the 'fontformat' parameter will be used as font format.
# The procedure will open a window if it does not exists, add a notifyWindow and
# play a sound if it's necessary
proc messageFrom { chatid user nick message type {p4c 0} } {
global remote_auth
set fonttype [$message getHeader X-MMS-IM-Format]
set begin [expr {[string first "FN=" $fonttype]+3}]
set end [expr {[string first ";" $fonttype $begin]-1}]
set fontfamily "[urldecode [string range $fonttype $begin $end]]"
set begin [expr {[string first "EF=" $fonttype]+3}]
set end [expr {[string first ";" $fonttype $begin]-1}]
set fontstyle "[urldecode [string range $fonttype $begin $end]]"
set begin [expr {[string first "CO=" $fonttype]+3}]
set end [expr {[string first ";" $fonttype $begin]-1}]
set fontcolor "000000[urldecode [string range $fonttype $begin $end]]"
set fontcolor "[string range $fontcolor end-1 end][string range $fontcolor end-3 end-2][string range $fontcolor end-5 end-4]"
set style [list]
if {[string first "B" $fontstyle] >= 0} {
lappend style "bold"
}
if {[string first "I" $fontstyle] >= 0} {
lappend style "italic"
}
if {[string first "U" $fontstyle] >= 0} {
lappend style "underline"
}
if {[string first "S" $fontstyle] >= 0} {
lappend style "overstrike"
}
if { [::config::getKey disableuserfonts] } {
# If user wants incoming and outgoing messages to have the same font\
set fontfamily [lindex [::config::getKey mychatfont] 0]
set style [lindex [::config::getKey mychatfont] 1]
#set fontcolor [lindex [::config::getKey mychatfont] 2]
} elseif { [::config::getKey theirchatfont] != "" && $user != [::config::getKey login] } {
# If user wants to specify a font for incoming messages (to override that user's font)
foreach { fontfamily style fontcolor } [::config::getKey theirchatfont] {}
#set fontfamily [lindex 0]
#set style [lindex [::config::getKey theirchatfont] 1]
#set fontcolor [lindex [::config::getKey theirchatfont 2]
}
#if customfnick exists replace the nick with customfnick
set customfnick [::abook::getVolatileData $user parsed_customfnick]
if { $customfnick != "" } {
set nick [::abook::getNick $user 1]
set customnick [::abook::getVolatileData $user parsed_customnick]
set psm [::abook::getpsmmedia $user 1]
set nick [::abook::removeStyles [::abook::parseCustomNickStyled $customfnick $nick $user $customnick $psm]]
}
set msg [$message getBody]
set maxw [expr {[::skin::getKey notifwidth]-20}]
incr maxw [expr {0-[font measure splainf "[trans says [list]]:"]}]
set nickt [trunc $nick $maxw splainf]
#if { ([::config::getKey notifymsg] == 1) && ([string first ${win_name} [focus]] != 0)} {
# notifyAdd "[trans says $nickt]:\n$msg" "::amsn::chatUser $chatid"
#}
set tmsg "[trans says $nickt]:\n$msg"
set win_name [::ChatWindow::MakeFor $chatid $tmsg $user]
if { $remote_auth == 1 } {
if { "$user" != "$chatid" } {
write_remote "To $chatid : $msg" msgsent
} else {
write_remote "From $chatid : $msg" msgrcv
}
}
PutMessage $chatid $user $nick $msg $type [list $fontfamily $style $fontcolor] $p4c
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# PUBLIC ShowInk(chatid,user,image,type,p4c)
# Called by the protocol layer when an ink 'image' arrives from the chat
# 'chatid'.'user' is the login of the message sender, and 'user' can be "msg" to
# send special messages not prefixed by "XXX says:". 'type' can be a style tag as
# defined in the ::ChatWindow::Open proc, or just "user". If the type is "user",
# the 'fontformat' parameter will be used as font format.
# The procedure will open a window if it does not exists, add a notifyWindow and
# play a sound if it's necessary
proc ShowInk { chatid user nick image type {p4c 0} } {
global remote_auth
#if customfnick exists replace the nick with customfnick
set customfnick [::abook::getVolatileData $user parsed_customfnick]
if { $customfnick != "" } {
set nick [::abook::getNick $user 1]
set customnick [::abook::getVolatileData $user parsed_customnick]
set psm [::abook::getpsmmedia $user 1]
set nick [::abook::removeStyles [::abook::parseCustomNickStyled $customfnick $nick $user $customnick $psm]]
}
set maxw [expr {[::skin::getKey notifwidth]-20}]
incr maxw [expr {0-[font measure splainf "[trans says [list]]:"]}]
set nickt [trunc $nick $maxw splainf]
set tmsg "[trans gotink $user]"
set win_name [::ChatWindow::MakeFor $chatid $tmsg $user]
PutMessageWrapped $chatid $user $nickt "" $type "" $p4c
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]
[::ChatWindow::GetOutText ${win_name}] image create end -image $image
if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# enterCustomStyle ()
# Dialog window to edit the custom chat style
proc enterCustomStyle {} {
set w .change_custom_style
if {[winfo exists $w]} {
raise $w
return 0
}
toplevel $w
wm group $w .
wm title $w "[trans customstyle]"
frame $w.fn
label $w.fn.label -font sboldf -text "[trans customstyle]:"
entry $w.fn.ent -width 40 -bg #FFFFFF -bd 1 -font splainf
menubutton $w.fn.help -font sboldf -text "<-" -menu $w.fn.help.menu
menu $w.fn.help.menu -tearoff 0
$w.fn.help.menu add command -label [trans nick] -command "$w.fn.ent insert insert \\\$nick"
$w.fn.help.menu add command -label [trans timestamp] -command "$w.fn.ent insert insert \\\$tstamp"
$w.fn.help.menu add command -label [trans newline] -command "$w.fn.ent insert insert \\\$newline"
$w.fn.help.menu add separator
$w.fn.help.menu add command -label [trans delete] -command "$w.fn.ent delete 0 end"
$w.fn.ent insert end [::config::getKey customchatstyle]
frame $w.fb
button $w.fb.ok -text [trans ok] -command [list ::amsn::enterCustomStyleOk $w]
button $w.fb.cancel -text [trans cancel] -command "destroy $w"
pack $w.fn.label $w.fn.ent $w.fn.help -side left -fill x -expand true
pack $w.fb.ok $w.fb.cancel -side right -padx 5
pack $w.fn $w.fb -side top -fill x -expand true -padx 5
bind $w.fn.ent <Return> [list ::amsn::enterCustomStyleOk $w]
catch {
raise $w
focus -force $w.fn.ent
}
moveinscreen $w 30
}
proc enterCustomStyleOk {w} {
::config::setKey customchatstyle [$w.fn.ent get]
destroy $w
}
#///////////////////////////////////////////////////////////////////////////////
# userJoins (chatid, user_name)
# called from the protocol layer when a user JOINS a chat
# It should be called after a JOI in the switchboard.
# If a window exists, it will show "user joins conversation" in the status bar
# - 'chatid' is the chat name
# - 'usr_name' is the user that joins email
proc userJoins { chatid usr_name {create_win 1} } {
set win_name [::ChatWindow::For $chatid]
if { $create_win && $win_name == 0 && [::config::getKey newchatwinstate]!=2 } {
set win_name [::ChatWindow::MakeFor $chatid "" $usr_name]
# PostEvent 'new_conversation' to notify plugins that the window was created
set evPar(chatid) $chatid
set evPar(usr_name) $usr_name
::plugins::PostEvent new_conversation evPar
}
if { $win_name != 0 } {
set statusmsg "[timestamp] [trans joins [::abook::getDisplayNick $usr_name]]\n"
::ChatWindow::Status [ ::ChatWindow::For $chatid ] $statusmsg minijoins
::ChatWindow::TopUpdate $chatid
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win_name]] } {
::amsn::ShowOrHidePicture
::amsn::ShowOrHideTopPicture
::amsn::UpdatePictures $win_name
} else {
if { [::config::getKey showdisplaypic] && $usr_name != ""} {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $usr_name] [trans showuserpic $usr_name]
} else {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $usr_name] [trans showuserpic $usr_name] nopack
}
}
if { [::config::getKey leavejoinsinchat] == 1 } {
SendMessageFIFO [list ::amsn::WinWriteJoin $chatid $usr_name] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
}
if { [::config::getKey keep_logs] } {
::log::JoinsConf $chatid $usr_name
}
#Postevent when user joins a chat
set evPar(usr_name) usr_name
set evPar(chatid) chatid
set evPar(win_name) win_name
::plugins::PostEvent user_joins_chat evPar
}
proc WinWriteJoin {chatid usr_name} {
::amsn::WinWrite $chatid "\n" green "" 0
::amsn::WinWriteIcon $chatid minijoins 5 0
::amsn::WinWrite $chatid "[timestamp] [trans joins [::abook::getDisplayNick $usr_name]]" green "" 0
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# userLeaves (chatid, user_name)
# called from the protocol layer when a user LEAVES a chat.
# It will show the status message. No need to show it if the window is already
# closed, right?
# - 'chatid' is the chat name
# - 'usr_name' is the user email to show in the status message
proc userLeaves { chatid usr_name closed } {
global automsgsent
set win_name [::ChatWindow::For $chatid]
if { $win_name == 0} {
return 0
}
set username [::abook::getDisplayNick $usr_name]
if { $closed } {
set statusmsg "[timestamp] [trans leaves $username]\n"
set icon minileaves
if { [::config::getKey leavejoinsinchat] == 1 } {
SendMessageFIFO [list ::amsn::WinWriteLeave $chatid $username] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
} else {
set statusmsg "[timestamp] [trans closed $username]\n"
set icon minileaves
}
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win_name]] } {
::amsn::UpdatePictures $win_name
} else {
#Check if the image that is currently showing is
#from the user that left. Then, change it
set current_image ""
#Catch it, because the window might be closed
catch {set current_image [[::ChatWindow::GetInDisplayPictureFrame $win_name].image cget -image]}
if { [string compare $current_image [::skin::getDisplayPicture $usr_name]]==0} {
set users_in_chat [::MSN::usersInChat $chatid]
set new_user [lindex $users_in_chat 0]
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $new_user] [trans showuserpic $new_user] nopack
}
}
::ChatWindow::Status $win_name $statusmsg $icon
::ChatWindow::TopUpdate $chatid
if { [::config::getKey keep_logs] } {
::log::LeavesConf $chatid $usr_name
}
# Unset automsg if he leaves so that it sends again on next msg
if { [info exists automsgsent($usr_name)] } {
unset automsgsent($usr_name)
}
#Postevent when user leaves a chat
set evPar(usr_name) usr_name
set evPar(chatid) chatid
set evPar(win_name) win_name
::plugins::PostEvent user_leaves_chat evPar
}
proc WinWriteLeave {chatid username} {
::amsn::WinWrite $chatid "\n" green "" 0
::amsn::WinWriteIcon $chatid minileaves 5 0
::amsn::WinWrite $chatid "[timestamp] [trans leaves $username]" green "" 0
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# updateTypers (chatid)
# Called from the protocol.
# Asks the protocol layer to get a list of typing users in the chat, and shows
# a message in the status bar.
# - 'chatid' is the name of the chat
proc updateTypers { chatid } {
if {[::ChatWindow::For $chatid] == 0} {
return 0
}
set typers_list [::MSN::typersInChat $chatid]
set typingusers ""
foreach login $typers_list {
set user_name [::abook::getDisplayNick $login]
set typingusers "${typingusers}${user_name}, "
}
set typingusers [string replace $typingusers end-1 end ""]
set statusmsg ""
set icon ""
if {[llength $typers_list] == 0} {
set lasttime [::MSN::lastMessageTime $chatid]
if { $lasttime != 0 } {
set statusmsg "[trans lastmsgtime $lasttime]"
}
} elseif {[llength $typers_list] == 1} {
set statusmsg " [trans istyping $typingusers]."
set icon typingimg
} else {
set statusmsg " [trans aretyping $typingusers]."
set icon typingimg
}
::ChatWindow::Status [::ChatWindow::For $chatid] $statusmsg $icon
}
#///////////////////////////////////////////////////////////////////////////////
if { $initialize_amsn == 1 } {
variable clipboard ""
}
proc ToggleShowPicture { } {
if { [::config::getKey showdisplaypic 0] == 1 } {
::config::setKey showdisplaypic 0
} else {
::config::setKey showdisplaypic 1
}
::amsn::ShowOrHidePicture
}
proc ShowTopPicMenu { win user x y } {
catch {menu $win.picmenu -tearoff 0}
$win.picmenu delete 0 end
#Make the picture menu appear on the conversation window instead of having it in the bottom of screen (and sometime lost it if the conversation window is in the bottom of the window)
if { [OnMac] } {
#Cursor at the top right hand corner (NE) of the popup.
incr x -123
incr y +2
}
set chatid [::ChatWindow::Name $win]
set pic [::skin::getDisplayPicture $user]
if { $pic != "displaypicture_std_none" && $user != ""} {
$win.picmenu add command -label "[trans changesize]" -command [list ::amsn::ShowTopPicMenu $win $user $x $y]
#4 possible size (someone can add something to let the user choose his size)
$win.picmenu add command -label " -> [trans small]" -command "::skin::ConvertDPSize $user 64 64; ::amsn::UpdateAllPictures"
$win.picmenu add command -label " -> [trans default2]" -command "::skin::ConvertDPSize $user 96 96; ::amsn::UpdateAllPictures"
$win.picmenu add command -label " -> [trans large]" -command "::skin::ConvertDPSize $user 128 128; ::amsn::UpdateAllPictures"
$win.picmenu add command -label " -> [trans huge]" -command "::skin::ConvertDPSize $user 192 192; ::amsn::UpdateAllPictures"
#Get back to original picture
$win.picmenu add command -label " -> [trans original]" -command "::MSNP2P::loadUserPic $chatid $user 1"
tk_popup $win.picmenu $x $y
}
}
proc ShowPicMenu { win x y } {
status_log "Show menu in window $win, position $x $y\n" blue
catch {menu $win.picmenu -tearoff 0}
$win.picmenu delete 0 end
#Make the picture menu appear on the conversation window instead of having it in the bottom of screen (and sometime lost it if the conversation window is in the bottom of the window)
if { [OnMac] } {
#Cursor in the bottom right hand corner (SE) of the popup.
incr x -212
incr y -25
}
#Load Change Display Picture window
$win.picmenu add command -label "[trans changedisplaypic]..." -command pictureBrowser
tk_popup $win.picmenu $x $y
}
proc ShowOldPicMenu { win x y } {
status_log "Show menu in window $win, position $x $y\n" blue
catch {menu $win.picmenu -tearoff 0}
$win.picmenu delete 0 end
#Make the picture menu appear on the conversation window instead of having it in the bottom of screen (and sometime lost it if the conversation window is in the bottom of the window)
if { [OnMac] } {
incr x -50
incr y -115
}
set chatid [::ChatWindow::Name $win]
set users [::MSN::usersInChat $chatid]
#Switch to "my picture" or "user picture"
$win.picmenu add command -label "[trans showmypic]" \
-command [list ::amsn::ChangePicture $win displaypicture_std_self [trans mypic]]
foreach user $users {
$win.picmenu add command -label "[trans showuserpic $user]" \
-command "::amsn::ChangePicture $win \[::skin::getDisplayPicture $user\] \[trans showuserpic $user\]"
}
set user [[::ChatWindow::GetInDisplayPictureFrame $win].image cget -image]
if { $user != "[::skin::getNoDisplayPicture]" && $user != "displaypicture_std_self" } {
#made easy for if we would change the image names
set user [string range $user [string length "displaypicture_std_"] end]
$win.picmenu add separator
#Sub-menu to change size
$win.picmenu add cascade -label "[trans changesize]" -menu $win.picmenu.size
catch {menu $win.picmenu.size -tearoff 0 -type normal}
$win.picmenu.size delete 0 end
#4 possible size (someone can add something to let the user choose his size)
$win.picmenu.size add command -label "[trans small]" -command "::skin::ConvertDPSize $user 64 64; ::amsn::UpdateAllPictures"
$win.picmenu.size add command -label "[trans default2]" -command "::skin::ConvertDPSize $user 96 96; ::amsn::UpdateAllPictures"
$win.picmenu.size add command -label "[trans large]" -command "::skin::ConvertDPSize $user 128 128; ::amsn::UpdateAllPictures"
$win.picmenu.size add command -label "[trans huge]" -command "::skin::ConvertDPSize $user 192 192; ::amsn::UpdateAllPictures"
#Get back to original picture
$win.picmenu.size add command -label "[trans original]" -command "::MSNP2P::loadUserPic $chatid $user 1"
}
tk_popup $win.picmenu $x $y
}
proc ChangePicture {win picture balloontext {nopack ""}} {
#pack [::ChatWindow::GetInDisplayPictureFrame $win].image -side left -padx 2 -pady 2
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText $win]]
#Get the path to the image
set pictureinner [[::ChatWindow::GetInDisplayPictureFrame $win].image getinnerframe]
if { $balloontext != "" } {
#TODO: Improve this!!! Use some kind of abstraction!
change_balloon $pictureinner $balloontext
#change_balloon [::ChatWindow::GetInDisplayPictureFrame $win].image $balloontext
}
if { [catch {[::ChatWindow::GetInDisplayPictureFrame $win].image configure -image $picture}] } {
status_log "Failed to set picture, using [::skin::getNoDisplayPicture]\n" red
[::ChatWindow::GetInDisplayPictureFrame $win].image configure -image [::skin::getNoDisplayPicture]
#change_balloon [::ChatWindow::GetInDisplayPictureFrame $win].image [trans nopic]
change_balloon $pictureinner [trans nopic]
} elseif { $nopack == "" } {
pack [::ChatWindow::GetInDisplayPictureFrame $win].image -side left -padx 0 -pady 0 -anchor w
[::ChatWindow::GetInDisplayPictureFrame $win].showpic configure -image [::skin::loadPixmap imghide]
bind [::ChatWindow::GetInDisplayPictureFrame $win].showpic <Enter> "[::ChatWindow::GetInDisplayPictureFrame $win].showpic configure -image [::skin::loadPixmap imghide_hover]"
bind [::ChatWindow::GetInDisplayPictureFrame $win].showpic <Leave> "[::ChatWindow::GetInDisplayPictureFrame $win].showpic configure -image [::skin::loadPixmap imghide]"
change_balloon [::ChatWindow::GetInDisplayPictureFrame $win].showpic [trans hidedisplaypic]
::config::setKey showdisplaypic 1
}
if { $scrolling } {
update idletasks
::ChatWindow::Scroll [::ChatWindow::GetOutText $win]
}
}
proc UpdateAllPictures { } {
set chatids [::ChatWindow::getAllChatIds]
# Loop through the chats
foreach chat $chatids {
set win [::ChatWindow::For $chat]
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win]]} {
::amsn::UpdatePictures $win
}
}
}
proc UpdatePictures { win } {
set frame [::ChatWindow::GetOutDisplayPicturesFrame $win]
set images [$frame.sw.sf getframe]
set chatid [::ChatWindow::Name $win]
set users [::MSN::usersInChat $chatid]
foreach child [winfo children $images] {
destroy $child
}
# don't show user labels if there's only one user
set show_user_labels 0
if {[llength $users] > 1} {
set show_user_labels 1
}
# Calculate the max width of the DPs shown, so we can know how much pixels to truncate all the labels
set max_width 0
foreach user $users {
set new_width [image width [::skin::getDisplayPicture $user]]
if {$new_width > $max_width } {
set max_width $new_width
}
}
set idx 0
foreach user $users {
if {$show_user_labels == 1} {
set truncated [trunc [::abook::getDisplayNick $user] $images [expr {${max_width}-10}] sitalf]
label $images.user_name$idx \
-background [::skin::getKey chatwindowbg] \
-relief flat -font sitalf -text $truncated
pack $images.user_name$idx -side top -padx 0 -pady 0 -anchor n
}
framec $images.user_dp$idx -type label -relief solid -image [::skin::getDisplayPicture $user] \
-borderwidth [::skin::getKey chat_dp_border] \
-bordercolor [::skin::getKey chat_dp_border_color] \
-background [::skin::getKey chatwindowbg]
set pictureinner [$images.user_dp$idx getinnerframe]
bind $pictureinner <Button1-ButtonRelease> [list ::amsn::ShowTopPicMenu $win $user %X %Y]
bind $pictureinner <<Button3>> [list ::amsn::ShowTopPicMenu $win $user %X %Y]
pack $images.user_dp$idx -side top -padx 0 -pady 0 -anchor n
set_balloon $pictureinner [trans showuserpic $user]
incr idx
}
$frame.sw.sf configure -width [expr {$max_width + (2 * [::skin::getKey chat_dp_border])}]
}
proc HidePicture { win } {
set dpframe [::ChatWindow::GetInDisplayPictureFrame $win]
pack forget $dpframe.image
#grid [::ChatWindow::GetInDisplayPictureFrame $win].showpic -row 0 -column 1 -padx 0 -pady 0 -rowspan 2
#Change here to change the icon, instead of text
$dpframe.showpic configure -image [::skin::loadPixmap imgshow]
bind $dpframe.showpic <Enter> "$dpframe.showpic configure -image [::skin::loadPixmap imgshow_hover]"
bind $dpframe.showpic <Leave> "$dpframe.showpic configure -image [::skin::loadPixmap imgshow]"
change_balloon $dpframe.showpic [trans showdisplaypic]
}
proc ShowOrHidePicture { } {
set chatids [::ChatWindow::getAllChatIds]
# Loop through the chats
foreach chat $chatids {
set win [::ChatWindow::For $chat]
if { [::config::getKey showdisplaypic 1] == 1} {
if {[winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win]] } {
::amsn::ChangePicture $win displaypicture_std_self [trans mypic]
} else {
::amsn::ChangePicture $win [[::ChatWindow::GetInDisplayPictureFrame $win].image cget -image] ""
}
} else {
::amsn::HidePicture $win
}
}
}
proc ToggleShowTopPicture { } {
if {[::config::getKey ShowTopPicture 0] == 1 } {
::config::setKey ShowTopPicture 0
} else {
::config::setKey ShowTopPicture 1
}
ShowOrHideTopPicture
}
proc ShowOrHideTopPicture { } {
set chatids [::ChatWindow::getAllChatIds]
# Loop through the chats
foreach chat $chatids {
set win [::ChatWindow::For $chat]
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win]] } {
if { [::config::getKey ShowTopPicture 1] == 1} {
ShowTopPicture $win
} else {
HideTopPicture $win
}
}
}
}
proc ShowTopPicture {win } {
set frame [::ChatWindow::GetOutDisplayPicturesFrame $win]
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText $win]]
pack $frame.sw -side left -fill y -expand false -anchor ne
$frame.showpic configure -image [::skin::loadPixmap imghide]
bind $frame.showpic <Enter> [list $frame.showpic configure -image [::skin::loadPixmap imghide_hover]]
bind $frame.showpic <Leave> [list $frame.showpic configure -image [::skin::loadPixmap imghide]]
change_balloon $frame.showpic [trans hidedisplaypic]
if { $scrolling } {
update idletasks
::ChatWindow::Scroll [::ChatWindow::GetOutText $win]
}
}
proc HideTopPicture { win } {
set frame [::ChatWindow::GetOutDisplayPicturesFrame $win]
pack forget $frame.sw
#Change here to change the icon, instead of text
$frame.showpic configure -image [::skin::loadPixmap imgshow]
bind $frame.showpic <Enter> [list $frame.showpic configure -image [::skin::loadPixmap imgshow_hover]]
bind $frame.showpic <Leave> [list $frame.showpic configure -image [::skin::loadPixmap imgshow]]
change_balloon $frame.showpic [trans showdisplaypic]
}
#///////////////////////////////////////////////////////////////////////////////
proc ShowUserList {title command {show_offlines 0}} {
#Replace for"::amsn::ChooseList \"[trans sendmsg]\" online ::amsn::chatUser 1 0"
set userlist [list]
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { $user_state_code == "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
} elseif { $user_state_code != "FLN" || $show_offlines == 1 } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])" $user_login]
}
}
::amsn::listChoose $title $userlist $command 1 1
}
proc ShowAddList {title win_name command} {
set userlist [list]
set chatusers [::MSN::usersInChat [::ChatWindow::Name $win_name]]
foreach user_login $chatusers {
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { [lsearch [::abook::getLists $user_login] FL] == -1 } {
if { $user_state_code != "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])" $user_login]
} else {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
}
}
}
if { [llength $userlist] > 0 } {
::amsn::listChoose $title $userlist $command 1 1
} else {
msg_box "[trans useralreadyonlist]"
}
}
proc ShowInviteList { title win_name } {
set userlist [list]
set chatusers [::MSN::usersInChat [::ChatWindow::Name $win_name]]
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
set user_state_no [::MSN::stateToNumber $user_state_code]
if {($user_state_no < 7) && ([lsearch $chatusers $user_login] == -1)} {
if { $user_state_code != "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])" $user_login]
} else {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
}
}
}
set chatid [::ChatWindow::Name $win_name]
if { [llength $userlist] > 0 } {
::amsn::listChoose $title $userlist "::amsn::queueinviteUser [::ChatWindow::Name $win_name]" 1 0
} else {
cmsn_draw_otherwindow $title "::amsn::queueinviteUser [::ChatWindow::Name $win_name]"
}
}
proc ShowInviteMenu { win_name x y } {
set menulength 0
set chatid [::ChatWindow::Name $win_name]
set chatusers [::MSN::usersInChat $chatid]
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
set user_state_no [::MSN::stateToNumber $user_state_code]
if {($user_state_no < 7) && ([lsearch $chatusers $user_login] == -1)} {
incr menulength 1
}
}
if { $menulength > 20 } {
::amsn::ShowInviteList "[trans invite]" $win_name
} elseif { $menulength == 0 } {
cmsn_draw_otherwindow [trans invite] "::amsn::queueinviteUser [::ChatWindow::Name $win_name]"
} else {
.menu_invite delete 0 end
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
set user_state_no [::MSN::stateToNumber $user_state_code]
if {($user_state_no < 7) && ([lsearch $chatusers $user_login] == -1)} {
if { $user_state_code != "NLN" } {
.menu_invite add command -label [trunc "[::abook::getDisplayNick $user_login] ([trans [::MSN::stateToDescription $user_state_code]])" "" 50] -command "::amsn::queueinviteUser $chatid $user_login"
} else {
.menu_invite add command -label [trunc "[::abook::getDisplayNick $user_login]" "" 50] -command "::amsn::queueinviteUser $chatid $user_login"
}
}
}
.menu_invite add separator
.menu_invite add command -label "[trans other]..." -command [list cmsn_draw_otherwindow [trans invite] "::amsn::queueinviteUser [::ChatWindow::Name $win_name]"]
tk_popup .menu_invite $x $y
}
}
proc queueinviteUser { chatid user } {
::MSN::ChatQueue $chatid [list ::MSN::inviteUser $chatid $user]
}
proc ShowChatList {title win_name command} {
set userlist [list]
set chatusers [::MSN::usersInChat [::ChatWindow::Name $win_name]]
if { [llength $chatusers] == 0 } {
#No SB yet. Check if chatid is a valid user
#example: opened chat while appearing offline
set chatid [::ChatWindow::Name $win_name]
if { [lsearch [::abook::getAllContacts] $chatid] != -1 } {
set chatusers $chatid
}
}
foreach user_login $chatusers {
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { $user_state_code != "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]]) " $user_login]
} else {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
}
}
if { [llength $userlist] > 0 } {
::amsn::listChoose $title $userlist $command 0 1
} else {
status_log "ShowChatList: No users\n"
}
}
#///////////////////////////////////////////////////////////////////////////////
#title: Title of the window
#itemlist: Array,or list, with two columns and N rows. Column 0 is the one to be
#shown in the list. Column 1 is the use used to parameter to the command
proc listChoose {title itemlist command {other 0} {skip 1}} {
global userchoose_req
set itemcount [llength $itemlist]
#If just 1 user, and $skip flag set to one, just run command on that user
if { $itemcount == 1 && $skip == 1 && $other == 0} {
eval $command [lindex [lindex $itemlist 0] 1]
return 0
}
if { [focus] == "" || [focus] =="." } {
set wname "._listchoose"
} else {
set wname "[focus]._listchoose"
}
if { [catch {toplevel $wname -borderwidth 0 -highlightthickness 0 } res ] } {
raise $wname
focus $wname
return 0
} else {
set wname $res
}
wm title $wname $title
#No ugly blue frame on Mac OS X, system already use a border around window
if { [OnMac] } {
frame $wname.blueframe -background [::skin::getKey topcontactlistbg]
} else {
frame $wname.blueframe -background [::skin::getKey mainwindowbg]
}
frame $wname.blueframe.list -class Amsn -borderwidth 0
frame $wname.buttons -class Amsn
listbox $wname.blueframe.list.items -yscrollcommand "$wname.blueframe.list.ys set" -font splainf \
-background white -relief flat -highlightthickness 0 -height 20 -width 60
scrollbar $wname.blueframe.list.ys -command "$wname.blueframe.list.items yview" -highlightthickness 0 \
-borderwidth 1 -elementborderwidth 1
button $wname.buttons.ok -text "[trans ok]" -command [list ::amsn::listChooseOk $wname $itemlist $command]
button $wname.buttons.cancel -text "[trans cancel]" -command [list destroy $wname]
pack $wname.blueframe.list.ys -side right -fill y
pack $wname.blueframe.list.items -side left -expand true -fill both
pack $wname.blueframe.list -side top -expand true -fill both -padx 4 -pady 4
pack $wname.blueframe -side top -expand true -fill both
if { $other == 1 } {
button $wname.buttons.other -text "[trans other]..." -command [list ::amsn::listChooseOther $wname $title $command]
pack $wname.buttons.ok -padx 5 -side right
pack $wname.buttons.cancel -padx 5 -side right
pack $wname.buttons.other -padx 5 -side left
} else {
pack $wname.buttons.ok -padx 5 -side right
pack $wname.buttons.cancel -padx 5 -side right
}
pack $wname.buttons -side bottom -fill x -pady 3
foreach item $itemlist {
$wname.blueframe.list.items insert end [lindex $item 0]
}
bind $wname.blueframe.list.items <Double-Button-1> [list ::amsn::listChooseOk $wname $itemlist $command]
catch {
raise $wname
focus $wname.buttons.ok
}
bind $wname <<Escape>> [list destroy $wname]
bind $wname <Return> [list ::amsn::listChooseOk $wname $itemlist $command]
moveinscreen $wname 30
}
#///////////////////////////////////////////////////////////////////////////////
proc listChooseOther { wname title command } {
destroy $wname
cmsn_draw_otherwindow $title $command
}
proc listChooseOk { wname itemlist command} {
set sel [$wname.blueframe.list.items curselection]
if { $sel == "" } { return }
destroy $wname
eval "$command [lindex [lindex $itemlist $sel] 1]"
}
#///////////////////////////////////////////////////////////////////////////////
# TypingNotification (win_name inputbox)
# Called by a window when the user types something into the text box. It tells
# the protocol layer to send a typing notification to the chat that the window
# 'win_name' is connected to
proc TypingNotification { win_name inputbox} {
global skipthistime
set chatid [::ChatWindow::Name $win_name]
if { $chatid == 0 } {
status_log "VERY BAD ERROR in ::amsn::TypingNotification!!!\n" red
return 0
}
if { $skipthistime } {
set skipthistime 0
} else {
if { [string length [$inputbox get 0.0 end-1c]] == 0 } {
CharsTyped $chatid ""
} else {
CharsTyped $chatid [string length [$inputbox get 0.0 end-1c]]
}
}
#Works for tcl/tk 8.4 only...
catch {
bind $inputbox <<Modified>> ""
$inputbox edit modified false
bind $inputbox <<Modified>> "::amsn::TypingNotification ${win_name} $inputbox"
}
if { [::MSNMobile::IsMobile $chatid] == 1} {
status_log "MOBILE CHAT\n" red
return 0
}
#no typing notification for OIM
if {[::OIM_GUI::IsOIM $chatid] == 1 } {
return 0
}
#Don't queue unless chat is ready, but try to reconnect
if { [::MSN::chatReady $chatid] } {
if { [::config::getKey notifytyping] } {
sb_change $chatid
}
} else {
::MSN::chatTo $chatid
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# DeleteKeyPressed (win_name inputbox)
# Called by a window when the user uses the delete key in a text box. It updates
# the number of characters typed to be correct
proc DeleteKeyPressed { win_name inputbox key} {
global skipthistime
set skipthistime 1
set totallength [string length [$inputbox get 0.0 end-1c]]
set x [$inputbox tag nextrange sel 0.0]
if { $x != "" } {
set y [string length [$inputbox get [lindex $x 0] [lindex $x 1]]]
} elseif { $key == "Delete" && [string length [$inputbox get 0.0 insert]] == $totallength \
|| $key == "BackSpace" && [string length [$inputbox get 0.0 insert]] == 0 } {
set y 0
set skipthistime 0
} else {
set y 1
}
set newlength [expr {$totallength - $y}]
set chatid [::ChatWindow::Name $win_name]
if { [string length [$inputbox get 0.0 end-1c]] == 0 } {
CharsTyped $chatid ""
} else {
CharsTyped $chatid $newlength
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# UpKeyPressed (inputbox)
# Called by a window when the user uses the up key in a text box. It returns
# the index of the character 1 line above the insertion cursor
proc UpKeyPressed { inputbox } {
$inputbox see insert
set bbox [$inputbox bbox insert]
set xpos [expr {[lindex $bbox 0]+[lindex $bbox 2]/2}]
set ypos [lindex $bbox 1]
set height [lindex $bbox 3]
if { $ypos > $height } {
return [$inputbox index "@$xpos,[expr {$ypos-$height}]"]
} else {
$inputbox yview scroll -1 units
update
set ypos [lindex [$inputbox bbox insert] 1]
set height [lindex [$inputbox bbox insert] 3]
if { $ypos > $height } {
return [$inputbox index "@$xpos,[expr {$ypos-$height}]"]
}
}
return [$inputbox index insert]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# DownKeyPressed (inputbox)
# Called by a window when the user uses the down key in a text box. It returns
# the index of the character 1 line below the insertion cursor
proc DownKeyPressed { inputbox } {
$inputbox see insert
set bbox [$inputbox bbox insert]
set xpos [expr {[lindex $bbox 0]+[lindex $bbox 2]/2}]
set ypos [lindex $bbox 1]
set height [lindex $bbox 3]
set inputboxheight [lindex [$inputbox configure -height] end]
if { [expr {$ypos+$height}] < [expr {$inputboxheight*$height}] } {
return [$inputbox index "@$xpos,[expr {$ypos+$height}]"]
} else {
$inputbox yview scroll +1 units
update
set ypos [lindex [$inputbox bbox insert] 1]
set height [lindex [$inputbox bbox insert] 3]
set inputboxheight [lindex [$inputbox configure -height] end]
if { [expr {$ypos+$height}] < [expr {$inputboxheight*$height}] } {
return [$inputbox index "@$xpos,[expr {$ypos+$height}]"]
}
}
return [$inputbox index insert]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# MessageSend (win_name,input)
# Called from a window the the user enters a message to send to the chat. It will
# just queue the message to send in the chat associated with 'win_name', and set
# a timeout for the message
proc MessageSend { win_name input {custom_msg ""} {friendlyname ""}} {
set chatid [::ChatWindow::Name $win_name]
if { $chatid == 0 } {
status_log "::amsn::MessageSend: TOO BAD!!! Got no chatid!\n" red
return 0
}
if { $custom_msg != "" } {
set msg $custom_msg
} else {
# Catch in case that $input is not a "text" control (ie: automessage).
if { [catch { set msg [$input get 0.0 end-1c] }] } {
set msg ""
}
}
#Blank message
if {[string length $msg] < 1} { return 0 }
if { $input != 0 } {
$input delete 0.0 end
focus ${input}
}
set fontfamily [lindex [::config::getKey mychatfont] 0]
set fontstyle [lindex [::config::getKey mychatfont] 1]
set fontcolor [lindex [::config::getKey mychatfont] 2]
if { $friendlyname != "" } {
set nick $friendlyname
set p4c 1
} elseif { [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] != ""} {
set friendlyname [::abook::parseCustomNick [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] [::abook::getPersonal MFN] [::abook::getPersonal login] "" [::abook::getpsmmedia]]
set nick $friendlyname
set p4c 1
} elseif { [::config::getKey p4c_name] != ""} {
set nick [::config::getKey p4c_name]
set p4c 1
} else {
set nick [::abook::getPersonal MFN]
set p4c 0
}
#Postevent when we send a message
set evPar(nick) nick
set evPar(msg) msg
set evPar(chatid) chatid
set evPar(win_name) win_name
set evPar(fontfamily) fontfamily
set evPar(fontstyle) fontstyle
set evPar(fontcolor) fontcolor
::plugins::PostEvent chat_msg_send evPar
if {![string equal $msg ""]} {
set first 0
while { [expr {$first + 400}] <= [string length $msg] } {
set msgchunk [string range $msg $first [expr {$first + 399}]]
if {[::MSNMobile::IsMobile $chatid] == 0 && [::OIM_GUI::IsOIM $chatid] == 0} {
set ackid [after 60000 [list ::amsn::DeliveryFailed $chatid $msgchunk]]
} else {
set ackid 0
}
::MSN::messageTo $chatid "$msgchunk" $ackid $friendlyname
incr first 400
}
set msgchunk [string range $msg $first end]
if {[::MSNMobile::IsMobile $chatid] == 0 && [::OIM_GUI::IsOIM $chatid] == 0} {
set ackid [after 60000 [list ::amsn::DeliveryFailed $chatid $msgchunk]]
} else {
set ackid 0
}
set message [Message create %AUTO%]
$message setBody $msg
#TODO: where is the best place to put this code?
set color "000000$fontcolor"
set color "[string range $color end-1 end][string range $color end-3 end-2][string range $color end-5 end-4]"
set style ""
if { [string first "bold" $fontstyle] >= 0 } { set style "${style}B" }
if { [string first "italic" $fontstyle] >= 0 } { set style "${style}I" }
if { [string first "overstrike" $fontstyle] >= 0 } { set style "${style}S" }
if { [string first "underline" $fontstyle] >= 0 } { set style "${style}U" }
set format ""
set format "{$format}FN=[urlencode $fontfamily]; "
set format "{$format}EF=$style; "
set format "{$format}CO=$color; "
set format "{$format}CS=0; "
set format "{$format}PF=22"
$message setHeader [list X-MMS-IM-Format "$format"]
#Draw our own message
messageFrom $chatid [::abook::getPersonal login] $nick $message user $p4c
#This object isn't used anymore: destroy it
$message destroy
::MSN::messageTo $chatid "$msgchunk" $ackid $friendlyname
CharsTyped $chatid ""
::plugins::PostEvent chat_msg_sent evPar
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# ackMessage (ackid)
# Called from the protocol layer when ACK for a message is received. It Cancels
# the timer for time outing the message 'ackid'.
proc ackMessage { ackid } {
after cancel $ackid
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# nackMessage (ackid)
# Called from the protocol layer when NACK for a message is received. It just
# writes the delivery error message without waiting for the message to timeout,
# and cancels the timer.
proc nackMessage { ackid } {
if {![catch {after info $ackid} command]} {
set command [lindex $command 0]
after cancel $ackid
eval $command
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# DeliveryFailed (chatid,msg)
# Writes the delivery error message along with the timeouted 'msg' into the
# window related to 'chatid'
proc DeliveryFailed { chatid msg } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
chatUser $chatid
}
update idletasks
SendMessageFIFO [list ::amsn::WinWriteFail $chatid $msg] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
proc WinWriteFail {chatid msg} {
WinWrite $chatid "\n[timestamp] [trans deliverfail]:\n" red
WinWrite $chatid "$msg" gray "" 1 [::config::getKey login]
if {[::config::getKey keep_logs]} {
::log::PutLog $chatid [trans deliverfail] $msg "" 1
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# PutMessage (chatid,user,msg,type,fontformat)
# Writes a message into the window related to 'chatid'
# - 'user' is the user login.
# - 'msg' is the message itself to be displayed.
# - 'type' can be red, gray... or any tag defined for the textbox when the window
# was created, or just "user" to use the fontformat parameter
# - 'fontformat' is a list containing font style and color
proc PutMessage { chatid user nick msg type fontformat {p4c ""}} {
#Run it in mutual exclusion
SendMessageFIFO [list ::amsn::PutMessageWrapped $chatid $user $nick $msg $type $fontformat $p4c] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
proc PutMessageWrapped { chatid user nick msg type fontformat {p4c 0 }} {
if { [::config::getKey showtimestamps] } {
set tstamp [timestamp]
} else {
set tstamp ""
}
switch [::config::getKey chatstyle] {
msn {
::config::setKey customchatstyle "\$tstamp [trans says \$nick]: \$newline"
}
irc {
::config::setKey customchatstyle "\$tstamp <\$nick> "
}
- {
}
}
#By default, quote backslashes and variables
set customchat [string map {"\\" "\\\\" "\$" "\\\$" "\(" "\\\(" } [::config::getKey customchatstyle]]
#Now, let's unquote the variables we want to replace
set customchat [string map { "\\\$nick" "\${nick}" "\\\$tstamp" "\${tstamp}" "\\\$newline" "\n" } $customchat]
if { [::abook::getContactData $user customcolor] != "" } {
set color [string trim [::abook::getContactData $user customcolor] "#"]
} else {
set color 404040
}
if { $p4c == 1 } {
if { $color == 404040 } { set color 000000 }
set style [list "bold" "italic"]
} else {
set style {}
}
set font [lindex [::config::getGlobalKey basefont] 0]
if { $font == "" } { set font "Helvetica"}
set customfont [list $font $style $color]
if {[::config::getKey truncatenicks]} {
set oldnick $nick
set nick ""
set says [subst -nocommands $customchat]
set measurefont [list $font [lindex [::config::getGlobalKey basefont] 1] $style]
set win_name [::ChatWindow::For $chatid]
set maxw [winfo width [::ChatWindow::GetOutText $win_name]]
#status_log "Custom font is $customfont\n" red
incr maxw [expr {-10-[font measure $measurefont -displayof $win_name "$says"]}]
set nick [trunc $oldnick $win_name $maxw splainf]
}
#Return the custom nick, replacing backslashses and variables
set customchat [subst -nocommands $customchat]
upvar #0 [string map {: _} ${chatid} ]_smileys emotions
if { [info exists emotions] } {
set emoticons_for_this_chatid [array get emotions]
unset emotions
}
WinWrite $chatid "\n$customchat" "says" $customfont
if { [info exists emoticons_for_this_chatid] } {
array set emotions $emoticons_for_this_chatid
unset emoticons_for_this_chatid
}
#Postevent for chat_msg_receive
set evPar(user) user
set evPar(msg) msg
set evPar(chatid) chatid
set evPar(fontformat) $fontformat
set message $msg
set evPar(message) message
::plugins::PostEvent chat_msg_receive evPar
if {![string equal $msg ""]} {
WinWrite $chatid "$message" $type $fontformat 1 $user
if {[::config::getKey keep_logs]} {
::log::PutLog $chatid $nick $msg $fontformat
}
}
if { [info exists emotions] } {
unset emotions
}
::plugins::PostEvent chat_msg_received evPar
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# chatStatus (chatid,msg,[icon])
# Called by the protocol layer to show some information about the chat, that
# should be shown in the status bar. It parameter "ready" is different from "",
# then it will only show it if the chat is not
# ready, as most information is about connections/reconnections, and we don't
# mind in case we have a "chat ready to chat".
proc chatStatus {chatid msg {icon ""} {ready ""}} {
if { $chatid == 0} {
return 0
} elseif { [::ChatWindow::For $chatid] == 0} {
return 0
} elseif { "$ready" != "" && [::MSN::chatReady $chatid] != 0 } {
return 0
} else {
::ChatWindow::Status [::ChatWindow::For $chatid] $msg $icon
}
}
#///////////////////////////////////////////////////////////////////////////////
proc chatDisabled {chatid} {
chatStatus $chatid ""
}
#///////////////////////////////////////////////////////////////////////////////
# CharsTyped (chatid,msg)
# Writes the message 'msg' (number of characters typed) in the window 'win_name' status bar.
proc CharsTyped { chatid msg } {
if { $chatid == 0} {
return 0
} elseif { [::ChatWindow::For $chatid] == 0} {
return 0
} else {
set win_name [::ChatWindow::For $chatid]
set msg [string map {"\n" " "} $msg]
[::ChatWindow::GetStatusCharsTypedText ${win_name}] configure -state normal
[::ChatWindow::GetStatusCharsTypedText ${win_name}] delete 0.0 end
[::ChatWindow::GetStatusCharsTypedText ${win_name}] insert end $msg center
[::ChatWindow::GetStatusCharsTypedText ${win_name}] configure -state disabled
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# chatUser (user, [oim])
# Opens a chat for user 'user'. If a window for that user already exists, it will
# use it and reconnect if necessary (will call to the protocol function chatUser),
# and raise and focus that window. If the window doesn't exist it will open a new
# one. 'user' is the mail address of the user to chat with.
# oim is 1 when we're opening this CW in order to put an OIM
#returns the name of the window
proc chatUser { user {oim 0}} {
# set lowuser [string tolower $user]
set lowuser $user
set win_name [::ChatWindow::For $lowuser]
set creating_window 0
if { $win_name == 0 } {
set creating_window 1
if { [::ChatWindow::UseContainer] == 0 } {
set win_name [::ChatWindow::Open]
::ChatWindow::SetFor $lowuser $win_name
} else {
set container [::ChatWindow::GetContainerFor $user]
set win_name [::ChatWindow::Open $container]
::ChatWindow::SetFor $lowuser $win_name
}
set ::ChatWindow::first_message($win_name) 0
status_log "win_name=$win_name" blue
#TODO: This check shouldn't be there
#Have a look at proc IsOIM (gui.tcl)
if {[::OIM_GUI::IsOIM $user] == 0} {
set chatid [::MSN::chatTo $lowuser]
} else {
#doing OIM
set chatid $lowuser
}
# PostEvent 'new_conversation' to notify plugins that the window was created
set evPar(chatid) $chatid
set evPar(usr_name) $user
::plugins::PostEvent new_conversation evPar
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win_name]] } {
::amsn::ShowOrHidePicture
::amsn::ShowOrHideTopPicture
::amsn::UpdatePictures $win_name
} else {
if { [::config::getKey showdisplaypic] && $user != ""} {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $user] [trans showuserpic $user]
} else {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $user] [trans showuserpic $user] nopack
}
}
}
#TODO: This check shouldn't be there
#Have a look at proc IsOIM (gui.tcl, ~2540)
if {[::OIM_GUI::IsOIM $user] == 0} {
set chatid [::MSN::chatTo $lowuser]
} else {
#doing OIM
set chatid $lowuser
}
if { [::ChatWindow::UseContainer] != 0 && $creating_window == 1} {
::ChatWindow::NameTabButton $win_name $chatid
set_balloon $::ChatWindow::win2tab($win_name) "--command--::ChatWindow::SetNickText $chatid"
}
if { "$chatid" != "${lowuser}" } {
status_log "Error in ::amsn::chatUser, expected same chatid as user, but was different\n" red
return 0
}
set top_win [winfo toplevel $win_name]
if { [winfo exists .bossmode] } {
set ::BossMode(${top_win}) "normal"
wm state ${top_win} withdraw
} else {
wm state ${top_win} normal
}
wm deiconify ${top_win}
update idletasks
if { [OnMac] } { ::ChatWindow::MacPosition ${top_win} }
::ChatWindow::TopUpdate $chatid
#We have a window for that chatid, raise it
raise ${top_win}
set container [::ChatWindow::GetContainerFromWindow $win_name]
if { $container != "" } { ::ChatWindow::SwitchToTab $container $win_name }
# while receiving oims, with no tabbed chatting,
# since many windows could open at the same time, and each of them were asking for the focus
# here is an ugly workaround
if {!$oim || [::config::getKey tabbedchat] != 0 } {
focus [::ChatWindow::GetInputText ${win_name}]
}
return $win_name
}
#///////////////////////////////////////////////////////////////////////////////
proc SelectUrl {textw urlname } {
if { [focus] != "${textw}.inner" || [llength [$textw tag ranges sel]] == 0} {
# If we were focusing on the text widget (user didn't explicitely just selected text with his mouse)
# We need to free up the selection to avoid having multiple ranges selected
if { [llength [$textw tag ranges sel]] > 0 } {
eval [list $textw] tag remove sel [$textw tag ranges sel]
}
# We force the focus on the inner frame, this way the selection will appear, otherwise, we won't see anything..
catch {focus -force ${textw}.inner}
eval [list $textw] tag add sel [$textw tag ranges $urlname]
}
}
#///////////////////////////////////////////////////////////////////////////////
# WinWrite (chatid,txt,tagid,[format])
# Writes 'txt' into the window related to 'chatid'
# It will use 'tagname' as style tag, unless 'tagname'=="user", where it will use
# 'fontname', 'fontstyle' and 'fontcolor' as from fontformat, or 'tagname'=="says"
# where it will use the same format as "user" but size 11.
# The parameter "user" is used for smiley substitution.
proc WinWrite {chatid txt tagname {fontformat ""} {flicker 1} {user ""}} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
#Avoid problems if the windows was closed
if {![winfo exists $win_name]} {
return
}
set textw [::ChatWindow::GetOutText ${win_name}]
set scrolling [::ChatWindow::getScrolling $textw]
set fontname [lindex $fontformat 0]
set fontstyle [lindex $fontformat 1]
set fontcolor [lindex $fontformat 2]
$textw configure -font bplainf -foreground black
#Store position for later smiley and URL replacement
# use end-1c because text widgets always have \n at the end, and it's better than getting the
# previous line as we did before (creates bug when we use a custom chat style that fits in one line).
set text_start [$textw index end-1c]
#Ugly hack for elided search, but at least it works!...
if { [info tclversion] == 8.4 && $tagname == "user" } {
if { [$textw get end-2c]!= "\n" } {
set all_chars 0
$textw search -elide -regexp -count all_chars .* end-1l end-1c
#Remove line below and aMSN Plus causes bug report
set visible_chars $all_chars
$textw search -regexp -count visible_chars .* end-1l end-1c
set elided_chars [expr {$all_chars - $visible_chars + 1}]
set text_start $text_start-${elided_chars}c
}
}
#Check if this is first line in the text, then ignore the \n
#at the beginning of the line
if { [$textw get 1.0 2.0] == "\n" } {
if {[string index $txt 0] == "\n"} {
set txt [string range $txt 1 end]
}
}
#By default tagid=tagname unless we generate a new one
set tagid $tagname
if { $tagid == "user" || $tagid == "yours" || $tagid == "says" } {
if { $tagid == "says" && [::config::getKey strictfonts] == 0 } {
set size [lindex [::config::getGlobalKey basefont] 1]
} else {
set size [expr {[lindex [::config::getGlobalKey basefont] 1]+[::config::getKey textsize]}]
}
# We'd rather avoid letting the system use 'fixed' whenever the font is not available, because it's THE ugliest...
# 7:44 <@azbridge> <Cameron> So, in the short term, you're rather stuck with [font families]. Maybe you can help make a better answer for a future release of Tk, though.
if { $tagid == "user" } {
set fontname [urldecode $fontname]
set font "bplainf"
foreach listed_font [string trim [split $fontname ","]] {
if { [info exists ::allfonts([string tolower $listed_font])] } {
#status_log "font $listed_font found!"
set font "\"$listed_font\" $size $fontstyle"
break
}
}
} else {
set font "\"$fontname\" $size $fontstyle"
}
set tagid [::md5::md5 "$font$fontcolor"]
if { ([string length $fontname] < 3 )
|| ([catch {$textw tag configure $tagid -foreground #$fontcolor -font $font} res])} {
status_log "Font $font or color $fontcolor wrong. Using default\n" red
$textw tag configure $tagid -foreground black -font bplainf
}
}
set evPar(tagname) tagname
set evPar(winname) {win_name}
set evPar(msg) txt
::plugins::PostEvent WinWrite evPar
set textw [::ChatWindow::GetOutText ${win_name}]
$textw roinsert end "$txt" $tagid
#TODO: Make an url_subst procedure, and improve this using regular expressions
variable urlcount
variable urlstarts
set endpos $text_start
foreach url $urlstarts {
while { $endpos != [$textw index end] && [set pos [$textw search -forward -exact -nocase \
$url $endpos end]] != "" } {
set urltext [$textw get $pos end]
set final 0
set caracter [string range $urltext $final $final]
while { $caracter != " " && $caracter != "\n" } {
set final [expr {$final+1}]
set caracter [string range $urltext $final $final]
}
set urltext [string range $urltext 0 [expr {$final-1}]]
set posyx [split $pos "."]
set endpos "[lindex $posyx 0].[expr {[lindex $posyx 1] + $final}]"
set urlcount "[expr {$urlcount+1}]"
set urlname "url_$urlcount"
$textw tag configure $urlname \
-foreground #000080 -font splainf -underline true
$textw tag bind $urlname <Enter> \
"$textw tag conf $urlname -underline false;\
$textw conf -cursor hand2"
$textw tag bind $urlname <Leave> \
"$textw tag conf $urlname -underline true;\
$textw conf -cursor xterm"
$textw tag bind $urlname <Button1-ButtonRelease> \
"$textw conf -cursor watch; launch_browser [string map {% %%} [list $urltext]]"
$textw tag bind $urlname <Button3-ButtonRelease> [list ::amsn::SelectUrl $textw $urlname]
$textw rodelete $pos $endpos
$textw roinsert $pos "$urltext" $urlname
#Don't replace smileys in URLs
$textw tag add dont_replace_smileys ${urlname}.first ${urlname}.last
}
}
#Avoid problems if the windows was closed in the middle...
if {![winfo exists $win_name]} { return }
if {[::config::getKey chatsmileys]} {
if {([::config::getKey customsmileys] && [::abook::getContactData $user showcustomsmileys] != 0) } {
custom_smile_subst $chatid $textw $text_start end
}
#Replace smileys... if you're sending custom ones, replace them too (last parameter)
if { $user == [string tolower [::config::getKey login]] } {
::smiley::substSmileys $textw $text_start end 0 1
#::smiley::substYourSmileys [::ChatWindow::GetOutText ${win_name}] $text_start end 0
} else {
::smiley::substSmileys $textw $text_start end 0 0
}
}
if { $scrolling } { ::ChatWindow::Scroll $textw }
if { $flicker } {
::ChatWindow::Flicker $chatid
}
after cancel [list set ::ChatWindow::recent_message($win_name) 0]
set ::ChatWindow::recent_message(${win_name}) 1
after 2000 [list set ::ChatWindow::recent_message($win_name) 0]
::plugins::PostEvent WinWritten evPar
}
#///////////////////////////////////////////////////////////////////////////////
proc WinWriteIcon { chatid imagename {padx 0} {pady 0}} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]
[::ChatWindow::GetOutText ${win_name}] image create end -image [::skin::loadPixmap $imagename] -pady $pady -padx $pady
if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }
}
proc WinWriteClickable { chatid txt command {tagid ""}} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]
if { $tagid == "" } {
set tagid [getUniqueValue]
}
[::ChatWindow::GetOutText ${win_name}] tag configure $tagid \
-foreground #000080 -font bboldf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind $tagid <Enter> \
"[::ChatWindow::GetOutText ${win_name}] tag conf $tagid -underline true;\
[::ChatWindow::GetOutText ${win_name}] conf -cursor hand2"
[::ChatWindow::GetOutText ${win_name}] tag bind $tagid <Leave> \
"[::ChatWindow::GetOutText ${win_name}] tag conf $tagid -underline false;\
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm"
[::ChatWindow::GetOutText ${win_name}] tag bind $tagid <Button1-ButtonRelease> "$command"
[::ChatWindow::GetOutText ${win_name}] roinsert end "$txt" $tagid
if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }
}
if { $initialize_amsn == 1 } {
variable NotifID 0
variable NotifPos [list]
}
proc closeAmsnMac {} {
set answer [::amsn::messageBox [trans exitamsn] yesno question [trans title]]
if { $answer == "yes"} { exit }
}
###
### $closingdocks: 0 / unexistant = ask
### 1 = dock
### 2 = close
proc closeOrDock { closingdocks } {
global rememberdock
set rememberdock 0
if {$closingdocks == 1} {
closeOrDockDock
} elseif { $closingdocks == 2} {
exit
} else {
set w .closeordock
if { [winfo exists $w] } {
raise $w
return
}
toplevel $w
wm title $w "[trans title]"
wm group $w .
wm resizable $w 0 0
#Create the 2 frames
frame $w.top
frame $w.buttons
#Create the picture of warning (at left)
label $w.top.bitmap -image [::skin::loadPixmap warning]
pack $w.top.bitmap -side left -pady 0 -padx [list 0 12 ]
label $w.top.question -text "[trans closeordock]" -wraplength 400 -justify left
pack $w.top.question -pady 0 -padx 0 -side top
checkbutton $w.top.remember -text [trans remembersetting] -variable rememberdock -anchor w
pack $w.top.remember -pady 5 -padx 10 -side bottom -fill x
#Create the buttons
button $w.buttons.quit -text "[trans quit]" -command "::amsn::closeOrDockClose"
button $w.buttons.dock -text "[trans minimize]" -command "::amsn::closeOrDockDock"
button $w.buttons.cancel -text "[trans cancel]" -command "destroy $w"
pack $w.buttons.quit -pady 0 -padx 0 -side right
pack $w.buttons.cancel -pady 0 -padx [list 0 6 ] -side right
pack $w.buttons.dock -pady 0 -padx 6 -side right
#Pack frames
pack $w.top -pady 12 -padx 12 -side top
pack $w.buttons -pady 12 -padx 12 -fill x
moveinscreen $w 30
bind $w <<Escape>> "destroy $w"
}
}
proc closeOrDockDock {} {
global systemtray_exist statusicon ishidden rememberdock
if {$rememberdock} {
::config::setKey closingdocks 1
}
wm iconify .
if { $systemtray_exist == 1 && $statusicon != 0 } {
status_log "Hiding\n" white
wm state . withdrawn
set ishidden 1
}
destroy .closeordock
unset rememberdock
}
proc closeOrDockClose {} {
global rememberdock
if {$rememberdock} {
::config::setKey closingdocks 2
}
destroy .closeordock
unset rememberdock
exit
}
#Adds a message to the notify, that executes "command" when clicked, and
#plays "sound"
proc notifyAdd { msg command {sound ""} {type other} {user ""}} {
#no notifications in bossmode or if disabled
if { [winfo exists .bossmode] || [::config::getKey shownotify] == 0} {
return
}
#if we gota sound, play it
if { $sound != ""} {
play_sound ${sound}.wav
}
global automessage
#Maybe we want to block the notification windows but not the sounds!
if { [info exists automessage] && $automessage != -1 && [lindex $automessage 7] == 1} { return }
# Check if we only want to play the sound notification
if { [::config::getKey notifyonlysound] == 0 } {
#have a unique name
variable NotifID
#the position, always incremented with height
variable NotifPos
#New name for the window
set w .notif$NotifID
incr NotifID
#the window will be stretched by the canvas anyways
toplevel $w -width 1 -height 1
wm group $w .
#no wm borders
wm state $w withdrawn
#To put the notify window in front of all, specific for Windows only
if {[OnWin]} {
#Some verions of tk don't support this
catch { wm attributes $w -topmost 1 }
}
set xpos [::config::getKey notifyXoffset]
set ypos [::config::getKey notifyYoffset]
if { $xpos < 0 } { set xpos 0 }
if { $ypos < 0 } { set ypos 0 }
set height [::skin::getKey notifheight]
#Search for a free notify window position
while { [lsearch -exact $NotifPos $ypos] >=0 } {
incr ypos $height
}
lappend NotifPos $ypos
canvas $w.c -bg #EEEEFF -width [::skin::getKey notifwidth] -height [::skin::getKey notifheight] \
-relief ridge -borderwidth 0 -highlightthickness 0
pack $w.c
#set the background picture
switch $type {
online { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyonline] -tag bg }
offline { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyoffline] -tag bg }
state { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifystate] -tag bg }
plugins { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyplugins] -tag bg }
message { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifymsg] -tag bg }
email { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyemail] -tag bg }
default { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyonline] -tag bg }
}
#If it's a notification about a user (user var given) and there is an image (the creation results 1) and we have the config set to show the image, show the display-picture
if {$user != "" && [getpicturefornotification $user] && [::config::getKey showpicnotify]} {
#Put the image on the canvas
$w.c create image [::skin::getKey x_notifydp] [::skin::getKey y_notifydp] -anchor nw\
-image displaypicture_not_$user -tag bg
#Put the text on the canvas
set notify_id [$w.c create text [::skin::getKey x_notifytext] [::skin::getKey y_notifytext] \
-font [::skin::getKey notify_font] -justify left\
-width [::skin::getKey width_notifytext] -anchor nw\
-text "$msg" -tag bg -fill [::skin::getKey notifyfg]]
#else, just show the text, using all the space
} else {
set notify_id [$w.c create text [expr {[::skin::getKey notifwidth]/2}] [expr {[::skin::getKey notifheight]/2}] \
-font [::skin::getKey notify_font] -justify left\
-width [expr {[::skin::getKey notifwidth]-20}] -anchor center\
-text "$msg" -tag bg -fill [::skin::getKey notifyfg]]
}
#add the close button
$w.c create image [::skin::getKey x_notifyclose] [::skin::getKey y_notifyclose] -anchor nw -image [::skin::loadPixmap notifclose] -tag close
if {[string length $msg] >100} {
set msg "[string range $msg 0 100]..."
}
set after_id [after [::config::getKey notifytimeout] [list ::amsn::KillNotify $w $ypos]]
$w.c bind bg <Enter> "$w.c configure -cursor hand2"
$w.c bind bg <Leave> "$w.c configure -cursor left_ptr"
$w.c bind bg <ButtonRelease-1> "after cancel $after_id; [list ::amsn::KillNotify $w $ypos $command]"
$w.c bind bg <ButtonRelease-3> "after cancel $after_id; [list ::amsn::KillNotify $w $ypos]"
$w.c bind close <Enter> "$w.c configure -cursor hand2"
$w.c bind close <Leave> "$w.c configure -cursor left_ptr"
$w.c bind close <ButtonRelease-1> "after cancel $after_id; ::amsn::KillNotify $w $ypos"
wm overrideredirect $w 1
#now show it
wm state $w normal
if { [OnMac] } {
#Raise $w to correct a bug in "wm geometry" in AquaTK (Mac OS X)
lower $w
}
#Disable Grownotify for Mac OS X Aqua/tk users
if {![::config::getKey animatenotify] || [OnMac] } {
wm geometry $w -$xpos-$ypos
} else {
wm geometry $w -$xpos-[expr {$ypos-100}]
after 50 "::amsn::growNotify $w $xpos [expr {$ypos-100}] $ypos"
}
}
}
proc growNotify { w xpos currenty finaly } {
if { [winfo exists $w] == 0 } { return 0}
if { $currenty>$finaly} {
wm geometry $w -$xpos-$finaly
raise $w
return 0
}
wm geometry $w -$xpos-$currenty
after 75 "::amsn::growNotify $w $xpos [expr {$currenty+15}] $finaly"
}
proc KillNotify { w ypos {command ""}} {
variable NotifPos
if { $command != "" } {
catch {eval $command}
set timer 500
} else {
set timer 0
}
# We need to wait before making this disappear because we need the window to be created
# BEFORE th