diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2017-12-13 10:59:09 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2017-12-13 10:59:09 +0000 |
commit | 54f4538c6e57adbcfb5baf42dae40ee6b3aeb691 (patch) | |
tree | c671dba6e966fa6b30550d0284d126e228309259 /Master/texmf-dist/scripts/tlshell | |
parent | d3e1b626b51481a62b9df0d0404d834f3883e081 (diff) |
Install, remove and update single and marked packages
git-svn-id: svn://tug.org/texlive/trunk@46058 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/tlshell')
-rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 276 |
1 files changed, 207 insertions, 69 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index ce7d9377f90..aa539ac90b8 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -468,7 +468,7 @@ proc collect_filtered {} { display_packages_info } ; # collect_filtered -# display packages obeying filter and search string. +# display packages obeying both filter and search string. # even on a relatively slow system, regenerating the entire list # at every keystroke is acceptably responsive. # with future more advanced search options, this scheme may not suffice. @@ -615,6 +615,194 @@ proc update_all {} { collect_filtered } ; # update_all +### doing something with some packages + +proc pkgs_option {opt {nm ""}} { + if {$opt eq "marked"} { + set pks {} + dict for {p props} $::pkgs { + if [dict get $props "marked"] {lappend pks $p} + } + } elseif {$opt eq "focus"} { + set p [.pkglist focus] + if {$p ne {}} {lappend pks $p} + } elseif {$opt eq "name"} { + lappend pks $nm + } + return $pks +} ; # pkgs_option + +proc after_package_changes {} { + update_local_revnumbers + collect_filtered + wm state .lw normal + place_wrt .lw . +} ; # after_package_changes + +proc install_pkgs {sel_opt {pk ""}} { + set pks [pkgs_option $sel_opt $pk] + # check whether packages are installed + set pre_installed {} + set todo {} + foreach p $pks { + if {[dict get $::pkgs $p localrev] > 0} { + lappend pre_installed $p + } else { + lappend todo $p + } + } + if {[llength $todo] == 0} { + tk_messageBox -message "Nothing to do!" -type ok -icon info + return + } + run_cmd_waiting "install --dry-run $todo" + # check whether dependencies are going to be installed + set r {^(\S+)\s+i\s} + set deps {} + foreach l $::out_log { + if {[regexp $r $l d p] && $p ni $pks} { + lappend deps $p + } + } + if {[llength $deps] > 0} { + set ans [tk_messageBox -message \ + "Also installing dependencies $deps.\nContinue?" \ + -type yesno -icon question] + if {$ans eq "cancel"} return + } + run_cmd "install $todo" log_widget_cb + vwait ::done_waiting + if {[llength $pre_installed] > 0} { + lappend ::err_log "Already installed: $pre_installed" + show_err_log + } + after_package_changes +} ; # install_pkgs + +proc update_pkgs {sel_opt {pk ""}} { + set pks [pkgs_option $sel_opt $pk] + # check whether packages are installed + set not_inst {} + set uptodate {} + set todo {} + foreach p $pks { + set lv [dict get $::pkgs $p localrev] + if {[dict get $::pkgs $p localrev] == 0} { + lappend not_inst $p + } else { + set rv [dict get $::pkgs $p remoterev] + if {$lv >= $rv} { + lappend uptodate $p + } else { + lappend todo $p + } + } + } + if {[llength $todo] == 0} { + tk_messageBox -message "Nothing to do!" -type ok -icon info + return + } + run_cmd "update $todo" log_widget_cb + vwait ::done_waiting + if {[llength $not_inst] > 0} { + lappend ::err_log "Skipped because not installed: $not_inst" + } + if {[llength $uptodate] > 0} { + lappend ::err_log "Skipped because already up to date: $uptodate" + } + if {[llength $not_inst] > 0 || [llength $uptodate] > 0} { + show_err_log + } + after_package_changes +} ; # update_pkgs + +proc remove_pkgs {sel_opt {pk ""}} { + set pks [pkgs_option $sel_opt $pk] + # check whether packages are installed + set not_inst {} + set todo {} + foreach p $pks { + if {[dict get $::pkgs $p localrev] > 0} { + lappend todo $p + } else { + lappend not_inst $p + } + } + run_cmd_waiting "remove --dry-run $todo" + # check whether dependencies are going to be removed + set r {^(\S+)\s+d\s} + set deps {} + foreach l $::out_log { + if {[regexp $r $l d p] && $p ni $pks} { + lappend deps $p + } + } + if {[llength $todo] == 0} { + tk_messageBox -message "Nothing to do!" -type ok -icon info + return + } + if {[llength $deps] > 0} { + set ans [tk_messageBox -message \ + "Also remove dependencies $deps?" \ + -type yesnocancel -icon question] + switch $ans { + "cancel" return + "yes" {run_cmd "remove $todo" log_widget_cb} + "no" {run_cmd "remove --no-depends $todo" log_widget_cb} + } + } else { + run_cmd "remove $todo" log_widget_cb + } + vwait ::done_waiting + if {[llength $not_inst] > 0} { + lappend ::err_log "Skipped because not installed: $not_inst" + show_err_log + } + after_package_changes +} ; # remove_pkgs + +#proc restore_pkgs {sel_opt {pk ""}} { +#} ; # restore_pkgs # not yet + +## package popup ## + +#proc run_package_cmd {cmd {chg 0}} { +# set mn [.pkglist focus] +# run_cmd "$cmd $mn" log_widget_cb +# vwait ::done_waiting +# if $chg { +# do_debug "Package_cmd $cmd; should call update_local_revnumbers" +# update_local_revnumbers +# collect_filtered +# } +#} ; # run_package_cmd + +proc do_package_popup {x y X Y} { + # as focused item, the identity of the item will be globally available: + .pkglist focus [.pkglist identify item $x $y] + # recreate menu with only applicable items + set lr [dict get $::pkgs [.pkglist focus] "localrev"] + set rr [dict get $::pkgs [.pkglist focus] "remoterev"] + .pkg_popup delete 0 end + .pkg_popup add command -label "Info" -command \ + {run_cmd "info [.pkglist focus]" log_widget_cb; \ + vwait ::done_waiting} + if {$::have_remote && ! $::need_update_tlmgr && $rr > 0 && $lr == 0} { + .pkg_popup add command -label "Install" -command \ + {install_pkgs "focus"} + } + if {$::have_remote && ! $::need_update_tlmgr && $lr > 0 && $rr > $lr} { + .pkg_popup add command -label "Update" -command \ + {update_pkgs "focus"} + } + if {$lr > 0} { + .pkg_popup add command -label "Remove" -command \ + {remove_pkgs "focus"} + } + .pkg_popup post $X $Y + focus .pkg_popup +} ; # do_package_popup + ##### building GUI ##### # dummy widgets for vertical spacing within $w @@ -696,13 +884,13 @@ proc make_widgets {} { # plain_unix: avoid a RenderBadPicture error on quitting. # 'send' changes the shutdown sequence, # which avoids triggering the bug. - # 'tk appname <something>' restores send and avoids the bug + # 'tk appname <something>' restores 'send' and avoids the bug bind . <Destroy> { catch {tk appname appname} } } - .mn add cascade -label File -menu .mn.file -underline 0 + .mn add cascade -label "File" -menu .mn.file -underline 0 menu .mn.file .mn.file add command -label "Load default repository" \ -command {get_packages_info_remote; collect_filtered} @@ -710,20 +898,28 @@ proc make_widgets {} { -command repositories .mn.file add command -command {destroy .} -label "Exit" -underline 1 - .mn add cascade -label Options -menu .mn.opt -underline 0 + .mn add cascade -label "Options" -menu .mn.opt -underline 0 menu .mn.opt - .mn add cascade -label Actions -menu .mn.act -underline 0 + .mn add cascade -label "Actions" -menu .mn.act -underline 0 menu .mn.act - - .mn add cascade -label Help -menu .mn.help -underline 0 + .mn.act add command -label "Install marked" \ + -command {install_pkgs "marked"} + .mn.act add command -label "Update marked" \ + -command {update_pkgs "marked"} + .mn.act add command -label "Remove marked" \ + -command {remove_pkgs "marked"} + + .mn add cascade -label "Help" -menu .mn.help -underline 0 menu .mn.help .mn.help add command -command {tk_messageBox -message "Helpless"} \ -label "About" # wallpaper frame + # it is possible to set a background color for the parent toplevel, + # but on MacOS I did not find a way to determine the right $::default_bg. pack [ttk::frame .bg] - + # various info ttk::frame .topf @@ -923,53 +1119,14 @@ proc make_widgets {} { raise .lw.log .lw.logs pack .lw.logs -in .lw.bg -side top -fill both -expand 1 - ttk::frame .lw.bottom + pack [ttk::frame .lw.bottom] -in .lw.bg -side top -expand 1 -fill x ttk::button .lw.close -text close -command {wm withdraw .lw} ppack .lw.close -in .lw.bottom -side right -anchor e ppack [ttk::label .lw.status -anchor w] -in .lw.bottom -side left - pack .lw.bottom -in .lw.bg -side top -expand 1 -fill x wm withdraw .lw } ; # make_widgets -## package popup ## - -proc run_package_cmd {cmd {chg 0}} { - set mn [.pkglist focus] - run_cmd "$cmd $mn" log_widget_cb - vwait ::done_waiting - if $chg { - do_debug "Package_cmd $cmd; should call update_local_revnumbers" - update_local_revnumbers - collect_filtered - } -} ; # run_package_cmd - -proc do_package_popup {x y X Y} { - # as focused item, the identity of the item will be globally available: - .pkglist focus [.pkglist identify item $x $y] - # recreate menu with only applicable items - set lr [dict get $::pkgs [.pkglist focus] "localrev"] - set rr [dict get $::pkgs [.pkglist focus] "remoterev"] - .pkg_popup delete 0 end - .pkg_popup add command -label "Info" -command \ - {run_package_cmd "info"} - if {$::have_remote && ! $::need_update_tlmgr && $rr > 0 && $lr == 0} { - .pkg_popup add command -label "Install" -command \ - {run_package_cmd "install" 1} - } - if {$::have_remote && ! $::need_update_tlmgr && $rr > $lr} { - .pkg_popup add command -label "Update" -command \ - {run_package_cmd "update" 1} - } - if {$lr > 0} { - .pkg_popup add command -label "Remove" -command \ - {run_package_cmd "remove" 1} - } - .pkg_popup post $X $Y - focus .pkg_popup -} ; # do_package_popup - ### repositories proc repositories {} { @@ -1058,7 +1215,6 @@ proc close_repos {{how ""}} { raise . destroy .tlr if {$how eq "save"} { - # the alternative set ::repo $::new_repo if {$::tcl_platform(platform) eq "windows"} { set ::repo [string map {\\ /} $::repo] @@ -1072,7 +1228,7 @@ proc close_repos {{how ""}} { get_packages_info_remote collect_filtered } -} +} ; # close_repos proc find_local_repo {} { if [is_repo_local $::new_repo] { @@ -1186,19 +1342,6 @@ proc read_mirrors {} { } close $fm if {! $ok} {do_debug $msg} - # relocate Australia and New Zealand if they are - # classified under North America - dict set ::mirrors "Other" [dict create] - set dict_nam [dict get $::mirrors "North America"] - foreach c {"Australia" "New Zealand"} { - if [dict exists $dict_nam $c] { - dict set ::mirrors "Other" $c [dict get $dict_nam $c] - dict unset ::mirrors "North America" $c - } - } - if {[dict size [dict get $::mirrors "Other"]] == 0} { - dict unset ::mirrors "Other" - } } ; # read_mirrors proc edit_name {n} { @@ -1272,18 +1415,13 @@ proc start_tlmgr {{args ""}} { chan configure $::tlshl -buffering line -blocking 0 chan event $::tlshl readable read_line vwait ::done_waiting -} +} ; # start_tlmgr proc close_tlmgr {} { catch {chan close $::tlshl} catch {chan close $::err} } -proc change_repo {} { - run_cmd_waiting "option repository $::repo" - get_packages_info_remote -} - proc restart_self {} { do_debug "trying to restart" if {$::progname eq ""} { |