summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/tlshell/tlshell.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/scripts/tlshell/tlshell.tcl')
-rwxr-xr-xMaster/texmf-dist/scripts/tlshell/tlshell.tcl279
1 files changed, 142 insertions, 137 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 14a41805b24..02a74e49807 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -16,14 +16,11 @@ source [file join $::instroot "tlpkg" "TeXLive" "tltcl.tcl"]
# searchpath and locale:
# windows: most scripts run via [w]runscript, which adjusts the searchpath
-# for the current process. The provided tcl/tk can set locale on the fly.
-# unix/linux:
-# we may need to run tlshell.tcl via a wrapper in order to
-# make localization work right for tcl/tk version 8.5 and on macos.
-# tlshell.[sh|tcl] should be run via a symlink in a directory
+# for the current process.
+# tlshell.tcl should be run via a symlink in a directory
# which also contains (a symlink to) kpsewhich.
# This directory will be prepended to the searchpath.
-# kpsewhich will disentangle symlinks.
+# kpsewhich should disentangle symlinks.
# dis/enable the restore dialog
set do_restore 0
@@ -144,6 +141,8 @@ proc long_message {str type {p "."}} {
}
place_dlg .tlmg $p
+ tkwait window .tlmg
+ return $::dialog_ans
} ; # long_message
proc any_message {str type {p "."}} {
@@ -930,33 +929,6 @@ proc pick_local_repo {} {
}
} ; # pick_local_repo
-# what is wrong with this version?
-#proc get_repos_from_tlmgr {} {
-# array unset ::repos
-# run_cmd_waiting "repository list"
-# # set re0 {^\s+([^\s\(][^\(]*[^\s\(])\s+\(([^\)]+)\)$}
-# set re0 {^[ \t]+(\S.*\S)[ \t]+\(([^\)]+)\)$}
-# set re1 {^[ \t]+(\S.*\S)$}
-# foreach l $::out_log {
-# if [regexp $re0 $l dum r t] {
-# # repository with tag
-# puts "$l\n$dum\nrep $r tag $t"
-# set ::repos($t) $r
-# } elseif [regexp $re1 $l dum r] {
-# # repository without tag, assign repository itself as tag
-# puts "rep $r"
-# set ::repos($r) $r
-# }
-# }
-# if {[llength [array names ::repos]] == 1} {
-# set n [lindex [array names ::repos] 0]
-# if {$n ne "main"} {
-# set ::repos(main) $::repos($n)
-# array unset ::repos $n
-# }
-# }
-#} ; # get_repos_from_tlmgr
-
proc get_repos_from_tlmgr {} {
array unset ::repos
run_cmd_waiting "option repository"
@@ -969,8 +941,8 @@ proc get_repos_from_tlmgr {} {
set nr [llength $reps]
foreach rp $reps {
# decode spaces and %
- #set rp [string map {"%20" " "} $rp]
- #set rp [string map {"%25" "%"} $rp]
+ set rp [string map {"%20" " "} $rp]
+ set rp [string map {"%25" "%"} $rp]
if {! [regexp {^(.+)#(.+)$} $rp dum r t]} {
# no tag; use repository as its own tag
set r $rp
@@ -1008,13 +980,11 @@ proc set_repos_in_tlmgr {} {
append rp "#$nm"
}
}
- # for now, ignore the possibility of spaces in paths;
- # I think tlmgr has bugs there
- #set rp [string map {"%" "%25"} $rp]
- #set rp [string map {" " "%20"} $rp]
+ # encode % and spaces
+ set rp [string map {"%" "%25"} $rp]
+ set rp [string map {" " "%20"} $rp]
append opt_repos " $rp"
}
- # puts "repository set [string range $opt_repos 1 end]"
run_cmd_waiting "repository set [string range $opt_repos 1 end]"
}; # set_repos_in_tlmgr
@@ -1035,21 +1005,52 @@ proc print_repos {} {
}
return $s
}
-}
+} ; # print_repos
proc repos_commit {} {
- .topf.lrepos configure -text [print_repos]
- set_repos_in_tlmgr
- close_tlmgr
- start_tlmgr
- # reload remote package information
- set ::have_remote 0
- get_packages_info_remote
- collect_filtered
+ set changes 0
+ # first remove pinning if appropriate
+ # then set repositories
+ # then add pinning if appropriate
+ if {! [regexp {^\s*$} [.tlr.new get]]} {
+ if {$::repos(main) ne [.tlr.new get]} {
+ set ::repos(main) [.tlr.new get]
+ set changes 1
+ }
+ }
+ set had_contrib 0
+ if $::toggle_contrib {
+ set changes 1
+ foreach nm [array names ::repos] {
+ if {$::repos($nm) eq $::tlcontrib} {
+ set had_contrib 1
+ run_cmd "pinning remove $nm --all" 0
+ run_cmd "pinning remove $::repos($nm) --all" 0
+ vwait ::done_waiting
+ array unset ::repos $nm
+ }
+ }
+ if {! $had_contrib} {
+ set ::repos(tlcontrib) $::tlcontrib
+ }
+ }
+ if $changes {
+ set_repos_in_tlmgr
+ .topf.lrepos configure -text [print_repos]
+ close_tlmgr
+ start_tlmgr
+ # reload remote package information
+ if {$::toggle_contrib && ! $had_contrib} {
+ run_cmd_waiting "pinning add tlcontrib \"*\""
+ }
+ set ::have_remote 0
+ get_packages_info_remote
+ collect_filtered
+ }
} ; # repos_commit
# main repository dialog
-proc main_repository {} {
+proc repository_dialog {} {
# dialog toplevel with
# - popup menu of mirrors (parse tlpkg/installer/ctan-mirrors.pl)
@@ -1073,7 +1074,7 @@ proc main_repository {} {
-in .tlr.info -row $row -column 0 -sticky w
pgrid [ttk::label .tlr.cur -text $::repos(main)] \
-in .tlr.info -row 0 -column 1 -sticky w
- # new repository
+ # proposed new repository
incr row
pgrid [ttk::label .tlr.lnew -text [__ "New"]] \
-in .tlr.info -row $row -column 0 -sticky w
@@ -1082,13 +1083,13 @@ proc main_repository {} {
### three ways to specify a repository ###
pack [ttk::frame .tlr.mirbuttons] -in .tlr.bg -fill x
- # default remote repository
+ # 1. default remote repository
ttk::button .tlr.ctan -text [__ "Any CTAN mirror"] -command {
.tlr.new delete 0 end
.tlr.new insert end $::any_mirror
}
ppack .tlr.ctan -in .tlr.mirbuttons -side left -fill x
- # freshly create a cascading mirror dropdown menu
+ # 2. specific repository: create a cascading dropdown menu of mirrors
destroy .tlr.mir.m
if {[dict size $::mirrors] == 0} read_mirrors
do_debug "[dict size $::mirrors] mirrors"
@@ -1112,15 +1113,39 @@ proc main_repository {} {
}
}
}
- # local repository
+ # 3. local repository
ttk::button .tlr.browse -text [__ "Local directory..."] -command {
.tlr.new delete 0 end; .tlr.new insert end [pick_local_repo]}
ppack .tlr.browse -in .tlr.mirbuttons -side left -fill x
+ ### add/remove tlcontrib ###
+ ttk::label .tlr.contribt -text [__ "tlcontrib additional repository"] \
+ -font bfont
+ pack .tlr.contribt -in .tlr.bg -anchor w -padx 3 -pady [list 10 3]
+ pack [ttk::label .tlr.contribl] -in .tlr.bg -anchor w -padx 3 -pady 3
+ ttk::checkbutton .tlr.contribb -variable ::toggle_contrib
+ pack .tlr.contribb -in .tlr.bg -anchor w -padx 3 -pady [list 3 10]
+ set ::toggle_contrib 0
+ set has_contrib 0
+ foreach nm [array names ::repos] {
+ if {$::repos($nm) eq $::tlcontrib} {
+ set has_contrib 1
+ set contrib_tag $nm
+ break
+ }
+ }
+ if $has_contrib {
+ .tlr.contribl configure -text [__ "tlcontrib repository is included"]
+ .tlr.contribb configure -text [__ "Remove tlcontrib repository"]
+ } else {
+ .tlr.contribl configure -text [__ "tlcontrib repository is not included"]
+ .tlr.contribb configure -text [__ "Add tlcontrib repository"]
+ }
+
# two ways to close the dialog
pack [ttk::frame .tlr.closebuttons] -pady [list 10 0] -in .tlr.bg -fill x
ttk::button .tlr.save -text [__ "Save and Load"] -command {
- set ::repos(main) [.tlr.new get]
+ #set ::repos(main) [.tlr.new get]
repos_commit
end_dlg "" .tlr
}
@@ -1130,79 +1155,7 @@ proc main_repository {} {
place_dlg .tlr .
wm resizable .tlr 0 0
-} ; # main_repository
-
-proc more_repos {} {
-
- create_dlg .tladr .
- wm title .tladr [__ "Additional repositories"]
-
- # wallpaper frame; see populate_main
- pack [ttk::frame .tladr.bg] -expand 1 -fill x
-
- set ttl [__ "Additional repositories"]
- ttk::label .tladr.title -text "$ttl (does nothing yet)" -font bigfont
- pack .tladr.title -in .tladr.bg -padx 3 -pady 10
-
- pack [ttk::frame .tladr.tlcf] -in .tladr.bg -anchor w -padx 3 -pady 10
- ppack [ttk::button .tladr.tlc -text [__ "Add tlcontrib"]] \
- -in .tladr.tlcf -side left
- ttk::label .tladr.tlcl -text [__ "Packages which cannot be part of TeX Live"]
- pack .tladr.tlcl -in .tladr.tlcf -side left
-
- # treeview with repositories
- ppack [ttk::frame .tladr.adrf] -in .tladr.bg -fill x -side top
- ttk::treeview .tladr.reps -columns {url tag} -height 3 -show headings \
- -selectmode browse -yscrollcommand {.tladr.vsb set}
- .tladr.reps heading url -text "Url" -anchor w
- .tladr.reps heading tag -text [__ "Tag (optional)"] -anchor w
- .tladr.reps column url -width [expr {$::cw * 60}]
- .tladr.reps column tag -width [expr {$::cw * 15}]
- grid columnconfigure .tladr.adrf 0 -weight 1
- ttk::scrollbar .tladr.vsb -orient vertical -command {.tladr.reps yview}
- incr row
- grid .tladr.vsb -in .tladr.adrf -row 0 -column 1 -sticky ns
- grid .tladr.reps -in .tladr.adrf -row 0 -column 0 -sticky news
- #pack .tladr.reps -in .tladr.adrf -side left -fill both -expand 1
- foreach nm [array names ::repos] {
- if {$nm ne "main"} {
- if {$nm ne $::repos($nm)} {
- .tladr.reps insert {} end -values [list $::repos($nm) $nm]
- } else {
- .tladr.reps insert {} end -values [list $::repos($nm) ""]
- }
- }
- }
- pack [ttk::frame .tladr.add_del] -in .tladr.bg -fill x -expand 1
- ppack [ttk::button .tladr.delb -text [__ "Delete"]] \
- -in .tladr.add_del -side left -fill x
- ppack [ttk::button .tladr.addb -text [__ "Add"]] \
- -in .tladr.add_del -side right -fill x
-
- # pinning
-
- ppack [ttk::frame .tladr.pinf] -in .tladr.bg -fill x -expand 1
- ttk::label .tladr.pinl -text "Pinning" -font bfont
- ttk::scrollbar .tladr.pinvbs -orient vertical -command {.tladr.pintx yview}
- ttk::scrollbar .tladr.pinhbs -orient horizontal -command {.tladr.pintx xview}
- text .tladr.pintx -height 3 -wrap none \
- -yscrollcommand {.tladr.pinvbs set} -xscrollcommand {.tladr.pinhbs set}
- grid columnconfigure .tladr.pinf 0 -weight 1
- grid .tladr.pinl -in .tladr.pinf -row 0 -column 0 -sticky w
- grid .tladr.pinhbs -in .tladr.pinf -row 2 -column 0 -sticky ew
- grid .tladr.pinvbs -in .tladr.pinf -row 1 -column 1 -sticky ns
- grid .tladr.pintx -in .tladr.pinf -row 1 -column 0 -sticky news
-
- pack [ttk::frame .tladr.cancelok] \
- -in .tladr.bg -fill x -pady [list 10 0] -side bottom
- ppack [ttk::button .tladr.ok -text [__ "Ok"]] -in .tladr.cancelok -side right
- ppack [ttk::button .tladr.cancel -text [__ "Cancel"]] \
- -in .tladr.cancelok -side right
- .tladr.ok configure -command {end_dlg "" .tladr}
- .tladr.cancel configure -command {end_dlg "" .tladr}
-
- place_dlg .tladr
-}
+} ; # repository_dialog
### platforms
@@ -1837,6 +1790,45 @@ proc set_paper {p} {
run_cmd "paper paper $p" 1
}
+proc set_language {l} {
+ set ok 1
+ if [catch {exec kpsewhich -var-value "TEXMFCONFIG"} d] {set ok 0}
+ if $ok {
+ set d [file join $d "tlmgr"]
+ if [catch {file mkdir $d}] {set ok 0}
+ }
+ set fn [file join $d "config"]
+ set oldlines [list]
+ if {$ok && ! [catch {open $fn r} fid]} {
+ set cnt 0
+ while 1 {
+ if [catch {chan gets $fid} ll] break
+ if [chan eof $fid] break
+ incr cnt
+ if {! [regexp {^\s*gui-lang} $ll]} {
+ lappend oldlines $ll
+ }
+ if {$cnt>20} break
+ }
+ catch {chan close $fid}
+ }
+ lappend oldlines "gui-lang = $l"
+ if {$ok && ! [catch {open $fn w} fid]} {
+ foreach ll $oldlines {
+ if [catch {puts $fid $ll}] {
+ set ok 0
+ break
+ }
+ }
+ catch {chan close $fid}
+ }
+ if $ok {
+ restart_self
+ } else {
+ tk_messageBox -message [__ "Cannot set default GUI language"] -icon error
+ }
+} ; # set_language
+
##### running external commands #####
# For capturing an external command, we need a separate output channel,
@@ -1911,7 +1903,8 @@ proc populate_main {} {
.mn.file add command -command {destroy .} -label [__ "Exit"] -underline 1
# inx: keeping count to record indices where needed,
- # i.e. when an entry needs to be referenced
+ # i.e. when an entry needs to be referenced.
+ # not all submenus need this.
.mn add cascade -label [__ "Packages"] -menu .mn.pkg
menu .mn.pkg
set inx 0
@@ -1946,18 +1939,23 @@ proc populate_main {} {
.mn add cascade -label [__ "Options"] -menu .mn.opt -underline 0
menu .mn.opt
- set inx 0
- .mn.opt add command -label [__ "Change main repository"] \
- -command main_repository
- incr inx
- .mn.opt add command -label [__ "Additional repositories"] \
- -command more_repos
- incr inx
+ .mn.opt add command -label [__ "Repositories"] \
+ -command repository_dialog
+
.mn.opt add cascade -label [__ "Paper"] -menu .mn.opt.paper
menu .mn.opt.paper
foreach p [list a4 letter] {
.mn.opt.paper add command -label $p -command "set_paper $p"
}
+
+ if {[llength $::langs] > 1} {
+ .mn.opt add cascade -label [__ "GUI language"] -menu .mn.opt.lang
+ menu .mn.opt.lang
+ foreach l $::langs {
+ .mn.opt.lang add command -label $l -command "set_language $l"
+ }
+ }
+
if {$::tcl_platform(platform) ne "windows"} {
incr inx
set ::inx_platforms $inx
@@ -2027,7 +2025,7 @@ proc populate_main {} {
pgrid .pkfilter.upd -column 0 -row 3 -sticky w
# filter on detail level: all, coll, schm
- ttk::label .pkfilter.ldtl -font TkHeadingFont -text [__ "Detail >> Global"]
+ ttk::label .pkfilter.ldtl -font TkHeadingFont -text [__ "Global >> Detail"]
ttk::radiobutton .pkfilter.alld -text [__ All] -value all \
-variable ::dtl_opt -command collect_filtered
ttk::radiobutton .pkfilter.coll -text [__ "Collections and schemes"] \
@@ -2172,6 +2170,13 @@ proc initialize {} {
set ::flid [open $fname w]
}
+ # languages
+ set ::langs [list "en"]
+ foreach l [glob -nocomplain -directory \
+ [file join $::instroot "tlpkg" "translations"] *.msg] {
+ lappend ::langs [string range [file tail $l] 0 end-4]
+ }
+
# in case we are going to do something with json:
# add json subdirectory to auto_path, but at low priority
# since the tcl/tk installation may already have a better implementation.