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