~ubuntu-branches/ubuntu/gutsy/amsn/gutsy

« back to all changes in this revision

Viewing changes to plugins.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Theodore Karkoulis
  • Date: 2006-01-04 15:26:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060104152602-ipe1yg00rl3nlklv
Tags: 0.95-1
New Upstream Release (closes: #345052, #278575).

Show diffs side-by-side

added added

removed removed

Lines of Context:
5
5
#####################################################
6
6
 
7
7
proc plugins_log {plugin msg} {
8
 
    status_log "Plugins System : $plugin : $msg\n"
 
8
        if {[info procs "::pluginslog::plugins_log"] == "::pluginslog::plugins_log"} {
 
9
                ::pluginslog::plugins_log $plugin $msg
 
10
        } else {
 
11
                status_log "Plugins System: $plugin: $msg"
 
12
        }
9
13
}
10
14
 
11
15
namespace eval ::plugins {
13
17
        # Do NOT access this variable directly, use ::plugins::findplugins
14
18
        variable found [list]
15
19
        namespace export PostEvent
16
 
    
 
20
 
17
21
        if { $initialize_amsn == 1 } {
18
22
                # The id of the currently selected plugin (also it's it in teh listbox)
19
23
                set selection(id) ""            
43
47
                variable cur_config
44
48
        }
45
49
 
46
 
        if {[package vcompare [package provide Tcl] 8.4] < 0} {
47
 
                proc lset { list index1 index2 newvalue } {
48
 
                        return [list [lrange $list 0 [expr $index1 -1]] $newvalue [lrange $list [expr $index2 + 1] end] ]
49
 
                }
50
 
        }
51
 
 
52
50
 
53
51
        ###############################################################
54
52
        # PostEvent (event, argarray)
65
63
        proc PostEvent { event var } {
66
64
                variable pluginsevents 
67
65
 
68
 
                status_log "Plugins System: Calling event $event with variable $var\n"
 
66
                plugins_log core "Calling event $event with variable $var\n"
69
67
        
70
68
                if { [info exists pluginsevents(${event}) ] } { # do we have any procs for the event?
71
69
                        foreach cmd $pluginsevents(${event}) { # let's call all of them
72
 
                                status_log "Plugins System: Executing $cmd\n"
 
70
                                plugins_log core "Executing $cmd\n"
73
71
                                catch { eval $cmd $event $var } res ; # call
74
 
                                status_log "Plugins System: Return $res from event handler $cmd\n"
 
72
                                plugins_log core "Return $res from event handler $cmd\n"
75
73
                        }
76
74
                }
77
75
        }
92
90
        proc RegisterPlugin { plugin } {
93
91
                variable knownplugins
94
92
        
95
 
                status_log "Plugins System: RegisterPlugin called with $plugin\n"
 
93
                plugins_log core "RegisterPlugin called with $plugin\n"
96
94
                if { [lsearch $knownplugins "$plugin"] != -1} { # Already registered?
97
95
                        status_log "Plugin System: Trying to register a plugin twice..\n"
98
96
                        return 0 ; #Yup, no need to do it again.
99
97
                }
100
98
                lappend knownplugins $plugin
101
99
 
102
 
                status_log "Plugins System: New plugin :\nName : [lindex $plugin 0]\n                            "
 
100
                plugins_log core "New plugin :\nName : [lindex $plugin 0]\n                            "
103
101
                return 1; # First timer :D
104
102
        }
105
103
    
124
122
                status_log "Plugin Systems: RegisterEvent called with $plugin $event $cmd\n"
125
123
 
126
124
                if { [lsearch $knownplugins $plugin] == -1 } { # UnRegistered?
127
 
                        status_log "Plugins System: Registering an event for an unknown plugin...\n"
 
125
                        plugins_log core "Registering an event for an unknown plugin...\n"
128
126
                        return; # Bye Bye
129
127
                }
130
 
                set pluginidx [lindex [lsearch -all $::plugins::found "*$plugin*"] 0]
131
 
                if { $pluginidx == "" } {
 
128
                set pluginidx [lsearch -glob $::plugins::found "*$plugin*"]
 
129
                if { $pluginidx == -1 } {
132
130
                        return
133
131
                }
134
 
                set namespace [lindex $::plugins::found $pluginidx 6]
 
132
                set namespace [lindex [lindex $::plugins::found $pluginidx] 6]
135
133
 
136
134
                if {[lsearch -exact [array names pluginsevents $event] $event]!=-1} { # Will error if I search with empty key
137
135
                        if {[lsearch $pluginsevents(${event}) "\:\:$namespace\:\:$cmd"] != -1 } { # Event already registered?
138
 
                                status_log "Plugins System: Trying to register a event twice"
 
136
                                plugins_log core "Trying to register a event twice"
139
137
                                return; # Bye Bye
140
138
                        }
141
139
                }
142
140
 
143
 
                status_log "Plugins System: Binding $event to $cmd\n"
 
141
                plugins_log core "Binding $event to $cmd\n"
144
142
                lappend pluginsevents(${event}) "\:\:$namespace\:\:$cmd"; # Add the command to the list
145
143
        }
146
144
 
162
160
                # get the event list
163
161
                variable pluginsevents
164
162
 
165
 
                set pluginidx [lindex [lsearch -all $::plugins::found "*$plugin*"] 0]
166
 
                if { $pluginidx == "" } {
 
163
                set pluginidx [lsearch -glob $::plugins::found "*$plugin*"]
 
164
                if { $pluginidx == -1 } {
167
165
                        return
168
166
                }
169
 
                set namespace [lindex $::plugins::found $pluginidx 6]
 
167
                set namespace [lindex [lindex $::plugins::found $pluginidx] 6]
170
168
 
171
169
                # do stuff only if there is a such a command for the event
172
170
                #TODO: do we need to check if such a event exists?
173
 
                if {[lsearch $pluginsevents(${event}) "\:\:$namespace\:\:$cmd"] != -1} {
 
171
                set pos [lsearch $pluginsevents(${event}) "\:\:$namespace\:\:$cmd"]
 
172
                if {$pos != -1} {
174
173
                        # the long erase way to remove a item from the list
175
 
                        set pluginsevents(${event}) [lreplace $pluginsevents(${event}) \
176
 
                                [lsearch $pluginsevents(${event}) "\:\:$namespace\:\:$cmd"] \
177
 
                                [expr [lsearch $pluginsevents(${event}) "\:\:$namespace\:\:$cmd"] +1] ""]
178
 
                        status_log "Plugins System: Event \:\:$namespace\:\:$cmd on $event unregistered ...\n"
 
174
                        set pluginsevents(${event}) [lreplace $pluginsevents(${event}) $pos $pos]
 
175
                        plugins_log core "Event \:\:$namespace\:\:$cmd on $event unregistered ...\n"
179
176
                } else {
180
 
                        status_log "Plugins System: Trying to unregister a unknown event...\n"
 
177
                        plugins_log core "Trying to unregister a unknown event...\n"
181
178
                }
182
179
        }
183
180
    
195
192
        proc UnRegisterEvents { plugin } {
196
193
                # event list
197
194
                variable pluginsevents
198
 
                set pluginidx [lindex [lsearch -all $::plugins::found "*$plugin*"] 0]
199
 
                if { $pluginidx == "" } {
 
195
                set pluginidx [lsearch $::plugins::found *$plugin*]
 
196
                if { $pluginidx == -1 } {
200
197
                        return
201
198
                }
202
 
                set namespace [lindex $::plugins::found $pluginidx 6]
 
199
                set namespace [lindex [lindex $::plugins::found $pluginidx] 6]
203
200
 
204
201
                # go through each event
205
202
                foreach {event} [array names pluginsevents] {
206
203
                        # While there is a command in the list that belongs to the 
207
204
                        # plugins namespace, give it's index to x and delete it
208
205
                        while { [set x [lsearch -regexp $pluginsevents(${event}) "\:\:$namespace\:\:*" ]] != -1 } {
209
 
                                status_log "Plugins System: UnRegistering command $x from $pluginsevents(${event})...\n"
 
206
                                plugins_log core "UnRegistering command $x from $pluginsevents(${event})...\n"
210
207
                                # the long remove item procedure
211
208
                                # TODO: move this into a proc?
212
 
                                set pluginsevents(${event}) [lreplace $pluginsevents(${event}) $x [expr $x +1] ""]
 
209
                                set pluginsevents(${event}) [lreplace $pluginsevents(${event}) $x $x]
213
210
                        }
214
211
                }
215
212
        }
216
213
 
217
 
 
 
214
        ###############################################################
 
215
        # calledFrom ()
 
216
        #
 
217
        # Finds out if a proc was called by a plugin.
 
218
        #
 
219
        # Arguments
 
220
        # none
 
221
        #
 
222
        # Return
 
223
        # -1 - not called by a plugin
 
224
        # $pluginnamespace - the namespace of the plugin calling the proc
 
225
        #
 
226
 
 
227
        proc calledFrom {} {
 
228
                #check for execution from the top level
 
229
                set l [info level]
 
230
                if {$l < 3} {
 
231
                        return -1
 
232
                }
 
233
            set proc [info level -2]
 
234
            #will create the following list if called from namespace:
 
235
            # {} {} namespace {} proc
 
236
            #anyone know how to fix this?
 
237
            set parts [split $proc ":"]
 
238
 
 
239
 
 
240
            if {[llength $parts] > 1} {
 
241
                #see above comment why '2'
 
242
                set namespace [lindex $parts 2]
 
243
            } else {
 
244
                #it is just a top level proc :(
 
245
                return -1
 
246
            }
 
247
 
 
248
            if {[::plugins::namespaceExists $namespace] == 1} {
 
249
                return $namespace
 
250
            } else {
 
251
                #this namespace dosn't belong to any plugin
 
252
                return -1
 
253
            }
 
254
        }
 
255
 
 
256
        ###############################################################
 
257
        # namespaceExists (namespace)
 
258
        #
 
259
        # finds out if a namespace belongs to a plugin
 
260
        #
 
261
        # Arguments
 
262
        # namespace - namespace to check for (without ::)
 
263
        #
 
264
        # Return
 
265
        # -1 - nope
 
266
        # 1 - yup
 
267
        #
 
268
 
 
269
        proc namespaceExists {namespace} {
 
270
            variable plugins
 
271
        
 
272
            #get info
 
273
            set plist [array get plugins]
 
274
            #loop till something returns
 
275
            while {1} {
 
276
                #it's not there!
 
277
                set idx [lsearch -exact $plist $namespace]
 
278
                if {$idx == -1} {
 
279
                    return -1
 
280
                }
 
281
                
 
282
                #is this an actual key?
 
283
                set key [lindex $plist [expr {$idx -1}] ]
 
284
                #will return the following list if a namespace
 
285
                # idx plugin namespace
 
286
                set klist [split $key "_"]
 
287
                if {[lindex $klist 2] == "namespace"} {
 
288
                    return 1
 
289
                }
 
290
 
 
291
                #make the list from last found to end so we won't be searching the same item
 
292
                set plist [lrange $plist [expr {$idx + 1}] end]
 
293
            }
 
294
        }
 
295
 
 
296
 
 
297
        ###############################################################
 
298
        # updatePluginsArray ()
 
299
        #
 
300
        # Updates the plugins array which holds info about plugins
 
301
        #
 
302
        # Arguments
 
303
        # none
 
304
        #
 
305
        # Return
 
306
        # number of plugins in array
 
307
        #
 
308
        
 
309
        proc updatePluginsArray { } {
 
310
            variable plugins
 
311
            set idx 0
 
312
            foreach plugin [findplugins] {
 
313
                # extract the info
 
314
                set name [lindex $plugin 0]
 
315
                set author [lindex $plugin 1]
 
316
                set desc [lindex $plugin 2]
 
317
                set required_amsn_version [lindex $plugin 3]
 
318
                set plugin_version [lindex $plugin 4]
 
319
                set plugin_file [lindex $plugin 5]
 
320
                set plugin_namespace [lindex $plugin 6]
 
321
                set init_proc [lindex $plugin 7]
 
322
                
 
323
                # add the info to our plugins array in the form counterid_infotype
 
324
                # the counterid is the same as the id of the plugin in the listbox
 
325
                set plugins(${idx}_name) $name
 
326
                set plugins(${idx}_author) $author
 
327
                set plugins(${idx}_desc) $desc
 
328
                set plugins(${idx}_required_amsn_version) $required_amsn_version
 
329
                set plugins(${idx}_plugin_version) $plugin_version
 
330
                set plugins(${idx}_plugin_file) $plugin_file
 
331
                set plugins(${idx}_plugin_namespace) $plugin_namespace
 
332
                set plugins(${idx}_init_proc) $init_proc
 
333
                incr idx
 
334
            }
 
335
            return $idx
 
336
        }
 
337
        
 
338
        
218
339
        ###############################################################
219
340
        # findplugins ()
220
341
        #
238
359
                lappend search_path [file join [set ::program_dir] plugins]
239
360
                lappend search_path [file join $HOME plugins]
240
361
                lappend search_path [file join $HOME2 plugins]
241
 
 
 
362
                lappend search_path [file join $HOME2 amsn-extras plugins]
 
363
            
242
364
                # decrare the list to return
243
365
                set ::plugins::found [list]
244
366
                set idx 0
248
370
                        # for each file names plugin.tcl that is in any directory, do stuff
249
371
                        # -nocomplain is used to shut errors up if no plugins found
250
372
                        foreach file [glob -nocomplain -directory $dir */plugininfo.xml] {
251
 
                                status_log "Plugins System: Found plugin files in $file\n"
 
373
                                plugins_log core "Found plugin files in $file\n"
252
374
                                if { [::plugins::LoadInfo $file] } {
253
 
                                        lset ::plugins::found $idx 5 [file join [file dirname $file] \
254
 
                                                [lindex [lindex $::plugins::found $idx] 5]]
 
375
                                        set newdir [lindex [lindex $::plugins::found $idx] 5]
 
376
                                        lset ::plugins::found $idx 5 [file join [file dirname $file] $newdir]
255
377
                                        incr idx
256
378
                                }
257
379
                        }
283
405
                                sxml::end $plugin_info
284
406
                                status_log "PLUGINS INFO READ\n" green
285
407
                        } res] } {
286
 
                                msg_box "ERROR: PLUGIN HAS MALFORMED XML PLUGININFO"
 
408
                                msg_box "ERROR: PLUGIN HAS MALFORMED XML PLUGININFO ($path)"
287
409
                                return 0
288
410
                        }
289
411
                }
