diff options
Diffstat (limited to 'Master')
-rw-r--r-- | Master/source/tltcl/LICENSE | 60 | ||||
-rw-r--r-- | Master/source/tltcl/kitcreator-0.11.0.tar.gz | bin | 0 -> 212938 bytes | |||
-rw-r--r-- | Master/source/tltcl/metakit-2.4.9.7.tar.gz | bin | 0 -> 868310 bytes | |||
-rw-r--r-- | Master/source/tltcl/tcl8.6.8.tar.gz | bin | 0 -> 9793786 bytes | |||
-rw-r--r-- | Master/source/tltcl/tclvfs-20080503.tar.gz | bin | 0 -> 258723 bytes | |||
-rw-r--r-- | Master/source/tltcl/tk8.6.8.tar.gz | bin | 0 -> 4319854 bytes | |||
-rw-r--r-- | Master/source/tltcl/tltcl.README | 54 | ||||
-rw-r--r-- | Master/source/tltcl/zlib-1.2.8.tar.gz | bin | 0 -> 571091 bytes | |||
-rwxr-xr-x | Master/tlpkg/tltcl/tclkit.exe | bin | 0 -> 6297510 bytes | |||
-rw-r--r-- | Master/tlpkg/tltcl/tltcl.tcl | 507 |
10 files changed, 621 insertions, 0 deletions
diff --git a/Master/source/tltcl/LICENSE b/Master/source/tltcl/LICENSE new file mode 100644 index 00000000000..d8fe08dc831 --- /dev/null +++ b/Master/source/tltcl/LICENSE @@ -0,0 +1,60 @@ +The MIT License is applied to all files in this distribution, except: + kitsh/buildsrc/kitsh-0.0/boot.tcl + kitsh/buildsrc/kitsh-0.0/boot.tcl.h + kitsh/buildsrc/kitsh-0.0/kit.rc + kitsh/buildsrc/kitsh-0.0/kit.ico + kitsh/buildsrc/kitsh-0.0/kitInit.c + kitsh/buildsrc/kitsh-0.0/license.terms + kitsh/buildsrc/kitsh-0.0/pwb.c + kitsh/buildsrc/kitsh-0.0/rechan.c + kitsh/buildsrc/kitsh-0.0/zipvfs.tcl + kitsh/buildsrc/kitsh-0.0/zipvfs.tcl.h + kitsh/buildsrc/kitsh-0.0/zlib.c + kitsh/buildsrc/kitsh-0.0/winMain.c + kitsh/buildsrc/kitsh-0.0/mk4tcl.tcl + kitsh/buildsrc/kitsh-0.0/mk4tcl.tcl.h + kitdll/buildsrc/kitdll-0.0/rechan.c + kitdll/buildsrc/kitdll-0.0/zlib.c + kitdll/buildsrc/kitdll-0.0/kitInit.c + kitdll/buildsrc/kitdll-0.0/boot.tcl + kitdll/buildsrc/kitdll-0.0/pwb.c + +Please see "kitsh/buildsrc/kitsh-0.0/license.terms" for licensing information +regarding these files. + +Files that are downloaded are under different licenses (grouped by project): + * Tcl: Tcl/Tk License <http://www.tcl.tk/software/tcltk/license.html> + * Tk: Tcl/Tk License <http://www.tcl.tk/software/tcltk/license.html> + * Itcl: Tcl/Tk License <http://incrtcl.sourceforge.net/itcl/copyright.html> + * Mk4tcl: MIT License <http://www.equi4.com/metakit/license.html> + * TclVFS: BSD License + * Thread: Tcl/Tk License <http://www.tcl.tk/software/tcltk/license.html> + * ZLib: Zlib License <http://www.gzip.org/zlib/zlib_license.html> + +The final result of this build process is a derivative work of all of these +projects and is restricted by the cumulative licensing requirements of all of +them. + +All other files in this distribution are licensed under the terms of the MIT +License, below: +The MIT License + +Copyright (c) 2010 Roy S. Keene + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Master/source/tltcl/kitcreator-0.11.0.tar.gz b/Master/source/tltcl/kitcreator-0.11.0.tar.gz Binary files differnew file mode 100644 index 00000000000..49eb0dac352 --- /dev/null +++ b/Master/source/tltcl/kitcreator-0.11.0.tar.gz diff --git a/Master/source/tltcl/metakit-2.4.9.7.tar.gz b/Master/source/tltcl/metakit-2.4.9.7.tar.gz Binary files differnew file mode 100644 index 00000000000..82378e0e26a --- /dev/null +++ b/Master/source/tltcl/metakit-2.4.9.7.tar.gz diff --git a/Master/source/tltcl/tcl8.6.8.tar.gz b/Master/source/tltcl/tcl8.6.8.tar.gz Binary files differnew file mode 100644 index 00000000000..c8577f40564 --- /dev/null +++ b/Master/source/tltcl/tcl8.6.8.tar.gz diff --git a/Master/source/tltcl/tclvfs-20080503.tar.gz b/Master/source/tltcl/tclvfs-20080503.tar.gz Binary files differnew file mode 100644 index 00000000000..6bbdf4a087b --- /dev/null +++ b/Master/source/tltcl/tclvfs-20080503.tar.gz diff --git a/Master/source/tltcl/tk8.6.8.tar.gz b/Master/source/tltcl/tk8.6.8.tar.gz Binary files differnew file mode 100644 index 00000000000..21cbb485ddc --- /dev/null +++ b/Master/source/tltcl/tk8.6.8.tar.gz diff --git a/Master/source/tltcl/tltcl.README b/Master/source/tltcl/tltcl.README new file mode 100644 index 00000000000..4f54395cd9a --- /dev/null +++ b/Master/source/tltcl/tltcl.README @@ -0,0 +1,54 @@ +tclkit.exe is a single-file Tcl/Tk runtime. The one included in TeX +Live is generated with kitcreator. This program downloads and +compiles tcl, tk and various pieces of infrastructure. + +I used kitcreator's README file for guidance in generating +tclkit.exe: + +from the root of the unpacked kitcreator archive I first created a +native Linux tclkit: + +./kitcreator +mv tclkit-8.6.8 tclkit-local + +From this same directory I ran the following script: + +================ +#!/bin/bash +export TCLKIT=`pwd`/tclkit-local +export CROSS=i686-w64-mingw32 + +export CC=${CROSS}-gcc +export CXX=${CROSS}-c++ +export AR=${CROSS}-ar +export RANLIB=${CROSS}-ranlib +export STRIP=${CROSS}-strip +export RC=${CROSS}-windres +./kitcreator --host=${CROSS} + +mv tclkit-8.6.8 tclkit.exe +================ + +This directory contains the archives of kitcreator and the archives +it downloaded during the build process. + +The LICENSE file is the one I found in the root of the kitcreator +archive. + +As to the urls of the downloaded files: a command + +find . -name "build*.sh" -exec grep '^SRCURL=' \{} \; + +generated the following output: + +SRCURL="http://sourceforge.net/projects/incrtcl/files/%5BIncr%20Tcl_Tk%5D-source/Itcl%20${ITCLVERS}/itcl${ITCLVERS}${ITCLVERSEXTRA}.tar.gz/download" +SRCURL="http://prdownloads.sourceforge.net/tcl/tcl${TCLVERS}-src.tar.gz" +SRCURL="http://sourceforge.net/projects/tcl/files/Thread%20Extension/${THREADVERS}/thread${THREADVERS}.tar.gz/download" +SRCURL="http://www.equi4.com/pub/mk/metakit-${MK4VERS}.tar.gz" +SRCURL="http://pkgs.fedoraproject.org/repo/pkgs/metakit/metakit-${MK4VERS}.tar.gz/17330257376eea657827ed632ea62c9e/metakit-${MK4VERS}.tar.gz" +SRCURL="http://prdownloads.sourceforge.net/tcl/tk${TCLVERS}-src.tar.gz" + +The itcl- and thread- packages listed above were not actually downloaded. + +Siep Kroonenberg +November 2018 diff --git a/Master/source/tltcl/zlib-1.2.8.tar.gz b/Master/source/tltcl/zlib-1.2.8.tar.gz Binary files differnew file mode 100644 index 00000000000..ed88885bd40 --- /dev/null +++ b/Master/source/tltcl/zlib-1.2.8.tar.gz diff --git a/Master/tlpkg/tltcl/tclkit.exe b/Master/tlpkg/tltcl/tclkit.exe Binary files differnew file mode 100755 index 00000000000..c58dacd579c --- /dev/null +++ b/Master/tlpkg/tltcl/tclkit.exe diff --git a/Master/tlpkg/tltcl/tltcl.tcl b/Master/tlpkg/tltcl/tltcl.tcl new file mode 100644 index 00000000000..75e9c12e724 --- /dev/null +++ b/Master/tlpkg/tltcl/tltcl.tcl @@ -0,0 +1,507 @@ +#!/usr/bin/env wish + +# Copyright 2018 Siep Kroonenberg + +# This file is licensed under the GNU General Public License version 2 +# or any later version. + +# common declarations for tlshell.tcl and install-tl-gui.tcl + +set ::plain_unix 0 +if {$::tcl_platform(platform) eq "unix" && $::tcl_platform(os) ne "Darwin"} { + set ::plain_unix 1 +} + +# process ID of the perl program that will run in the background +set ::perlpid 0 + +set any_mirror "http://mirror.ctan.org/systems/texlive/tlnet" + +proc get_stacktrace {} { + set level [info level] + set s "" + for {set i 1} {$i < $level} {incr i} { + append s [format "Level %u: %s\n" $i [info level $i]] + } + return $s +} ; # get_stacktrace + +proc err_exit {{mess ""}} { + if {$mess eq ""} {set mess "Error"} + append mess "\n" [get_stacktrace] + if $::plain_unix { + # 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 + bind . <Destroy> { + catch {tk appname appname} + } + } + tk_messageBox -icon error -message $mess + # kill perl process, just in case + if $::perlpid { + catch { + if {$::tcl_platform(platform) eq "unix"} { + exec -ignorestderr "kill" $::perlpid + } else { + exec -ignorestderr "taskkill" "/pid" $::perlpid + } + } + } + exit +} ; # err_exit + +# localization support + +# for the sake of our translators we use our own translation function +# which can use .po files directly. This allows them to check their work +# without creating or waiting for a conversion to .msg. +# We still use the msgcat module for detecting default locale. +# Otherwise, the localization code borrows much from Norbert Preining's +# translation module for TL. + +proc load_translations {} { + + # check the command-line for a lang parameter + set ::lang "" + set i 0 + while {$i < $::argc} { + set p [lindex $::argv $i] + incr i + if {$p eq "-lang" || $p eq "--lang"} { + if {$i < $::argc} { + set ::lang [lindex $::argv $i] + break + } + } elseif {[string range $p 0 5] eq "-lang="} { + set ::lang [string range $p 6 end] + break + } elseif {[string range $p 0 6] eq "--lang="} { + set ::lang [string range $p 7 end] + break + } + } + unset i + + # First fallback: check config file. + # $TEXMFCONFIG/tlmgr/config can have a setting for gui-lang. + # There will not be one for the installer, only for tlmgr. + if {! [info exists ::lang] || $::lang eq ""} { + foreach tmf {"TEXMFCONFIG" "TEXMFSYSCONFIG"} { + if [catch {exec kpsewhich -var-value $tmf} d] { + break; # apparently there is not yet a TL installation + } + if [catch {open [file join $d "tlmgr" "config"] r} fid] continue + while 1 { + if [chan eof $fid] { + break + } + if [catch {chan gets $fid} l] break + if {[regexp {^\s*gui-lang\s*=\s*(\S+)$} $l m ::lang]} { + break + } + } + chan close $fid + if {[info exists ::lang] && $::lang ne ""} break + } + } + + # second fallback: what does msgcat think about it? Note that + # msgcat checks the environment and on windows also the registry. + if {! [info exists ::lang] || $::lang eq ""} { + package require msgcat + set ::lang [::msgcat::mclocale] + } + + set messcat "" + if {$::lang ne ""} { + set messcat "" + set maybe "" + set ::lang [string tolower $::lang] + set tdir [file join $::instroot "tlpkg" "translations"] + foreach f [glob -directory $tdir *.po] { + set ln_f [string tolower [string range [file tail $f] 0 end-3]] + if {$ln_f eq $::lang} { + set messcat $f + break + } elseif {[string range $ln_f 0 1] eq [string range $::lang 0 1]} { + set maybe $f + } + } + if {$messcat eq ""} { + set messcat $maybe + } + } + + # parse messcat. + # for now, just skip lines which make no sense. + # empty messcat: no suitable message catalog + if {$messcat ne ""} { + # create array with msgid keys and msgstr values + if {! [catch {open $messcat r} fid]} { + fconfigure $fid -encoding utf-8 + set inmsgid 0 + set inmsgstr 0 + set msgid "" + set msgstr "" + while 1 { + if [chan eof $fid] break + if [catch {chan gets $fid} l] break + if [regexp {^\s*#} $l] continue + if [regexp {^\s*$} $l] { + # empty line separates msgid/msgstr pairs + if $inmsgid { + # msgstr lines missing + # puts stderr "no translation for $msgid in $messcat" + set msgid "" + set msgstr "" + set inmsgid 0 + set inmsgstr 0 + continue + } + if $inmsgstr { + # empty line signals end of msgstr + if {$msgstr ne ""} { + set msgid [string map {"\\n" "\n"} $msgid] + set msgstr [string map {"\\n" "\n"} $msgstr] + set msgid [string map {"\\\\" "\\"} $msgid] + set msgstr [string map {"\\\\" "\\"} $msgstr] + set ::TRANS($msgid) $msgstr + } + set msgid "" + set msgstr "" + set inmsgid 0 + set inmsgstr 0 + continue + } + continue + } ; # empty line + if [regexp {^msgid\s+"(.*)"\s*$} $l m msgid] { + # note. a failed match will leave msgid alone + set inmsgid 1 + continue + } + if [regexp {^"(.*)"\s*$} $l m s] { + if $inmsgid { + append msgid $s + } elseif $inmsgstr { + append msgstr $s + } + continue + } + if [regexp {^msgstr\s+"(.*)"\s*$} $l m msgstr] { + set inmsgstr 1 + set inmsgid 0 + } + } + chan close $fid + } + } +} +load_translations + +proc __ {s args} { + if {[info exists ::TRANS($s)]} { + set s $::TRANS($s) + #} else { + # puts stderr "No translation found for $s\n[get_stacktrace]" + } + if {$args eq ""} { + return $s + } else { + return [format $s {*}$args] + } +} + +# string representation of booleans +proc yes_no {b} { + if $b { + set ans [__ "Yes"] + } else { + set ans [__ "No"] + } + return $ans +} + +if {$::tcl_platform(os) eq "Darwin"} { + # avoid warnings 'tar: Failed to set default locale' + set ::env(LC_ALL) "en_US.UTF-8" +} + +### fonts ### + +# no bold text for messages; `userDefault' indicates priority +option add *Dialog.msg.font TkDefaultFont userDefault + +# normal size bold +font create bfont {*}[font configure TkDefaultFont] +font configure bfont -weight bold +# larger, not bold: lfont +font create lfont {*}[font configure TkDefaultFont] +font configure lfont -size [expr {round(1.2 * [font actual lfont -size])}] +# larger and bold +font create hfont {*}[font configure lfont] +font configure hfont -weight bold +# extra large and bold +font create titlefont {*}[font configure TkDefaultFont] +font configure titlefont -weight bold \ + -size [expr {round(1.5 * [font actual titlefont -size])}] + +## italicized items; not used +#font create it_font {*}[font configure TkDefaultFont] +#font configure it_font -slant italic + +# width of '0', as a very rough estimate of average character width +# assume height == width*2 +set ::cw [font measure TkDefaultFont "0"] + +# default foreground color and disabled foreground color +# may not be black in e.g. dark color schemes +set blk [ttk::style lookup TButton -foreground] +set gry [ttk::style lookup TButton -foreground disabled] + +# 'default' padding + +proc ppack {wdg args} { ; # pack command with padding + pack $wdg {*}$args -padx 3 -pady 3 +} + +proc pgrid {wdg args} { ; # grid command with padding + grid $wdg {*}$args -padx 3 -pady 3 +} + +# unicode symbols as fake checkboxes in ttk::treeview widgets + +proc mark_sym {mrk} { + if {$::tcl_platform(platform) eq "windows"} { + # under windows, these look slightly better than + # the non-windows selections + if $mrk { + return "\u25C9" ; # 'fisheye' + } else { + return "\u25CB" ; # 'white circle' + } + } else { + if $mrk { + return "\u25A3" ; # 'white square containing black small square' + } else { + return "\u25A1" ; # 'white square' + } + } +} ; # mark_sym + +# for help output +set ::env(NOPERLDOC) 1 + +##### dialog support ##### + +# for example code, look at dialog.tcl, part of Tk itself + +# global variable for dialog return value, in case the outcome +# must be handled by the caller rather than by the dialog itself: +set ::dialog_ans {} + +# start new toplevel with settings appropriate for a dialog +proc create_dlg {wnd {p .}} { + unset -nocomplain ::dialog_ans + catch {destroy $wnd} ; # no error if it does not exist + toplevel $wnd -class Dialog + wm withdraw $wnd + if [winfo viewable $p] {wm transient $wnd $p} + if $::plain_unix {wm attributes $wnd -type dialog} + wm protocol $wnd WM_DELETE_WINDOW {destroy $wnd} +} + +# Place a dialog centered wrt its parent. +# If its geometry is somehow not yet available, +# its upperleft corner will be centered. + +proc place_dlg {wnd {p "."}} { + set g [wm geometry $p] + scan $g "%dx%d+%d+%d" pw ph px py + set hcenter [expr {$px + $pw / 2}] + set vcenter [expr {$py + $ph / 2}] + set g [wm geometry $wnd] + set wh [winfo reqheight $wnd] + set ww [winfo reqwidth $wnd] + set wx [expr {$hcenter - $ww / 2}] + if {$wx < 0} { set wx 0} + set wy [expr {$vcenter - $wh / 2}] + if {$wy < 0} { set wy 0} + wm geometry $wnd [format "+%d+%d" $wx $wy] + wm state $wnd normal + wm attributes $wnd -topmost + raise $wnd $p + tkwait visibility $wnd + focus $wnd + grab set $wnd +} ; # place_dlg + +proc end_dlg {ans wnd} { + set ::dialog_ans $ans + set p [winfo parent $wnd] + if {$p eq ""} {set p "."} + raise $p + destroy $wnd +} ; # end_dlg + +##### directories ##### + +# slash flipping +proc forward_slashify {s} { + regsub -all {\\} $s {/} r + return $r +} +proc native_slashify {s} { + if {$::tcl_platform(platform) eq "windows"} { + regsub -all {/} $s {\\} r + } else { + regsub -all {\\} $s {/} r + } + return $r +} + +# unix: choose_dir replacing native directory browser + +if {$::tcl_platform(platform) eq "unix"} { + + # Based on the tcl/tk widget demo. + # Also for MacOS, because we want to see /usr. + # For windows, the native browser widget is better. + + ## Code to populate a single directory node + proc populateTree {tree node} { + if {[$tree set $node type] ne "directory"} { + set type [$tree set $node type] + return + } + $tree delete [$tree children $node] + foreach f [lsort [glob -nocomplain -directory $node *]] { + set type [file type $f] + if {$type eq "directory"} { + $tree insert $node end \ + -id $f -text [file tail $f] -values [list $type] + # Need at least one child to make this node openable, + # will be deleted when actually populating this node + $tree insert $f 0 -text "dummy" + } + } + # Stop this code from rerunning on the current node + $tree set $node type processedDirectory + } + + proc choose_dir {initdir {parent .}} { + + create_dlg .browser $parent + wm title .browser [__ "Browse..."] + + # wallpaper + pack [ttk::frame .browser.bg -padding 3] -fill both -expand 1 + ## Create the tree and set it up + pack [ttk::frame .browser.fr0] -in .browser.bg -fill both -expand 1 + set tree [ttk::treeview .browser.tree \ + -columns {type} -displaycolumns {} -selectmode browse \ + -yscroll ".browser.vsb set"] + .browser.tree column 0 -minwidth 500 -stretch 0 + ttk::scrollbar .browser.vsb -orient vertical -command "$tree yview" + # hor. scrolling does not work, but toplevel and widget are resizable + $tree heading \#0 -text "/" + $tree insert {} end -id "/" -text "/" -values [list "directory"] + + populateTree $tree "/" + bind $tree <<TreeviewOpen>> { + populateTree %W [%W focus] + } + bind $tree <ButtonRelease-1> { + .browser.tree heading \#0 -text [%W focus] + } + + ## Arrange the tree and its scrollbar in the toplevel + # horizontal scrolling does not work. + # possible solution: very wide treeview in smaller paned window + # (may as well use pack in the absence of a horizontal scrollbar) + grid $tree .browser.vsb -sticky nsew -in .browser.fr0 + grid columnconfigure .browser.fr0 0 -weight 1 + grid rowconfigure .browser.fr0 0 -weight 1 + + # ok and cancel buttons + pack [ttk::frame .browser.fr1] -in .browser.bg -fill x -expand 1 + ppack [ttk::button .browser.ok -text [__ "Ok"]] \ + -in .browser.fr1 -side right + ppack [ttk::button .browser.cancel -text [__ "Cancel"]] \ + -in .browser.fr1 -side right + .browser.ok configure -command { + set ::dialog_ans [.browser.tree focus] + destroy .browser + } + .browser.cancel configure -command { + set ::dialog_ans "" + destroy .browser + } + unset -nocomplain ::dialog_ans + + # navigate tree to $initdir + set chosenDir {} + foreach d [file split [file normalize $initdir]] { + set nextdir [file join $chosenDir $d] + if [file isdirectory $nextdir] { + if {! [$tree exists $nextdir]} { + $tree insert $chosenDir end -id $nextdir \ + -text $d -values [list "directory"] + } + populateTree $tree $nextdir + set chosenDir $nextdir + } else { + break + } + } + $tree see $chosenDir + $tree selection set [list $chosenDir] + $tree focus $chosenDir + $tree heading \#0 -text $chosenDir + + place_dlg .browser $parent + tkwait window .browser + return $::dialog_ans + }; # choose_dir + +}; # if unix + +proc browse4dir {inidir {parent .}} { + if {$::tcl_platform(platform) eq "unix"} { + return [choose_dir $inidir $parent] + } else { + return [tk_chooseDirectory \ + -initialdir $inidir -title [__ "Select or type"] -parent $parent] + } +} ; # browse4dir + +# browse for a directory and store in entry- or label widget $w +proc dirbrowser2widget {w} { + set wclass [winfo class $w] + if {$wclass eq "Entry" || $wclass eq "TEntry"} { + set is_entry 1 + } elseif {$wclass eq "Label" || $wclass eq "TLabel"} { + set is_entry 0 + } else { + err_exit "browse2widget invoked with unsupported widget class $wclass" + } + if $is_entry { + set retval [$w get] + } else { + set retval [$w cget -text] + } + set retval [browse4dir $retval [winfo parent $w]] + if {$retval eq ""} { + return 0 + } else { + if {$wclass eq "Entry" || $wclass eq "TEntry"} { + $w delete 0 end + $w insert 0 $retval + } else { + $w configure -text $retval + } + return 1 + } +} |