File: remotegui.tcl

package info (click to toggle)
tik 0.90-1
  • links: PTS
  • area: main
  • in suites: sarge, woody
  • size: 1,200 kB
  • ctags: 557
  • sloc: tcl: 11,323; makefile: 65; sh: 54
file content (278 lines) | stat: -rw-r--r-- 9,100 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
# Remote Administration GUI Package
# Written by MZhang and Daspek
#
# $Revision: 1.7 $

# All packages must be inside a namespace with the
# same name as the file name.

# Set VERSION and VERSDATE using the CVS tags.
namespace eval remotegui {     
  regexp -- {[0-9]+\.[0-9]+} {@(#)TiK Remote Administration GUI package $Revision: 1.7 $} \
      ::remotegui::VERSION
  regexp -- { .* } {:$Date: 2000/11/04 03:03:22 $} \
      ::remotegui::VERSDATE
}


# Options the user might want to set.  A user should use
# set ::TIK(options,...), not the tik_default_set

namespace eval remotegui {

    # Must export at least: load, unload, goOnline, goOffline
    namespace export load unload goOnline goOffline

    variable info

    # All packages must have a load routine.  This should do most
    # of the setup for the package.  Called only once.
    proc load {} {
        toc_register_func * IM_IN remotegui::IM_IN
        toc_register_func * toc_send_im remotegui::IM_OUT
        tik_register_filter * IM_IN remotegui::filter_IN
        tik_register_filter * IM_OUT remotegui::filter_OUT
        menu .remoteguiMenu -tearoff 0
        .toolsMenu add cascade -label [tik_str P_REMOTEGUI_M] -menu .remoteguiMenu
        .remoteguiMenu add command -label [tik_str P_REMOTEGUI_NEW] \
                -command remotegui::newrgui
        remotegui::enable
    }

    proc enable { {unload 0} } {
        if {!$unload} {
            set ::TIK(remoteguiuse) ""
        } else {
            catch {unset ::TIK(remoteguiuse)}
        }
    }

    # All pacakges must have goOnline routine.  Called when the user signs
    # on, or if the user is already online when packages loaded.
    proc goOnline {} {
    }

    # All pacakges must have goOffline routine.  Called when the user signs
    # off.  NOT called when the package is unloaded.
    proc goOffline {} {
    }

    # All packages must have a unload routine.  This should remove everything 
    # the package set up.  This is called before load is called when reloading.
    proc unload {} {
        toc_unregister_func * IM_IN remotegui::IM_IN
        toc_unregister_func * toc_send_im remotegui::IM_OUT
        tik_unregister_filter * IM_IN remotegui::filter_IN
        tik_unregister_filter * IM_OUT remotegui::filter_OUT
        remotegui::enable 1
        .toolsMenu delete [tik_str P_REMOTEGUI_M]
        destroy .remoteguiMenu
    }

    proc IM_IN {connName nick msg auto} {
        if {![info exists ::TIK(remoteguiuse)]} {
            return
        }
        set server [normalize $nick]
        if {[regexp {>>>>.*<<<<} $msg]} {
            if {[winfo exists .rgui$server]} {
                $remotegui::info(rguis,$server) configure -state normal
                addHTML $remotegui::info(rguis,$server) "Server: $msg\n" 1
                $remotegui::info(rguis,$server) configure -state disabled
#                if {[info exists remotegui::info(closenow,$server)]} {
#                    destroy .rgui$server
#                    unset remotegui::info(closenow,$server)
#                }
            }  else {
                tik_receive_im $nick $auto $msg F
            }
        }
    }

    proc IM_OUT {name source msg auto} {
        if {![info exists ::TIK(remoteguiuse)]} {
            return
        }
        set server [normalize $name]
        if {[regexp {<!--(\[.*\])-->} $msg match cmd]} {
            regsub {\[login(\s)\S+\]} $cmd {[login\1(password suppressed)]} cmd
            set msg ">>>>Remote Administration command sent: $cmd<<<<"
            if {[winfo exists .rgui$server]} {
                $remotegui::info(rguis,$server) configure -state normal
                addHTML $remotegui::info(rguis,$server) "Client: $msg\n" 1
                $remotegui::info(rguis,$server) configure -state disabled
            }  else {
                tik_receive_im $source $auto $msg T
            }
        }
    }
    
    proc send {server w {remoteproc "_none_"} } {
	if {$remoteproc == "_none_"} {
	    set remoteproc ""
	}

        if {![winfo exists $w]} {
            return
        }
        set cmd [$w.e get]
	if {$remoteproc != "_none_"} {
	    set cmd "$remoteproc $cmd"
	    set cmd [string trim $cmd]
	}
        if {$cmd == ""} {
            return
        }
        toc_send_im $::NSCREENNAME $server "<!--\[$cmd\]-->"
        $w.e delete 0 end
    }
    
    proc closeconn {server} {
        if {![winfo exists .rgui$server]} {
            return
        }
        if {$::BUDDIES($server,online)} {
            toc_send_im $::NSCREENNAME $server "<!--\[logoff\]-->"
        }
        set remotegui::info(closenow,$server) ""
        destroy .rgui$server
        unset remotegui::info(closenow,$server) ""
    }
    
    proc cmdsend {server cmd} {
	sflap::send $::NSCREENNAME "toc_send_im $server [encode <!--\[$cmd\]-->]"
    }

    proc create_rgui {} {
        if {![winfo exists .newrgui]} {
            return
        }
        set name [.newrgui.server.e get]
        set passwd [.newrgui.passwd.e get]
        set server [normalize $name]
        if {$server == ""} {
            tk_messageBox -type ok -message [tik_str P_REMOTEGUI_ENTER_SERVER]
            raise .newrgui
            focus .newrgui.server.e
            return
        }

        if {![tik_is_buddy $server]} {
            tk_messageBox -type ok -message [tik_str P_REMOTEGUI_INVALID_SERVER]
            raise .newrgui
            focus .newrgui.server.e
            return
        }

        if {$::BUDDIES($server,online) == "F"} {
            tk_messageBox -type ok -message [tik_str P_REMOTEGUI_NOTONLINE]
            raise .newrgui
            focus .newrgui.server.e
            return
        }

        destroy .newrgui
        set w .rgui$server
        
        if {[winfo exists $w]} {
            raise $w
        }    
        
        toplevel $w -class Tik
        wm title $w [tik_str P_REMOTEGUI_TITLE $name]
        wm iconname $w [tik_str P_REMOTEGUI_ICON $name]
        
        set remotegui::info(rguis,$server) [createHTML $w.textF]
        pack $w.textF -fill both -expand 1 -side top
	frame $w.entry
        entry $w.e

        frame $w.buttons
	
	#if {$::TIK(options,iconbuttons)} {
	#    button $w.send -image bsend -command "remotegui::send $server $w"
	#    button $w.close -image bclose -command "remotegui::closeconn $server"
	#} else {
	    button $w.set -text [tik_str P_REMOTEGUI_SETAWAY] -command "remotegui::send $server $w setaway"
	    button $w.back -text [tik_str P_REMOTEGUI_SETBACK] -command "remotegui::cmdsend $server setback"
	    button $w.send -text [tik_str B_SEND] -command "remotegui::send $server $w"
	    button $w.close -text [tik_str B_CLOSE] -command "remotegui::closeconn $server"
        #}

	pack $w.e -fill x -in $w.entry
	pack $w.entry -fill x
        pack $w.set $w.back -in $w.buttons -side left -padx 2m
	pack $w.send $w.close -in $w.buttons -side left -padx 2m
        pack $w.buttons -pady 2
	

        #pack $w.e -fill x -side bottom

        bind $w.e <Return> "$w.send invoke"
        $remotegui::info(rguis,$server) configure -state disabled
        set loginstring "<!--\[login $passwd\]-->"
        sflap::send $::NSCREENNAME "toc_send_im $server [encode $loginstring]"
        focus $w.e
        wm protocol $w WM_DELETE_WINDOW "remotegui::closeconn $server"
    }
    
    proc newrgui {} {
        set w .newrgui

        if {[winfo exists $w]} {
            raise $w
            return
        }

        toplevel $w -class Tik
        if {$::TIK(options,windowgroup)} {wm group $w .login}
        wm title $w [tik_str P_REMOTEGUI_NEW_TITLE]
        wm iconname $w [tik_str P_REMOTEGUI_NEW_ICON]

        frame $w.server
        label $w.server.l -text [tik_str P_REMOTEGUI_SERVER] -width 15
        entry $w.server.e
        pack $w.server.l $w.server.e -side left
        pack $w.server -side top
        frame $w.passwd
        label $w.passwd.l -text [tik_str P_REMOTEGUI_PASSWD] -width 15
        entry $w.passwd.e -show "*"
        pack $w.passwd.l $w.passwd.e -side left
        pack $w.passwd -side top
        
        frame $w.buttons

	if {$::TIK(options,iconbuttons)} {
	    button $w.ok -image bok -command "remotegui::create_rgui"
	    button $w.cancel -image bclose -command [list destroy $w]
	} else {
	    button $w.ok -text [tik_str B_OK] -command "remotegui::create_rgui"
	    button $w.cancel -text [tik_str B_CANCEL] -command [list destroy $w]
	}
        
        pack $w.ok $w.cancel -in $w.buttons -side left -padx 2m
        pack $w.buttons -side bottom
        bind $w.server.e <Return> "focus $w.passwd.e"
        bind $w.passwd.e <Return> "remotegui::create_rgui"
        focus $w.server.e
    }

    proc filter_OUT {connName msg args} {
        if {[info exists ::TIK(remoteguiuse)]} {
            if {[regexp {<!--\[.*\]-->} $msg]} {
                return
            }
        }   
        return $msg
    }

    proc filter_IN {connName msg args} {
        if {[info exists ::TIK(remoteguiuse)]} {
            if {[regexp {>>>>.*<<<<} $msg]} {
                return
            }
        }
        return $msg
    }

}