summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2017-12-13 10:59:09 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2017-12-13 10:59:09 +0000
commit54f4538c6e57adbcfb5baf42dae40ee6b3aeb691 (patch)
treec671dba6e966fa6b30550d0284d126e228309259 /Master/texmf-dist/scripts
parentd3e1b626b51481a62b9df0d0404d834f3883e081 (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')
-rwxr-xr-xMaster/texmf-dist/scripts/tlshell/tlshell.tcl276
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 ""} {