312
434
                        set deinit $sdata(${cstack}:deinit_procedure)
313
435
                }
314
436
 
315
 
                lappend ::plugins::found [list $sdata(${cstack}:name) $sdata(${cstack}:author) $sdata(${cstack}:description) \
316
 
                        $sdata(${cstack}:amsn_version) $sdata(${cstack}:plugin_version) $sdata(${cstack}:plugin_file) \
317
 
                        $sdata(${cstack}:plugin_namespace) $sdata(${cstack}:init_procedure) $deinit]
 
437
                lappend ::plugins::found [list \
 
438
                                $sdata(${cstack}:name) \
 
439
                                $sdata(${cstack}:author) \
 
440
                                $sdata(${cstack}:description) \
 
441
                                $sdata(${cstack}:amsn_version) \
 
442
                                $sdata(${cstack}:plugin_version) \
 
443
                                $sdata(${cstack}:plugin_file) \
 
444
                                $sdata(${cstack}:plugin_namespace) \
 
445
                                $sdata(${cstack}:init_procedure) \
 
446
                                $deinit \
 
447
                ]
318
448
 
319
449
                return 0
320
450
        }
353
483
                set w .plugin_selector
354
484
                # if the window already exists, focus it, otherwise create it
355
485
                if {[winfo exists $w]==1} {
356
 
                        focus $w
 
486
                        raise $w
357
487
                } else {
358
488
                        # create window and give it it's title
359
489
                        toplevel $w
360
490
                        wm title $w [trans pluginselector]
361
491
                        # create widgets
362
 
                        # frame that holds the selection dialog
363
 
                        frame $w.select
364
492
                        # listbox with all the plugins
365
 
                        listbox $w.select.plugin_list -background "white" -height 15
366
 
                        # frame that holds the plugins info like name and description
367
 
                        frame $w.desc
368
 
                        label $w.desc.name_title -text [trans name] -font sboldf
369
 
                        label $w.desc.name
370
 
                        label $w.desc.author_title -text [trans author] -font sboldf
371
 
                        label $w.desc.author
372
 
                        label $w.desc.desc_title -text [trans description] -font sboldf
373
 
                        label $w.desc.desc -textvariable ::plugins::selection(desc) -width 40 \
374
 
                                -wraplength 250 -justify left -anchor w
375
 
                        # frame that holds the 'command center' buttons
376
 
                        frame $w.command
377
 
                        #TODO: translate "load"
378
 
                        button $w.command.load -text "[trans load]" -command "::plugins::GUI_Load" -state disabled
379
 
                        button $w.command.config -text "[trans configure]" -command "::plugins::GUI_Config" ;#-state disabled
380
 
                        button $w.command.close -text [trans close] -command "::plugins::GUI_Close"
 
493
                        listbox $w.plugin_list -background "white" -height 15 -yscrollcommand "$w.ys set" -relief flat -highlightthickness 0
 
494
                        scrollbar $w.ys -command "$w.plugin_list yview"
 
495
 
 
496
 
 
497
                        # holds the plugins info like name and description
 
498
                        label $w.name_title -text [trans name] -font sboldf
 
499
                        label $w.name
 
500
                        label $w.version_title -text [trans version] -font sboldf
 
501
                        label $w.version
 
502
                        label $w.author_title -text [trans author] -font sboldf
 
503
                        label $w.author
 
504
                        label $w.desc_title -text [trans description] -font sboldf
 
505
                        label $w.desc -textvariable ::plugins::selection(desc) -width 40 \
 
506
                                -wraplength 300 -justify left -anchor w
 
507
                        # holds the 'command center' buttons
 
508
                        button $w.load -text "[trans load]" -command "::plugins::GUI_Load" -state disabled
 
509
                        button $w.config -text "[trans configure]" -command "::plugins::GUI_Config" ;#-state disabled
 
510
                        button $w.close -text [trans close] -command "::plugins::GUI_Close"
381
511
 
382
 
                        # add the plugins to the list
383
 
                        # idx will be used as a counter
384
 
                        set idx 0
385
512
                        # loop through all the found plugins
386
 
                        foreach plugin [findplugins] {
387
 
                                # extract the info
388
 
                                set name [lindex $plugin 0]
389
 
                                set author [lindex $plugin 1]
390
 
                                set desc [lindex $plugin 2]
391
 
                                set required_amsn_version [lindex $plugin 3]
392
 
                                set plugin_version [lindex $plugin 4]
393
 
                                set plugin_file [lindex $plugin 5]
394
 
                                set plugin_namespace [lindex $plugin 6]
395
 
                                set init_proc [lindex $plugin 7]
396
 
 
397
 
                                # add the info to our plugins array in the form counterid_infotype
398
 
                                # the counterid is the same as the id of the plugin in the listbox
399
 
                                set plugins(${idx}_name) $name
400
 
                                set plugins(${idx}_author) $author
401
 
                                set plugins(${idx}_desc) $desc
402
 
                                set plugins(${idx}_required_amsn_version) $required_amsn_version
403
 
                                set plugins(${idx}_plugin_version) $plugin_version
404
 
                                set plugins(${idx}_plugin_file) $plugin_file
405
 
                                set plugins(${idx}_plugin_namespace) $plugin_namespace
406
 
                                set plugins(${idx}_init_proc) $init_proc
407
 
                
408
 
                                # add the plugin name to the list at counterid position
409
 
                                $w.select.plugin_list insert $idx $name
410
 
                                # if the plugin is loaded, color it one color. otherwise use other colors
411
 
                                #TODO: Why not use skins?
412
 
                                if {[lsearch "$loadedplugins" $name] != -1} {
413
 
                                        $w.select.plugin_list itemconfigure $idx -background #DDF3FE
414
 
                                } else {
415
 
                                        $w.select.plugin_list itemconfigure $idx -background #FFFFFF
416
 
                                }
417
 
                                # increase the counter
418
 
                                incr idx
419
 
                        }
420
 
 
 
513
                        set plugs [::plugins::updatePluginsArray]
 
514
                        for {set idx 0} {$idx < $plugs} {incr idx} {
 
515
                            # add the plugin name to the list at counterid position
 
516
                            $w.plugin_list insert $idx $plugins(${idx}_name)
 
517
                            # if the plugin is loaded, color it one color. otherwise use other colors
 
518
                            #TODO: Why not use skins?
 
519
                            if {[lsearch "$loadedplugins" $plugins(${idx}_name)] != -1} {
 
520
                                $w.plugin_list itemconfigure $idx -background #DDF3FE
 
521
                            } else {
 
522
                                $w.plugin_list itemconfigure $idx -background #FFFFFF
 
523
                            }
 
524
                        }
 
525
                        if {$idx > "15"} {
 
526
                                $w.plugin_list configure -height $idx
 
527
                        }
421
528
                        #do the bindings
422
 
                        bind $w.select.plugin_list <<ListboxSelect>> "::plugins::GUI_NewSel"
 
529
                        bind $w.plugin_list <<ListboxSelect>> "::plugins::GUI_NewSel"
423
530
                        bind $w <<Escape>> "::plugins::GUI_Close"
424
531
 
425
 
                        # display the widgets
426
 
                        grid $w.select.plugin_list -row 1 -column 1 -sticky nsew
427
 
                        grid $w.desc.name_title -row 1 -column 1 -sticky w -padx 10
428
 
                        grid $w.desc.name -row 2 -column 1 -sticky w -padx 20
429
 
                        grid $w.desc.author_title -row 3 -column 1 -sticky w -padx 10
430
 
                        grid $w.desc.author -row 4 -column 1 -sticky w -padx 20
431
 
                        grid $w.desc.desc_title -row 5 -column 1 -sticky w -padx 10
432
 
                        grid $w.desc.desc -row 6 -column 1 -sticky w -padx 20
433
 
                        grid $w.command.load -column 1 -row 1 -sticky e -padx 5 -pady 5
434
 
                        grid $w.command.config -column 2 -row 1 -sticky e -padx 5 -pady 5
435
 
                        grid $w.command.close -column 3 -row 1 -sticky e -padx 5 -pady 5
436
 
                        #grid the frames
437
 
                        grid $w.select -column 1 -row 1 -rowspan 2 -sticky nw
438
 
                        grid $w.desc -column 2 -row 1 -sticky n
439
 
                        grid $w.command -column 1 -row 2 -columnspan 2 -sticky se
440
 
                }
