195
192
proc UnRegisterEvents { plugin } {
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 } {
202
set namespace [lindex $::plugins::found $pluginidx 6]
199
set namespace [lindex [lindex $::plugins::found $pluginidx] 6]
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]
214
###############################################################
217
# Finds out if a proc was called by a plugin.
223
# -1 - not called by a plugin
224
# $pluginnamespace - the namespace of the plugin calling the proc
228
#check for execution from the top level
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 ":"]
240
if {[llength $parts] > 1} {
241
#see above comment why '2'
242
set namespace [lindex $parts 2]
244
#it is just a top level proc :(
248
if {[::plugins::namespaceExists $namespace] == 1} {
251
#this namespace dosn't belong to any plugin
256
###############################################################
257
# namespaceExists (namespace)
259
# finds out if a namespace belongs to a plugin
262
# namespace - namespace to check for (without ::)
269
proc namespaceExists {namespace} {
273
set plist [array get plugins]
274
#loop till something returns
277
set idx [lsearch -exact $plist $namespace]
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"} {
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]
297
###############################################################
298
# updatePluginsArray ()
300
# Updates the plugins array which holds info about plugins
306
# number of plugins in array
309
proc updatePluginsArray { } {
312
foreach plugin [findplugins] {
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]
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
218
339
###############################################################
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} {
358
488
# create window and give it it's title
360
490
wm title $w [trans pluginselector]
362
# frame that holds the selection dialog
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
368
label $w.desc.name_title -text [trans name] -font sboldf
370
label $w.desc.author_title -text [trans author] -font sboldf
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
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"
497
# holds the plugins info like name and description
498
label $w.name_title -text [trans name] -font sboldf
500
label $w.version_title -text [trans version] -font sboldf
502
label $w.author_title -text [trans author] -font sboldf
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"
382
# add the plugins to the list
383
# idx will be used as a counter
385
512
# loop through all the found plugins
386
foreach plugin [findplugins] {
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]
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
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
415
$w.select.plugin_list itemconfigure $idx -background #FFFFFF
417
# increase the counter
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
522
$w.plugin_list itemconfigure $idx -background #FFFFFF
526
$w.plugin_list configure -height $idx
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"
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
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
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
443
548
moveinscreen $w 30
598
719
proc GUI_Config { } {
599
# selection, will configure it
603
#If the window is already here, just raise it to the front
604
if { [winfo exists $w.winconf] } {
608
# current config, see it's declaration for more info
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]
633
set winconf [toplevel $w.winconf]
634
set confwin [frame $winconf.area]
635
# id used for the item name in the widget
639
# loop through all the items
640
foreach confitem [set ::${namespace}::configlist] {
641
# Increment both variables
644
# Check the configuration item type and create it in the GUI
645
switch [lindex $confitem 0] {
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
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
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
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
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
720
# selection, will configure it
724
#If the window is already here, just raise it to the front
725
if { [winfo exists $w.winconf] } {
729
# current config, see it's declaration for more info
731
# list of callbacks for pressing save of frame types
732
variable saveframelist
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"
753
} else { # configlist exists
754
# backup the current config
755
array set cur_config [array get ::${namespace}::config]
757
set winconf [toplevel $w.winconf]
758
set confwin [frame $winconf.area]
759
# id used for the item name in the widget
761
# loop through all the items
762
foreach confitem [set ::${namespace}::configlist] {
763
# Increment both variables
765
# Check the configuration item type and create it in the GUI
766
switch [lindex $confitem 0] {
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
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
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
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
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
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
811
bind $confwin.$i <<ListboxSelect>> "::plugins::lst_refresh $confwin.$i ::${namespace}::config([lindex $confitem 2])"
812
pack $confwin.$i -anchor w -padx 40
815
# This configuration item contains radiobutton
816
set buttonlist [lrange $confitem 1 end-1]
818
foreach item $buttonlist {
820
radiobutton $confwin.$i -text "$item" -variable ::${namespace}::config([lindex $confitem end]) -value $value
821
pack $confwin.$i -anchor w -padx 40
827
# This configureation item creates a frame so the plugin can place whatever it like inside
829
[lindex $confitem 1] $confwin.$i
830
if { "[lindex $confitem 2]" != "" } {
831
lappend saveframelist "[lindex $confitem 2] $confwin.$i"
833
pack $confwin.$i -fill x -anchor w
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
839
# set the name of the winconf
840
wm title $w.winconf "[trans configure] $selection(name)"
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
854
###############################################################
855
# lst_refresh (path, config)
857
# The list box on config window changes its selected value, so
858
# this proc refresh the associated variable with the new value
861
# path - The listbox widget path
862
# config - The complete config entry (with plugin namespace)
867
proc lst_refresh { path config } {
868
set ${config} [$path get [$path curselection] [$path curselection]]
1074
1293
set ::${cur_plugin}_cfg($sdata(${cstack}:key)) $sdata(${cstack}:value);
1298
#/////////////////////////////////////////////////////
1299
# Load the XML information of a plugin
1301
proc get_Version { path plugin } {
1303
set ::plugins::plgversion ""
1304
set ::plugins::plglang ""
1305
set ::plugins::plgfile ""
1306
set ::plugins::URL_plugininfo ""
1308
set id [::sxml::init $path]
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"
1326
proc XML_Plugin_CVS { cstack cdata saved_data cattr saved_attr args } {
1328
upvar $saved_data sdata
1330
catch {set ::plugins::plgversion $sdata(${cstack}:cvs_version)}
1337
proc XML_Plugin_Lang { cstack cdata saved_data cattr saved_attr args } {
1339
upvar $saved_data sdata
1341
catch {lappend ::plugins::plglang "$sdata(${cstack}:langcode)" "$sdata(${cstack}:version)"}
1348
proc XML_Plugin_File { cstack cdata saved_data cattr saved_attr args } {
1350
upvar $saved_data sdata
1352
catch {lappend ::plugins::plgfile "$sdata(${cstack}:path)" "$sdata(${cstack}:version)"}
1359
proc XML_Plugin_URL { cstack cdata saved_data cattr saved_attr args } {
1361
upvar $saved_data sdata
1363
catch {set ::plugins::URL_plugininfo "$sdata(${cstack}:plugininfo)"}
1368
#/////////////////////////////////////////////////////
1369
# Get the plugininfo.xml on the CVS, and load it
1371
proc get_OnlineVersion { path plugin {URL ""} } {
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 ""
1384
set program_dir [set ::program_dir]
1388
# If no URL is given, look at the CVS URL
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 } {
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 } {
1407
# Else, look at the URL given
1410
set token [::http::geturl "$URL" -timeout 120000 -binary 1]
1411
set content [::http::data $token]
1412
if { [string first "<html>" "$content"] != -1 } {
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
1425
set filename "[file join $HOME2 $plugin.xml]"
1426
set fid [open $filename w]
1427
fconfigure $fid -encoding binary
1428
puts -nonewline $fid "$content"
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"
1441
status_log "Can't get online plugininfo.xml for $plugin (place $place - URL $URL)\n" red
1451
proc XML_OnlinePlugin_CVS { cstack cdata saved_data cattr saved_attr args } {
1453
upvar $saved_data sdata
1455
catch {set ::plugins::plgonlinerequire $sdata(${cstack}:amsn_version)}
1456
catch {set ::plugins::plgonlineversion $sdata(${cstack}:cvs_version)}
1463
proc XML_OnlinePlugin_Lang { cstack cdata saved_data cattr saved_attr args } {
1465
upvar $saved_data sdata
1467
catch {lappend ::plugins::plgonlinelang [list $sdata(${cstack}:langcode) $sdata(${cstack}:version)]}
1474
proc XML_OnlinePlugin_File { cstack cdata saved_data cattr saved_attr args } {
1476
upvar $saved_data sdata
1478
catch {lappend ::plugins::plgonlinefile [list $sdata(${cstack}:path) $sdata(${cstack}:version)]}
1485
proc XML_OnlinePlugin_URL { cstack cdata saved_data cattr saved_attr args } {
1487
upvar $saved_data sdata
1489
catch {set ::plugins::plgonlineURLmain "$sdata(${cstack}:main)"}
1490
catch {set ::plugins::plgonlineURLlang "$sdata(${cstack}:lang)"}
1491
catch {set ::plugins::plgonlineURLfile "$sdata(${cstack}:file)"}
1498
#/////////////////////////////////////////////////////
1499
# Update the plugin (.tcl file)
1501
proc UpdateMain { plugin path version place URL } {
1505
# If we already have the current version
1506
if { $version == 0 } {
1510
set program_dir [set ::program_dir]
1512
set w ".updatelangplugin"
1514
if { [winfo exists $w] } {
1515
$w.update.txt configure -text "[trans updating] $plugin..."
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]
1529
set status [::http::status $token]
1530
if { $status != "ok" } {
1534
set content [::http::data $token]
1536
if { [string first "<html>" "$content"] != -1 } {
1540
set filename [file join $path $plugin.tcl]
1541
set fid [open $filename w]
1542
fconfigure $fid -encoding binary
1543
puts -nonewline $fid "$content"
1550
#/////////////////////////////////////////////////////
1551
# Update the language files
1553
proc UpdateLangs { plugin path langcodes place URL } {
1557
set program_dir [set ::program_dir]
1559
set w ".updatelangplugin"
1562
foreach { langcode version} $langcodes {
1564
if { [winfo exists $w] } {
1565
$w.update.txt configure -text "[trans updating] $plugin : lang$langcode..."
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]
1579
set status [::http::status $token]
1580
if { $status != "ok" } {
1584
set content [::http::data $token]
1586
if { [string first "<html>" "$content"] != -1 } {
1590
set filename [file join $path "lang" lang$langcode]
1592
set fid [open $filename w]
1593
fconfigure $fid -encoding binary
1594
puts -nonewline $fid "$content"
1603
#/////////////////////////////////////////////////////
1604
# Delete a language file of a plugin
1606
proc DeleteLang { plugin langcode path} {
1608
set id [lsearch $::plugins::plglang $langcode]
1611
set file "[file join $path "lang" "lang$langcode"]"
1613
set ::plugins::plglang [lreplace $::plugins::plglang $id [expr {$id + 1}]]
1614
status_log "Plugin autoupdate : delete $file\n" blue
1619
#/////////////////////////////////////////////////////
1620
# Update all the others files (pictures, sounds...)
1622
proc UpdateFiles { plugin path files place URL } {
1626
set program_dir [set ::program_dir]
1628
set w ".updatelangplugin"
1630
foreach { file version } $files {
1632
if { [winfo exists $w] } {
1633
$w.update.txt configure -text "[trans updating] $plugin : $file..."
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]
1647
set status [::http::status $token]
1648
if { $status != "ok" } {
1652
set content [::http::data $token]
1654
if { [string first "<html>" "$content"] != -1 } {
1658
set filename [file join $path $file]
1660
set dir [file join $path [file dirname $file]]
1661
if { ![file isdirectory $dir] } {
1663
status_log "Auto-update ($plugin) : create dir $dir\n" red
1666
set fid [open $filename w]
1667
fconfigure $fid -encoding binary
1668
puts -nonewline $fid "$content"
1677
#/////////////////////////////////////////////////////
1680
proc UpdatePlugin { plugin } {
1682
variable loadedplugins
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]
1692
set path "[string range $path 0 end-[expr {[string length $name] + 5}]]"
1693
set pathinfo "$path/plugininfo.xml"
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]
1702
# if no error occurs while updating the plugin, save the plugininfo.xml file
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]
1708
status_log "Error while updating $name\n" red
1709
} elseif { $mainstate == 1 && $langstate == 1 && $filestate == 1 } {
1710
SavePlugininfo "$plugin" "$pathinfo"
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
1719
status_log "Error while updating $name : main $mainstate, lang $langstate, file $filestate\n" red
1725
#/////////////////////////////////////////////////////
1727
proc UpdatedPlugins { } {
1729
set ::plugins::UpdatedPlugins [list]
1731
foreach plugin [::plugins::findplugins] {
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"
1742
if { ![file writable $pathinfo] } {
1746
set place [::plugins::get_OnlineVersion "$pathinfo" "$name" "$::plugins::URL_plugininfo"]
1748
if { $place == 0 || ![info exist ::plugins::plgonlinerequire] || $::plugins::plgonlinerequire == ""} {
1752
set plugin [lappend plugin $place]
1754
# If the online plugin is compatible with the current version of aMSN
1755
if { [::plugins::CheckRequirements $::plugins::plgonlinerequire] } {
1757
# If the main file has been updated
1758
if { [::plugins::DetectNew "$::plugins::plgversion" "$::plugins::plgonlineversion"] } {
1760
set file [file join $path $name.tcl]
1762
if { ![file writable $file] } {
1765
set main "$::plugins::plgonlineversion"
1774
# Check each language file
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}]
1786
set version [lindex $::plugins::plglang $id]
1788
if { [::plugins::DetectNew $version $onlineversion] } {
1790
set file [file join $path "lang" lang$langcode]
1792
if { [file exists $file] && ![file writable $file] } {
1795
set langlist [lappend langlist "$langcode" "$onlineversion"]
1804
# Check each other file
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}]
1815
set version [lindex $::plugins::plgfile $id]
1817
if { [::plugins::DetectNew $version $onlineversion] } {
1818
set file2 [file join $path $file]
1819
if { [file exists $file2] && ![file writable $file2] } {
1822
set filelist [lappend filelist "$file" "$onlineversion"]
1828
array set ::plugins::UpdatedPlugin$name [list main "$main" lang "$langlist" file "$filelist" URLmain "$::plugins::plgonlineURLmain" URLlang "$::plugins::plgonlineURLlang" URLfile "$::plugins::plgonlineURLfile"]
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
1839
status_log "Can't update $name : required version $::plugins::plgonlinerequire\n" red
1849
#/////////////////////////////////////////////////////
1850
# Detect if the online version if upper than the current version
1852
proc DetectNew { version onlineversion } {
1854
set current [split $version "."]
1855
set new [split $onlineversion "."]
1856
if { $version == "" || $onlineversion == ""} {
1858
} elseif { [lindex $new 0] > [lindex $current 0] } {
1860
} elseif { [lindex $new 1] > [lindex $current 1] } {
1870
#/////////////////////////////////////////////////////
1871
# Read the updated file of a plugi
1873
proc ReadPluginUpdates { name array } {
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}]]
1886
#/////////////////////////////////////////////////////
1887
# Save plugininfo.xml
1889
proc SavePlugininfo { plugin path } {
1893
set name [lindex $plugin 6]
1894
set file "[file join $HOME2 $name.xml]"
1896
if { [file exists $file] } {
1898
file copy $file $path
1901
status_log "Error while updating $name : can't find plugininfo.xml\n"