00001 # TKE - Advanced Programmer's Editor
00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00003 #
00004 # This program is free software; you can redistribute it and/or modify
00005 # it under the terms of the GNU General Public License as published by
00006 # the Free Software Foundation; either version 2 of the License, or
00007 # (at your option) any later version.
00008 #
00009 # This program is distributed in the hope that it will be useful,
00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00012 # GNU General Public License for more details.
00013 #
00014 # You should have received a copy of the GNU General Public License along
00015 # with this program; if not, write to the Free Software Foundation, Inc.,
00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00017
00018 ######################################################################
00019 # Name: plugmgr.tcl
00020 # Author: Trevor Williams (phase1geo@gmail.com)
00021 # Date: 12/06/2018
00022 # Brief: Namespace for the plugin manager.
00023 ######################################################################
00024
00025 namespace eval plugmgr {
00026
00027 variable current_id ""
00028
00029 array set default_pdata {
00030 author "Anonymous"
00031 email ""
00032 website ""
00033 version "1.0"
00034 category "Miscellaneous"
00035 description ""
00036 release_notes ""
00037 overview ""
00038 }
00039
00040 array set database {
00041 plugins {}
00042 }
00043 array set widgets {}
00044
00045 # TEMPORARY
00046 # array set database {
00047 # plugins {
00048 # 0 {installed 1 update_avail 0 display_name {Plugin 0} author {Trevor Williams} email {phase1geo@gmail.com} website {http://www.apple.com} version {1.2.2} category miscellaneous description "Quick\ndescription\nYes" release_notes {Some release notes} overview {<p>This is a really great overview of 0!</p>}}
00049 # 1 {installed 0 update_avail 0 display_name {Plugin 1} author {Trevor Williams} email {phase1geo@gmail.com} website {} version {2.0} category miscellaneous description {Another quick description} release_notes {Some release notes about nothing} overview {<p>This is a really great overview of 1!</p>}}
00050 # 2 {installed 0 update_avail 0 display_name {Plugin 2} author {Trevor Williams} email {phase1geo@gmail.com} website {} version {2.3} category miscellaneous description {Quick description 2} release_notes {My release notes} overview {<p>This is a really great overview of 2!</p>}}
00051 # 3 {installed 1 update_avail 1 display_name {Plugin 3} author {Trevor Williams} email {phase1geo@gmail.com} website {} version {2.4.1} category filesystem description {Quick description 3} release_notes {My release notes} overview {<p>This is a really great overview of 3!</p>}}
00052 # 4 {installed 1 update_avail 0 display_name {Plugin 4} author {Trevor Williams} email {phase1geo@gmail.com} website {} version {1.5.2} category filesystem description {Quick description 4} release_notes {My release notes} overview {<p>This is a really great overview of 4!</p>}}
00053 # }
00054 # }
00055
00056 ######################################################################
00057 # Adds a single plugin to the plugin database file. Returns the
00058 # data that is stored in the plugin entry.
00059 proc add_plugin {dbfile name args} {
00060
00061 variable default_pdata
00062
00063 # Store the important plugin values
00064 array set pdata [array get default_pdata]
00065 foreach {attr value} $args {
00066 if {[info exists pdata($attr)]} {
00067 set pdata($attr) $value
00068 }
00069 }
00070
00071 if {[file exists $dbfile]} {
00072
00073 # Read in the existing values
00074 if {[catch { tkedat::read $dbfile } rc]} {
00075 return -code error "Unable to read the given plugin database file"
00076 }
00077
00078 array set data $rc
00079 array set plugins $data(plugins)
00080
00081 }
00082
00083 set plugins($name) [array get pdata]
00084 set data(plugins) [array get plugins]
00085
00086 # Save the file
00087 if {[catch { tkedat::write $dbfile [array get data] } rc]} {
00088 return -code error "Unable to update the plugin database file"
00089 }
00090
00091 return [array get pdata]
00092
00093 }
00094
00095 ######################################################################
00096 # Displays the popup window to allow the user to adjust plugin information
00097 # prior to exporting.
00098 proc export_win {plugdir} {
00099
00100 set w [toplevel .pmewin]
00101 wm title $w [msgcat::mc "Export Plugin"]
00102 wm transient $w .
00103
00104 ttk::frame $w.tf
00105 ttk::label $w.tf.vl -text [format "%s: " [msgcat::mc "Version"]]
00106 ttk::combobox $w.tf.vcb
00107 ttk::label $w.tf.rl -text [format "%s: \n(%s)" [msgcat::mc "Release Notes"] [msgcat::mc "Markdown"]] -justify center
00108 ttk::label $w.tf.ol -text [format "%s: " [msgcat::mc "Output Directory"]]
00109 ttk::entry $w.tf.oe
00110 ttk::button $w.tf.ob -style BButton -text [msgcat::mc "Choose"] -command [list plugmgr::choose_output_dir $w]
00111
00112 ttk::frame $w.tf.tf
00113 text $w.tf.tf.t -wrap word -yscrollcommand [list $w.tf.tf.vb set]
00114 ttk::scrollbar $w.tf.tf.vb -orient vertical -command [list $w.tf.tf.t xview]
00115
00116 grid rowconfigure $w.tf.tf 0 -weight 1
00117 grid columnconfigure $w.tf.tf 0 -weight 1
00118 grid $w.tf.tf.t -row 0 -column 0 -sticky news
00119 grid $w.tf.tf.vb -row 0 -column 1 -sticky ns
00120
00121 grid rowconfigure $w.tf 1 -weight 1
00122 grid columnconfigure $w.tf 1 -weight 1
00123 grid $w.tf.vl -row 0 -column 0 -sticky nw -padx 2 -pady 2
00124 grid $w.tf.vcb -row 0 -column 1 -sticky news -padx 2 -pady 2
00125 grid $w.tf.rl -row 1 -column 0 -sticky nw -padx 2 -pady 2
00126 grid $w.tf.tf -row 1 -column 1 -sticky news -padx 2 -pady 2
00127 grid $w.tf.ol -row 2 -column 0 -sticky nw -padx 2 -pady 2
00128 grid $w.tf.oe -row 2 -column 1 -sticky news -padx 2 -pady 2
00129 grid $w.tf.ob -row 2 -column 2 -sticky news -padx 2 -pady 2
00130
00131 ttk::separator $w.sep -orient horizontal
00132
00133 set width [msgcat::mcmax "Export" "Cancel"]
00134
00135 ttk::frame $w.bf
00136 ttk::button $w.bf.export -style BButton -text [msgcat::mc "Export"] -width $width -command [list plugmgr::export $w $plugdir] -state disabled
00137 ttk::button $w.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width $width -command [list destroy $w]
00138
00139 pack $w.bf.cancel -side right -padx 2 -pady 2
00140 pack $w.bf.export -side right -padx 2 -pady 2
00141
00142 pack $w.tf -fill both -expand yes
00143 pack $w.sep -fill x
00144 pack $w.bf -fill x
00145
00146 # Get the field values to populate
00147 lassign [get_versions $plugdir] version next_versions
00148 set release_notes [get_release_notes $plugdir]
00149
00150 # Populate fields
00151 $w.tf.vcb configure -values $next_versions
00152 $w.tf.vcb set $version
00153 $w.tf.tf.t insert end $release_notes
00154 $w.tf.oe insert end [preferences::get General/DefaultPluginExportDirectory]
00155 $w.tf.oe configure -state readonly
00156
00157 # Set the focus on the version entry field
00158 focus $w.tf.vcb
00159
00160 # Make sure that the state of the export button is set properly
00161 handle_export_button_state $w
00162
00163 }
00164
00165 ######################################################################
00166 # Updates the state of the export button.
00167 proc handle_export_button_state {w {version ""}} {
00168
00169 if {$version eq ""} {
00170 set version [$w.tf.vcb get]
00171 }
00172
00173 set odir [$w.tf.oe get]
00174
00175 if {[regexp {^\d+(\.\d+)+$} $version] && ($odir ne "")} {
00176 $w.bf.export configure -state normal
00177 } else {
00178 $w.bf.export configure -state disabled
00179 }
00180
00181 }
00182
00183 ######################################################################
00184 # If the given value is a valid version value, allow the Export button
00185 # to be clickable.
00186 proc check_version {w value} {
00187
00188 handle_export_button_state $w $value
00189
00190 return 1
00191
00192 }
00193
00194 ######################################################################
00195 # Allows the user to select an alternative output directory.
00196 proc choose_output_dir {w} {
00197
00198 # Get the current output directory
00199 set initial_dir [$w.tf.oe get]
00200
00201 if {$initial_dir eq ""} {
00202 if {[preferences::get General/DefaultPluginExportDirectory] ne ""} {
00203 set initial_dir [preferences::get General/DefaultPluginExportDirectory]
00204 } else {
00205 set initial_dir [gui::get_browse_directory]
00206 }
00207 }
00208
00209 # Get the directory to save the file to
00210 if {[set odir [tk_chooseDirectory -parent $w -initialdir $initial_dir]] ne ""} {
00211 $w.tf.oe configure -state normal
00212 $w.tf.oe delete 0 end
00213 $w.tf.oe insert end $odir
00214 $w.tf.oe configure -state disabled
00215 handle_export_button_state $w
00216 }
00217
00218 }
00219
00220 ######################################################################
00221 # Get version information from the given plugin directory.
00222 proc get_versions {plugdir} {
00223
00224 if {[catch { tkedat::read [file join $plugdir header.tkedat] } rc]} {
00225 return [list "1.0" {}]
00226 } else {
00227 array set header $rc
00228 set i 0
00229 set version [split $header(version) .]
00230 foreach num $version {
00231 if {$i == 0} {
00232 lappend next_versions "[expr $num + 1].0"
00233 } else {
00234 lappend next_versions [join [list {*}[lrange $version 0 [expr $i - 1]] [expr $num + 1]] .]
00235 }
00236 incr i
00237 }
00238 set next_versions [linsert $next_versions end-1 [join [list {*}$version 1] .]]
00239 return [list $header(version) [lreverse $next_versions]]
00240 }
00241
00242 }
00243
00244 ######################################################################
00245 # Get release notes from the given plugin directory.
00246 proc get_release_notes {plugdir} {
00247
00248 if {[catch { open [file join $plugdir release_nodes.md] r } rc]} {
00249 return ""
00250 }
00251
00252 set contents [read $rc]
00253 close $rc
00254
00255 return $contents
00256
00257 }
00258
00259 ######################################################################
00260 # Update the version information.
00261 proc update_version {plugdir version} {
00262
00263 set header [file join $plugdir header.tkedat]
00264
00265 if {[catch { tkedat::read $header 0 } rc]} {
00266 return -code error "Unable to read header.tkedat"
00267 }
00268
00269 array set contents $rc
00270
00271 if {$version ne $contents(version)} {
00272 set contents(version) $version
00273 if {[catch { tkedat::write $header [array get contents] 0 } rc]} {
00274 return -code error "Unable to write header.tkedat"
00275 }
00276 }
00277
00278 }
00279
00280 ######################################################################
00281 # Updates the given release notes.
00282 proc update_release_notes {plugdir notes} {
00283
00284 set release_notes [file join $plugdir release_notes.md]
00285
00286 if {[catch { open $release_notes w } rc]} {
00287 return -code error "Unable to write release notes"
00288 }
00289
00290 puts $rc $notes
00291 close $rc
00292
00293 }
00294
00295 ######################################################################
00296 # Takes the version number and the release notes and puts them into the
00297 # plugin directory and then perform the bundling process.
00298 proc export {w plugdir} {
00299
00300 # Get the values from the interface
00301 set version [$w.tf.vcb get]
00302 set release_notes [$w.tf.tf.t get 1.0 end-1c]
00303 set odir [$w.tf.oe get]
00304
00305 # Update the version information
00306 update_version $plugdir $version
00307
00308 # Update the release notes
00309 update_release_notes $plugdir $release_notes
00310
00311 # Create the plugin bundle
00312 if {[plugins::export_plugin . [file tail $plugdir] $odir]} {
00313 gui::set_info_message [msgcat::mc "Plugin export completed successfully"]
00314 }
00315
00316 # Destroy the window
00317 destroy $w
00318
00319 }
00320
00321 ######################################################################
00322 # Creates the main pluging manager window.
00323 proc manager_win {} {
00324
00325 variable widgets
00326
00327 set w [toplevel .pmwin]
00328 wm title $w [msgcat::mc "Plugin Manager"]
00329 wm transient $w .
00330
00331 set bwidth [msgcat::mcmax "Available" "Installed"]
00332
00333 ttk::frame $w.nf
00334 ttk::frame $w.nf.f
00335 set widgets(available_btn) [ttk::button $w.nf.f.avail -style BButton -text [msgcat::mc "Available"] -width $bwidth -command plugmgr::available_selected]
00336 set widgets(installed_btn) [ttk::button $w.nf.f.install -style BButton -text [msgcat::mc "Installed"] -width $bwidth -command plugmgr::installed_selected]
00337
00338 bind $widgets(available_btn) <Leave> {
00339 after idle {
00340 if {$plugmgr::last_pane eq "available"} {
00341 %W state active
00342 }
00343 }
00344 }
00345 bind $widgets(installed_btn) <Leave> {
00346 after idle {
00347 if {$plugmgr::last_pane eq "installed"} {
00348 %W state active
00349 }
00350 }
00351 }
00352
00353 pack $w.nf.f.avail -side left -padx 4 -pady 2
00354 pack $w.nf.f.install -side left -padx 4 -pady 2
00355
00356 pack $w.nf.f -side top
00357
00358 set widgets(nb) [ttk::notebook $w.nb -style Plain.TNotebook]
00359
00360 $widgets(nb) add [set widgets(available) [create_available_pane $widgets(nb).avail]]
00361 $widgets(nb) add [set widgets(installed) [create_installed_pane $widgets(nb).install]]
00362 $widgets(nb) add [set widgets(detail) [create_detail_pane $widgets(nb).detail]]
00363
00364 pack $w.nf -fill x
00365 pack $widgets(nb) -fill both -expand yes
00366
00367 # Make sure that everything looks correct theme-wise
00368 update_theme
00369
00370 # Load the plugin database from the server
00371 load_database
00372
00373 # Make the available notebook pane the visible panel
00374 available_selected
00375
00376 }
00377
00378 ######################################################################
00379 # Create the available plugin pane.
00380 proc create_table_pane {w type} {
00381
00382 variable widgets
00383
00384 ttk::frame $w
00385
00386 ttk::frame $w.sf
00387 set widgets($type,search) [wmarkentry::wmarkentry $w.sf.e -validate key -validatecommand [list plugmgr::do_search $type %P] -width 30 -watermark [msgcat::mc "Search"]]
00388
00389 if {$type eq "installed"} {
00390 set widgets($type,pupdate) [ttk::button $w.sf.upd -style BButton -text [msgcat::mc "Update All"] -command plugmgr::pupdate_all]
00391 pack $w.sf.upd -side right -padx 2 -pady 2
00392 }
00393
00394 pack $w.sf.e -side left -padx 2 -pady 2
00395
00396 ttk::frame $w.lf
00397 set widgets($type,table) [tablelist::tablelist $w.lf.tl -columns [list 0 [msgcat::mc "Plugins"]] \
00398 -stretch all -exportselection 1 -selectmode browse -showlabels 0 -relief flat -bd 0 -highlightthickness 0 \
00399 -yscrollcommand [list $w.lf.vb set]]
00400 set widgets($type,scroll) [scroller::scroller $w.lf.vb -orient vertical -command [list $w.lf.tl yview]]
00401
00402 $widgets($type,table) columnconfigure 0 -name plugin -stretchable 1 -wrap 1 -editable 0 -formatcommand plugmgr::format_plugin_cell
00403
00404 bind [$widgets($type,table) bodytag] <Return> plugmgr::show_detail
00405 bind [$widgets($type,table) bodytag] <Double-Button-1> plugmgr::show_detail
00406
00407 grid rowconfigure $w.lf 0 -weight 1
00408 grid columnconfigure $w.lf 0 -weight 1
00409 grid $w.lf.tl -row 0 -column 0 -sticky news
00410 grid $w.lf.vb -row 0 -column 1 -sticky ns
00411
00412 pack $w.sf -fill x -padx 2 -pady 4
00413 pack $w.lf -fill both -expand yes -padx 2 -pady 4
00414
00415 return $w
00416
00417 }
00418
00419 ######################################################################
00420 # Make sure that the plugin cell does not display the data natively.
00421 proc format_plugin_cell {value} {
00422
00423 return ""
00424
00425 }
00426
00427 ######################################################################
00428 # Creates the available plugin pane.
00429 proc create_available_pane {w} {
00430
00431 return [create_table_pane $w available]
00432
00433 }
00434
00435 ######################################################################
00436 # Creates the installed plugin pane.
00437 proc create_installed_pane {w} {
00438
00439 return [create_table_pane $w installed]
00440
00441 }
00442
00443 ######################################################################
00444 # Creates the detail pane.
00445 proc create_detail_pane {w} {
00446
00447 variable widgets
00448
00449 ttk::frame $w
00450
00451 set bwidth [msgcat::mcmax "Back" "Install" "Uninstall" "Update" "Delete"]
00452
00453 ttk::frame $w.bf
00454 set widgets(back) [ttk::button $w.bf.back -style BButton -compound left -image search_prev -text [msgcat::mc "Back"] -width $bwidth -command [list plugmgr::go_back]]
00455 set widgets(install) [ttk::button $w.bf.install -style BButton -text [msgcat::mc "Install"] -width $bwidth -command [list plugmgr::install]]
00456 set widgets(pupdate) [ttk::button $w.bf.pupdate -style BButton -text [msgcat::mc "Update"] -width $bwidth -command [list plugmgr::pupdate]]
00457 set widgets(uninstall) [ttk::button $w.bf.uninstall -style BButton -text [msgcat::mc "Uninstall"] -width $bwidth -command [list plugmgr::uninstall]]
00458
00459 grid rowconfigure $w.bf 0 -weight 1
00460 grid columnconfigure $w.bf 1 -weight 1
00461 grid $w.bf.back -row 0 -column 0 -sticky news -padx 4 -pady 2
00462 grid $w.bf.install -row 0 -column 2 -sticky news -padx 4 -pady 2
00463 grid $w.bf.pupdate -row 0 -column 3 -sticky news -padx 4 -pady 2
00464 grid $w.bf.uninstall -row 0 -column 4 -sticky news -padx 4 -pady 2
00465
00466 # Create HTML viewer
00467 ttk::frame $w.hf
00468 set widgets(html) [text $w.hf.t -highlightthickness 0 -bd 0 -cursor arrow -yscrollcommand [list $w.hf.vb set]]
00469 set widgets(html,vb) [scroller::scroller $w.hf.vb -orient vertical -command [list $w.hf.t yview]]
00470
00471 # Make the HTML text widget setup to show HTML syntax
00472 HMinitialize $widgets(html)
00473
00474 grid rowconfigure $w.hf 0 -weight 1
00475 grid columnconfigure $w.hf 0 -weight 1
00476 grid $w.hf.t -row 0 -column 0 -sticky news
00477 grid $w.hf.vb -row 0 -column 1 -sticky ns
00478
00479 pack $w.bf -fill x -padx 2 -pady 2
00480 pack $w.hf -fill both -expand yes -padx 2 -pady 2
00481
00482 return $w
00483
00484 }
00485
00486 ######################################################################
00487 # Handle the Back button being pressed in the detail pane.
00488 proc go_back {} {
00489
00490 variable last_pane
00491
00492 # Run the last pane's select command
00493 ${last_pane}_selected
00494
00495 }
00496
00497 ######################################################################
00498 # Called when the available tab is selected.
00499 proc available_selected {} {
00500
00501 variable widgets
00502 variable last_pane
00503
00504 # Remember that this pane was selected
00505 set last_pane available
00506
00507 # Select the available pane
00508 $widgets(nb) select $widgets(available)
00509
00510 $widgets(available_btn) state active
00511 $widgets(installed_btn) state !active
00512
00513 # Populate the table
00514 populate_plugin_table "available"
00515
00516 # Give the search panel the focus
00517 focus $widgets(available,search)
00518
00519 }
00520
00521 ######################################################################
00522 # Called when the available tab is selected.
00523 proc installed_selected {} {
00524
00525 variable widgets
00526 variable last_pane
00527
00528 # Remember that this pane was selected
00529 set last_pane installed
00530
00531 # Select the installed pane
00532 $widgets(nb) select $widgets(installed)
00533
00534 $widgets(available_btn) state !active
00535 $widgets(installed_btn) state active
00536
00537 # Populate the plugin table
00538 populate_plugin_table "installed"
00539
00540 # Give the search panel the focus
00541 focus $widgets(installed,search)
00542
00543 }
00544
00545 ######################################################################
00546 # Populates the table of the given type with the needed plugin data.
00547 proc populate_plugin_table {type} {
00548
00549 variable widgets
00550 variable database
00551
00552 # Clear the table
00553 $widgets($type,table) delete 0 end
00554
00555 array set db_plugins $database(plugins)
00556
00557 set installed [expr {($type eq "available") ? 0 : 1}]
00558 set updateable 0
00559
00560 foreach name [lsort [array names db_plugins]] {
00561 array set data $db_plugins($name)
00562 if {$data(installed) == $installed} {
00563 append_plugin $type $data(display_name) $data(description) $name
00564 }
00565 incr updateable $data(update_avail)
00566 }
00567
00568 if {$updateable} {
00569 pack $widgets(installed,pupdate) -side right -padx 4 -pady 2
00570 } else {
00571 pack forget $widgets(installed,pupdate)
00572 }
00573
00574 }
00575
00576 ######################################################################
00577 # Adds the given plugin to the given table.
00578 proc append_plugin {type name detail id} {
00579
00580 variable widgets
00581
00582 $widgets($type,table) insert end [list [list $name $detail $id]]
00583 $widgets($type,table) cellconfigure end,plugin -stretchwindow 1 -window plugmgr::make_plugin_cell -windowupdate plugmgr::update_plugin_cell
00584
00585 }
00586
00587 ######################################################################
00588 # Create the plugin cell and populate it with the appropriate text.
00589 proc make_plugin_cell {tbl row col win} {
00590
00591 variable last_pane
00592
00593 array set ttk_theme [theme::get_category_options ttk_style 1]
00594 array set theme [theme::get_syntax_colors]
00595
00596 lassign [$tbl cellcget $row,$col -text] name detail id
00597
00598 text $win -wrap word -height 1 -relief flat -highlightthickness 0 -bd 0 -cursor [ttk::cursor standard] -background $theme(background) -foreground $theme(foreground)
00599
00600 bind $win <Configure> [list plugmgr::update_height %W]
00601 bindtags $win [linsert [bindtags $win] 1 [$tbl bodytag] TablelistBody]
00602
00603 if {[get_database_attr $id update_avail]} {
00604 set txt [list "\n" {} $name header "\t\t(Update Available)" pupdate "\n\n$detail\n" body]
00605 } else {
00606 set txt [list "\n" {} $name header "\n\n$detail\n" body]
00607 }
00608
00609 $win tag configure header -font [list -size 14 -weight bold] -foreground $theme(keywords)
00610 $win tag configure pupdate -foreground $theme(miscellaneous1) -justify right
00611 $win tag configure body -lmargin1 20 -lmargin2 20
00612 $win insert end {*}$txt
00613 $win configure -state disabled
00614
00615 return $win
00616
00617 }
00618
00619 ######################################################################
00620 # Updates the given plugin cell contents.
00621 proc update_plugin_cell {tbl row col win args} {
00622
00623 array set opts $args
00624
00625 foreach {opt value} $args {
00626 if {$value ne ""} {
00627 $win configure $opt $value
00628 }
00629 }
00630
00631 }
00632
00633 ######################################################################
00634 # Updates the height of the given text widget.
00635 proc update_height {txt} {
00636
00637 $txt configure -height [expr [$txt count -displaylines 1.0 end] + 1]
00638
00639 [winfo parent $txt] configure -height [winfo reqheight $txt]
00640
00641 }
00642
00643 ######################################################################
00644 # Creates the overview HTML code and returns this value.
00645 proc make_overview_html {name} {
00646
00647 variable database
00648
00649 array set db_plugins $database(plugins)
00650
00651 if {![info exists db_plugins($name)]} {
00652 return ""
00653 }
00654
00655 array set data $db_plugins($name)
00656
00657 # Create the HTML code to display
00658 append html "<h1>$data(display_name)</h1><hr>"
00659
00660 if {$data(overview) ne ""} {
00661 append html "$data(overview)<br><br><hr>"
00662 }
00663
00664 if {$data(release_notes) ne ""} {
00665 append html "<h4>Release Notes</h4><dl>$data(release_notes)</dl>"
00666 }
00667
00668 append html "<h4>Version</h4><dl>$data(version)</dl>"
00669
00670 if {$data(author) ne ""} {
00671 append html "<h4>Author</h4><dl>$data(author)</dl>"
00672 } else {
00673 append html "<h4>Author</h4><dl>Anonymous</dl>"
00674 }
00675
00676 if {$data(email) ne ""} {
00677 append html "<h4>E-mail</h4><dl><a href=\"mailto:$data(email)\">$data(email)</a></dl>"
00678 }
00679
00680 if {$data(website) ne ""} {
00681 append html "<h4>Website</h4><dl><a href=\"$data(website)\">$data(website)</a></dl>"
00682 }
00683
00684 return $html
00685
00686 }
00687
00688 ######################################################################
00689 # Displays the plugin detail in the detail pane.
00690 proc show_detail {} {
00691
00692 variable widgets
00693 variable current_id
00694 variable database
00695 variable last_pane
00696
00697 # Get the currently selected row
00698 set selected [$widgets($last_pane,table) curselection]
00699
00700 # Get the plugin ID
00701 set current_id [lindex [$widgets($last_pane,table) cellcget $selected,plugin -text] 2]
00702
00703 # Get the content to display
00704 set html [make_overview_html $current_id]
00705
00706 # Clear the detail text widget
00707 $widgets(html) configure -state normal
00708 $widgets(html) delete 1.0 end
00709
00710 # Add the HTML to the HTML widget
00711 HMparse_html $html "HMrender $widgets(html)"
00712
00713 # Configure the text widget to be disabled
00714 $widgets(html) configure -state disabled
00715
00716 if {$last_pane eq "available"} {
00717 grid remove $widgets(uninstall)
00718 grid remove $widgets(pupdate)
00719 grid $widgets(install)
00720 } else {
00721 grid remove $widgets(install)
00722 grid $widgets(uninstall)
00723 if {[get_database_attr $current_id update_avail]} {
00724 grid $widgets(pupdate)
00725 } else {
00726 grid remove $widgets(pupdate)
00727 }
00728 }
00729
00730 # Display the detail pane
00731 $widgets(nb) select $widgets(detail)
00732
00733 }
00734
00735 ######################################################################
00736 # Installs the given plugin from memory.
00737 proc install {} {
00738
00739 variable widgets
00740 variable current_id
00741
00742 # Download the file
00743 if {[set fname [get_bundle_fname $current_id]] eq ""} {
00744 show_error_message [msgcat::mc "Failed to download plugin bundle"]
00745 return
00746 }
00747
00748 # Import the file
00749 plugins::import_plugin .pmwin $fname
00750
00751 # Delete the bundle file
00752 catch { file delete -force $fname }
00753
00754 # Reload the plugin information
00755 plugins::load
00756
00757 # Get the plugin index
00758 if {[set index [plugins::get_plugin_index $current_id]] eq ""} {
00759 return
00760 }
00761
00762 # Perform the plugin install
00763 plugins::install_item $index
00764
00765 # Set the database installed value
00766 set_database_attr $current_id installed 1
00767
00768 # Save the database
00769 save_database
00770
00771 # Update the UI state of the pane
00772 grid remove $widgets(install)
00773 grid remove $widgets(pupdate)
00774 grid $widgets(uninstall)
00775
00776 }
00777
00778 ######################################################################
00779 # Updates the given plugin from memory.
00780 proc pupdate {} {
00781
00782 variable widgets
00783 variable current_id
00784 variable database
00785
00786 # Download the file
00787 if {[set fname [get_bundle_fname $current_id]] eq ""} {
00788 show_error_message [msgcat::mc "Failed to download plugin bundle"]
00789 return
00790 }
00791
00792 # Import the file
00793 plugins::import_plugin .pmwin $fname
00794
00795 # Delete the file
00796 catch { file delete -force $fname }
00797
00798 # Perform the plugin install
00799 plugins::reload
00800
00801 # Specify that the update is no longer available
00802 set_database_attr $current_id update_avail 0
00803
00804 # Save the database
00805 save_database
00806
00807 # Update the UI state of the pane
00808 grid remove $widgets(pupdate)
00809
00810 }
00811
00812 ######################################################################
00813 # Update all of the plugins that are upgradable.
00814 proc pupdate_all {} {
00815
00816 variable widgets
00817 variable database
00818
00819 array set db_plugins $database(plugins)
00820
00821 # Import the plugins that have an update available
00822 foreach name [array names db_plugins] {
00823 array set data $db_plugins($name)
00824 if {$data(update_avail)} {
00825 if {[set fname [get_bundle_fname $name]] eq ""} {
00826 lappend error_plugins $name
00827 } else {
00828 plugins::import_plugin .pmwin $fname
00829 catch { file delete -force $fname }
00830 set data(update_avail) 0
00831 set db_plugins($name) [array get data]
00832 }
00833 }
00834 }
00835
00836 # Reload the plugins
00837 plugins::reload
00838
00839 # Save the database changes
00840 array set database(plugins) [array get db_plugins]
00841
00842 # Save the database
00843 save_database
00844
00845 if {[llength $error_plugins] > 0} {
00846 show_error_message [msgcat::mc "Failed to download the following plugin bundles:"] $error_plugins
00847 } else {
00848 pack forget $widgets(installed,pupdate)
00849 }
00850
00851 }
00852
00853 ######################################################################
00854 # Uninstalls the given plugin from memory.
00855 proc uninstall {} {
00856
00857 variable widgets
00858 variable current_id
00859
00860 # Get the plugin index
00861 if {[set index [plugins::get_plugin_index $current_id]] eq ""} {
00862 return
00863 }
00864
00865 # Uninstall the item
00866 plugins::uninstall_item $index
00867
00868 # Delete the data
00869 catch { file delete -force [file join $::tke_home iplugins $current_id] }
00870
00871 # Save the fact that the plugin is no longer installed
00872 set_database_attr $current_id installed 0
00873
00874 # Save the database
00875 save_database
00876
00877 # Update the UI state of the pane
00878 grid remove $widgets(uninstall)
00879 grid remove $widgets(pupdate)
00880 grid $widgets(install)
00881
00882 }
00883
00884 ######################################################################
00885 # Performs search with the given value.
00886 proc do_search {type value} {
00887
00888 variable widgets
00889
00890 set tbl $widgets($type,table)
00891 set tbl_size [$tbl size]
00892
00893 if {$value eq ""} {
00894 for {set i 0} {$i < $tbl_size} {incr i} {
00895 $tbl rowconfigure $i -hide 0
00896 }
00897 } else {
00898 for {set i 0} {$i < $tbl_size} {incr i} {
00899 set txt [$tbl windowpath $i,plugin].t
00900 $tbl rowconfigure $i -hide [expr {[$txt search -nocase -exact -- $value 1.0] ne ""} ? 0 : 1]
00901 }
00902 }
00903
00904 return 1
00905
00906 }
00907
00908 ######################################################################
00909 # This is called whenever the theme changes.
00910 proc update_theme {} {
00911
00912 variable widgets
00913
00914 # If the window does not exist, just return
00915 if {![winfo exists .pmwin]} {
00916 return
00917 }
00918
00919 array set theme [theme::get_category_options ttk_style 1]
00920 array set syntax [theme::get_syntax_colors]
00921
00922 $widgets(available,table) configure -background $theme(background) -foreground $theme(foreground)
00923 $widgets(available,scroll) configure -background $theme(background) -foreground $theme(foreground)
00924 $widgets(installed,table) configure -background $theme(background) -foreground $theme(foreground)
00925 $widgets(installed,scroll) configure -background $theme(background) -foreground $theme(foreground)
00926 $widgets(html,vb) configure -background $syntax(background) -foreground $syntax(foreground)
00927
00928 # Update the HTML view colors
00929 $widgets(html) configure -background $syntax(background) -foreground $syntax(foreground)
00930
00931 $widgets(html) tag configure link -foreground $syntax(miscellaneous1) -relief flat
00932 $widgets(html) tag configure h4 -foreground $syntax(keywords)
00933 $widgets(html) tag configure code -background $syntax(numbers) -foreground $syntax(background)
00934
00935 }
00936
00937 ######################################################################
00938 # Loads the plugin database file from the server.
00939 proc load_database {} {
00940
00941 variable database
00942
00943 set url "http://tke.sourceforge.net/plugins/plugins.tkedat"
00944
00945 # Download the database to a local file
00946 if {[set fname [utils::download_url $url]] eq ""} {
00947 show_error_message [msgcat::mc "Unable to fetch plugin database"]
00948 return
00949 }
00950
00951 # Load the downloaded file
00952 if {[catch { tkedat::read $fname } rc]} {
00953 file delete -force $fname
00954 show_error_message [msgcat::mc "Unable to load plugin database file"]
00955 return
00956 }
00957
00958 catch { file delete -force $fname }
00959
00960 # Make sure that the database is cleared
00961 array unset database
00962
00963 array set database $rc
00964 array set new_plugins $database(plugins)
00965
00966 # Initialize the new plugins database
00967 foreach name [array names new_plugins] {
00968 array set new_plugin $new_plugins($name)
00969 set new_plugin(update_avail) 0
00970 set new_plugin(installed) 0
00971 set new_plugins($name) [array get new_plugin]
00972 }
00973
00974 # Load the local file and compare the old versions to the new versions
00975 if {![catch { tkedata::read [file join $::tke_home iplugins plugins.tkedat] } rc]} {
00976
00977 array set old_data $rc
00978 array set old_plugins $old_data(plugins)
00979
00980 # Cross-reference the old database with the new, updating the new
00981 foreach name [array names old_plugins] {
00982 if {[info exists new_plugins($name)]} {
00983 array set old_plugin $old_plugins($name)
00984 array set new_plugin $new_plugins($name)
00985 set new_plugin(update_avail) [expr {$old_plugin(version) ne $new_plugin(version)}]
00986 set new_plugin(installed) 1
00987 set new_plugins($name) [array get new_plugin]
00988 }
00989 }
00990
00991 }
00992
00993 # Save the new plugins data back to the database
00994 set database(plugins) [array get new_plugins]
00995
00996 }
00997
00998 ######################################################################
00999 # Saves the internal database structure to the local plugins database file.
01000 proc save_database {} {
01001
01002 variable database
01003
01004 if {[catch { tkedat::write [file join $::tke_home iplugins plugins.tkedat] [array get database] } rc]} {
01005 return -code error "Unable to update the plugin database file"
01006 }
01007
01008 }
01009
01010 ######################################################################
01011 # Retrieves the specified attribute value from the database.
01012 proc get_database_attr {id attr} {
01013
01014 variable database
01015
01016 array set db_plugins $database(plugins)
01017 array set data $db_plugins($id)
01018
01019 return $data($attr)
01020
01021 }
01022
01023 ######################################################################
01024 # Sets the given database attribute to the specified value.
01025 proc set_database_attr {id attr value} {
01026
01027 variable database
01028
01029 array set db_plugins $database(plugins)
01030 array set data $db_plugins($id)
01031
01032 set data($attr) $value
01033 set db_plugins($id) [array get data]
01034 set database(plugins) [array get db_plugins]
01035
01036 }
01037
01038 ######################################################################
01039 # Returns the necessary URL to download the given plugin package.
01040 proc get_bundle_fname {id} {
01041
01042 set url "http://tke.sourceforge.net/plugins/$id.tkeplugz"
01043
01044 return [utils::download_url $url]
01045
01046 }
01047
01048 ######################################################################
01049 # Displays the given error message for the plugin manager.
01050 proc show_error_message {msg {detail ""}} {
01051
01052 tk_messageBox -parent .pmwin -icon error -title [msgcat::mc "Error"] -type ok -default ok -message $msg -detail $detail
01053
01054 }
01055
01056 }
01057
01058