441
 
 
442
 
                # not really sure what this does...
 
532
                        pack $w.plugin_list -fill both -side left
 
533
                        pack $w.ys -fill both -side left
 
534
                        pack $w.name_title -padx 5 -anchor w
 
535
                        pack $w.name -padx 5 -anchor w
 
536
                        pack $w.version_title -padx 5 -anchor w
 
537
                        pack $w.version -padx 5 -anchor w 
 
538
                        pack $w.author_title -padx 5 -anchor w
 
539
                        pack $w.author -padx 5 -anchor w
 
540
                        pack $w.desc_title -padx 5 -anchor w
 
541
                        pack $w.desc -anchor nw -expand true -fill x -padx 5
 
542
                        pack $w.close -padx 5 -pady 5 -side right -anchor se
 
543
                        pack $w.config -padx 5 -pady 5 -side right -anchor se
 
544
                        pack $w.load -padx 5 -pady 5 -side right -anchor se
 
545
 
 
546
                    }
 
547
 
443
548
                moveinscreen $w 30
444
549
                return
445
550
        }
467
572
                variable loadedplugins
468
573
 
469
574
                # find the id of the currently selected plugin
470
 
                set selection(id) [$w.select.plugin_list curselection]
 
575
                set selection(id) [$w.plugin_list curselection]
471
576
                # if the selection is empty, end proc
472
577
                if { $selection(id) == "" } {
473
578
                        return
480
585
                set selection(init_proc) $plugins(${selection(id)}_init_proc)
481
586
                set selection(author) $plugins(${selection(id)}_author)
482
587
                set selection(desc) $plugins(${selection(id)}_desc)
 
588
                set selection(plugin_version) $plugins(${selection(id)}_plugin_version)
483
589
 
484
590
                # update the description
485
 
                $w.desc.name configure -text $selection(name)
486
 
                $w.desc.author configure -text $selection(author)
 
591
                $w.name configure -text $selection(name)
 
592
                $w.author configure -text $selection(author)
 
593
                $w.version configure -text $selection(plugin_version)
487
594
                
488
595
                # update the buttons
 
596
 
 
597
                $w.config configure -state normal
 
598
 
489
599
                if {[lsearch "$loadedplugins" $selection(name)] != -1 } {
490
600
                        # if the plugin is loaded, enable the Unload button
491
 
                        $w.command.load configure -state normal -text [trans unload] -command "::plugins::GUI_Unload"
492
 
                        # if the plugin has a configlist, then enable configuration. Otherwise disable it
 
601
                        $w.load configure -state normal -text [trans unload] -command "::plugins::GUI_Unload"
 
602
                        # if the plugin has a configlist, then enable configuration.
 
603
                        # Otherwise disable it
493
604
                        if {[info exists ::${selection(namespace)}::configlist] == 1} {
494
 
                                $w.command.config configure -state normal
 
605
                                $w.config configure -state normal
495
606
                        } else {
496
 
                                $w.command.config configure -state disabled
 
607
                                $w.config configure -state disabled
497
608
                        }
498
609
                } else { # plugin is not loaded
499
610
                        # enable the load button and disable config button
500
 
                        $w.command.load configure -state normal -text "[trans load]" -command "::plugins::GUI_Load"
501
 
                        $w.command.config configure -state disabled
 
611
                        $w.load configure -state normal -text "[trans load]" -command "::plugins::GUI_Load"
 
612
                        $w.config configure -state disabled
502
613
                }
503
614
        }
504
615
 
520
631
                # window path
521
632
                variable w
522
633
                # don't do anything is there is no selection
