#!/usr/bin/wish
# $Id$
lappend auto_path .
package require Tclx
package require BWidget
set font "fixed"
set loginconf(user) test
set loginconf(password) test
set loginconf(resource) test
set loginconf(server) localhost
set loginconf(port) 5222
set loginconf(priority) 8
set loginconf(usessl) 0
set loginconf(sslport) 5223
set loginconf(useproxy) 0
set loginconf(httpproxy) localhost
set loginconf(httpproxyport) 3128
set usetabbar 1
set default_jlib jabberlib-tclxml
proc postload {} {}
if {[file exists ~/.tkabber/config.tcl]} {
source ~/.tkabber/config.tcl
}
set version 0.0.0.0.1-alpha-20020809
tk appname tkabber
#option readfile ermine.xrdb userDefault
#option readfile examples/teopetuk.xrdb userDefault
option add *Entry.font $font widgetDefault
#option add *Entry.background White
#option add *Text.background White
if {$tcl_platform(platform) == "unix"} {
set debug_lvls {jlib}
} else {
# Don't show debug information on enemy os
set debug_lvls {}
}
proc debugmsg {level msg} {
global debug_lvls
if {[lcontain $debug_lvls $level]} {
puts "$level: $msg"
}
}
proc rescmd {id res ls} {
puts "RESULT: $id $res $ls"
}
proc fullpath {args} {
return [eval file join [file dirname [info script]] $args]
}
proc load_source {args} {
set fullpath [eval fullpath $args]
puts "Loading $fullpath"
uplevel #0 source $fullpath
}
load_source $default_jlib jabberlib.tcl
package require jabberlib 0.8.2
load_source utils.tcl
load_source plugins.tcl
load_source balloon.tcl
load_source presence.tcl
load_source roster.tcl
load_source editgroups.tcl
load_source messages.tcl
load_source chats.tcl
load_source joingrdialog.tcl
load_source emoticons.tcl
load_source login.tcl
load_source browser.tcl
load_source userinfo.tcl
load_source iq.tcl
load_source datagathering.tcl
load_source search.tcl
load_source register.tcl
load_source filetransfer.tcl
load_source filters.tcl
postload
###### XML library hack
proc xml::XML:decrypt {text} {
return $text
}
proc ::LOG text {
debugmsg jlib "$text\n"
}
###############################################################################
# Interface
###############################################################################
set w {}
wm title $w. "Tkabber"
image create photo groupchat \
-file [fullpath gabber-pixmaps/glade-groupchat.gif]
image create photo newuser -file [fullpath gabber-pixmaps/glade-new-user.gif]
image create photo jb -file [fullpath pixmaps/jb.gif]
set descmenu {
"&Tkabber" {} {} 1 {
{cascad "Presence" {} presence 1 {
{command "Online" {} {} {} -command {set userstatus available}}
{command "Free for chat" {} {} {} -command {set userstatus chat}}
{command "Away" {} {} {} -command {set userstatus away}}
{command "Extended Away" {} {} {} -command {set userstatus xa}}
{command "Do not distrub" {} {} {} -command {set userstatus dnd}}
{command "Invisible" {} {} {} -command {set userstatus invisible}}
}}
{command "Log in..." {} {} {Ctrl l} -command {show_login_dialog}}
{command "Log out" {} {} {Ctrl f} -command {logout}}
{command "Log out with reason" {} {} {} -command {}}
{separator}
{command "Quit" {} {} {} -command {exit}}
{command "Profile on" {} {} {} -command {
profile -commands -eval on
}}
{command "Profile report" {} {} {} -command {
profile off profil
profrep profil cpu profresults
}}
}
"&Services" {} {} 1 {
{command "Send message" {} {} {} \
-command {message::send_dlg "" "" ""}}
{cascad "Roster" {} {} 1 {
{command "Add user" {} {} {} \
-command {message::send_subscribe_dlg ""}}
{command "Add conference" {} {} {} -command {add_group_dialog}}
}}
{command "Browser" {} {} {} -command {browser::open}}
{command "Join group" {} {} {} -command {join_group_dialog}}
{command "Filters" {} {} {} -command {filters::open}}
{separator}
{cascad "Admin tools" {} {} 1 {
{command "Send broadcast message" {} {} {} \
-command {eval {message::send_dlg \
"$loginconf(server)/announce/online" \
{} {}}}}
}}
}
"&Help" {} {} 1 {
{command "Quick help" {} {} {} -command {
MessageDlg .m -anchor center -aspect 50000 -title "Quick help" \
-type user -buttons Ok -message "
Tabs:
Close tab C-F4
Next tab C-PgDown
Previous tab C-PgUp
Hide/Show roster C-r
Chats:
Complete nick TAB
Previous history message C-Up
Next history message C-Down
"
}}
{command "About" {} {} {} -command {
MessageDlg .m -anchor center -aspect 50000 -title About \
-type user -buttons Ok -message "Tkabber $version
Copyright (c) 2002 Alexey Shchepin
Author: Alexey Shchepin
http://www.jabber.ru/projects/tkabber/
"
}}
}
}
set mf [MainFrame .mainframe -menu $descmenu -textvariable status]
pack $mf -expand yes -fill both
bind $mf <Destroy> {
jlib::disconnect
exit
}
set toolbar [$mf addtoolbar]
set bbox [ButtonBox $toolbar.bbox -spacing 0 -padx 1 -pady 1]
$bbox add -image newuser \
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
-padx 1 -pady 1 -command {message::send_subscribe_dlg ""} \
-helptext "Add new user"
$bbox add -image jb \
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
-padx 1 -pady 1 -command {browser::open} \
-helptext "Jabber Browser"
$bbox add -image groupchat \
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
-padx 1 -pady 1 -command {join_group_dialog} \
-helptext "Join conference"
$bbox add -text O \
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
-padx 1 -pady 1 -command {roster::switch_only_online} \
-helptext "Show only online users"
if {$usetabbar} {
$bbox add -text T \
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
-padx 1 -pady 1 -command {} \
-helptext "Open new windows in tabbar"
}
pack $bbox -side left -anchor w
menubutton .presence -menu .presence.menu -relief raised \
-textvariable userstatusdesc -direction above
pack .presence -side bottom -anchor w -in [$mf getframe]
set m [menu $w.presence.menu]
$m add command -label "Online" -command {set userstatus available}
$m add command -label "Free for chat" -command {set userstatus chat}
$m add command -label "Away" -command {set userstatus away}
$m add command -label "Extended Away" -command {set userstatus xa}
$m add command -label "Do not distrub" -command {set userstatus dnd}
$m add command -label "Invisible" -command {set userstatus invisible}
if {$usetabbar} {
set pw [PanedWindow [$mf getframe].pw -side bottom]
pack $pw -fill both -expand yes
set rw [$pw add -minsize 0 -weight 0]
set nw [$pw add -minsize 32 -weight 4]
roster::create $w.roster -width 150 -height 300 -popup roster::popup_menu
pack $w.roster -expand yes -fill both -side left -in $rw
NoteBook .nb -width 400
pack .nb -side right -in $nw -fill both -expand yes
bind . <Control-Key-r> {collapse_roster}
bind . <Control-Prior> {tab_move .nb -1}
bind . <Control-Next> {tab_move .nb 1}
bind . <Control-Key-F4> {
if {[.nb raise] != ""} {
eval destroy [pack slaves [.nb getframe [.nb raise]]]
.nb delete [.nb raise] 1
tab_move .nb 0
}
}
set m [menu .tabsmenu -tearoff 0]
$m add command -label "Close" -accelerator C-F4 \
-command {
if {[.nb raise] != ""} {
eval destroy [pack slaves [.nb getframe $curmenutab]]
.nb delete $curmenutab 1
tab_move .nb 0
}
}
.nb bindtabs <3> {tab_menu %X %Y}
wm geometry . 788x550
} else {
roster::create $w.roster -width 150 -height 300 -popup roster::popup_menu
pack $w.roster -expand yes -fill both -side left -in [$mf getframe]
}
proc add_win {path args} {
global usetabbar
set title ""
set tabtitle ""
set class ""
set raisecmd ""
foreach {attr val} $args {
switch -- $attr {
-title {set title $val}
-tabtitle {set tabtitle $val}
-class {set class $val}
-raisecmd {set raisecmd $val}
default {error "Unknown option $attr"}
}
}
if {$usetabbar} {
set page [crange [win_id tab $path] 1 end]
#regsub -all {[[:space:]]} $page _ page
set f [.nb insert end $page -text $tabtitle -raisecmd $raisecmd]
frame $path -class $class
pack $path -expand yes -fill both -in $f
#tkwait visibility $path
after idle .nb raise $page
} else {
toplevel $path -class $class
wm title $path $title
}
}
proc tab_move {nb shift} {
set len [llength [$nb pages]]
if {$len > 0} {
set newidx [expr [$nb index [$nb raise]] + $shift]
if {$newidx < 0} {
set newidx [expr $len - 1]
} elseif {$newidx >= $len} {
set newidx 0
}
$nb see [lindex [$nb pages] $newidx]
$nb raise [lindex [$nb pages] $newidx]
}
}
proc tab_set_updated {path updated} {
global usetabbar
if {$usetabbar} {
set page [crange [win_id tab $path] 1 end]
update idletasks
#if {$page == [.nb raise]} {return}
if {$updated && $page != [.nb raise]} {
set color Red
} else {
set color Black
}
#.nb.c itemconfigure $page:text -fill $color
if {[.nb itemconfigure $page -foreground] != $color} {
.nb itemconfigure $page -foreground $color
}
#puts "$path $updated $page $color [.nb raise]"
}
}
proc tab_menu {x y page} {
global curmenutab
set curmenutab $page
tk_popup .tabsmenu $x $y
}
###############################################################################
proc collapse_roster {} {
global rw
[winfo parent $rw] configure -width 0
bind . <Control-Key-r> {uncollapse_roster}
}
proc uncollapse_roster {} {
global rw
[winfo parent $rw] configure -width 4c
bind . <Control-Key-r> {collapse_roster}
}
###############################################################################
set status_afterid ""
proc set_status {text} {
global status
global status_afterid
after cancel $status_afterid
set status $text
set status_afterid [after 5000 clear_status]
}
proc clear_status {} {
global status
set status ""
}
###############################################################################
if {[file exists proton.tcl]} {
# show_login_dialog
login
} else {
show_login_dialog
}