523
 
                if { $selection(file) != "" } {
 
634
                if { $selection(file) != "" && $selection(id) != ""} {
524
635
                        # Do the actual loading and check if it loads properly
525
 
                        set loaded [LoadPlugin $selection(name) $selection(required_version) $selection(file) \
526
 
                                $selection(namespace) $selection(init_proc)]
 
636
                        set loaded [LoadPlugin $selection(name) $selection(required_version) \
 
637
                                                                                        $selection(file) \
 
638
                                                                                        $selection(namespace) \
 
639
                                                                                        $selection(init_proc) \
 
640
                                                                                 ]
 
641
 
527
642
                        if { !$loaded } {
 
643
                                msg_box "Failed to load $selection(name) plug-in"
528
644
                                return
529
645
                        }
530
646
                        # change the color in the listbox
531
 
                        $w.select.plugin_list itemconfigure $selection(id) -background #DDF3FE
 
647
                        $w.plugin_list itemconfigure $selection(id) -background #DDF3FE
532
648
                        #Call PostEvent Load
533
649
                        #Keep in variable if we are online or not
534
 
                        if {[sb get ns stat] == "o" } {
 
650
                        if {[ns cget -stat] == "o" } {
535
651
                                set status online
536
652
                        } else {
537
653
                                set status offline
538
654
                        }
539
655
 
540
 
                        set evpar(status) status
 
656
                        set evpar(name) $selection(name)
 
657
                        set evpar(status) $status
541
658
                        ::plugins::PostEvent Load evpar
542
659
                        # and upate other info
543
660
                        GUI_NewSel
562
679
                variable selection
563
680
                # window path
564
681
                variable w
 
682
                if {$selection(id)==""} {
 
683
                    return;
 
684
                }
565
685
                # change the color
566
 
                $w.select.plugin_list itemconfigure $selection(id) -background #FFFFFF
 
686
                $w.plugin_list itemconfigure $selection(id) -background #FFFFFF
567
687
                # Call PostEvent Unload
568
688
                # Verify if we are online or offline
569
 
                if {[sb get ns stat] == "o" } {    
 
689
                if {[ns cget -stat] == "o" } {     
570
690
                        set status online
571
691
                } else {
572
692
                        set status offline
573
693
                }
574
694
 
575
 
                set evpar(status) status
 
695
                set evpar(name) $selection(name)
 
696
                set evpar(status) $status
576
697
                ::plugins::PostEvent Unload evpar
577
698
                # do the actual unloading
578
699
                UnLoadPlugin $selection(name)
596
717
        # none
597
718
        #
598
719
        proc GUI_Config { } {
599
 
                # selection, will configure it
600
 
                variable selection
601
 
                # window path
602
 
                variable w
603
 
                #If the window is already here, just raise it to the front
604
 
                if { [winfo exists $w.winconf] } {
605
 
                        raise $w.winconf
606
 
                        return
607
 
                }
608
 
                # current config, see it's declaration for more info
609
 
                variable cur_config
610
 
                
611
 
                # get the name
612
 
                set name $selection(name)
613
 
                set namespace $selection(namespace)
614
 
                # continue if something is selected
615
 
                if {$name != "" && $namespace != ""} {
616
 
                        status_log "Plugins System: Calling ConfigPlugin in the $name namespace\n"
617
 
                        # is there a config list?
618
 
                        if {[info exists ::${namespace}::configlist] == 0} {
619
 
                                # no config list, do a error.
620
 
                                #TODO: instead a error, just put a label "Nothing to configure" in the configure dialog
621
 
                                status_log "Plugins System: No Configuration variable for $name.\n"
622
 
                                set x [toplevel $w.error]
623
 
                                label $x.title -text "Error in Plugin!"
624
 
                                label $x.label -text "No Configuration variable for $name.\n"
625
 
                                button $x.ok -text [trans ok] -command "destroy $x"
626
 
                                grid $x.title -column 1 -row 1
627
 
                                grid $x.label -column 1 -row 2
628
 
                                grid $x.ok -column 1 -row 3
629
 
                        } else { # configlist exists
630
 
                                # backup the current config
631
 
                                array set cur_config [array get ::${namespace}::config]
632
 
                                # create the window
633
 
                                set winconf [toplevel $w.winconf]
634
 
                                set confwin [frame $winconf.area]
635
 
                                # id used for the item name in the widget
636
 
                                set i 0
637
 
                                # row to be used
638
 
                                set row 0
639
 
                                # loop through all the items
640
 
                                foreach confitem [set ::${namespace}::configlist] {
641
 
                                        # Increment both variables
642
 
                                        incr i
643
 
                                        incr row
644
 
                                        # Check the configuration item type and create it in the GUI
645
 
                                        switch [lindex $confitem 0] {
646
 
                                                label {
647
 
                                                        # This configuration item is a label (Simply text to show)
648
 
                                                        label $confwin.$i -text [lindex $confitem 1]
649
 
                                                        grid $confwin.$i -column 1 -row $row -sticky w -padx 10
650
 
                                                }
651
 
                                                bool {
652
 
                                                        # This configuration item is a checkbox (Boolean variable)
653
 
                                                        checkbutton $confwin.$i -text [lindex $confitem 1] -variable \
654
 
                                                                ::${namespace}::config([lindex $confitem 2])
655
 
                                                        grid $confwin.$i -column 1 -row $row -sticky w -padx 20
656
 
                                                }
657
 
                                                ext {
658
 
                                                        # This configuration item is a button (Action related to key)
659
 
                                                        button $confwin.$i -text [lindex $confitem 1] -command \
660
 
                                                                ::${namespace}::[lindex $confitem 2]
661
 
                                                        grid $confwin.$i -column 1 -row $row -sticky w -padx 20 -pady 5
662
 
                                                }
663
 
                                                str {
664
 
                                                        # This configuration item is a text input (Text string variable)
665
 
                                                        entry $confwin.${i}e -textvariable \
666
 
                                                                ::${namespace}::config([lindex $confitem 2])
667
 
                                                        label $confwin.${i}l -text [lindex $confitem 1]
668
 
                                                        grid $confwin.${i}l -column 1 -row $row -sticky w -padx 20
669
 
                                                        grid $confwin.${i}e -column 2 -row $row -sticky w
670
 
                                                }
671
 
                                                pass {
672
 
                                                        # This configuration item is a password input (Text string variable)
673
 
                                                        entry $confwin.${i}e -show "*" -textvariable \
674
 
                                                                ::${namespace}::config([lindex $confitem 2])
675
 
                                                        label $confwin.${i}l -text [lindex $confitem 1]
676
 
                                                        grid $confwin.${i}l -column 1 -row $row -sticky w -padx 20
677
 
                                                        grid $confwin.${i}e -column 2 -row $row -sticky w
678
 
                                                }
679
 
                                        }
680
 
                                }
 
720
            # selection, will configure it
 
721
            variable selection
 
722
            # window path
 
723
            variable w
 
724
            #If the window is already here, just raise it to the front
 
725
            if { [winfo exists $w.winconf] } {
 
726
                raise $w.winconf
 
727
                return
 
728
            }
 
729
            # current config, see it's declaration for more info
 
730
            variable cur_config
 
731
            # list of callbacks for pressing save of frame types
 
732
            variable saveframelist 
 
733
            set saveframelist {}
 
734
            
 
735
            # get the name
 
736
            set name $selection(name)
 
737
            set namespace $selection(namespace)
 
738
            # continue if something is selected
 
739
            if {$name != "" && $namespace != ""} {
 
740
                plugins_log core "Calling ConfigPlugin in the $name namespace\n"
 
741
                # is there a config list?
 
742
                if {[info exists ::${namespace}::configlist] == 0} {
 
743
                    # no config list, do a error.
 
744
                    #TODO: instead a error, just put a label "Nothing to configure" in the configure dialog
 
745
                    plugins_log core "No Configuration variable for $name.\n"
 
746
                    set x [toplevel $w.error]
 
747
                    label $x.title -text "Error in Plugin!"
 
748
                    label $x.label -text "No Configuration variable for $name.\n"
 
749
                    button $x.ok -text [trans ok] -command "destroy $x"
 
750
                    pack $x.title
 
751
                    pack $x.label
 
752
                    pack $x.ok
 
753
                } else { # configlist exists
 
754
                    # backup the current config
 
755
                    array set cur_config [array get ::${namespace}::config]
 
756
                    # create the window
 
757
                    set winconf [toplevel $w.winconf]
 
758
                    set confwin [frame $winconf.area]
 
759
                    # id used for the item name in the widget
 
760
                    set i 0
 
761
                    # loop through all the items
 
762
                    foreach confitem [set ::${namespace}::configlist] {
 
763
                        # Increment both variables
 
764
                        incr i
 
765
                        # Check the configuration item type and create it in the GUI
 
766
                        switch [lindex $confitem 0] {
 
767
                            label {
 
768
                                # This configuration item is a label (Simply text to show)
 
769
                                label $confwin.$i -text [lindex $confitem 1]
 
770
                                pack $confwin.$i -anchor w -padx 10
 
771
                            }
 
772
                            bool {
 
773
                                # This configuration item is a checkbox (Boolean variable)
 
774
                                checkbutton $confwin.$i -text [lindex $confitem 1] -variable \
 
775
                                    ::${namespace}::config([lindex $confitem 2])
 
776
                                pack $confwin.$i -anchor w -padx 20
 
777
                            }
 
778
                            ext {
 
779
                                # This configuration item is a button (Action related to key)
 
780
                                button $confwin.$i -text [lindex $confitem 1] -command \
 
781
                                    ::${namespace}::[lindex $confitem 2]
 
782
                                pack $confwin.$i -anchor w -padx 20 -pady 5
 
783
                            }
 
784
                            str {
 
785
                                # This configuration item is a text input (Text string variable)
 
786
                                set frame [frame $confwin.f$i]
 
787
                                entry $frame.${i}e -textvariable \
 
788
                                    ::${namespace}::config([lindex $confitem 2]) -bg white
 
789
                                label $frame.${i}l -text [lindex $confitem 1]
 
790
                                pack $frame.${i}l -anchor w -side left -padx 20
 
791
                                pack $frame.${i}e -anchor w -side left -fill x
 
792
                                pack $frame -fill x
 
793
                            }
 
794
                            pass {
 
795
                                # This configuration item is a password input (Text string variable)
 
796
                                set frame [frame $confwin.f$i]
 
797
                                entry $frame.${i}e -show "*" -textvariable \
 
798
                                    ::${namespace}::config([lindex $confitem 2])
 
799
                                label $frame.${i}l -text [lindex $confitem 1]
 
800
                                pack $frame.${i}l -anchor w -side left -padx 20
 
801
                                pack $frame.${i}e -anchor w -side left -fill x
 
802
                                pack $frame -fill x -anchor w
 
803
                            }
 
804
                            lst {
 
805
                                # This configuration item is a listbox that stores the selected item.
 
806
                                set height [llength [lindex $confitem 1]]
 
807
                                listbox $confwin.$i -height $height -width 0 -bg white
 
808
                                foreach item [lindex $confitem 1] {
 
809
                                    $confwin.$i insert end $item
 
810
                                }
 
811
                                bind $confwin.$i <<ListboxSelect>> "::plugins::lst_refresh $confwin.$i ::${namespace}::config([lindex $confitem 2])"
 
812
                                pack $confwin.$i -anchor w -padx 40
 
813
                            }
 
814
                            rbt {
 
815
                                # This configuration item contains radiobutton
 
816
                                set buttonlist [lrange $confitem 1 end-1]
 
817
                                set value 0
 
818
                                foreach item $buttonlist {
 
819
                                    incr value
 
820
                                    radiobutton $confwin.$i -text "$item" -variable ::${namespace}::config([lindex $confitem end]) -value $value
 
821
                                    pack $confwin.$i -anchor w -padx 40
 
822
                                    incr i
 
823
                                }
 
824
                                incr i -1
 
825
                            }
 
826
                            frame {
 
827
                                # This configureation item creates a frame so the plugin can place whatever it like inside
 
828
                                frame $confwin.$i
 
829
                                [lindex $confitem 1] $confwin.$i
 
830
                                if { "[lindex $confitem 2]" != "" } {
 
831
                                        lappend saveframelist "[lindex $confitem 2] $confwin.$i"
 
832
                                }
 
833
                                pack $confwin.$i -fill x -anchor w
 
834
                            }
681
835
                        }
682
 
 
683
 
                        # Grid the frame
684
 
                        grid $confwin -column 1 -row 1
685
 
                        # Create and grid the buttons
686
 
                        button $winconf.save -text [trans save] -command "::plugins::GUI_SaveConfig $winconf"
687
 
                        button $winconf.cancel -text [trans cancel] -command "::plugins::GUI_CancelConfig $winconf $namespace"
688
 
                        grid $winconf.save -column 1 -row 2 -sticky e -pady 5 -padx 5
689
 
                        grid $winconf.cancel -column 2 -row 2 -sticky e -pady 5 -padx 5
690
 
                        moveinscreen $winconf 30
 
836
                    }
691
837
                }
 
838
                
 
839
                # set the name of the winconf
 
840
                wm title $w.winconf "[trans configure] $selection(name)"
 
841
                
 
842
                # Grid the frame
 
843
                pack $confwin -fill x
 
844
                # Create and grid the buttons
 
845
                button $winconf.save -text [trans save] -command "[list ::plugins::GUI_SaveConfig $winconf $name]"
 
846
                button $winconf.cancel -text [trans cancel] -command "[list ::plugins::GUI_CancelConfig $winconf $namespace]"
 
847
                pack $winconf.save -anchor se -pady 5 -padx 5 -side right
 
848
                pack $winconf.cancel -anchor se -pady 5 -padx 5 -side right
 
849
                moveinscreen $winconf 30
 
850
            }
 
851
        }
 
852
 
 
853
 
 
854
        ###############################################################
 
855
        # lst_refresh (path, config)
 
856
        #
 
857
        # The list box on config window changes its selected value, so
 
858
        # this proc refresh the associated variable with the new value
 
859
        #
 
860
        # Arguments
 
861
        # path - The listbox widget path 
 
862
        # config - The complete config entry (with plugin namespace)
 
863
        #
 
864
        # Return
 
865
        # none
 
866
        #
 
867
        proc lst_refresh { path config } {
 
868
                set ${config} [$path get [$path curselection] [$path curselection]]     
692
869
        }
693
870
 
694
871
 
699
876
        # plugins configuration and then destroy the Configuration Window
700
877
        #
701
878
        # Arguments
702
 
        # w - The configuration window widget path 
 
879
        # w - The configuration window widget path
 
880
        # name - The name of the plugin that was changed (if any)
703
881
        #
704
882
        # Return
705
883
        # none
706
884
        #
707
 
        proc GUI_SaveConfig { w } {
 
885
        proc GUI_SaveConfig { w {name ""}} {
 
886
                variable saveframelist
 
887
                
 
888
                if { $name != "" } {
 
889
                        #add a postevent to warn the plugin when it is configured
 
890
                        set evPar(name) $name
 
891
                        ::plugins::PostEvent PluginConfigured evPar
 
892
                }
 
893
                
 
894
                foreach call $saveframelist {
 
895
                        eval $call
 
896
                }
 
897
 
 
898
                set saveframelist {}
 
899
 
708
900
                ::plugins::save_config
709
901
                destroy $w;
710
902
        }
788
980
        #
789
981
        proc UnLoadPlugin { plugin } {
790
982
                variable loadedplugins
791
 
                status_log "Plugins System: Unloading plugin $plugin\n"
 
983
                plugins_log core "Unloading plugin $plugin\n"
792
984
                set loadedplugins [lreplace $loadedplugins [lsearch $loadedplugins "$plugin"] [lsearch $loadedplugins "$plugin"]]
793
985
                UnRegisterEvents $plugin
794
 
                set pluginidx [lindex [lsearch -all $::plugins::found "*$plugin*"] 0]
795
 
                if { $pluginidx == "" } {
 
986
                set pluginidx [lsearch -glob $::plugins::found "*$plugin*"]
 
987
                if { $pluginidx == -1 } {
796
988
                        return
797
989
                }
798
 
                set namespace [lindex $::plugins::found $pluginidx 6]
799
 
                set deinit [lindex $::plugins::found $pluginidx 8]
 
990
                set namespace [lindex [lindex $::plugins::found $pluginidx] 6]
 
991
                set deinit [lindex [lindex $::plugins::found $pluginidx] 8]
800
992
                if {[info procs "::${namespace}::${deinit}"] == "::${namespace}::${deinit}"} {
801
993
                        ::${namespace}::${deinit}
802
994
                }
819
1011
        # none
820
1012
        #
821
1013
        proc LoadPlugins {} {
822
 
                variable loadedplugins
823
 
                ::plugins::UnLoadPlugins
824
 
                load_config
825
 
                foreach {plugin} [findplugins] {
826
 
                        set name [lindex $plugin 0]
827
 
                        set required_version [lindex $plugin 3]
828
 
                        set file [lindex $plugin 5]
829
 
                        set plugin_namespace [lindex $plugin 6]
830
 
                        set init_proc [lindex $plugin 7]
831
 
                        if {[lsearch $loadedplugins $name] != -1} {
832
 
                                LoadPlugin $name $required_version $file $plugin_namespace $init_proc
833
 
                        }
 
1014
            variable loadedplugins
 
1015
            variable plugins
 
1016
            variable knownplugins
 
1017
            
 
1018
            ::plugins::UnLoadPlugins
 
1019
            load_config
 
1020
 
 
1021
#"HACK" to load 'core' plugins for the 0.95 release
 
1022
#HERE WE HAVE A LIST OF PLUGINS THAT ARE SHIPPED WITH AMSN AND SHOULD BE LOADED IF THE USER SEES 'M FOR THE FIRST TIME
 
1023
            set coreplugins [list "Nudge" "Cam Shooter"]
 
1024
 
 
1025
            set plugs [::plugins::updatePluginsArray]
 
1026
            for {set idx 0} {$idx < $plugs} {incr idx} {
 
1027
                set name $::plugins::plugins(${idx}_name)
 
1028
                set required_version $::plugins::plugins(${idx}_required_amsn_version)
 
1029
                set file $::plugins::plugins(${idx}_plugin_file)
 
1030
                set plugin_namespace $::plugins::plugins(${idx}_plugin_namespace)
 
1031
                set init_proc $::plugins::plugins(${idx}_init_proc)
 
1032
                if {[lsearch $loadedplugins $name] != -1} {
 
1033
                    LoadPlugin $name $required_version $file $plugin_namespace $init_proc
834
1034
                }
 
1035
 
 
1036
#"HACK" TO LOAD 'core' plugins
 
1037
                #if this plugin is one of the core plugins, it should be loaded if it's not known yet
 
1038
                if { ([lsearch $coreplugins $name] != -1)  && ([lsearch $knownplugins $name] == -1) } {
 
1039
                        LoadPlugin $name $required_version $file $plugin_namespace $init_proc 
 
1040
                }                       
 
1041
 
 
1042
            }
 
1043
 
 
1044
            ::plugins::PostEvent AllPluginsLoaded evPar
835
1045
        }
836
1046
 
837
1047
 
853
1063
        proc LoadPlugin { plugin required_version file namespace init_proc } {
854
1064
                variable loadedplugins
855
1065
 
856
 
                if { ![CheckRequeriments $required_version] } {
857
 
                        msg_box "[trans required_version $required_version]"
 
1066
                if { ![CheckRequirements $required_version] } {
 
1067
                        msg_box "$plugin: [trans required_version $required_version]"
858
1068
                        return 0
859
1069
                }
860
1070
 
861
 
                catch { source $file }
 
1071
                if { [catch { source $file } res] } {
 
1072
                        msg_box "$plugin: Failed to load source with result:\n\n$res"
 
1073
                        return 0
 
1074
                }
862
1075
 
863
1076
                if {[lsearch "$loadedplugins" $plugin] == -1} {
864
 
                        status_log "Plugins System: appending to loadedplugins\n"
 
1077
                        plugins_log core "appending to loadedplugins\n"
865
1078
                        lappend loadedplugins $plugin
866
1079
                }
867
1080
                if {[info procs ::${namespace}::${init_proc}] == "::${namespace}::${init_proc}"} {
868
 
                        status_log "Plugins System: Initializing plugin $plugin with ${namespace}::${init_proc}\n"
 
1081
                        plugins_log core "Initializing plugin $plugin with ${namespace}::${init_proc}\n"
869
1082
                        ::${namespace}::${init_proc} [file dirname $file]
870
1083
                        eval {proc ::${namespace}::${init_proc} {file} { return } }
 
1084
                } else {
 
1085
                        msg_box "Plugins System: Can't initialize plugin:init procedure not found"
871
1086
                }
872
1087
                if {[array exists ::${plugin}_cfg] == 1} {
873
1088
                        array set ::${namespace}::config [array get ::${plugin}_cfg]
 
1089
                } else {
 
1090
                        status_log "Plugins System: no config for plug-in $plugin\n" red
874
1091
                }
875
1092
                return 1
876
1093
        }
877
1094
 
878
1095
 
879
1096
        ###############################################################
880
 
        # CheckRequeriments (required_version)
 
1097
        # CheckRequirements (required_version)
881
1098
        #
882
1099
        # Checks if we satisfy requirements of the plugin (only version now)
883
1100
        #
888
1105
        # 0 - We don't satisfy them
889
1106
        # 1 - We satisfy them, we can load the plugin.
890
1107
        #
891
 
        proc CheckRequeriments { required_version } {
 
1108
        proc CheckRequirements { required_version } {
892
1109
                global version
893
1110
 
894
1111
                scan $required_version "%d.%d" r1 r2;
919
1136
                variable knownplugins
920
1137
                variable loadedplugins
921
1138
 
922
 
                status_log "Plugins System: save_config: saving plugin config for user [::config::getKey login] in $HOME]\n" black
 
1139
                plugins_log core "save_config: saving plugin config for user [::config::getKey login] in $HOME]\n"
923
1140
        
924
1141
                if { [catch {
925
1142
                        if {$tcl_platform(platform) == "unix"} {
931
1148
                        return 0
932
1149
                }
933
1150
 
934
 
                status_log "Plugins System: save_config: saving plugin config_file. Opening of file returned : $res\n"
 
1151
                plugins_log core "save_config: saving plugin config_file. Opening of file returned : $res\n"
935
1152
 
936
1153
                puts $file_id  "<?xml version=\"1.0\"?>\n\n<config>"
937
 
                status_log "Plugins System: I will save the folowing: $knownplugins\n"
 
1154
                plugins_log core "I will save the folowing: $knownplugins\n"
938
1155
                foreach {plugin} $knownplugins {
939
 
                        set pluginidx [lindex [lsearch -all $::plugins::found "*$plugin*"] 0]
940
 
                        if { $pluginidx != "" } {
941
 
                                set namespace [lindex $::plugins::found $pluginidx 6]
 
1156
                        set pluginidx [lsearch -glob $::plugins::found "*$plugin*"]
 
1157
                        if { $pluginidx != -1 } {
 
1158
                                set namespace [lindex [lindex $::plugins::found $pluginidx] 6]
942
1159
                                status_log "NAMESPACE: $namespace\n"
943
1160
                                puts $file_id "<plugin>\n<name>${plugin}</name>"
944
1161
                                if {[lsearch $loadedplugins $plugin]!=-1} {
945
 
                                        status_log "Plugins System: $plugin loaded...\n"
 
1162
                                        plugins_log core "$plugin loaded...\n"
946
1163
                                        puts $file_id "<loaded>true</loaded>"
947
1164
                                }
948
1165
                                if {[array exists ::${namespace}::config]==1} {
949
 
                                        status_log "Plugins System: save_config: Saving from $plugin's namespace\n" black
 
1166
                                        plugins_log core "save_config: Saving from $plugin's namespace\n"
950
1167
                                        array set aval [array get ::${namespace}::config];
951
1168
                                } else {
952
 
                                        status_log "Plugins System: save_config: Saving from $plugin's global place\n" black
 
1169
                                        plugins_log core "save_config: Saving from $plugin's global place\n"
953
1170
                                        array set aval [array get ::${plugin}_cfg]
954
1171
                                }
955
1172
                                foreach var_attribute [array names aval] {
965
1182
                puts $file_id "</config>"
966
1183
                close $file_id
967
1184
 
968
 
                status_log "Plugins System: save_config: Plugins config saved\n" black
 
1185
                plugins_log core "save_config: Plugins config saved\n"
969
1186
        }
970
1187
 
971
1188
 
981
1198
        # none
982
1199
        #
983
1200
        proc load_config {} {
984
 
                global HOME password protocol clientid tcl_platform
 
1201
                global HOME password protocol tcl_platform
985
1202
                variable loadedplugins
986
1203
                foreach {plugin} $loadedplugins {
987
1204
                        ::plugins::UnLoadPlugin $plugin
989
1206
                set loadedplugins [list]
990
1207
 
991
1208
                if { [file exists [file join ${HOME} "plugins.xml"]] } {
992
 
                        status_log "Plugins System: load_config: loading file [file join ${HOME} plugins.xml]\n" blue
 
1209
                        plugins_log core "load_config: loading file [file join ${HOME} plugins.xml]\n"
993
1210
                        if { [catch {
994
1211
                                set file_id [::sxml::init [file join ${HOME} "plugins.xml"]]
995
1212
                                ::sxml::register_routine $file_id "config:plugin:name" "::plugins::new_plugin_config"
997
1214
                                ::sxml::register_routine $file_id "config:plugin:entry" "::plugins::new_plugin_entry_config"
998
1215
                                ::sxml::parse $file_id
999
1216
                                ::sxml::end $file_id
1000
 
                                status_log "Plugins System: load_config: Config loaded\n" green
 
1217
                                plugins_log core "load_config: Config loaded\n"
1001
1218
                        } res] } {
1002
1219
                                ::amsn::errorMsg "[trans corruptconfig [file join ${HOME} "plugins.xml.old"]]"
1003
1220
                                file copy [file join ${HOME} "plugins.xml"] [file join ${HOME} "plugins.xml.old"]
1004
1221
                        }
 
1222
                } else {
 
1223
                        status_log "Plugins System: load_config: No plugins.xml]\n" red
1005
1224
                }
1006
1225
        }
1007
1226
 
1046
1265
                variable cur_plugin
1047
1266
                variable loadedplugins
1048
1267
                set yes $cdata
1049
 
                status_log "Plugins System: $cur_plugin has a loaded tag with $yes in it...\n" black
 
1268
                plugins_log core "$cur_plugin has a loaded tag with $yes in it...\n"
1050
1269
                if {$yes == "true"} {
1051
1270
                        if {[lsearch $loadedplugins $cur_plugin] == -1 } {
1052
1271
                                lappend loadedplugins $cur_plugin
1074
1293
                set ::${cur_plugin}_cfg($sdata(${cstack}:key)) $sdata(${cstack}:value);
1075
1294
                return 0
1076
1295
        }
 
1296
 
 
1297
 
 
1298
#/////////////////////////////////////////////////////
 
1299
# Load the XML information of a plugin
 
1300
 
 
1301
        proc get_Version { path plugin } {
 
1302
 
 
1303
                set ::plugins::plgversion ""
 
1304
                set ::plugins::plglang ""
 
1305
                set ::plugins::plgfile ""
 
1306
                set ::plugins::URL_plugininfo ""
 
1307
 
 
1308
                set id [::sxml::init $path]
 
1309
                
 
1310
                if { $id!=-1 } {
 
1311
 
 
1312
                        sxml::register_routine $id "plugin" "::plugins::XML_Plugin_CVS"
 
1313
                        sxml::register_routine $id "plugin:lang" "::plugins::XML_Plugin_Lang"
 
1314
                        sxml::register_routine $id "plugin:file" "::plugins::XML_Plugin_File"
 
1315
                        sxml::register_routine $id "plugin:URL" "::plugins::XML_Plugin_URL"
 
1316
 
 
1317
                        sxml::parse $id
 
1318
 
 
1319
                        sxml::end $id
 
1320
 
 
1321
                }
 
1322
 
 
1323
        }
 
1324
 
 
1325
 
 
1326
        proc XML_Plugin_CVS { cstack cdata saved_data cattr saved_attr args } {
 
1327
 
 
1328
                upvar $saved_data sdata
 
1329
 
 
1330
                catch {set ::plugins::plgversion $sdata(${cstack}:cvs_version)}
 
1331
 
 
1332
                return 0
 
1333
 
 
1334
        }
 
1335
 
 
1336
 
 
1337
        proc XML_Plugin_Lang { cstack cdata saved_data cattr saved_attr args } {
 
1338
 
 
1339
                upvar $saved_data sdata
 
1340
 
 
1341
                catch {lappend ::plugins::plglang "$sdata(${cstack}:langcode)" "$sdata(${cstack}:version)"}
 
1342
 
 
1343
                return 0
 
1344
 
 
1345
        }
 
1346
 
 
1347
 
 
1348
        proc XML_Plugin_File { cstack cdata saved_data cattr saved_attr args } {
 
1349
 
 
1350
                upvar $saved_data sdata
 
1351
 
 
1352
                catch {lappend ::plugins::plgfile "$sdata(${cstack}:path)" "$sdata(${cstack}:version)"}
 
1353
 
 
1354
                return 0
 
1355
 
 
1356
        }
 
1357
        
 
1358
        
 
1359
        proc XML_Plugin_URL { cstack cdata saved_data cattr saved_attr args } {
 
1360
        
 
1361
                upvar $saved_data sdata
 
1362
                
 
1363
                catch {set ::plugins::URL_plugininfo "$sdata(${cstack}:plugininfo)"}
 
1364
                
 
1365
        }
 
1366
 
 
1367
 
 
1368
#/////////////////////////////////////////////////////
 
1369
# Get the plugininfo.xml on the CVS, and load it
 
1370
 
 
1371
        proc get_OnlineVersion { path plugin {URL ""} } {
 
1372
 
 
1373
                global HOME HOME2
 
1374
                
 
1375
                set place 0
 
1376
                set ::plugins::plgonlinerequire ""
 
1377
                set ::plugins::plgonlineversion ""
 
1378
                set ::plugins::plgonlinelang ""
 
1379
                set ::plugins::plgonlinefile ""
 
1380
                set ::plugins::plgonlineURLmain ""
 
1381
                set ::plugins::plgonlineURLlang ""
 
1382
                set ::plugins::plgonlineURLfile ""
 
1383
                
 
1384
                set program_dir [set ::program_dir]
 
1385
 
 
1386
                if { [catch {
 
1387
                
 
1388
                # If no URL is given, look at the CVS URL
 
1389
                if { $URL == "" } {
 
1390
 
 
1391
                        set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/amsn-extras/plugins/$plugin/plugininfo.xml?rev=HEAD&content-type=text/plain" -timeout 120000 -binary 1]
 
1392
                        set content [::http::data $token]
 
1393
                        if { [string first "<html>" "$content"] == -1 } {
 
1394
                                set place 1
 
1395
                        } else {
 
1396
                                set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/msn/plugins/$plugin/plugininfo.xml?rev=HEAD&content-type=text/plain" -timeout 120000 -binary 1]
 
1397
                                set content [::http::data $token]
 
1398
                                if { [string first "<html>" "$content"] == -1 } {
 
1399
                                        set place 2
 
1400
                                } else {
 
1401
                                        return 0
 
1402
                                }
 
1403
 
 
1404
                        }
 
1405
 
 
1406
 
 
1407
                # Else, look at the URL given
 
1408
                } else {
 
1409
                
 
1410
                        set token [::http::geturl "$URL" -timeout 120000 -binary 1]
 
1411
                        set content [::http::data $token]
 
1412
                        if { [string first "<html>" "$content"] != -1 } {
 
1413
                                return 0
 
1414
                        }
 
1415
                        set place 3
 
1416
 
 
1417
                }
 
1418
 
 
1419
                set status [::http::status $token]
 
1420
                if { $status != "ok" } {
 
1421
                        status_log "Can't get plugininfo.xml for $plugin (place $place - URL $URL): $status\n" red
 
1422
                        return 0
 
1423
                }
 
1424
 
 
1425
                set filename "[file join $HOME2 $plugin.xml]"
 
1426
                set fid [open $filename w]
 
1427
                fconfigure $fid -encoding binary
 
1428
                puts -nonewline $fid "$content"
 
1429
                close $fid
 
1430
 
 
1431
                set id [::sxml::init $filename]
 
1432
                sxml::register_routine $id "plugin" "::plugins::XML_OnlinePlugin_CVS"
 
1433
                sxml::register_routine $id "plugin:lang" "::plugins::XML_OnlinePlugin_Lang"
 
1434
                sxml::register_routine $id "plugin:file" "::plugins::XML_OnlinePlugin_File"
 
1435
                sxml::register_routine $id "plugin:URL" "::plugins::XML_OnlinePlugin_URL"
 
1436
                sxml::parse $id
 
1437
                sxml::end $id
 
1438
                
 
1439
                } ] } {
 
1440
                
 
1441
                status_log "Can't get online plugininfo.xml for $plugin (place $place - URL $URL)\n" red
 
1442
                return 0
 
1443
                
 
1444
                }
 
1445
 
 
1446
                return $place
 
1447
 
 
1448
        }
 
1449
 
 
1450
 
 
1451
        proc XML_OnlinePlugin_CVS { cstack cdata saved_data cattr saved_attr args } {
 
1452
 
 
1453
                upvar $saved_data sdata
 
1454
                
 
1455
                catch {set ::plugins::plgonlinerequire $sdata(${cstack}:amsn_version)}
 
1456
                catch {set ::plugins::plgonlineversion $sdata(${cstack}:cvs_version)}
 
1457
 
 
1458
                return 0
 
1459
 
 
1460
        }
 
1461
 
 
1462
 
 
1463
        proc XML_OnlinePlugin_Lang { cstack cdata saved_data cattr saved_attr args } {
 
1464
 
 
1465
                upvar $saved_data sdata
 
1466
 
 
1467
                catch {lappend ::plugins::plgonlinelang [list $sdata(${cstack}:langcode) $sdata(${cstack}:version)]}
 
1468
 
 
1469
                return 0
 
1470
 
 
1471
        }
 
1472
 
 
1473
 
 
1474
        proc XML_OnlinePlugin_File { cstack cdata saved_data cattr saved_attr args } {
 
1475
 
 
1476
                upvar $saved_data sdata
 
1477
 
 
1478
                catch {lappend ::plugins::plgonlinefile [list $sdata(${cstack}:path) $sdata(${cstack}:version)]}
 
1479
 
 
1480
                return 0
 
1481
 
 
1482
        }
 
1483
 
 
1484
 
 
1485
        proc XML_OnlinePlugin_URL { cstack cdata saved_data cattr saved_attr args } {
 
1486
 
 
1487
                upvar $saved_data sdata
 
1488
 
 
1489
                catch {set ::plugins::plgonlineURLmain "$sdata(${cstack}:main)"}
 
1490
                catch {set ::plugins::plgonlineURLlang "$sdata(${cstack}:lang)"}
 
1491
                catch {set ::plugins::plgonlineURLfile "$sdata(${cstack}:file)"}
 
1492
                
 
1493
                return 0
 
1494
 
 
1495
        }
 
1496
 
 
1497
 
 
1498
#/////////////////////////////////////////////////////
 
1499
# Update the plugin (.tcl file)
 
1500
 
 
1501
        proc UpdateMain { plugin path version place URL } {
 
1502
        
 
1503
                global HOME HOME2
 
1504
                
 
1505
                # If we already have the current version
 
1506
                if { $version == 0 } {
 
1507
                        return 1
 
1508
                }
 
1509
 
 
1510
                set program_dir [set ::program_dir]
 
1511
                
 
1512
                set w ".updatelangplugin"
 
1513
                
 
1514
                if { [winfo exists $w] } {
 
1515
                        $w.update.txt configure -text "[trans updating] $plugin..."
 
1516
                }
 
1517
                
 
1518
                if { $place == 1 } {
 
1519
                        set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/amsn-extras/plugins/$plugin/$plugin.tcl?rev=$version&content-type=text/plain" -timeout 120000 -binary 1]
 
1520
                } elseif { $place == 2 } {
 
1521
                        set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/msn/plugins/$plugin/$plugin.tcl?rev=$version&content-type=text/plain" -timeout 120000 -binary 1]
 
1522
                } elseif { $place == 3 && $URL != "" } {
 
1523
                        set URL "[subst $URL]"
 
1524
                        set token [::http::geturl "$URL" -timeout 120000 -binary 1]
 
1525
                } else {
 
1526
                        return 0
 
1527
                }
 
1528
 
 
1529
                set status [::http::status $token]
 
1530
                if { $status != "ok" } {
 
1531
                        return 0
 
1532
                }
 
1533
 
 
1534
                set content [::http::data $token]
 
1535
                
 
1536
                if { [string first "<html>" "$content"] != -1 } {
 
1537
                        return 0
 
1538
                }
 
1539
 
 
1540
                set filename [file join $path $plugin.tcl]
 
1541
                set fid [open $filename w]
 
1542
                fconfigure $fid -encoding binary
 
1543
                puts -nonewline $fid "$content"
 
1544
                close $fid
 
1545
                
 
1546
                return 1
 
1547
 
 
1548
        }
 
1549
 
 
1550
#/////////////////////////////////////////////////////
 
1551
# Update the language files
 
1552
 
 
1553
        proc UpdateLangs { plugin path langcodes place URL } {
 
1554
 
 
1555
                global HOME HOME2
 
1556
 
 
1557
                set program_dir [set ::program_dir]
 
1558
                
 
1559
                set w ".updatelangplugin"
 
1560
 
 
1561
                
 
1562
                foreach { langcode version} $langcodes {
 
1563
                
 
1564
                        if { [winfo exists $w] } {
 
1565
                                $w.update.txt configure -text "[trans updating] $plugin : lang$langcode..."
 
1566
                        }
 
1567
 
 
1568
                        if { $place == 1 } {
 
1569
                                set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/amsn-extras/plugins/$plugin/lang/lang$langcode?rev=$version&content-type=text/plain" -timeout 120000 -binary 1]
 
1570
                        } elseif { $place == 2 } {
 
1571
                                set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/msn/plugins/$plugin/lang/lang$langcode?rev=$version&content-type=text/plain" -timeout 120000 -binary 1]
 
1572
                        } elseif { $place == 3 && $URL != "" } {
 
1573
                                set URL "[subst $URL]"
 
1574
                                set token [::http::geturl "$URL" -timeout 120000 -binary 1]
 
1575
                        } else {
 
1576
                                return 0
 
1577
                        }
 
1578
 
 
1579
                        set status [::http::status $token]
 
1580
                        if { $status != "ok" } {
 
1581
                                return 0
 
1582
                        }
 
1583
 
 
1584
                        set content [::http::data $token]
 
1585
                        
 
1586
                        if { [string first "<html>" "$content"] != -1 } {
 
1587
                                return 0
 
1588
                        }
 
1589
 
 
1590
                        set filename [file join $path "lang" lang$langcode]
 
1591
 
 
1592
                        set fid [open $filename w]
 
1593
                        fconfigure $fid -encoding binary
 
1594
                        puts -nonewline $fid "$content"
 
1595
                        close $fid
 
1596
 
 
1597
                }
 
1598
                
 
1599
                return 1
 
1600
                
 
1601
        }
 
1602
 
 
1603
#/////////////////////////////////////////////////////
 
1604
# Delete a language file of a plugin
 
1605
 
 
1606
        proc DeleteLang { plugin langcode path} {
 
1607
 
 
1608
                set id [lsearch $::plugins::plglang $langcode]
 
1609
 
 
1610
                if { $id != -1 } {
 
1611
                        set file "[file join $path "lang" "lang$langcode"]"
 
1612
                        file delete $file
 
1613
                        set ::plugins::plglang [lreplace $::plugins::plglang $id [expr {$id + 1}]]
 
1614
                        status_log "Plugin autoupdate : delete $file\n" blue
 
1615
                }
 
1616
 
 
1617
        }
 
1618
 
 
1619
#/////////////////////////////////////////////////////
 
1620
# Update all the others files (pictures, sounds...)
 
1621
 
 
1622
        proc UpdateFiles { plugin path files place URL } {
 
1623
 
 
1624
                global HOME HOME2
 
1625
                
 
1626
                set program_dir [set ::program_dir]
 
1627
                
 
1628
                set w ".updatelangplugin"
 
1629
                
 
1630
                foreach { file version } $files {
 
1631
 
 
1632
                        if { [winfo exists $w] } {
 
1633
                                $w.update.txt configure -text "[trans updating] $plugin : $file..."
 
1634
                        }
 
1635
 
 
1636
                        if { $place == 1 } {
 
1637
                                set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/amsn-extras/plugins/$plugin/$file?rev=$version&content-type=text/plain" -timeout 120000 -binary 1]
 
1638
                        } elseif { $place == 2} {
 
1639
                                set token [::http::geturl "http://cvs.sourceforge.net/viewcvs.py/*checkout*/amsn/msn/plugins/$plugin/$file?rev=$version&content-type=text/plain" -timeout 120000 -binary 1]
 
1640
                        } elseif { $place == 3 && $URL != "" } {
 
1641
                                set URL "[subst $URL]"
 
1642
                                set token [::http::geturl "$URL" -timeout 120000 -binary 1]
 
1643
                        } else {
 
1644
                                return 0
 
1645
                        }
 
1646
 
 
1647
                        set status [::http::status $token]
 
1648
                        if { $status != "ok" } {
 
1649
                                return 0
 
1650
                        }
 
1651
 
 
1652
                        set content [::http::data $token]
 
1653
                        
 
1654
                        if { [string first "<html>" "$content"] != -1 } {
 
1655
                                return 0
 
1656
                        }
 
1657
 
 
1658
                        set filename [file join $path $file]
 
1659
 
 
1660
                        set dir [file join $path [file dirname $file]]
 
1661
                        if { ![file isdirectory $dir] } {
 
1662
                                file mkdir $dir
 
1663
                                status_log "Auto-update ($plugin) : create dir $dir\n" red
 
1664
                        }       
 
1665
 
 
1666
                        set fid [open $filename w]
 
1667
                        fconfigure $fid -encoding binary
 
1668
                        puts -nonewline $fid "$content"
 
1669
                        close $fid
 
1670
                        
 
1671
                }
 
1672
                
 
1673
                return 1
 
1674
 
 
1675
        }
 
1676
 
 
1677
#/////////////////////////////////////////////////////
 
1678
# Update a plugin
 
1679
 
 
1680
        proc UpdatePlugin { plugin } {
 
1681
        
 
1682
                variable loadedplugins
 
1683
 
 
1684
                set namespace [lindex $plugin 0]
 
1685
                set required_version [lindex $plugin 3]
 
1686
                set file [lindex $plugin 5]
 
1687
                set name [lindex $plugin 6]
 
1688
                set init_proc [lindex $plugin 7]
 
1689
                set place [lindex $plugin 9]
 
1690
                
 
1691
                set path "$file"
 
1692
                set path "[string range $path 0 end-[expr {[string length $name] + 5}]]"
 
1693
                set pathinfo "$path/plugininfo.xml"
 
1694
                
 
1695
                set main [::plugins::ReadPluginUpdates $name main]
 
1696
                set langs [::plugins::ReadPluginUpdates $name lang]
 
1697
                set files [::plugins::ReadPluginUpdates $name file]
 
1698
                set URLmain [::plugins::ReadPluginUpdates $name URLmain]
 
1699
                set URLlang [::plugins::ReadPluginUpdates $name URLlang]
 
1700
                set URLfile [::plugins::ReadPluginUpdates $name URLfile]
 
1701
 
 
1702
                # if no error occurs while updating the plugin, save the plugininfo.xml file            
 
1703
                if { [catch {
 
1704
                        set mainstate [::plugins::UpdateMain $name $path $main $place $URLmain]
 
1705
                        set langstate [::plugins::UpdateLangs $name $path $langs $place $URLlang]
 
1706
                        set filestate [::plugins::UpdateFiles $name $path $files $place $URLfile]
 
1707
                        }] } {
 
1708
                        status_log "Error while updating $name\n" red
 
1709
                } elseif { $mainstate == 1 && $langstate == 1 && $filestate == 1 } {
 
1710
                        SavePlugininfo "$plugin" "$pathinfo"
 
1711
                        
 
1712
                        # Reload the plugin if it was loaded
 
1713
                        if { [lsearch $loadedplugins $name] != -1 } {
 
1714
                                ::plugins::UnLoadPlugin $plugin
 
1715
                                ::plugins::LoadPlugin $namespace $required_version $file $name $init_proc
 
1716
                        }
 
1717
                        
 
1718
                } else {
 
1719
                        status_log "Error while updating $name : main $mainstate, lang $langstate, file $filestate\n" red
 
1720
                }
 
1721
                
 
1722
        }
 
1723
 
 
1724
 
 
1725
#/////////////////////////////////////////////////////
 
1726
 
 
1727
        proc UpdatedPlugins { } {
 
1728
 
 
1729
                set ::plugins::UpdatedPlugins [list]
 
1730
 
 
1731
                foreach plugin [::plugins::findplugins] {
 
1732
 
 
1733
                        set updated 0
 
1734
                        set protected 0
 
1735
 
 
1736
                        set path [lindex $plugin 5]
 
1737
                        set name [lindex $plugin 6]
 
1738
                        set path "[string range $path 0 end-[expr {[string length $name] + 5}]]"
 
1739
                        set pathinfo "$path/plugininfo.xml"
 
1740
                        ::plugins::get_Version "$pathinfo" "$name"
 
1741
                        
 
1742
                        if { ![file writable $pathinfo] } {
 
1743
                                continue
 
1744
                        }
 
1745
                        
 
1746
                        set place [::plugins::get_OnlineVersion "$pathinfo" "$name" "$::plugins::URL_plugininfo"]
 
1747
                        
 
1748
                        if { $place == 0 || ![info exist ::plugins::plgonlinerequire] || $::plugins::plgonlinerequire == ""} {
 
1749
                                continue
 
1750
                        }
 
1751
                        
 
1752
                        set plugin [lappend plugin $place]
 
1753
                        
 
1754
                        # If the online plugin is compatible with the current version of aMSN
 
1755
                        if { [::plugins::CheckRequirements $::plugins::plgonlinerequire] } {
 
1756
 
 
1757
                                # If the main file has been updated
 
1758
                                if { [::plugins::DetectNew "$::plugins::plgversion" "$::plugins::plgonlineversion"] } {
 
1759
                                
 
1760
                                        set file [file join $path $name.tcl]
 
1761
                                        
 
1762
                                        if { ![file writable $file] } {
 
1763
                                                set protected 1
 
1764
                                        } else {
 
1765
                                                set main "$::plugins::plgonlineversion"
 
1766
                                                set updated 1
 
1767
                                        }
 
1768
                                        
 
1769
                                } else {
 
1770
                                        set main 0
 
1771
                                }
 
1772
                                
 
1773
 
 
1774
                                # Check each language file
 
1775
                                
 
1776
                                set langlist [list]
 
1777
                                
 
1778
                                foreach onlinelang $::plugins::plgonlinelang {
 
1779
                                        set langcode [lindex $onlinelang 0]
 
1780
                                        set onlineversion [lindex $onlinelang 1]
 
1781
                                        if { [::lang::LangExists $langcode] } {
 
1782
                                                set id [expr {[lsearch $::plugins::plglang $langcode] + 1}]
 
1783
                                                if { $id == 0 } {
 
1784
                                                        set version "0.0"
 
1785
                                                } else {
 
1786
                                                        set version [lindex $::plugins::plglang $id]
 
1787
                                                }
 
1788
                                                if { [::plugins::DetectNew $version $onlineversion] } {
 
1789
                                                
 
1790
                                                        set file [file join $path "lang" lang$langcode]
 
1791
                                                        
 
1792
                                                        if { [file exists $file] && ![file writable $file] } {
 
1793
                                                                set protected 1
 
1794
                                                        } else {
 
1795
                                                                set langlist [lappend langlist "$langcode" "$onlineversion"]
 
1796
                                                                set updated 1
 
1797
                                                        }
 
1798
                                                        
 
1799
                                                }
 
1800
                                        }
 
1801
                                }
 
1802
 
 
1803
 
 
1804
                                # Check each other file
 
1805
                                
 
1806
                                set filelist [list]
 
1807
                                
 
1808
                                foreach onlinefile $::plugins::plgonlinefile {
 
1809
                                        set file [lindex $onlinefile 0]
 
1810
                                        set onlineversion [lindex $onlinefile 1]
 
1811
                                        set id [expr {[lsearch $::plugins::plgfile $file] + 1}]
 
1812
                                        if { $id == 0 } {
 
1813
                                                set version "0.0"
 
1814
                                        } else {
 
1815
                                                set version [lindex $::plugins::plgfile $id]
 
1816
                                        }
 
1817
                                        if { [::plugins::DetectNew $version $onlineversion] } {
 
1818
                                                set file2 [file join $path $file]
 
1819
                                                if { [file exists $file2] && ![file writable $file2] } {
 
1820
                                                        set protected 1
 
1821
                                                } else {
 
1822
                                                        set filelist [lappend filelist "$file" "$onlineversion"]
 
1823
                                                        set updated 1
 
1824
                                                }
 
1825
                                        }
 
1826
                                }
 
1827
                                
 
1828
                                array set ::plugins::UpdatedPlugin$name [list main "$main" lang "$langlist" file "$filelist" URLmain "$::plugins::plgonlineURLmain" URLlang "$::plugins::plgonlineURLlang" URLfile "$::plugins::plgonlineURLfile"]
 
1829
 
 
1830
                                # If the plugin has been updated and no file is protected, add it to the updated plugin list
 
1831
                                if { $updated == 1 && $protected == 0 } {
 
1832
                                        set ::plugins::UpdatedPlugins [lappend ::plugins::UpdatedPlugins $plugin]
 
1833
                                } elseif { $updated == 1 && $protected == 1 } {
 
1834
                                        status_log "Can't update $plugin : files protected\n" red
 
1835
                                }
 
1836
                                
 
1837
                        } else {
 
1838
                        
 
1839
                                status_log "Can't update $name : required version $::plugins::plgonlinerequire\n" red
 
1840
                                        
 
1841
                        }
 
1842
 
 
1843
                        
 
1844
                }
 
1845
 
 
1846
        }
 
1847
 
 
1848
 
 
1849
#/////////////////////////////////////////////////////
 
1850
# Detect if the online version if upper than the current version
 
1851
 
 
1852
        proc DetectNew { version onlineversion } {
 
1853
 
 
1854
                set current [split $version "."]
 
1855
                set new [split $onlineversion "."]
 
1856
                if { $version == "" || $onlineversion == ""} {
 
1857
                        return 0
 
1858
                } elseif { [lindex $new 0] > [lindex $current 0] } {
 
1859
                        return 1
 
1860
                } elseif { [lindex $new 1] > [lindex $current 1] } {
 
1861
                        return 1
 
1862
 
 
1863
                } else {
 
1864
                        return 0
 
1865
                }
 
1866
 
 
1867
        }
 
1868
 
 
1869
 
 
1870
#/////////////////////////////////////////////////////
 
1871
# Read the updated file of a plugi
 
1872
 
 
1873
        proc ReadPluginUpdates { name array } {
 
1874
 
 
1875
                set list [array get ::plugins::UpdatedPlugin$name]
 
1876
                set index [lsearch $list $array]
 
1877
                if { $index != -1 } {
 
1878
                        return [lindex $list [expr {$index + 1}]]
 
1879
                } else {
 
1880
                        return ""
 
1881
                }
 
1882
        
 
1883
        }
 
1884
 
 
1885
 
 
1886
#/////////////////////////////////////////////////////
 
1887
# Save plugininfo.xml
 
1888
 
 
1889
        proc SavePlugininfo { plugin path } {
 
1890
 
 
1891
                global HOME2
 
1892
                
 
1893
                set name [lindex $plugin 6]
 
1894
                set file "[file join $HOME2 $name.xml]"
 
1895
 
 
1896
                if { [file exists $file] } {
 
1897
                        file delete $path
 
1898
                        file copy $file $path
 
1899
                        file delete $file
 
1900
                } else {
 
1901
                        status_log "Error while updating $name : can't find plugininfo.xml\n"
 
1902
                }
 
1903
 
 
1904
        }
 
1905
 
 
1906
 
 
1907
 
1077
1908
}
 
1909