diff options
author | Denis Bitouzé <dbitouze@wanadoo.fr> | 2021-02-25 18:23:07 +0000 |
---|---|---|
committer | Denis Bitouzé <dbitouze@wanadoo.fr> | 2021-02-25 18:23:07 +0000 |
commit | c6101f91d071883b48b1b4b51e5eba0f36d9a78d (patch) | |
tree | 1bf7f5a881d7a4f5c5bf59d0b2821943dd822372 /Build/source/texk/tests | |
parent | 07ee7222e389b0777456b427a55c22d0e6ffd267 (diff) |
French translation for tlmgr updated
git-svn-id: svn://tug.org/texlive/trunk@57912 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/tests')
-rw-r--r-- | Build/source/texk/tests/ChangeLog | 13 | ||||
-rw-r--r-- | Build/source/texk/tests/TeXLive/TLConfig.pm | 385 | ||||
-rw-r--r-- | Build/source/texk/tests/TeXLive/TLUtils.pm | 4866 | ||||
-rw-r--r-- | Build/source/texk/tests/common-test.pl | 64 | ||||
-rw-r--r-- | Build/source/texk/tests/texmf/afmtest.afm | 23 | ||||
-rw-r--r-- | Build/source/texk/tests/texmf/plain.bst | 1097 | ||||
-rw-r--r-- | Build/source/texk/tests/texmf/plain.tex | 1241 |
7 files changed, 0 insertions, 7689 deletions
diff --git a/Build/source/texk/tests/ChangeLog b/Build/source/texk/tests/ChangeLog deleted file mode 100644 index e1c3cbd0f89..00000000000 --- a/Build/source/texk/tests/ChangeLog +++ /dev/null @@ -1,13 +0,0 @@ -2011-10-02 Karl Berry <karl@tug.org> - - * TeXLive: new subdir for TL*.pm copies to be used by tests. - -2010-04-11 Karl Berry <karl@tug.org> - - * common-test.pl (AFMFONTS): set also. - -2010-03-08 Karl Berry <karl@tug.org> - - * texmf/: new subdir. - * common-test.pl (BSTINPUTS, et al.): search it. - (test_file_copy): new fn. diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm deleted file mode 100644 index ae5806c3727..00000000000 --- a/Build/source/texk/tests/TeXLive/TLConfig.pm +++ /dev/null @@ -1,385 +0,0 @@ -# TeXLive::TLConfig.pm - module exporting configuration values -# Copyright 2007-2020 Norbert Preining -# This file is licensed under the GNU General Public License version 2 -# or any later version. - -package TeXLive::TLConfig; - -my $svnrev = '$Revision: 54123 $'; -my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown"; -sub module_revision { return $_modulerevision; } - -BEGIN { - use Exporter (); - use vars qw( @ISA @EXPORT_OK @EXPORT ); - @ISA = qw(Exporter); - @EXPORT_OK = qw( - $ReleaseYear - @MetaCategories - @NormalCategories - @Categories - $MetaCategoriesRegexp - $CategoriesRegexp - $DefaultCategory - @AcceptedFallbackDownloaders - %FallbackDownloaderProgram - %FallbackDownloaderArgs - $DefaultCompressorFormat - $CompressorExtRegexp - %Compressors - $InfraLocation - $DatabaseName - $DatabaseLocation - $PackageBackupDir - $BlockSize - $Archive - $TeXLiveServerURL - $TeXLiveServerPath - $TeXLiveURL - @CriticalPackagesList - $CriticalPackagesRegexp - $WindowsMainMenuName - $RelocPrefix - $RelocTree - %TLPDBOptions - %TLPDBSettings - %TLPDBConfigs - $NetworkTimeout - $MaxLWPErrors - $MaxLWPReinitCount - $PartialEngineSupport - $F_OK $F_WARNING $F_ERROR $F_NOPOSTACTION - $ChecksumLength - $ChecksumProgram - $ChecksumExtension - ); - @EXPORT = @EXPORT_OK; -} - -# the year of our release, will be used in the location of the -# network packages, and in menu names, and other places. -$ReleaseYear = 2020; - -# users can upgrade from this year to the current year; might be the -# same as the release year, or any number of releases earlier. -# Generally not tested, but should be. -$MinRelease = 2016; - -# Meta Categories do not ship files, but only call for other packages. -our @MetaCategories = qw/Collection Scheme/; -our $MetaCategoriesRegexp = '(Collection|Scheme)'; -# -# Normal Categories contain actial files and do not depend on other things. -our @NormalCategories = qw/Package TLCore ConTeXt/; -# -# list of all Categories -our @Categories = (@MetaCategories, @NormalCategories); - -# repeat, as a regexp. -our $CategoriesRegexp = '(Collection|Scheme|Package|TLCore|ConTeXt)'; - -our $DefaultCategory = "Package"; - -# location of various infra files (texlive.tlpdb, .tlpobj etc) -# relative to a root (e.g., the Master/, or the installation path) -our $InfraLocation = "tlpkg"; -our $DatabaseName = "texlive.tlpdb"; -our $DatabaseLocation = "$InfraLocation/$DatabaseName"; - -# location of backups in default autobackup setting (under tlpkg) -our $PackageBackupDir = "$InfraLocation/backups"; - -# for computing disk usage; this is most common. -our $BlockSize = 4096; - -# timeout for network connections (wget, LWP) in seconds -our $NetworkTimeout = 30; -# number of errors during an LWP session until it is marked as disabled -our $MaxLWPErrors = 5; -# max number of times we reenable LWP after it was disabled -our $MaxLWPReinitCount = 10; - -our $Archive = "archive"; -our $TeXLiveServerURL = "http://mirror.ctan.org"; -# from 2009 on we try to put them all into tlnet directly without any -# release year since we hope that we can switch over to 2010 on the fly -# our $TeXLiveServerPath = "systems/texlive/tlnet/$ReleaseYear"; -our $TeXLiveServerPath = "systems/texlive/tlnet"; -our $TeXLiveURL = "$TeXLiveServerURL/$TeXLiveServerPath"; - -# Relocatable packages. -our $RelocTree = "texmf-dist"; -our $RelocPrefix = "RELOC"; - -our @CriticalPackagesList = qw/texlive.infra/; -our $CriticalPackagesRegexp = '^(texlive\.infra)'; -if ($^O =~ /^MSWin/i) { - push (@CriticalPackagesList, "tlperl.win32"); - $CriticalPackagesRegexp = '^(texlive\.infra|tlperl\.win32$)'; -} - -# -our @AcceptedFallbackDownloaders = qw/curl wget/; -our %FallbackDownloaderProgram = ( 'wget' => 'wget', 'curl' => 'curl'); -our %FallbackDownloaderArgs = ( - 'curl' => ['--user-agent', 'texlive/curl', '--retry', '4', '--retry-delay', '5', - '--fail', '--location', - '--connect-timeout', "$NetworkTimeout", '--silent', '--output'], - 'wget' => ['--user-agent=texlive/wget', '--tries=4', - "--timeout=$NetworkTimeout", '-q', '-O'], -); -# the way we package things on the web -our $DefaultCompressorFormat = "xz"; -# priority defines which compressor is selected for backups/rollback containers -# less is better -our %Compressors = ( - "lz4" => { - "decompress_args" => ["-dcf"], - "compress_args" => ["-zfmq"], - "extension" => "lz4", - "priority" => 10, - }, - "gzip" => { - "decompress_args" => ["-dcf"], - "compress_args" => ["-f"], - "extension" => "gz", - "priority" => 20, - }, - "xz" => { - "decompress_args" => ["-dcf"], - "compress_args" => ["-zf"], - "extension" => "xz", - "priority" => 30, - }, -); -our $CompressorExtRegexp = "(" - . join("|", map { $Compressors{$_}{'extension'} } keys %Compressors) - . ")"; - -# archive (not user) settings. -# these can be overridden by putting them into 00texlive.config.tlpsrc -# in the format -# depend key/value -our %TLPDBConfigs = ( - "container_split_src_files" => 1, - "container_split_doc_files" => 1, - "container_format" => $DefaultCompressorFormat, - "minrelease" => $MinRelease, - "release" => $ReleaseYear, - "frozen" => 0, -); - -# definition of the option strings and their value types -# possible types are: -# - u: url -# - b: boolean, saved as 0/1 -# - p: path (local path) -# - n: natural number -# it allows n:[a]..[b] -# if a is empty start at -infty -# if b is empty end at +infty -# so "n:.." is equivalent to "n" - -# $TLPDBOptions{"option"}->[0] --> type -# ->[1] --> default value -# ->[2] --> tlmgr name -# ->[3] --> tlmgr description -# the "option" is the value in the TLPDB - -our %TLPDBOptions = ( - "autobackup" => - [ "n:-1..", 1, "autobackup", - "Number of backups to keep" ], - "backupdir" => - [ "p", $PackageBackupDir, "backupdir", - "Directory for backups" ], - "create_formats" => - [ "b", 1, "formats", - "Generate formats at installation or update" ], - "desktop_integration" => - [ "b", 1, "desktop_integration", - "Create Start menu shortcuts (w32)" ], - "file_assocs" => - [ "n:0..2", 1, "fileassocs", - "Change file associations (w32)" ], - "generate_updmap" => - [ "b", 0, "generate_updmap", - "Run tlmgr generate updmap after maps have changed" ], - "install_docfiles" => - [ "b", 1, "docfiles", - "Install documentation files" ], - "install_srcfiles" => - [ "b", 1, "srcfiles", - "Install source files" ], - "location" => - [ "u", "__MASTER__", "repository", - "Default package repository" ], - "post_code" => - [ "b", 1, "postcode", - "Run postinst code blobs" ], - "sys_bin" => - [ "p", "/usr/local/bin", "sys_bin", - "Destination for symlinks for binaries" ], - "sys_info" => - [ "p", "/usr/local/share/info", "sys_info", - "Destination for symlinks for info docs" ], - "sys_man" => - [ "p", "/usr/local/share/man", "sys_man", - "Destination for symlinks for man pages" ], - "w32_multi_user" => - [ "b", 1, "multiuser", - "Install for all users (w32)" ], -); - - -our %TLPDBSettings = ( - "platform" => [ "s", "Main platform for this computer" ], - "available_architectures" => [ "l","All available/installed architectures" ], - "usertree" => [ "b", "This tree acts as user tree" ] -); - -our $WindowsMainMenuName = "TeX Live $ReleaseYear"; - -# Comma-separated list of engines which do not exist on all platforms. -our $PartialEngineSupport = "luajithbtex,luajittex,mfluajit"; - -# Flags for error handling across the scripts and modules -# all fine -our $F_OK = 0; -# -# some warnings, but we still try to run post actions -our $F_WARNING = 1; -# -# error, terminating -our $F_ERROR = 2; -# -# all fine, but no need to run post actions -our $F_NOPOSTACTION = 4; - -# The length of a checksum generated by tlchecksum and contained in -# texlive.tlpdb.checksum. Needs to be in agreement with the hash -# method used in TLCrypto::tlchecksum and TLCrypto::tldigest -our $ChecksumLength = 128; - -# The program generating the checksum for the file given as first -# argument -our $ChecksumProgram = "sha512sum"; - -# The extension of the checksum file -our $ChecksumExtension = "sha512"; - -1; - - -=head1 NAME - -C<TeXLive::TLConfig> -- TeX Live Configuration module - -=head1 SYNOPSIS - - use TeXLive::TLConfig; - -=head1 DESCRIPTION - -The L<TeXLive::TLConfig> module contains definitions of variables -configuring all of TeX Live. - -=over 4 - -=head1 EXPORTED VARIABLES - -All of the following variables are pulled into the callers namespace, -i.e., are declared with C<EXPORT> (and C<EXPORT_OK>). - -=item C<@TeXLive::TLConfig::MetaCategories> - -The list of meta categories, i.e., those categories whose packages only -depend on other packages, but don't ship any files. Currently -C<Collection> and <Scheme>. - -=item C<@TeXLive::TLConfig::NormalCategories> - -The list of normal categories, i.e., those categories whose packages do -ship files. Currently C<TLCore>, C<Package>, C<ConTeXt>. - -=item C<@TeXLive::TLConfig::Categories> - -The list of all categories, i.e., the union of the above. - -=item C<$TeXLive::TLConfig::CategoriesRegexp> - -A regexp matching any category. - -=item C<$TeXLive::TLConfig::DefaultCategory> - -The default category used when creating new packages. - -=item C<$TeXLive::TLConfig::InfraLocation> - -The subdirectory with various infrastructure files (C<texlive.tlpdb>, -tlpobj files, ...) relative to the root of the installation; currently -C<tlpkg>. - -=item C<$TeXLive::TLConfig::DatabaseName> - -The name of our so-called database file: C<texlive.tlpdb>. It's just a -plain text file, not any kind of relational or other database. - -=item C<$TeXLive::TLConfig::DatabaseLocation> - -Concatenation of C<InfraLocation> "/" C<DatabaseName>, i.e., -C<tlpkg/texlive.tlpdb>. - -=item C<$TeXLive::TLConfig::BlockSize> - -The assumed block size, currently 4k. - -=item C<$TeXLive::TLConfig::Archive> -=item C<$TeXLive::TLConfig::TeXLiveURL> - -These values specify where to find packages. - -=item C<$TeXLive::TLConfig::TeXLiveServerURL> -=item C<$TeXLive::TLConfig::TeXLiveServerPath> - -C<TeXLiveURL> is concatenated from these values, with a string between. -The defaults are respectively, C<http://mirror.ctan.org> and -C<systems/texlive/tlnet/>. - -=item C<@TeXLive::TLConfig::CriticalPackagesList> -=item C<@TeXLive::TLConfig::CriticalPackagesRegexp> - -A list of all those packages which we do not update regularly since they -are too central, currently texlive.infra and (for Windows) tlperl.win32. - -=item C<$TeXLive::TLConfig::RelocTree> - -The texmf-tree name that can be relocated, defaults to C<texmf-dist>. - -=item C<$TeXLive::TLConfig::RelocPrefix> - -The string that replaces the C<RelocTree> in the tlpdb if a package is -relocated, defaults to C<RELOC>". - -=back - -=head1 SEE ALSO - -All the other TeX Live modules and scripts, especially C<tlmgr> and -C<install-tl>, and the documentation in the repository: -C<Master/tlpkg/doc/>. - -=head1 AUTHORS AND COPYRIGHT - -This script and its documentation were written for the TeX Live -distribution (L<http://tug.org/texlive>) and both are licensed under the -GNU General Public License Version 2 or later. - -=cut - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm deleted file mode 100644 index aa5a00b3a7d..00000000000 --- a/Build/source/texk/tests/TeXLive/TLUtils.pm +++ /dev/null @@ -1,4866 +0,0 @@ -# TeXLive::TLUtils.pm - the inevitable utilities for TeX Live. -# Copyright 2007-2020 Norbert Preining, Reinhard Kotucha -# This file is licensed under the GNU General Public License version 2 -# or any later version. - -package TeXLive::TLUtils; - -my $svnrev = '$Revision: 57421 $'; -my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown"; -sub module_revision { return $_modulerevision; } - -=pod - -=head1 NAME - -C<TeXLive::TLUtils> - utilities used in TeX Live infrastructure - -=head1 SYNOPSIS - - use TeXLive::TLUtils; - -=head2 Platform detection - - TeXLive::TLUtils::platform(); - TeXLive::TLUtils::platform_name($canonical_host); - TeXLive::TLUtils::platform_desc($platform); - TeXLive::TLUtils::win32(); - TeXLive::TLUtils::unix(); - -=head2 System tools - - TeXLive::TLUtils::getenv($string); - TeXLive::TLUtils::which($string); - TeXLive::TLUtils::initialize_global_tmpdir(); - TeXLive::TLUtils::tl_tmpdir(); - TeXLive::TLUtils::tl_tmpfile(); - TeXLive::TLUtils::xchdir($dir); - TeXLive::TLUtils::wsystem($msg,@args); - TeXLive::TLUtils::xsystem(@args); - TeXLive::TLUtils::run_cmd($cmd); - TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @args); - -=head2 File utilities - - TeXLive::TLUtils::dirname($path); - TeXLive::TLUtils::basename($path); - TeXLive::TLUtils::dirname_and_basename($path); - TeXLive::TLUtils::tl_abs_path($path); - TeXLive::TLUtils::dir_writable($path); - TeXLive::TLUtils::dir_creatable($path); - TeXLive::TLUtils::mkdirhier($path); - TeXLive::TLUtils::rmtree($root, $verbose, $safe); - TeXLive::TLUtils::copy($file, $target_dir); - TeXLive::TLUtils::touch(@files); - TeXLive::TLUtils::collapse_dirs(@files); - TeXLive::TLUtils::removed_dirs(@files); - TeXLive::TLUtils::download_file($path, $destination); - TeXLive::TLUtils::setup_programs($bindir, $platform); - TeXLive::TLUtils::tlcmp($file, $file); - TeXLive::TLUtils::nulldev(); - TeXLive::TLUtils::get_full_line($fh); - -=head2 Installer functions - - TeXLive::TLUtils::make_var_skeleton($path); - TeXLive::TLUtils::make_local_skeleton($path); - TeXLive::TLUtils::create_fmtutil($tlpdb,$dest); - TeXLive::TLUtils::create_updmap($tlpdb,$dest); - TeXLive::TLUtils::create_language_dat($tlpdb,$dest,$localconf); - TeXLive::TLUtils::create_language_def($tlpdb,$dest,$localconf); - TeXLive::TLUtils::create_language_lua($tlpdb,$dest,$localconf); - TeXLive::TLUtils::time_estimate($totalsize, $donesize, $starttime) - TeXLive::TLUtils::install_packages($from_tlpdb,$media,$to_tlpdb,$what,$opt_src, $opt_doc)>); - TeXLive::TLUtils::do_postaction($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script); - TeXLive::TLUtils::announce_execute_actions($how, @executes, $what); - TeXLive::TLUtils::add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info); - TeXLive::TLUtils::remove_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info); - TeXLive::TLUtils::w32_add_to_path($bindir, $multiuser); - TeXLive::TLUtils::w32_remove_from_path($bindir, $multiuser); - TeXLive::TLUtils::setup_persistent_downloads(); - -=head2 Logging and debugging - - TeXLive::TLUtils::info($str1, ...); # output unless -q - TeXLive::TLUtils::debug($str1, ...); # output if -v - TeXLive::TLUtils::ddebug($str1, ...); # output if -vv - TeXLive::TLUtils::dddebug($str1, ...); # output if -vvv - TeXLive::TLUtils::log($str1, ...); # only to log file - TeXLive::TLUtils::tlwarn($str1, ...); # warn on stderr and log - TeXLive::TLUtils::tldie($str1, ...); # tlwarn and die - TeXLive::TLUtils::debug_hash_str($label, HASH); # stringified HASH - TeXLive::TLUtils::debug_hash($label, HASH); # warn stringified HASH - TeXLive::TLUtils::backtrace(); # return call stack as string - TeXLive::TLUtils::process_logging_options($texdir); # handle -q -v* -logfile - -=head2 Miscellaneous - - TeXLive::TLUtils::sort_uniq(@list); - TeXLive::TLUtils::push_uniq(\@list, @items); - TeXLive::TLUtils::member($item, @list); - TeXLive::TLUtils::merge_into(\%to, \%from); - TeXLive::TLUtils::texdir_check($texdir); - TeXLive::TLUtils::quotify_path_with_spaces($path); - TeXLive::TLUtils::conv_to_w32_path($path); - TeXLive::TLUtils::native_slashify($internal_path); - TeXLive::TLUtils::forward_slashify($path_from_user); - TeXLive::TLUtils::give_ctan_mirror(); - TeXLive::TLUtils::give_ctan_mirror_base(); - TeXLive::TLUtils::compare_tlpobjs($tlpA, $tlpB); - TeXLive::TLUtils::compare_tlpdbs($tlpdbA, $tlpdbB); - TeXLive::TLUtils::report_tlpdb_differences(\%ret); - TeXLive::TLUtils::tlnet_disabled_packages($root); - TeXLive::TLUtils::mktexupd(); - TeXLive::TLUtils::setup_sys_user_mode($optsref,$tmfc, $tmfsc, $tmfv, $tmfsv); - TeXLive::TLUtils::prepend_own_path(); - TeXLive::TLUtils::repository_to_array($str); - -=head2 JSON - - TeXLive::TLUtils::encode_json($ref); - TeXLive::TLUtils::True(); - TeXLive::TLUtils::False(); - -=head1 DESCRIPTION - -=cut - -# avoid -warnings. -our $PERL_SINGLE_QUOTE; # we steal code from Text::ParseWords -use vars qw( - $::LOGFILE $::LOGFILENAME @::LOGLINES - @::debug_hook @::ddebug_hook @::dddebug_hook @::info_hook - @::install_packages_hook @::warn_hook - $TeXLive::TLDownload::net_lib_avail - $::checksum_method $::gui_mode $::machinereadable $::no_execute_actions - $::regenerate_all_formats - $JSON::false $JSON::true -); - -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT_OK @EXPORT); - @ISA = qw(Exporter); - @EXPORT_OK = qw( - &platform - &platform_name - &platform_desc - &unix - &getenv - &which - &initialize_global_tmpdir - &dirname - &basename - &dirname_and_basename - &tl_abs_path - &dir_writable - &dir_creatable - &mkdirhier - &rmtree - © - &touch - &collapse_dirs - &removed_dirs - &install_package - &install_packages - &make_var_skeleton - &make_local_skeleton - &create_fmtutil - &create_updmap - &create_language_dat - &create_language_def - &create_language_lua - &parse_AddFormat_line - &parse_AddHyphen_line - &sort_uniq - &push_uniq - &texdir_check - &member - "ewords - "ify_path_with_spaces - &conv_to_w32_path - &native_slashify - &forward_slashify - &untar - &unpack - &merge_into - &give_ctan_mirror - &give_ctan_mirror_base - &create_mirror_list - &extract_mirror_entry - &wsystem - &xsystem - &run_cmd - &system_pipe - &announce_execute_actions - &add_symlinks - &remove_symlinks - &w32_add_to_path - &w32_remove_from_path - &tlcmp - &time_estimate - &compare_tlpobjs - &compare_tlpdbs - &report_tlpdb_differences - &setup_persistent_downloads - &mktexupd - &setup_sys_user_mode - &prepend_own_path - &nulldev - &get_full_line - &sort_archs - &repository_to_array - &encode_json - &True - &False - &SshURIRegex - ); - @EXPORT = qw(setup_programs download_file process_logging_options - tldie tlwarn info log debug ddebug dddebug debug - debug_hash_str debug_hash - win32 xchdir xsystem run_cmd system_pipe sort_archs); -} - -use Cwd; -use Getopt::Long; -use File::Temp; - -use TeXLive::TLConfig; - -$::opt_verbosity = 0; # see process_logging_options - -our $SshURIRegex = '^((ssh|scp)://([^@]*)@([^/]*)/|([^@]*)@([^:]*):).*$'; - -=head2 Platform detection - -=over 4 - -=item C<platform> - -If C<$^O =~ /MSWin/i> is true we know that we're on -Windows and we set the global variable C<$::_platform_> to C<win32>. -Otherwise we call C<platform_name> with the output of C<config.guess> -as argument. - -The result is stored in a global variable C<$::_platform_>, and -subsequent calls just return that value. - -=cut - -sub platform { - unless (defined $::_platform_) { - if ($^O =~ /^MSWin/i) { - $::_platform_ = "win32"; - } else { - my $config_guess = "$::installerdir/tlpkg/installer/config.guess"; - - # We cannot rely on #! in config.guess but have to call /bin/sh - # explicitly because sometimes the 'noexec' flag is set in - # /etc/fstab for ISO9660 file systems. - chomp (my $guessed_platform = `/bin/sh '$config_guess'`); - - # For example, if the disc or reader has hardware problems. - die "$0: could not run $config_guess, cannot proceed, sorry" - if ! $guessed_platform; - - $::_platform_ = platform_name($guessed_platform); - } - } - return $::_platform_; -} - - -=item C<platform_name($canonical_host)> - -Convert ORIG_PLATFORM, a canonical host name as returned by -C<config.guess>, into a TeX Live platform name. - -CPU type is determined by a regexp, and any C</^i.86/> name is replaced -by C<i386>. - -For the OS value we need a list because what's returned is not likely to -match our historical names, e.g., C<config.guess> returns C<linux-gnu> -but we need C<linux>. This list contains old OSs which are no longer -supported, just in case. - -If the environment variable TEXLIVE_OS_NAME is set, it is used as-is. - -=cut - -sub platform_name { - my ($orig_platform) = @_; - my $guessed_platform = $orig_platform; - - # try to parse out some bsd variants that use amd64. - # We throw away everything after the "bsd" to elide version numbers, - # as in amd64-unknown-midnightbsd1.2. - $guessed_platform =~ s/^x86_64-(.*-k?)(free|net)bsd/amd64-$1$2bsd/; - my $CPU; # CPU type as reported by config.guess. - my $OS; # O/S type as reported by config.guess. - ($CPU = $guessed_platform) =~ s/(.*?)-.*/$1/; - - $CPU =~ s/^alpha(.*)/alpha/; # alphaev whatever - $CPU =~ s/mips64el/mipsel/; # don't distinguish mips64 and 32 el - $CPU =~ s/powerpc64/powerpc/; # don't distinguish ppc64 - $CPU =~ s/sparc64/sparc/; # don't distinguish sparc64 - - # armv6l-unknown-linux-gnueabihf -> armhf-linux (RPi) - # armv7l-unknown-linux-gnueabi -> armel-linux (Android) - if ($CPU =~ /^arm/) { - $CPU = $guessed_platform =~ /hf$/ ? "armhf" : "armel"; - } - - if ($ENV{"TEXLIVE_OS_NAME"}) { - $OS = $ENV{"TEXLIVE_OS_NAME"}; - } else { - my @OSs = qw(aix cygwin darwin dragonfly freebsd hpux irix - kfreebsd linux midnightbsd netbsd openbsd solaris); - for my $os (@OSs) { - # Match word boundary at the beginning of the os name so that - # freebsd and kfreebsd are distinguished. - # Do not match word boundary at the end of the os so that - # solaris2 is matched. - $OS = $os if $guessed_platform =~ /\b$os/; - } - } - - if (! $OS) { - warn "$0: could not guess OS from config.guess string: $orig_platform"; - $OS = "unknownOS"; - } - - if ($OS eq "linux") { - # deal with the special case of musl based distributions - # config.guess returns - # x86_64-pc-linux-musl - # i386-pc-linux-musl - $OS = "linuxmusl" if $guessed_platform =~ /\blinux-musl/; - } - - if ($OS eq "darwin") { - # We have two versions of Mac binary sets. - # 10.x and newer -> x86_64-darwin [MacTeX] - # 10.6/Snow Leopard through 10.x -> x86_64-darwinlegacy, if 64-bit - # x changes every year. In 2020 (Big Sur) Apple started with 11.x. - # - # (BTW, uname -r numbers are larger by 4 than the Mac minor version. - # We don't use uname numbers here.) - # - # this changes each year, per above: - my $mactex_darwin = 13; # lowest minor rev supported by x86_64-darwin. - # - # Most robust approach is apparently to check sw_vers (os version, - # returns "10.x" values), and sysctl (processor hardware). - chomp (my $sw_vers = `sw_vers -productVersion`); - my ($os_major,$os_minor) = split (/\./, $sw_vers); - if ($os_major < 10) { - warn "$0: only MacOSX is supported, not $OS $os_major.$os_minor " - . " (from sw_vers -productVersion: $sw_vers)\n"; - return "unknownmac-unknownmac"; - } - if ($os_major >= 11) { - $CPU = "x86_64"; - $OS = "darwin"; - } elsif ($os_minor >= $mactex_darwin) { - ; # sufficiently new 10.x, default is ok (x86_64-darwin). - } elsif ($os_minor >= 6 && $os_minor < $mactex_darwin) { - # in between, x86 hardware only. On 10.6 only, must check if 64-bit, - # since if later than that, always 64-bit. - my $is64 = $os_minor == 6 - ? `/usr/sbin/sysctl -n hw.cpu64bit_capable` >= 1 - : 1; - if ($is64) { - $CPU = "x86_64"; - $OS = "darwinlegacy"; - } # if not 64-bit, default is ok (i386-darwin). - } else { - ; # older version, default is ok (i386-darwin, powerpc-darwin). - } - - } elsif ($CPU =~ /^i.86$/) { - $CPU = "i386"; # 586, 686, whatever - } - - if (! defined $OS) { - ($OS = $guessed_platform) =~ s/.*-(.*)/$1/; - } - - return "$CPU-$OS"; -} - -=item C<platform_desc($platform)> - -Return a string which describes a particular platform identifier, e.g., -given C<i386-linux> we return C<Intel x86 with GNU/Linux>. - -=cut - -sub platform_desc { - my ($platform) = @_; - - my %platform_name = ( - 'aarch64-linux' => 'GNU/Linux on ARM64', - 'alpha-linux' => 'GNU/Linux on DEC Alpha', - 'amd64-freebsd' => 'FreeBSD on x86_64', - 'amd64-kfreebsd' => 'GNU/kFreeBSD on x86_64', - 'amd64-midnightbsd'=> 'MidnightBSD on x86_64', - 'amd64-netbsd' => 'NetBSD on x86_64', - 'armel-linux' => 'GNU/Linux on ARM', - 'armhf-linux' => 'GNU/Linux on ARMv6/RPi', - 'hppa-hpux' => 'HP-UX', - 'i386-cygwin' => 'Cygwin on Intel x86', - 'i386-darwin' => 'MacOSX legacy (10.5-10.6) on Intel x86', - 'i386-freebsd' => 'FreeBSD on Intel x86', - 'i386-kfreebsd' => 'GNU/kFreeBSD on Intel x86', - 'i386-linux' => 'GNU/Linux on Intel x86', - 'i386-linuxmusl' => 'GNU/Linux on Intel x86 with musl', - 'i386-netbsd' => 'NetBSD on Intel x86', - 'i386-openbsd' => 'OpenBSD on Intel x86', - 'i386-solaris' => 'Solaris on Intel x86', - 'mips-irix' => 'SGI IRIX', - 'mipsel-linux' => 'GNU/Linux on MIPSel', - 'powerpc-aix' => 'AIX on PowerPC', - 'powerpc-darwin' => 'MacOSX legacy (10.5) on PowerPC', - 'powerpc-linux' => 'GNU/Linux on PowerPC', - 'sparc-linux' => 'GNU/Linux on Sparc', - 'sparc-solaris' => 'Solaris on Sparc', - 'universal-darwin' => 'MacOSX universal binaries', - 'win32' => 'Windows', - 'x86_64-cygwin' => 'Cygwin on x86_64', - 'x86_64-darwin' => 'MacOSX current (10.13-) on x86_64', - 'x86_64-darwinlegacy' => 'MacOSX legacy (10.6-) on x86_64', - 'x86_64-dragonfly' => 'DragonFlyBSD on x86_64', - 'x86_64-linux' => 'GNU/Linux on x86_64', - 'x86_64-linuxmusl' => 'GNU/Linux on x86_64 with musl', - 'x86_64-solaris' => 'Solaris on x86_64', - ); - - # the inconsistency between amd64-freebsd and x86_64-linux is - # unfortunate (it's the same hardware), but the os people say those - # are the conventional names on the respective os's, so we follow suit. - - if (exists $platform_name{$platform}) { - return "$platform_name{$platform}"; - } else { - my ($CPU,$OS) = split ('-', $platform); - return "$CPU with " . ucfirst "$OS"; - } -} - - -=item C<win32> - -Return C<1> if platform is Windows and C<0> otherwise. The test is -currently based on the value of Perl's C<$^O> variable. - -=cut - -sub win32 { - if ($^O =~ /^MSWin/i) { - return 1; - } else { - return 0; - } - # the following needs config.guess, which is quite bad ... - # return (&platform eq "win32")? 1:0; -} - - -=item C<unix> - -Return C<1> if platform is UNIX and C<0> otherwise. - -=cut - -sub unix { - return (&platform eq "win32")? 0:1; -} - - -=back - -=head2 System Tools - -=over 4 - -=item C<getenv($string)> - -Get an environment variable. It is assumed that the environment -variable contains a path. On Windows all backslashes are replaced by -forward slashes as required by Perl. If this behavior is not desired, -use C<$ENV{"$variable"}> instead. C<0> is returned if the -environment variable is not set. - -=cut - -sub getenv { - my $envvar=shift; - my $var=$ENV{"$envvar"}; - return 0 unless (defined $var); - if (&win32) { - $var=~s!\\!/!g; # change \ -> / (required by Perl) - } - return "$var"; -} - - -=item C<which($string)> - -C<which> does the same as the UNIX command C<which(1)>, but it is -supposed to work on Windows too. On Windows we have to try all the -extensions given in the C<PATHEXT> environment variable. We also try -without appending an extension because if C<$string> comes from an -environment variable, an extension might already be present. - -=cut - -sub which { - my ($prog) = @_; - my @PATH; - my $PATH = getenv('PATH'); - - if (&win32) { - my @PATHEXT = split (';', getenv('PATHEXT')); - push (@PATHEXT, ''); # in case argument contains an extension - @PATH = split (';', $PATH); - for my $dir (@PATH) { - for my $ext (@PATHEXT) { - if (-f "$dir/$prog$ext") { - return "$dir/$prog$ext"; - } - } - } - - } else { # not windows - @PATH = split (':', $PATH); - for my $dir (@PATH) { - if (-x "$dir/$prog") { - return "$dir/$prog"; - } - } - } - return 0; -} - -=item C<initialize_global_tmpdir();> - -Initializes a directory for all temporary files. This uses C<File::Temp> -and thus honors various env variables like C<TMPDIR>, C<TMP>, and C<TEMP>. - -=cut - -sub initialize_global_tmpdir { - $::tl_tmpdir = File::Temp::tempdir(CLEANUP => 1); - ddebug("TLUtils::initialize_global_tmpdir: creating global tempdir $::tl_tmpdir\n"); - return ($::tl_tmpdir); -} - -=item C<tl_tmpdir> - -Create a temporary directory which is removed when the program -is terminated. - -=cut - -sub tl_tmpdir { - initialize_global_tmpdir() if (!defined($::tl_tmpdir)); - my $tmp = File::Temp::tempdir(DIR => $::tl_tmpdir, CLEANUP => 1); - ddebug("TLUtils::tl_tmpdir: creating tempdir $tmp\n"); - return ($tmp); -} - -=item C<tl_tmpfile> - -Create a temporary file which is removed when the program -is terminated. Returns file handle and file name. -Arguments are passed on to C<File::Temp::tempfile>. - -=cut - -sub tl_tmpfile { - initialize_global_tmpdir() if (!defined($::tl_tmpdir)); - my ($fh, $fn) = File::Temp::tempfile(@_, DIR => $::tl_tmpdir, UNLINK => 1); - ddebug("TLUtils::tl_tempfile: creating tempfile $fn\n"); - return ($fh, $fn); -} - - -=item C<xchdir($dir)> - -C<chdir($dir)> or die. - -=cut - -sub xchdir { - my ($dir) = @_; - chdir($dir) || die "$0: chdir($dir) failed: $!"; - ddebug("xchdir($dir) ok\n"); -} - - -=item C<wsystem($msg, @args)> - -Call C<info> about what is being done starting with C<$msg>, then run -C<system(@args)>; C<tlwarn> if unsuccessful and return the exit status. - -=cut - -sub wsystem { - my ($msg,@args) = @_; - info("$msg @args ...\n"); - my $retval = system(@args); - if ($retval != 0) { - $retval /= 256 if $retval > 0; - tlwarn("$0: command failed (status $retval): @args: $!\n"); - } - return $retval; -} - - -=item C<xsystem(@args)> - -Call C<ddebug> about what is being done, then run C<system(@args)>, and -die if unsuccessful. - -=cut - -sub xsystem { - my (@args) = @_; - ddebug("running system(@args)\n"); - my $retval = system(@args); - if ($retval != 0) { - $retval /= 256 if $retval > 0; - my $pwd = cwd (); - die "$0: system(@args) failed in $pwd, status $retval"; - } - return $retval; -} - -=item C<run_cmd($cmd)> - -Run shell command C<$cmd> and captures its output. Returns a list with CMD's -output as the first element and the return value (exit code) as second. - -=cut - -sub run_cmd { - my $cmd = shift; - my $output = `$cmd`; - $output = "" if ! defined ($output); # don't return undef - - my $retval = $?; - if ($retval != 0) { - $retval /= 256 if $retval > 0; - } - return ($output,$retval); -} - -=item C<system_pipe($prog, $infile, $outfile, $removeIn, @extraargs)> - -Runs C<$prog> with C<@extraargs> redirecting stdin from C<$infile>, stdout to C<$outfile>. -Removes C<$infile> if C<$removeIn> is true. - -=cut - -sub system_pipe { - my ($prog, $infile, $outfile, $removeIn, @extraargs) = @_; - - my $progQuote = quotify_path_with_spaces($prog); - if (win32()) { - $infile =~ s!/!\\!g; - $outfile =~ s!/!\\!g; - } - my $infileQuote = "\"$infile\""; - my $outfileQuote = "\"$outfile\""; - debug("TLUtils::system_pipe: calling $progQuote @extraargs < $infileQuote > $outfileQuote\n"); - my $retval = system("$progQuote @extraargs < $infileQuote > $outfileQuote"); - if ($retval != 0) { - $retval /= 256 if $retval > 0; - debug("TLUtils::system_pipe: system exit code = $retval\n"); - return 0; - } else { - if ($removeIn) { - debug("TLUtils::system_pipe: removing $infile\n"); - unlink($infile); - } - return 1; - } -} - -=back - -=head2 File utilities - -=over 4 - -=item C<dirname_and_basename($path)> - -Return both C<dirname> and C<basename>. Example: - - ($dirpart,$filepart) = dirname_and_basename ($path); - -=cut - -sub dirname_and_basename { - my $path=shift; - my ($share, $base) = ("", ""); - if (win32) { - $path=~s!\\!/!g; - } - # do not try to make sense of paths ending with /.. - return (undef, undef) if $path =~ m!/\.\.$!; - if ($path=~m!/!) { # dirname("foo/bar/baz") -> "foo/bar" - # eliminate `/.' path components - while ($path =~ s!/\./!/!) {}; - # UNC path? => first split in $share = //xxx/yy and $path = /zzzz - if (win32() and $path =~ m!^(//[^/]+/[^/]+)(.*)$!) { - ($share, $path) = ($1, $2); - if ($path =~ m!^/?$!) { - $path = $share; - $base = ""; - } elsif ($path =~ m!(/.*)/(.*)!) { - $path = $share.$1; - $base = $2; - } else { - $base = $path; - $path = $share; - } - return ($path, $base); - } - # not a UNC path - $path=~m!(.*)/(.*)!; # works because of greedy matching - return ((($1 eq '') ? '/' : $1), $2); - } else { # dirname("ignore") -> "." - return (".", $path); - } -} - - -=item C<dirname($path)> - -Return C<$path> with its trailing C</component> removed. - -=cut - -sub dirname { - my $path = shift; - my ($dirname, $basename) = dirname_and_basename($path); - return $dirname; -} - - -=item C<basename($path)> - -Return C<$path> with any leading directory components removed. - -=cut - -sub basename { - my $path = shift; - my ($dirname, $basename) = dirname_and_basename($path); - return $basename; -} - - -=item C<tl_abs_path($path)> - -# Other than Cwd::abs_path, tl_abs_path also works if the argument does not -# yet exist as long as the path does not contain '..' components. - -=cut - -sub tl_abs_path { - my $path = shift; - if (win32) { - $path=~s!\\!/!g; - } - if (-e $path) { - $path = Cwd::abs_path($path); - } elsif ($path eq '.') { - $path = Cwd::getcwd(); - } else{ - # collapse /./ components - $path =~ s!/\./!/!g; - # no support for .. path components or for win32 long-path syntax - # (//?/ path prefix) - die "Unsupported path syntax" if $path =~ m!/\.\./! || $path =~ m!/\.\.$! - || $path =~ m!^\.\.!; - die "Unsupported path syntax" if win32() && $path =~ m!^//\?/!; - if ($path !~ m!^(.:)?/!) { # relative path - if (win32() && $path =~ /^.:/) { # drive letter - my $dcwd; - # starts with drive letter: current dir on drive - $dcwd = Cwd::getdcwd ($1); - $dcwd .= '/' unless $dcwd =~ m!/$!; - return $dcwd.$path; - } else { # relative path without drive letter - my $cwd = Cwd::getcwd(); - $cwd .= '/' unless $cwd =~ m!/$!; - return $cwd . $path; - } - } # else absolute path - } - $path =~ s!/$!! unless $path =~ m!^(.:)?/$!; - return $path; -} - - -=item C<dir_creatable($path)> - -Tests whether its argument is a directory where we can create a directory. - -=cut - -sub dir_slash { - my $d = shift; - $d = "$d/" unless $d =~ m!/!; - return $d; -} - -# test whether subdirectories can be created in the argument -sub dir_creatable { - my $path=shift; - #print STDERR "testing $path\n"; - $path =~ s!\\!/!g if win32; - return 0 unless -d $path; - $path .= '/' unless $path =~ m!/$!; - #print STDERR "testing $path\n"; - my $d; - for my $i (1..100) { - $d = ""; - # find a non-existent dirname - $d = $path . int(rand(1000000)); - last unless -e $d; - } - if (!$d) { - tlwarn("Cannot find available testdir name\n"); - return 0; - } - #print STDERR "creating $d\n"; - return 0 unless mkdir $d; - return 0 unless -d $d; - rmdir $d; - return 1; -} - - -=item C<dir_writable($path)> - -Tests whether its argument is writable by trying to write to -it. This function is necessary because the built-in C<-w> test just -looks at mode and uid/gid, which on Windows always returns true and -even on Unix is not always good enough for directories mounted from -a fileserver. - -=cut - -# The Unix test gives the wrong answer when used under Windows Vista -# with one of the `virtualized' directories such as Program Files: -# lacking administrative permissions, it would write successfully to -# the virtualized Program Files rather than fail to write to the -# real Program Files. Ugh. - -sub dir_writable { - my ($path) = @_; - return 0 unless -d $path; - $path =~ s!\\!/!g if win32; - $path .= '/' unless $path =~ m!/$!; - my $i = 0; - my $f; - for my $i (1..100) { - $f = ""; - # find a non-existent filename - $f = $path . int(rand(1000000)); - last unless -e $f; - } - if (!$f) { - tlwarn("Cannot find available testfile name\n"); - return 0; - } - return 0 if ! open (TEST, ">$f"); - my $written = 0; - $written = (print TEST "\n"); - close (TEST); - unlink ($f); - return $written; -} - - -=item C<mkdirhier($path, [$mode])> - -The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>. -It behaves differently depending on the context in which it is called: -If called in void context it will die on failure. If called in -scalar context, it will return 1/0 on sucess/failure. If called in -list context, it returns 1/0 as first element and an error message -as second, if an error occurred (and no second element in case of -success). The optional parameter sets the permission bits. - -=cut - -sub mkdirhier { - my ($tree,$mode) = @_; - my $ret = 1; - my $reterror; - - if (-d "$tree") { - $ret = 1; - } else { - my $subdir = ""; - # win32 is special as usual: we need to separate //servername/ part - # from the UNC path, since (! -d //servername/) tests true - $subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) ); - - @dirs = split (/[\/\\]/, $tree); - for my $dir (@dirs) { - $subdir .= "$dir/"; - if (! -d $subdir) { - if (defined $mode) { - if (! mkdir ($subdir, $mode)) { - $ret = 0; - $reterror = "mkdir($subdir,$mode) failed: $!"; - last; - } - } else { - if (! mkdir ($subdir)) { - $ret = 0; - $reterror = "mkdir($subdir) failed for tree $tree: $!"; - last; - } - } - } - } - } - if ($ret) { - return(1); # nothing bad here returning 1 in any case, will - # be ignored in void context, and give 1 in list context - } else { - if (wantarray) { - return(0, $reterror); - } elsif (defined wantarray) { - return(0); - } else { - die "$0: $reterror"; - } - } -} - - -=item C<rmtree($root, $verbose, $safe)> - -The C<rmtree> function provides a convenient way to delete a -subtree from the directory structure, much like the Unix command C<rm -r>. -C<rmtree> takes three arguments: - -=over 4 - -=item * - -the root of the subtree to delete, or a reference to -a list of roots. All of the files and directories -below each root, as well as the roots themselves, -will be deleted. - -=item * - -a boolean value, which if TRUE will cause C<rmtree> to -print a message each time it examines a file, giving the -name of the file, and indicating whether it's using C<rmdir> -or C<unlink> to remove it, or that it's skipping it. -(defaults to FALSE) - -=item * - -a boolean value, which if TRUE will cause C<rmtree> to -skip any files to which you do not have delete access -(if running under VMS) or write access (if running -under another OS). This will change in the future when -a criterion for 'delete permission' under OSs other -than VMS is settled. (defaults to FALSE) - -=back - -It returns the number of files successfully deleted. Symlinks are -simply deleted and not followed. - -B<NOTE:> There are race conditions internal to the implementation of -C<rmtree> making it unsafe to use on directory trees which may be -altered or moved while C<rmtree> is running, and in particular on any -directory trees with any path components or subdirectories potentially -writable by untrusted users. - -Additionally, if the third parameter is not TRUE and C<rmtree> is -interrupted, it may leave files and directories with permissions altered -to allow deletion (and older versions of this module would even set -files and directories to world-read/writable!) - -Note also that the occurrence of errors in C<rmtree> can be determined I<only> -by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent -from the return value. - -=cut - -#taken from File/Path.pm -# -my $Is_VMS = $^O eq 'VMS'; -my $Is_MacOS = $^O eq 'MacOS'; - -# These OSes complain if you want to remove a file that you have no -# write permission to: -my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' || - $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc'); - -sub rmtree { - my($roots, $verbose, $safe) = @_; - my(@files); - my($count) = 0; - $verbose ||= 0; - $safe ||= 0; - - if ( defined($roots) && length($roots) ) { - $roots = [$roots] unless ref $roots; - } else { - warn "No root path(s) specified"; - return 0; - } - - my($root); - foreach $root (@{$roots}) { - if ($Is_MacOS) { - $root = ":$root" if $root !~ /:/; - $root =~ s#([^:])\z#$1:#; - } else { - $root =~ s#/\z##; - } - (undef, undef, my $rp) = lstat $root or next; - $rp &= 07777; # don't forget setuid, setgid, sticky bits - if ( -d _ ) { - # notabene: 0700 is for making readable in the first place, - # it's also intended to change it to writable in case we have - # to recurse in which case we are better than rm -rf for - # subtrees with strange permissions - chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) - or warn "Can't make directory $root read+writeable: $!" - unless $safe; - - if (opendir my $d, $root) { - no strict 'refs'; - if (!defined ${"\cTAINT"} or ${"\cTAINT"}) { - # Blindly untaint dir names - @files = map { /^(.*)$/s ; $1 } readdir $d; - } else { - @files = readdir $d; - } - closedir $d; - } else { - warn "Can't read $root: $!"; - @files = (); - } - # Deleting large numbers of files from VMS Files-11 filesystems - # is faster if done in reverse ASCIIbetical order - @files = reverse @files if $Is_VMS; - ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS; - if ($Is_MacOS) { - @files = map("$root$_", @files); - } else { - @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files); - } - $count += rmtree(\@files,$verbose,$safe); - if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { - print "skipped $root\n" if $verbose; - next; - } - chmod $rp | 0700, $root - or warn "Can't make directory $root writeable: $!" - if $force_writeable; - print "rmdir $root\n" if $verbose; - if (rmdir $root) { - ++$count; - } else { - warn "Can't remove directory $root: $!"; - chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) - or warn("and can't restore permissions to " - . sprintf("0%o",$rp) . "\n"); - } - } else { - if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) - : !(-l $root || -w $root))) - { - print "skipped $root\n" if $verbose; - next; - } - chmod $rp | 0600, $root - or warn "Can't make file $root writeable: $!" - if $force_writeable; - print "unlink $root\n" if $verbose; - # delete all versions under VMS - for (;;) { - unless (unlink $root) { - warn "Can't unlink file $root: $!"; - if ($force_writeable) { - chmod $rp, $root - or warn("and can't restore permissions to " - . sprintf("0%o",$rp) . "\n"); - } - last; - } - ++$count; - last unless $Is_VMS && lstat $root; - } - } - } - $count; -} - - -=item C<copy($file, $target_dir)> - -=item C<copy("-f", $file, $destfile)> - -=item C<copy("-L", $file, $destfile)> - -Copy file C<$file> to directory C<$target_dir>, or to the C<$destfile> -if the first argument is C<"-f">. No external programs are involved. -Since we need C<sysopen()>, the Perl module C<Fcntl.pm> is required. The -time stamps are preserved and symlinks are created on Unix systems. On -Windows, C<(-l $file)> will never return 'C<true>' and so symlinks will -be (uselessly) copied as regular files. - -If the argument is C<"-L"> and C<$file> is a symlink, the link is -dereferenced before the copying is done. (If both C<"-f"> and C<"-L"> -are desired, they must be given in that order, although the current code -has no need to do this.) - -C<copy> invokes C<mkdirhier> if target directories do not exist. Files -have mode C<0777> if they are executable and C<0666> otherwise, with -the set bits in I<umask> cleared in each case. - -C<$file> can begin with a C<file:/> prefix. - -If C<$file> is not readable, we return without copying anything. (This -can happen when the database and files are not in perfect sync.) On the -other file, if the destination is not writable, or the writing fails, -that is a fatal error. - -=cut - -sub copy { - #too verbose ddebug("TLUtils::copy(", join (",", @_), "\n"); - my $infile = shift; - my $filemode = 0; - my $dereference = 0; - if ($infile eq "-f") { # second argument is a file - $filemode = 1; - $infile = shift; - } - if ($infile eq "-L") { - $dereference = 1; - $infile = shift; - } - my $destdir=shift; - - # while we're trying to figure out the versioned containers. - #debug("copy($infile, $destdir, filemode=$filemode)\n"); - #debug("copy: backtrace:\n", backtrace(), "copy: end backtrace\n"); - - my $outfile; - my @stat; - my $mode; - my $buffer; - my $offset; - my $filename; - my $dirmode = 0755; - my $blocksize = $TeXLive::TLConfig::BlockSize; - - $infile =~ s!^file://*!/!i; # remove file:/ url prefix - $filename = basename "$infile"; - if ($filemode) { - # given a destination file - $outfile = $destdir; - $destdir = dirname($outfile); - } else { - $outfile = "$destdir/$filename"; - } - - if (! -d $destdir) { - my ($ret,$err) = mkdirhier ($destdir); - die "mkdirhier($destdir) failed: $err\n" if ! $ret; - } - - # if we should dereference, change $infile to refer to the link target. - if (-l $infile && $dereference) { - my $linktarget = readlink($infile); - # The symlink target should always be relative, and we need to - # prepend the directory containing the link in that case. - # (Although it should never happen, if the symlink target happens - # to already be absolute, do not prepend.) - if ($linktarget !~ m,^/,) { - $infile = Cwd::abs_path(dirname($infile)) . "/$linktarget"; - } - ddebug("TLUtils::copy: dereferencing symlink $infile -> $linktarget"); - } - - if (-l $infile) { - my $linktarget = readlink($infile); - my $dest = "$destdir/$filename"; - ddebug("TLUtils::copy: doing symlink($linktarget,$dest)" - . " [from readlink($infile)]\n"); - symlink($linktarget, $dest) || die "symlink($linktarget,$dest) failed: $!"; - } else { - if (! open (IN, $infile)) { - warn "open($infile) failed, not copying: $!"; - return; - } - binmode IN; - - $mode = (-x $infile) ? oct("0777") : oct("0666"); - $mode &= ~umask; - - open (OUT, ">$outfile") || die "open(>$outfile) failed: $!"; - binmode OUT; - - chmod ($mode, $outfile) || warn "chmod($mode,$outfile) failed: $!"; - - while ($read = sysread (IN, $buffer, $blocksize)) { - die "read($infile) failed: $!" unless defined $read; - $offset = 0; - while ($read) { - $written = syswrite (OUT, $buffer, $read, $offset); - die "write($outfile) failed: $!" unless defined $written; - $read -= $written; - $offset += $written; - } - } - close (OUT) || warn "close($outfile) failed: $!"; - close (IN) || warn "close($infile) failed: $!";; - @stat = lstat ($infile); - die "lstat($infile) failed: $!" if ! @stat; - utime ($stat[8], $stat[9], $outfile); - } -} - - -=item C<touch(@files)> - -Update modification and access time of C<@files>. Non-existent files -are created. - -=cut - -sub touch { - my @files=@_; - - foreach my $file (@_) { - if (-e $file) { - utime time, time, $file; - } else { - if (open( TMP, ">$file")) { - close(TMP); - } else { - warn "Can't create file $file: $!\n"; - } - } - } -} - - -=item C<collapse_dirs(@files)> - -Return a (more or less) minimal list of directories and files, given an -original list of files C<@files>. That is, if every file within a given -directory is included in C<@files>, replace all of those files with the -absolute directory name in the return list. Any files which have -sibling files not included are retained and made absolute. - -We try to walk up the tree so that the highest-level directory -containing only directories or files that are in C<@files> is returned. -(This logic may not be perfect, though.) - -This is not just a string function; we check for other directory entries -existing on disk within the directories of C<@files>. Therefore, if the -entries are relative pathnames, the current directory must be set by the -caller so that file tests work. - -As mentioned above, the returned list is absolute paths to directories -and files. - -For example, suppose the input list is - - dir1/subdir1/file1 - dir1/subdir2/file2 - dir1/file3 - -If there are no other entries under C<dir1/>, the result will be -C</absolute/path/to/dir1>. - -=cut - -sub collapse_dirs { - my (@files) = @_; - my @ret = (); - my %by_dir; - - # construct hash of all directories mentioned, values are lists of the - # files in that directory. - for my $f (@files) { - my $abs_f = Cwd::abs_path ($f); - die ("oops, no abs_path($f) from " . `pwd`) unless $abs_f; - (my $d = $abs_f) =~ s,/[^/]*$,,; - my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : (); - push (@a, $abs_f); - $by_dir{$d} = \@a; - } - - # for each of our directories, see if we are given everything in - # the directory. if so, return the directory; else return the - # individual files. - for my $d (sort keys %by_dir) { - opendir (DIR, $d) || die "opendir($d) failed: $!"; - my @dirents = readdir (DIR); - closedir (DIR) || warn "closedir($d) failed: $!"; - - # initialize test hash with all the files we saw in this dir. - # (These idioms are due to "Finding Elements in One Array and Not - # Another" in the Perl Cookbook.) - my %seen; - my @rmfiles = @{$by_dir{$d}}; - @seen{@rmfiles} = (); - - # see if everything is the same. - my $ok_to_collapse = 1; - for my $dirent (@dirents) { - next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn - - my $item = "$d/$dirent"; # prepend directory for comparison - if (! exists $seen{$item}) { - ddebug(" no collapse of $d because of: $dirent\n"); - $ok_to_collapse = 0; - last; # no need to keep looking after the first. - } - } - - push (@ret, $ok_to_collapse ? $d : @{$by_dir{$d}}); - } - - if (@ret != @files) { - @ret = &collapse_dirs (@ret); - } - return @ret; -} - -=item C<removed_dirs(@files)> - -Returns all the directories from which all content will be removed. - -Here is the idea: - -=over 4 - -=item create a hashes by_dir listing all files that should be removed - by directory, i.e., key = dir, value is list of files - -=item for each of the dirs (keys of by_dir and ordered deepest first) - check that all actually contained files are removed - and all the contained dirs are in the removal list. If this is the - case put that directory into the removal list - -=item return this removal list - -=back -=cut - -sub removed_dirs { - my (@files) = @_; - my %removed_dirs; - my %by_dir; - - # construct hash of all directories mentioned, values are lists of the - # files/dirs in that directory. - for my $f (@files) { - # what should we do with not existing entries???? - next if (! -r "$f"); - my $abs_f = Cwd::abs_path ($f); - # the following is necessary because on win32, - # abs_path("tl-portable") - # returns - # c:\tl test\... - # and not forward slashes, while, if there is already a forward / - # in the path, also the rest is done with forward slashes. - $abs_f =~ s!\\!/!g if win32(); - if (!$abs_f) { - warn ("oops, no abs_path($f) from " . `pwd`); - next; - } - (my $d = $abs_f) =~ s,/[^/]*$,,; - my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : (); - push (@a, $abs_f); - $by_dir{$d} = \@a; - } - - # for each of our directories, see if we are removing everything in - # the directory. if so, return the directory; else return the - # individual files. - for my $d (reverse sort keys %by_dir) { - opendir (DIR, $d) || die "opendir($d) failed: $!"; - my @dirents = readdir (DIR); - closedir (DIR) || warn "closedir($d) failed: $!"; - - # initialize test hash with all the files we saw in this dir. - # (These idioms are due to "Finding Elements in One Array and Not - # Another" in the Perl Cookbook.) - my %seen; - my @rmfiles = @{$by_dir{$d}}; - @seen{@rmfiles} = (); - - # see if everything is the same. - my $cleandir = 1; - for my $dirent (@dirents) { - next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn - my $item = "$d/$dirent"; # prepend directory for comparison - if ( - ((-d $item) && (defined($removed_dirs{$item}))) - || - (exists $seen{$item}) - ) { - # do nothing - } else { - $cleandir = 0; - last; - } - } - if ($cleandir) { - $removed_dirs{$d} = 1; - } - } - return keys %removed_dirs; -} - -=item C<time_estimate($totalsize, $donesize, $starttime)> - -Returns the current running time and the estimated total time -based on the total size, the already done size, and the start time. - -=cut - -sub time_estimate { - my ($totalsize, $donesize, $starttime) = @_; - if ($donesize <= 0) { - return ("??:??", "??:??"); - } - my $curtime = time(); - my $passedtime = $curtime - $starttime; - my $esttotalsecs = int ( ( $passedtime * $totalsize ) / $donesize ); - # - # we change the display to show that passed time instead of the - # estimated remaining time. We keep the old code and naming and - # only initialize the $remsecs to the $passedtime instead. - # my $remsecs = $esttotalsecs - $passedtime; - my $remsecs = $passedtime; - my $min = int($remsecs/60); - my $hour; - if ($min >= 60) { - $hour = int($min/60); - $min %= 60; - } - my $sec = $remsecs % 60; - $remtime = sprintf("%02d:%02d", $min, $sec); - if ($hour) { - $remtime = sprintf("%02d:$remtime", $hour); - } - my $tmin = int($esttotalsecs/60); - my $thour; - if ($tmin >= 60) { - $thour = int($tmin/60); - $tmin %= 60; - } - my $tsec = $esttotalsecs % 60; - $tottime = sprintf("%02d:%02d", $tmin, $tsec); - if ($thour) { - $tottime = sprintf("%02d:$tottime", $thour); - } - return($remtime, $tottime); -} - - -=item C<install_packages($from_tlpdb, $media, $to_tlpdb, $what, $opt_src, $opt_doc)> - -Installs the list of packages found in C<@$what> (a ref to a list) into -the TLPDB given by C<$to_tlpdb>. Information on files are taken from -the TLPDB C<$from_tlpdb>. - -C<$opt_src> and C<$opt_doc> specify whether srcfiles and docfiles should be -installed (currently implemented only for installation from uncompressed media). - -Returns 1 on success and 0 on error. - -=cut - -sub install_packages { - my ($fromtlpdb,$media,$totlpdb,$what,$opt_src,$opt_doc) = @_; - my $container_src_split = $fromtlpdb->config_src_container; - my $container_doc_split = $fromtlpdb->config_doc_container; - my $root = $fromtlpdb->root; - my @packs = @$what; - my $totalnr = $#packs + 1; - my $td = length("$totalnr"); - my $n = 0; - my %tlpobjs; - my $totalsize = 0; - my $donesize = 0; - my %tlpsizes; - debug("TLUtils::install_packages: fromtlpdb.root=$root, media=$media," - . " totlpdb.root=" . $totlpdb->root - . " what=$what ($totalnr), opt_src=$opt_src, opt_doc=$opt_doc\n"); - - foreach my $p (@packs) { - $tlpobjs{$p} = $fromtlpdb->get_package($p); - if (!defined($tlpobjs{$p})) { - die "STRANGE: $p not to be found in ", $fromtlpdb->root; - } - if ($media ne 'local_uncompressed') { - # we use the container size as the measuring unit since probably - # downloading will be the limiting factor - $tlpsizes{$p} = $tlpobjs{$p}->containersize; - $tlpsizes{$p} += $tlpobjs{$p}->srccontainersize if $opt_src; - $tlpsizes{$p} += $tlpobjs{$p}->doccontainersize if $opt_doc; - } else { - # we have to add the respective sizes, that is checking for - # installation of src and doc file - $tlpsizes{$p} = $tlpobjs{$p}->runsize; - $tlpsizes{$p} += $tlpobjs{$p}->srcsize if $opt_src; - $tlpsizes{$p} += $tlpobjs{$p}->docsize if $opt_doc; - my %foo = %{$tlpobjs{$p}->binsize}; - for my $k (keys %foo) { $tlpsizes{$p} += $foo{$k}; } - # all the packages sizes are in blocks, so transfer that to bytes - $tlpsizes{$p} *= $TeXLive::TLConfig::BlockSize; - } - $totalsize += $tlpsizes{$p}; - } - my $starttime = time(); - my @packs_again; # packages that we failed to download and should retry later - foreach my $package (@packs) { - my $tlpobj = $tlpobjs{$package}; - my $reloc = $tlpobj->relocated; - $n++; - my ($estrem, $esttot) = time_estimate($totalsize, $donesize, $starttime); - my $infostr = sprintf("Installing [%0${td}d/$totalnr, " - . "time/total: $estrem/$esttot]: $package [%dk]", - $n, int($tlpsizes{$package}/1024) + 1); - info("$infostr\n"); - foreach my $h (@::install_packages_hook) { - &$h($n,$totalnr); - } - # push $package to @packs_again if download failed - # (and not installing from disk). - if (!$fromtlpdb->install_package($package, $totlpdb)) { - tlwarn("TLUtils::install_packages: Failed to install $package\n"); - if ($media eq "NET") { - tlwarn(" $package will be retried later.\n"); - push @packs_again, $package; - } else { - # return false as soon as one package failed, since we won't - # be trying again. - return 0; - } - } else { - $donesize += $tlpsizes{$package}; - } - } - # try to download packages in @packs_again again - foreach my $package (@packs_again) { - my $infostr = sprintf("Retrying to install: $package [%dk]", - int($tlpsizes{$package}/1024) + 1); - info("$infostr\n"); - # return false if download failed again - if (!$fromtlpdb->install_package($package, $totlpdb)) { - return 0; - } - $donesize += $tlpsizes{$package}; - } - my $totaltime = time() - $starttime; - my $totmin = int ($totaltime/60); - my $totsec = $totaltime % 60; - info(sprintf("Time used for installing the packages: %02d:%02d\n", - $totmin, $totsec)); - $totlpdb->save; - return 1; -} - -=item C<do_postaction($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script)> - -Evaluates the C<postaction> fields in the C<$tlpobj>. The first parameter -can be either C<install> or C<remove>. The second gives the TLPOBJ whos -postactions should be evaluated, and the last four arguments specify -what type of postactions should (or shouldn't) be evaluated. - -Returns 1 on success, and 0 on failure. - -=cut - -sub do_postaction { - my ($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script) = @_; - my $ret = 1; - if (!defined($tlpobj)) { - tlwarn("do_postaction: didn't get a tlpobj\n"); - return 0; - } - debug("running postaction=$how for " . $tlpobj->name . "\n") - if $tlpobj->postactions; - for my $pa ($tlpobj->postactions) { - if ($pa =~ m/^\s*shortcut\s+(.*)\s*$/) { - $ret &&= _do_postaction_shortcut($how, $tlpobj, $do_menu, $do_desktop, $1); - } elsif ($pa =~ m/\s*filetype\s+(.*)\s*$/) { - next unless $do_fileassocs; - $ret &&= _do_postaction_filetype($how, $tlpobj, $1); - } elsif ($pa =~ m/\s*fileassoc\s+(.*)\s*$/) { - $ret &&= _do_postaction_fileassoc($how, $do_fileassocs, $tlpobj, $1); - next; - } elsif ($pa =~ m/\s*progid\s+(.*)\s*$/) { - next unless $do_fileassocs; - $ret &&= _do_postaction_progid($how, $tlpobj, $1); - } elsif ($pa =~ m/\s*script\s+(.*)\s*$/) { - next unless $do_script; - $ret &&= _do_postaction_script($how, $tlpobj, $1); - } else { - tlwarn("do_postaction: don't know how to do $pa\n"); - $ret = 0; - } - } - # nothing to do - return $ret; -} - -sub _do_postaction_fileassoc { - my ($how, $mode, $tlpobj, $pa) = @_; - return 1 unless win32(); - my ($errors, %keyval) = - parse_into_keywords($pa, qw/extension filetype/); - - if ($errors) { - tlwarn("parsing the postaction line >>$pa<< did not succeed!\n"); - return 0; - } - - # name can be an arbitrary string - if (!defined($keyval{'extension'})) { - tlwarn("extension of fileassoc postaction not given\n"); - return 0; - } - my $extension = $keyval{'extension'}; - - # cmd can be an arbitrary string - if (!defined($keyval{'filetype'})) { - tlwarn("filetype of fileassoc postaction not given\n"); - return 0; - } - my $filetype = $keyval{'filetype'}.'.'.$ReleaseYear; - - &log("postaction $how fileassoc for " . $tlpobj->name . - ": $extension, $filetype\n"); - if ($how eq "install") { - TeXLive::TLWinGoo::register_extension($mode, $extension, $filetype); - } elsif ($how eq "remove") { - TeXLive::TLWinGoo::unregister_extension($mode, $extension, $filetype); - } else { - tlwarn("Unknown mode $how\n"); - return 0; - } - return 1; -} - -sub _do_postaction_filetype { - my ($how, $tlpobj, $pa) = @_; - return 1 unless win32(); - my ($errors, %keyval) = - parse_into_keywords($pa, qw/name cmd/); - - if ($errors) { - tlwarn("parsing the postaction line >>$pa<< did not succeed!\n"); - return 0; - } - - # name can be an arbitrary string - if (!defined($keyval{'name'})) { - tlwarn("name of filetype postaction not given\n"); - return 0; - } - my $name = $keyval{'name'}.'.'.$ReleaseYear; - - # cmd can be an arbitrary string - if (!defined($keyval{'cmd'})) { - tlwarn("cmd of filetype postaction not given\n"); - return 0; - } - my $cmd = $keyval{'cmd'}; - - my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`; - chomp($texdir); - my $texdir_bsl = conv_to_w32_path($texdir); - $cmd =~ s!^("?)TEXDIR/!$1$texdir/!g; - - &log("postaction $how filetype for " . $tlpobj->name . - ": $name, $cmd\n"); - if ($how eq "install") { - TeXLive::TLWinGoo::register_file_type($name, $cmd); - } elsif ($how eq "remove") { - TeXLive::TLWinGoo::unregister_file_type($name); - } else { - tlwarn("Unknown mode $how\n"); - return 0; - } - return 1; -} - -# alternate filetype (= progid) for an extension; -# associated program shows up in `open with' menu -sub _do_postaction_progid { - my ($how, $tlpobj, $pa) = @_; - return 1 unless win32(); - my ($errors, %keyval) = - parse_into_keywords($pa, qw/extension filetype/); - - if ($errors) { - tlwarn("parsing the postaction line >>$pa<< did not succeed!\n"); - return 0; - } - - if (!defined($keyval{'extension'})) { - tlwarn("extension of progid postaction not given\n"); - return 0; - } - my $extension = $keyval{'extension'}; - - if (!defined($keyval{'filetype'})) { - tlwarn("filetype of progid postaction not given\n"); - return 0; - } - my $filetype = $keyval{'filetype'}.'.'.$ReleaseYear; - - &log("postaction $how progid for " . $tlpobj->name . - ": $extension, $filetype\n"); - if ($how eq "install") { - TeXLive::TLWinGoo::add_to_progids($extension, $filetype); - } elsif ($how eq "remove") { - TeXLive::TLWinGoo::remove_from_progids($extension, $filetype); - } else { - tlwarn("Unknown mode $how\n"); - return 0; - } - return 1; -} - -sub _do_postaction_script { - my ($how, $tlpobj, $pa) = @_; - my ($errors, %keyval) = - parse_into_keywords($pa, qw/file filew32/); - - if ($errors) { - tlwarn("parsing the postaction line >>$pa<< did not succeed!\n"); - return 0; - } - - # file can be an arbitrary string - if (!defined($keyval{'file'})) { - tlwarn("filename of script not given\n"); - return 0; - } - my $file = $keyval{'file'}; - if (win32() && defined($keyval{'filew32'})) { - $file = $keyval{'filew32'}; - } - my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`; - chomp($texdir); - my @syscmd; - if ($file =~ m/\.pl$/i) { - # we got a perl script, call it via perl - push @syscmd, "perl", "$texdir/$file"; - } elsif ($file =~ m/\.texlua$/i) { - # we got a texlua script, call it via texlua - push @syscmd, "texlua", "$texdir/$file"; - } else { - # we got anything else, call it directly and hope it is excutable - push @syscmd, "$texdir/$file"; - } - &log("postaction $how script for " . $tlpobj->name . ": @syscmd\n"); - push @syscmd, $how, $texdir; - my $ret = system (@syscmd); - if ($ret != 0) { - $ret /= 256 if $ret > 0; - my $pwd = cwd (); - warn "$0: calling post action script $file did not succeed in $pwd, status $ret"; - return 0; - } - return 1; -} - -sub _do_postaction_shortcut { - my ($how, $tlpobj, $do_menu, $do_desktop, $pa) = @_; - return 1 unless win32(); - my ($errors, %keyval) = - parse_into_keywords($pa, qw/type name icon cmd args hide/); - - if ($errors) { - tlwarn("parsing the postaction line >>$pa<< did not succeed!\n"); - return 0; - } - - # type can be either menu or desktop - if (!defined($keyval{'type'})) { - tlwarn("type of shortcut postaction not given\n"); - return 0; - } - my $type = $keyval{'type'}; - if (($type ne "menu") && ($type ne "desktop")) { - tlwarn("type of shortcut postaction $type is unknown (menu, desktop)\n"); - return 0; - } - - if (($type eq "menu") && !$do_menu) { - return 1; - } - if (($type eq "desktop") && !$do_desktop) { - return 1; - } - - # name can be an arbitrary string - if (!defined($keyval{'name'})) { - tlwarn("name of shortcut postaction not given\n"); - return 0; - } - my $name = $keyval{'name'}; - - # icon, cmd, args is optional - my $icon = (defined($keyval{'icon'}) ? $keyval{'icon'} : ''); - my $cmd = (defined($keyval{'cmd'}) ? $keyval{'cmd'} : ''); - my $args = (defined($keyval{'args'}) ? $keyval{'args'} : ''); - - # hide can be only 0 or 1, and defaults to 1 - my $hide = (defined($keyval{'hide'}) ? $keyval{'hide'} : 1); - if (($hide ne "0") && ($hide ne "1")) { - tlwarn("hide of shortcut postaction $hide is unknown (0, 1)\n"); - return 0; - } - - &log("postaction $how shortcut for " . $tlpobj->name . "\n"); - if ($how eq "install") { - my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`; - chomp($texdir); - my $texdir_bsl = conv_to_w32_path($texdir); - $icon =~ s!^TEXDIR/!$texdir/!; - $cmd =~ s!^TEXDIR/!$texdir/!; - # $cmd can be an URL, in which case we do NOT want to convert it to - # w32 paths! - if ($cmd !~ m!^\s*(https?://|ftp://)!) { - if (!(-e $cmd) or !(-r $cmd)) { - tlwarn("Target of shortcut action does not exist: $cmd\n") - if $cmd =~ /\.(exe|bat|cmd)$/i; - # if not an executable, just omit shortcut silently: no error - return 1; - } - $cmd = conv_to_w32_path($cmd); - } - if ($type eq "menu" ) { - TeXLive::TLWinGoo::add_menu_shortcut( - $TeXLive::TLConfig::WindowsMainMenuName, - $name, $icon, $cmd, $args, $hide); - } elsif ($type eq "desktop") { - TeXLive::TLWinGoo::add_desktop_shortcut( - $name, $icon, $cmd, $args, $hide); - } else { - tlwarn("Unknown type of shortcut: $type\n"); - return 0; - } - } elsif ($how eq "remove") { - if ($type eq "menu") { - TeXLive::TLWinGoo::remove_menu_shortcut( - $TeXLive::TLConfig::WindowsMainMenuName, $name); - } elsif ($type eq "desktop") { - TeXLive::TLWinGoo::remove_desktop_shortcut($name); - } else { - tlwarn("Unknown type of shortcut: $type\n"); - return 0; - } - } else { - tlwarn("Unknown mode $how\n"); - return 0; - } - return 1; -} - -sub parse_into_keywords { - my ($str, @keys) = @_; - my @words = quotewords('\s+', 0, $str); - my %ret; - my $error = 0; - while (@words) { - $_ = shift @words; - if (/^([^=]+)=(.*)$/) { - $ret{$1} = $2; - } else { - tlwarn("parser found a invalid word in parsing keys: $_\n"); - $error++; - $ret{$_} = ""; - } - } - for my $k (keys %ret) { - if (!member($k, @keys)) { - $error++; - tlwarn("parser found invalid keyword: $k\n"); - } - } - return($error, %ret); -} - -=item C<announce_execute_actions($how, $tlpobj, $what)> - -Announces that the actions given in C<$tlpobj> should be executed -after all packages have been unpacked. C<$what> provides -additional information. - -=cut - -sub announce_execute_actions { - my ($type, $tlp, $what) = @_; - # do simply return immediately if execute actions are suppressed - return if $::no_execute_actions; - - if (defined($type) && ($type eq "regenerate-formats")) { - $::regenerate_all_formats = 1; - return; - } - if (defined($type) && ($type eq "files-changed")) { - $::files_changed = 1; - return; - } - if (defined($type) && ($type eq "rebuild-format")) { - # rebuild-format must feed in a hashref of a parse_AddFormat_line data - # the $tlp argument is not used - $::execute_actions{'enable'}{'formats'}{$what->{'name'}} = $what; - return; - } - if (!defined($type) || (($type ne "enable") && ($type ne "disable"))) { - die "announce_execute_actions: enable or disable, not type $type"; - } - my (@maps, @formats, @dats); - if ($tlp->runfiles || $tlp->srcfiles || $tlp->docfiles) { - $::files_changed = 1; - } - $what = "map format hyphen" if (!defined($what)); - foreach my $e ($tlp->executes) { - if ($e =~ m/^add((Mixed|Kanji)?Map)\s+([^\s]+)\s*$/) { - # save the refs as we have another =~ grep in the following lines - my $a = $1; - my $b = $3; - $::execute_actions{$type}{'maps'}{$b} = $a if ($what =~ m/map/); - } elsif ($e =~ m/^AddFormat\s+(.*)\s*$/) { - my %r = TeXLive::TLUtils::parse_AddFormat_line("$1"); - if (defined($r{"error"})) { - tlwarn ("$r{'error'} in parsing $e for return hash\n"); - } else { - $::execute_actions{$type}{'formats'}{$r{'name'}} = \%r - if ($what =~ m/format/); - } - } elsif ($e =~ m/^AddHyphen\s+(.*)\s*$/) { - my %r = TeXLive::TLUtils::parse_AddHyphen_line("$1"); - if (defined($r{"error"})) { - tlwarn ("$r{'error'} in parsing $e for return hash\n"); - } else { - $::execute_actions{$type}{'hyphens'}{$r{'name'}} = \%r - if ($what =~ m/hyphen/); - } - } else { - tlwarn("Unknown execute $e in ", $tlp->name, "\n"); - } - } -} - - -=pod - -=item C<add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info)> - -=item C<remove_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info)> - -These two functions try to create/remove symlinks for binaries, man pages, -and info files as specified by the options $sys_bin, $sys_man, $sys_info. - -The functions return 1 on success and 0 on error. -On Windows it returns undefined. - -=cut - -sub add_link_dir_dir { - my ($from,$to) = @_; - my ($ret, $err) = mkdirhier ($to); - if (!$ret) { - tlwarn("$err\n"); - return 0; - } - if (-w $to) { - debug ("TLUtils::add_link_dir_dir: linking from $from to $to\n"); - chomp (@files = `ls "$from"`); - my $ret = 1; - for my $f (@files) { - # don't make a system-dir link to our special "man" link. - if ($f eq "man") { - debug ("not linking `man' into $to.\n"); - next; - } - # - # attempt to remove an existing symlink, but nothing else. - unlink ("$to/$f") if -l "$to/$f"; - # - # if the destination still exists, skip it. - if (-e "$to/$f") { - tlwarn ("add_link_dir_dir: $to/$f exists; not making symlink.\n"); - next; - } - # - # try to make the link. - if (symlink ("$from/$f", "$to/$f") == 0) { - tlwarn ("add_link_dir_dir: symlink of $f from $from to $to failed: $!\n"); - $ret = 0; - } - } - return $ret; - } else { - tlwarn ("add_link_dir_dir: destination $to not writable, " - . "no links from $from.\n"); - return 0; - } -} - -sub remove_link_dir_dir { - my ($from, $to) = @_; - if ((-d "$to") && (-w "$to")) { - debug("TLUtils::remove_link_dir_dir: removing links from $from to $to\n"); - chomp (@files = `ls "$from"`); - my $ret = 1; - foreach my $f (@files) { - next if (! -r "$to/$f"); - if ($f eq "man") { - debug("TLUtils::remove_link_dir_dir: not considering man in $to, it should not be from us!\n"); - next; - } - if ((-l "$to/$f") && - (readlink("$to/$f") =~ m;^$from/;)) { - $ret = 0 unless unlink("$to/$f"); - } else { - $ret = 0; - tlwarn ("TLUtils::remove_link_dir_dir: not removing $to/$f, not a link or wrong destination!\n"); - } - } - # try to remove the destination directory, it might be empty and - # we might have write permissions, ignore errors - # `rmdir "$to" 2>/dev/null`; - return $ret; - } else { - tlwarn ("TLUtils::remove_link_dir_dir: destination $to not writable, no removal of links done!\n"); - return 0; - } -} - -sub add_remove_symlinks { - my ($mode, $Master, $arch, $sys_bin, $sys_man, $sys_info) = @_; - my $errors = 0; - my $plat_bindir = "$Master/bin/$arch"; - - # nothing to do with symlinks on Windows, of course. - return if win32(); - - my $info_dir = "$Master/texmf-dist/doc/info"; - if ($mode eq "add") { - $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin); # bin - if (-d $info_dir) { - $errors++ unless add_link_dir_dir($info_dir, $sys_info); - } - } elsif ($mode eq "remove") { - $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin); # bin - if (-d $info_dir) { - $errors++ unless remove_link_dir_dir($info_dir, $sys_info); - } - } else { - die ("should not happen, unknown mode $mode in add_remove_symlinks!"); - } - - # man - my $top_man_dir = "$Master/texmf-dist/doc/man"; - debug("TLUtils::add_remove_symlinks: $mode symlinks for man pages to $sys_man from $top_man_dir\n"); - if (! -d $top_man_dir) { - ; # better to be silent? - #info("skipping add of man symlinks, no source directory $top_man_dir\n"); - } else { - my $man_doable = 1; - if ($mode eq "add") { - my ($ret, $err) = mkdirhier $sys_man; - if (!$ret) { - $man_doable = 0; - tlwarn("$err\n"); - $errors++; - } - } - if ($man_doable) { - if (-w $sys_man) { - my $foo = `(cd "$top_man_dir" && echo *)`; - my @mans = split (' ', $foo); - chomp (@mans); - foreach my $m (@mans) { - my $mandir = "$top_man_dir/$m"; - next unless -d $mandir; - if ($mode eq "add") { - $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m"); - } else { - $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m"); - } - } - #`rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove"); - } else { - tlwarn("TLUtils::add_remove_symlinks: man symlink destination ($sys_man) not writable, " - . "cannot $mode symlinks.\n"); - $errors++; - } - } - } - - # we collected errors in $errors, so return the negation of it - if ($errors) { - info("TLUtils::add_remove_symlinks: $mode of symlinks had $errors error(s), see messages above.\n"); - return $F_ERROR; - } else { - return $F_OK; - } -} - -sub add_symlinks { return (add_remove_symlinks("add", @_)); } -sub remove_symlinks { return (add_remove_symlinks("remove", @_)); } - -=pod - -=item C<w32_add_to_path($bindir, $multiuser)> -=item C<w32_remove_from_path($bindir, $multiuser)> - -These two functions try to add/remove the binary directory $bindir -on Windows to the registry PATH variable. - -If running as admin user and $multiuser is set, the system path will -be adjusted, otherwise the user path. - -After calling these functions TeXLive::TLWinGoo::broadcast_env() should -be called to make the changes immediately visible. - -=cut - -sub w32_add_to_path { - my ($bindir, $multiuser) = @_; - return if (!win32()); - - my $path = TeXLive::TLWinGoo::get_system_env() -> {'/Path'}; - $path =~ s/[\s\x00]+$//; - &log("Old system path: $path\n"); - $path = TeXLive::TLWinGoo::get_user_env() -> {'/Path'}; - if ($path) { - $path =~ s/[\s\x00]+$//; - &log("Old user path: $path\n"); - } else { - &log("Old user path: none\n"); - } - my $mode = 'user'; - if (TeXLive::TLWinGoo::admin() && $multiuser) { - $mode = 'system'; - } - debug("TLUtils:w32_add_to_path: calling adjust_reg_path_for_texlive add $bindir $mode\n"); - TeXLive::TLWinGoo::adjust_reg_path_for_texlive('add', $bindir, $mode); - $path = TeXLive::TLWinGoo::get_system_env() -> {'/Path'}; - $path =~ s/[\s\x00]+$//; - &log("New system path: $path\n"); - $path = TeXLive::TLWinGoo::get_user_env() -> {'/Path'}; - if ($path) { - $path =~ s/[\s\x00]+$//; - &log("New user path: $path\n"); - } else { - &log("New user path: none\n"); - } -} - -sub w32_remove_from_path { - my ($bindir, $multiuser) = @_; - my $mode = 'user'; - if (TeXLive::TLWinGoo::admin() && $multiuser) { - $mode = 'system'; - } - debug("w32_remove_from_path: trying to remove $bindir in $mode\n"); - TeXLive::TLWinGoo::adjust_reg_path_for_texlive('remove', $bindir, $mode); -} - -=pod - -=item C<check_file_and_remove($what, $checksum, $checksize> - -Remove the file C<$what> if either the given C<$checksum> or -C<$checksize> for C<$what> does not agree with our recomputation using -C<TLCrypto::tlchecksum> and C<stat>, respectively. If a check argument -is not given, that check is not performed. If the checksums agree, the -size is not checked. The return status is random. - -This unusual behavior (removing the given file) is because this is used -for newly-downloaded files; see the calls in the C<unpack> routine -(which is the only caller). - -=cut - -sub check_file_and_remove { - my ($xzfile, $checksum, $checksize) = @_; - my $fn_name = (caller(0))[3]; - debug("$fn_name $xzfile, $checksum, $checksize\n"); - - if (!$checksum && !$checksize) { - tlwarn("$fn_name: neither checksum nor checksize " . - "available for $xzfile, cannot check integrity"); - return; - } - - # The idea is that if one of the tests fail, we want to save a copy of - # the input file for debugging. But we can't just omit removing the - # file, since the caller depends on the removal. So we copy it to a - # new temporary directory, which we want to persist, so can't use tl_tmpdir. - my $check_file_tmpdir = undef; - - # only run checksum tests if we can actually compute the checksum - if ($checksum && ($checksum ne "-1") && $::checksum_method) { - my $tlchecksum = TeXLive::TLCrypto::tlchecksum($xzfile); - if ($tlchecksum ne $checksum) { - tlwarn("$fn_name: checksums differ for $xzfile:\n"); - tlwarn("$fn_name: tlchecksum=$tlchecksum, arg=$checksum\n"); - tlwarn("$fn_name: backtrace:\n" . backtrace()); - # on Windows passing a pattern creates the tmpdir in PWD - # which means that it will be tried to be created on the DVD - # $check_file_tmpdir = File::Temp::tempdir("tlcheckfileXXXXXXXX"); - $check_file_tmpdir = File::Temp::tempdir(); - tlwarn("$fn_name: removing $xzfile, " - . "but saving copy in $check_file_tmpdir\n"); - copy($xzfile, $check_file_tmpdir); - unlink($xzfile); - return; - } else { - debug("$fn_name: checksums for $xzfile agree\n"); - # if we have checked the checksum, we don't need to check the size, too - return; - } - } - if ($checksize && ($checksize ne "-1")) { - my $filesize = (stat $xzfile)[7]; - if ($filesize != $checksize) { - tlwarn("$fn_name: removing $xzfile, sizes differ:\n"); - tlwarn("$fn_name: tlfilesize=$filesize, arg=$checksize\n"); - if (!defined($check_file_tmpdir)) { - # the tmpdir should always be undefined, since we shouldn't get - # here if the checksums failed, but test anyway. - $check_file_tmpdir = File::Temp::tempdir("tlcheckfileXXXXXXXX"); - tlwarn("$fn_name: saving copy in $check_file_tmpdir\n"); - copy($xzfile, $check_file_tmpdir); - } - unlink($xzfile); - return; - } - } - # We cannot remove the file here, otherwise restoring of backups - # or unwind packages might die. -} - -=pod - -=item C<unpack($what, $targetdir, @opts> - -If necessary, downloads C$what>, and then unpacks it into C<$targetdir>. -C<@opts> is assigned to a hash and can contain the following -keys: C<tmpdir> (use this directory for downloaded files), -C<checksum> (check downloaded file against this checksum), -C<size> (check downloaded file against this size), -C<remove> (remove temporary files after operation). - -Returns a pair of values: in case of error return 0 and an additional -explanation, in case of success return 1 and the name of the package. - -If C<checksum> or C<size> is C<-1>, no warnings about missing checksum/size -is printed. This is used during restore and unwinding of failed updates. - -=cut - -sub unpack { - my ($what, $target, %opts) = @_; - # remove by default - my $remove = (defined($opts{'remove'}) ? $opts{'remove'} : 1); - my $tempdir = (defined($opts{'tmpdir'}) ? $opts{'tmpdir'} : tl_tmpdir()); - my $checksum = (defined($opts{'checksum'}) ? $opts{'checksum'} : 0); - my $size = (defined($opts{'size'}) ? $opts{'size'} : 0); - - if (!defined($what)) { - return (0, "nothing to unpack"); - } - - my $decompressorType; - my $compressorextension; - if ($what =~ m/\.tar\.$CompressorExtRegexp$/) { - $compressorextension = $1; - $decompressorType = $1 eq "gz" ? "gzip" : $1; - } - if (!$decompressorType) { - return(0, "don't know how to unpack"); - } - # make sure that the found uncompressor type is also available - if (!member($decompressorType, @{$::progs{'working_compressors'}})) { - return(0, "unsupported container format $decompressorType"); - } - - # only check the necessary compressor program - my $decompressor = $::progs{$decompressorType}; - my @decompressorArgs = @{$Compressors{$decompressorType}{'decompress_args'}}; - - my $fn = basename($what); - my $pkg = $fn; - $pkg =~ s/\.tar\.$compressorextension$//; - my $remove_containerfile = $remove; - my $containerfile = "$tempdir/$fn"; - my $tarfile = "$tempdir/$fn"; - $tarfile =~ s/\.$compressorextension$//; - if ($what =~ m,^(https?|ftp)://, || $what =~ m!$SshURIRegex!) { - # we are installing from the NET - # check for the presence of $what in $tempdir - if (-r $containerfile) { - check_file_and_remove($containerfile, $checksum, $size); - } - # if the file is now not present, we can use it - if (! -r $containerfile) { - # try download the file and put it into temp - if (!download_file($what, $containerfile)) { - return(0, "downloading did not succeed (download_file failed)"); - } - # remove false downloads - check_file_and_remove($containerfile, $checksum, $size); - if ( ! -r $containerfile ) { - return(0, "downloading did not succeed (check_file_and_remove failed)"); - } - } - } else { - # we are installing from local compressed files - # copy it to temp with dereferencing of link target - TeXLive::TLUtils::copy("-L", $what, $tempdir); - - check_file_and_remove($containerfile, $checksum, $size); - if (! -r $containerfile) { - return (0, "consistency checks failed"); - } - # we can remove it afterwards - $remove_containerfile = 1; - } - if (!system_pipe($decompressor, $containerfile, $tarfile, - $remove_containerfile, @decompressorArgs) - || - ! -f $tarfile) { - unlink($tarfile, $containerfile); - return(0, "Decompressing $containerfile failed"); - } - if (untar($tarfile, $target, 1)) { - return (1, "$pkg"); - } else { - return (0, "untar failed"); - } -} - -=pod - -=item C<untar($tarfile, $targetdir, $remove_tarfile)> - -Unpacks C<$tarfile> in C<$targetdir> (changing directories to -C<$targetdir> and then back to the original directory). If -C<$remove_tarfile> is true, unlink C<$tarfile> after unpacking. - -Assumes the global C<$::progs{"tar"}> has been set up. - -=cut - -# return 1 if success, 0 if failure. -sub untar { - my ($tarfile, $targetdir, $remove_tarfile) = @_; - my $ret; - - my $tar = $::progs{'tar'}; # assume it's been set up - - # don't use the -C option to tar since Solaris tar et al. don't support it. - # don't use system("cd ... && $tar ...") since that opens us up to - # quoting issues. - # so fall back on chdir in Perl. - # - debug("unpacking $tarfile in $targetdir\n"); - my $cwd = cwd(); - chdir($targetdir) || die "chdir($targetdir) failed: $!"; - - # on w32 don't extract file modified time, because AV soft can open - # files in the mean time causing time stamp modification to fail - my $taropt = win32() ? "xmf" : "xf"; - if (system($tar, $taropt, $tarfile) != 0) { - tlwarn("TLUtils::untar: $tar $taropt $tarfile failed (in $targetdir)\n"); - $ret = 0; - } else { - $ret = 1; - } - unlink($tarfile) if $remove_tarfile; - - chdir($cwd) || die "chdir($cwd) failed: $!"; - return $ret; -} - - -=item C<tlcmp($file, $file)> - -Compare two files considering CR, LF, and CRLF as equivalent. -Returns 1 if different, 0 if the same. - -=cut - -sub tlcmp { - my ($filea, $fileb) = @_; - if (!defined($fileb)) { - die <<END_USAGE; -tlcmp needs two arguments FILE1 FILE2. -Compare as text files, ignoring line endings. -Exit status is zero if the same, 1 if different, something else if trouble. -END_USAGE - } - my $file1 = &read_file_ignore_cr ($filea); - my $file2 = &read_file_ignore_cr ($fileb); - - return $file1 eq $file2 ? 0 : 1; -} - - -=item C<read_file_ignore_cr($file)> - -Return contents of FILE as a string, converting all of CR, LF, and -CRLF to just LF. - -=cut - -sub read_file_ignore_cr { - my ($fname) = @_; - my $ret = ""; - - local *FILE; - open (FILE, $fname) || die "open($fname) failed: $!"; - while (<FILE>) { - s/\r\n?/\n/g; - #warn "line is |$_|"; - $ret .= $_; - } - close (FILE) || warn "close($fname) failed: $!"; - - return $ret; -} - - -=item C<setup_programs($bindir, $platform, $tlfirst)> - -Populate the global C<$::progs> hash containing the paths to the -programs C<lz4>, C<tar>, C<wget>, C<xz>. The C<$bindir> argument specifies -the path to the location of the C<xz> binaries, the C<$platform> -gives the TeX Live platform name, used as the extension on our -executables. If a program is not present in the TeX Live tree, we also -check along PATH (without the platform extension.) - -If the C<$tlfirst> argument or the C<TEXLIVE_PREFER_OWN> envvar is set, -prefer TL versions; else prefer system versions (except for Windows -C<tar.exe>, where we always use ours). - -Check many different downloads and compressors to determine what is -working. - -Return 0 if failure, nonzero if success. - -=cut - -sub setup_programs { - my ($bindir, $platform, $tlfirst) = @_; - my $ok = 1; - - # tlfirst is (currently) not passed in by either the installer or - # tlmgr, so it will be always false. - # If it is not defined, we check for the env variable - # TEXLIVE_PREFER_OWN - # - if (!defined($tlfirst)) { - if ($ENV{'TEXLIVE_PREFER_OWN'}) { - debug("setup_programs: TEXLIVE_PREFER_OWN is set!\n"); - $tlfirst = 1; - } - } - - debug("setup_programs: preferring " . ($tlfirst ? "TL" : "system") . " versions\n"); - - my $isWin = ($^O =~ /^MSWin/i); - - if ($isWin) { - # we need to make sure that we use our own tar, since - # Windows system tar is stupid bsdtar ... - setup_one("w32", 'tar', "$bindir/tar.exe", "--version", 1); - $platform = "exe"; - } else { - # tar needs to be provided by the system, we not even check! - $::progs{'tar'} = "tar"; - - if (!defined($platform) || ($platform eq "")) { - # we assume that we run from uncompressed media, so we can call - # platform() and thus also the config.guess script but we have to - # setup $::installerdir because the platform script relies on it - $::installerdir = "$bindir/../.."; - $platform = platform(); - } - } - - # setup of the fallback downloaders - my @working_downloaders; - for my $dltype (@AcceptedFallbackDownloaders) { - my $defprog = $FallbackDownloaderProgram{$dltype}; - # do not warn on errors - push @working_downloaders, $dltype if - setup_one(($isWin ? "w32" : "unix"), $defprog, - "$bindir/$dltype/$defprog.$platform", "--version", $tlfirst); - } - $::progs{'working_downloaders'} = [ @working_downloaders ]; - my @working_compressors; - for my $defprog (sort - { $Compressors{$a}{'priority'} <=> $Compressors{$b}{'priority'} } - keys %Compressors) { - # do not warn on errors - if (setup_one(($isWin ? "w32" : "unix"), $defprog, - "$bindir/$defprog/$defprog.$platform", "--version", - $tlfirst)) { - push @working_compressors, $defprog; - # also set up $::{'compressor'} if not already done - # this selects the first one, but we might reset this depending on - # TEXLIVE_COMPRESSOR setting, see below - defined($::progs{'compressor'}) || ($::progs{'compressor'} = $defprog); - } - } - $::progs{'working_compressors'} = [ @working_compressors ]; - - # check whether selected downloader/compressor is working - # for downloader we allow 'lwp' as setting, too - if ($ENV{'TEXLIVE_DOWNLOADER'} - && $ENV{'TEXLIVE_DOWNLOADER'} ne 'lwp' - && !TeXLive::TLUtils::member($ENV{'TEXLIVE_DOWNLOADER'}, - @{$::progs{'working_downloaders'}})) { - tlwarn(<<END_DOWNLOADER_BAD); -Selected download program TEXLIVE_DOWNLOADER=$ENV{'TEXLIVE_DOWNLOADER'} -is not working! -Please choose a different downloader or don't set TEXLIVE_DOWNLOADER. -Detected working downloaders: @{$::progs{'working_downloaders'}}. -END_DOWNLOADER_BAD - $ok = 0; - } - if ($ENV{'TEXLIVE_COMPRESSOR'} - && !TeXLive::TLUtils::member($ENV{'TEXLIVE_COMPRESSOR'}, - @{$::progs{'working_compressors'}})) { - tlwarn(<<END_COMPRESSOR_BAD); -Selected compression program TEXLIVE_COMPRESSOR=$ENV{'TEXLIVE_COMPRESSOR'} -is not working! -Please choose a different compressor or don't set TEXLIVE_COMPRESSOR. -Detected working compressors: @{$::progs{'working_compressors'}}. -END_COMPRESSOR_BAD - $ok = 0; - } - # setup default compressor $::progs{'compressor'} which is used in - # tlmgr in the calls to make_container. By default we have already - # chosen the first that is actually working from our list of - # @AcceptableCompressors, but let the user override this. - if ($ENV{'TEXLIVE_COMPRESSOR'}) { - $::progs{'compressor'} = $ENV{'TEXLIVE_COMPRESSOR'}; - } - - if ($::opt_verbosity >= 2) { - require Data::Dumper; - use vars qw($Data::Dumper::Indent $Data::Dumper::Sortkeys - $Data::Dumper::Purity); # -w pain - $Data::Dumper::Indent = 1; - $Data::Dumper::Sortkeys = 1; # stable output - $Data::Dumper::Purity = 1; # recursive structures must be safe - print STDERR "DD:dumping "; - print STDERR Data::Dumper->Dump([\%::progs], [qw(::progs)]); - } - return $ok; -} - -sub setup_one { - my ($what, $p, $def, $arg, $tlfirst) = @_; - my $setupfunc = ($what eq "unix") ? \&setup_unix_tl_one : \&setup_windows_tl_one ; - if ($tlfirst) { - if (&$setupfunc($p, $def, $arg)) { - return(1); - } else { - return(setup_system_one($p, $arg)); - } - } else { - if (setup_system_one($p, $arg)) { - return(1); - } else { - return(&$setupfunc($p, $def, $arg)); - } - } -} - -sub setup_system_one { - my ($p, $arg) = @_; - my $nulldev = nulldev(); - ddebug("trying to set up system $p, arg $arg\n"); - my $ret = system("$p $arg >$nulldev 2>&1"); - if ($ret == 0) { - debug("program $p found in path\n"); - $::progs{$p} = $p; - return(1); - } else { - debug("program $p not usable from path\n"); - return(0); - } -} - -sub setup_windows_tl_one { - my ($p, $def, $arg) = @_; - debug("(w32) trying to set up $p, default $def, arg $arg\n"); - - if (-r $def) { - my $prog = conv_to_w32_path($def); - my $ret = system("$prog $arg >nul 2>&1"); # on windows - if ($ret == 0) { - debug("Using shipped $def for $p (tested).\n"); - $::progs{$p} = $prog; - return(1); - } else { - tlwarn("Setting up $p with $def as $prog didn't work\n"); - system("$prog $arg"); - return(0); - } - } else { - debug("Default program $def not readable?\n"); - return(0); - } -} - - -# setup one prog on unix using the following logic: -# - if the shipped one is -x and can be executed, use it -# - if the shipped one is -x but cannot be executed, copy it. set -x -# . if the copy is -x and executable, use it -# - if the shipped one is not -x, copy it, set -x -# . if the copy is -x and executable, use it -sub setup_unix_tl_one { - my ($p, $def, $arg) = @_; - our $tmp; - debug("(unix) trying to set up $p, default $def, arg $arg\n"); - if (-r $def) { - if (-x $def) { - ddebug(" Default $def has executable permissions\n"); - # we have to check for actual "executability" since a "noexec" - # mount option may interfere, which is not taken into account by -x. - my $ret = system("'$def' $arg >/dev/null 2>&1" ); # we are on Unix - if ($ret == 0) { - $::progs{$p} = $def; - debug(" Using shipped $def for $p (tested).\n"); - return(1); - } else { - ddebug(" Shipped $def has -x but cannot be executed, " - . "trying tmp copy.\n"); - } - } - # we are still here - # out of some reasons we couldn't execute the shipped program - # try to copy it to a temp directory and make it executable - # - # create tmp dir only when necessary - $tmp = TeXLive::TLUtils::tl_tmpdir() unless defined($tmp); - # probably we are running from uncompressed media and want to copy it to - # some temporary location - copy($def, $tmp); - my $bn = basename($def); - my $tmpprog = "$tmp/$bn"; - chmod(0755,$tmpprog); - # we do not check the return value of chmod, but check whether - # the -x bit is now set, the only thing that counts - if (! -x $tmpprog) { - # hmm, something is going really bad, not even the copy is - # executable. Fall back to normal path element - ddebug(" Copied $p $tmpprog does not have -x bit, strange!\n"); - return(0); - } else { - # check again for executability - my $ret = system("$tmpprog $arg > /dev/null 2>&1"); - if ($ret == 0) { - # ok, the copy works - debug(" Using copied $tmpprog for $p (tested).\n"); - $::progs{$p} = $tmpprog; - return(1); - } else { - # even the copied prog is not executable, strange - ddebug(" Copied $p $tmpprog has x bit but not executable?!\n"); - return(0); - } - } - } else { - # default program is not readable - return(0); - } -} - - -=item C<download_file( $relpath, $destination )> - -Try to download the file given in C<$relpath> from C<$TeXLiveURL> -into C<$destination>, which can be either -a filename of simply C<|>. In the latter case a file handle is returned. - -Downloading first checks for the environment variable C<TEXLIVE_DOWNLOADER>, -which takes various built-in values. If not set, the next check is for -C<TL_DOWNLOAD_PROGRAM> and C<TL_DOWNLOAD_ARGS>. The former overrides the -above specification devolving to C<wget>, and the latter overrides the -default wget arguments. - -C<TL_DOWNLOAD_ARGS> must be defined so that the file the output goes to -is the first argument after the C<TL_DOWNLOAD_ARGS>. Thus, for wget it -would end in C<-O>. Use with care. - -=cut - -sub download_file { - my ($relpath, $dest) = @_; - # create output dir if necessary - my $par; - if ($dest ne "|") { - $par = dirname($dest); - mkdirhier ($par) unless -d "$par"; - } - my $url; - if ($relpath =~ m;^file://*(.*)$;) { - my $filetoopen = "/$1"; - # $dest is a file name, we have to get the respective dirname - if ($dest eq "|") { - open(RETFH, "<$filetoopen") or - die("Cannot open $filetoopen for reading"); - # opening to a pipe always succeeds, so we return immediately - return \*RETFH; - } else { - if (-r $filetoopen) { - copy ($filetoopen, $par); - return 1; - } - return 0; - } - } - - if ($relpath =~ m!$SshURIRegex!) { - my $downdest; - if ($dest eq "|") { - my ($fh, $fn) = TeXLive::TLUtils::tl_tmpfile(); - $downdest = $fn; - } else { - $downdest = $dest; - } - # massage ssh:// into the scp-acceptable scp:// - $relpath =~ s!^ssh://!scp://!; - my $retval = system("scp", "-q", $relpath, $downdest); - if ($retval != 0) { - $retval /= 256 if $retval > 0; - my $pwd = cwd (); - tlwarn("$0: system(scp -q $relpath $downdest) failed in $pwd, status $retval"); - return 0; - } - if ($dest eq "|") { - open(RETFH, "<$downdest") or - die("Cannot open $downdest for reading"); - # opening to a pipe always succeeds, so we return immediately - return \*RETFH; - } else { - return 1; - } - } - - if ($relpath =~ /^(https?|ftp):\/\//) { - $url = $relpath; - } else { - $url = "$TeXLiveURL/$relpath"; - } - - my @downloader_trials; - if ($ENV{'TEXLIVE_DOWNLOADER'}) { - push @downloader_trials, $ENV{'TEXLIVE_DOWNLOADER'}; - } elsif ($ENV{"TL_DOWNLOAD_PROGRAM"}) { - push @downloader_trials, 'custom'; - } else { - @downloader_trials = qw/lwp curl wget/; - } - - my $success = 0; - for my $downtype (@downloader_trials) { - if ($downtype eq 'lwp') { - if (_download_file_lwp($url, $dest)) { - $success = $downtype; - last; - } - } - if ($downtype eq "custom" || TeXLive::TLUtils::member($downtype, @{$::progs{'working_downloaders'}})) { - if (_download_file_program($url, $dest, $downtype)) { - $success = $downtype; - last; - } - } - } - if ($success) { - debug("TLUtils::download_file: downloading using $success succeeded\n"); - return(1); - } else { - debug("TLUtils::download_file: tried to download using @downloader_trials, none succeeded\n"); - return(0); - } -} - - -sub _download_file_lwp { - my ($url, $dest) = @_; - if (!defined($::tldownload_server)) { - ddebug("::tldownload_server not defined\n"); - return(0); - } - if (!$::tldownload_server->enabled) { - # try to reinitialize a disabled connection - # disabling happens after 6 failed download trials - # we just re-initialize the connection - if (!setup_persistent_downloads()) { - # setup failed, give up - debug("reinitialization of LWP download failed\n"); - return(0); - } - # we don't need to check for ->enabled, because - # setup_persistent_downloads calls TLDownload->new() - # which, if it succeeds, automatically set enabled to 1 - } - # we are still here, so try to download - debug("persistent connection set up, trying to get $url (for $dest)\n"); - my $ret = $::tldownload_server->get_file($url, $dest); - if ($ret) { - ddebug("downloading file via persistent connection succeeded\n"); - return $ret; - } else { - debug("TLUtils::download_file: persistent connection ok," - . " but download failed: $url\n"); - debug("TLUtils::download_file: retrying with other downloaders.\n"); - } - # if we are still here, download with LWP didn't succeed. - return(0); -} - - -sub _download_file_program { - my ($url, $dest, $type) = @_; - if (win32()) { - $dest =~ s!/!\\!g; - } - - debug("TLUtils::_download_file_program: $type $url $dest\n"); - my $downloader; - my $downloaderargs; - my @downloaderargs; - if ($type eq 'custom') { - $downloader = $ENV{"TL_DOWNLOAD_PROGRAM"}; - if ($ENV{"TL_DOWNLOAD_ARGS"}) { - $downloaderargs = $ENV{"TL_DOWNLOAD_ARGS"}; - @downloaderargs = split(' ', $downloaderargs); - } - } else { - $downloader = $::progs{$FallbackDownloaderProgram{$type}}; - @downloaderargs = @{$FallbackDownloaderArgs{$type}}; - $downloaderargs = join(' ',@downloaderargs); - } - - debug("downloading $url using $downloader $downloaderargs\n"); - my $ret; - if ($dest eq "|") { - open(RETFH, "$downloader $downloaderargs - $url|") - || die "open($url) via $downloader $downloaderargs failed: $!"; - # opening to a pipe always succeeds, so we return immediately - return \*RETFH; - } else { - $ret = system ($downloader, @downloaderargs, $dest, $url); - # we have to reverse the meaning of ret because system has 0=success. - $ret = ($ret ? 0 : 1); - } - # return false/undef in case the download did not succeed. - return ($ret) unless $ret; - debug("download of $url succeeded\n"); - if ($dest eq "|") { - return \*RETFH; - } else { - return 1; - } -} - -=item C<nulldev ()> - -Return C</dev/null> on Unix and C<nul> on Windows. - -=cut - -sub nulldev { - return (&win32)? 'nul' : '/dev/null'; -} - -=item C<get_full_line ($fh)> - -returns the next line from the file handle $fh, taking -continuation lines into account (last character of a line is \, and -no quoting is parsed). - -=cut - -# open my $f, '<', $file_name or die; -# while (my $l = get_full_line($f)) { ... } -# close $f or die; -sub get_full_line { - my ($fh) = @_; - my $line = <$fh>; - return undef unless defined $line; - return $line unless $line =~ s/\\\r?\n$//; - my $cont = get_full_line($fh); - if (!defined($cont)) { - tlwarn('Continuation disallowed at end of file'); - $cont = ""; - } - $cont =~ s/^\s*//; - return $line . $cont; -} - - -=back - -=head2 Installer Functions - -=over 4 - -=item C<make_var_skeleton($prefix)> - -Generate a skeleton of empty directories in the C<TEXMFSYSVAR> tree. - -=cut - -sub make_var_skeleton { - my ($prefix) = @_; - - mkdirhier "$prefix/tex/generic/config"; - mkdirhier "$prefix/fonts/map/dvipdfmx/updmap"; - mkdirhier "$prefix/fonts/map/dvips/updmap"; - mkdirhier "$prefix/fonts/map/pdftex/updmap"; - mkdirhier "$prefix/fonts/pk"; - mkdirhier "$prefix/fonts/tfm"; - mkdirhier "$prefix/web2c"; - mkdirhier "$prefix/xdvi"; - mkdirhier "$prefix/tex/context/config"; -} - - -=item C<make_local_skeleton($prefix)> - -Generate a skeleton of empty directories in the C<TEXMFLOCAL> tree, -unless C<TEXMFLOCAL> already exists. - -=cut - -sub make_local_skeleton { - my ($prefix) = @_; - - return if (-d $prefix); - - mkdirhier "$prefix/bibtex/bib/local"; - mkdirhier "$prefix/bibtex/bst/local"; - mkdirhier "$prefix/doc/local"; - mkdirhier "$prefix/dvips/local"; - mkdirhier "$prefix/fonts/source/local"; - mkdirhier "$prefix/fonts/tfm/local"; - mkdirhier "$prefix/fonts/type1/local"; - mkdirhier "$prefix/fonts/vf/local"; - mkdirhier "$prefix/metapost/local"; - mkdirhier "$prefix/tex/latex/local"; - mkdirhier "$prefix/tex/plain/local"; - mkdirhier "$prefix/tlpkg"; - mkdirhier "$prefix/web2c"; -} - - -=item C<create_fmtutil($tlpdb, $dest)> - -=item C<create_updmap($tlpdb, $dest)> - -=item C<create_language_dat($tlpdb, $dest, $localconf)> - -=item C<create_language_def($tlpdb, $dest, $localconf)> - -=item C<create_language_lua($tlpdb, $dest, $localconf)> - -These five functions create C<fmtutil.cnf>, C<updmap.cfg>, C<language.dat>, -C<language.def>, and C<language.dat.lua> respectively, in C<$dest> (which by -default is below C<$TEXMFSYSVAR>). These functions merge the information -present in the TLPDB C<$tlpdb> (formats, maps, hyphenations) with local -configuration additions: C<$localconf>. - -Currently the merging is done by omitting disabled entries specified -in the local file, and then appending the content of the local -configuration files at the end of the file. We should also check for -duplicates, maybe even error checking. - -=cut - -# -# get_disabled_local_configs -# returns the list of disabled formats/hyphenpatterns/maps -# disabling is done by putting -# #!NAME -# or -# %!NAME -# into the respective foo-local.cnf/cfg file -# -sub get_disabled_local_configs { - my $localconf = shift; - my $cc = shift; - my @disabled = (); - if ($localconf && -r $localconf) { - open (FOO, "<$localconf") - || die "strange, -r ok but open($localconf) failed: $!"; - my @tmp = <FOO>; - close(FOO) || warn("close($localconf) failed: $!"); - @disabled = map { if (m/^$cc!(\S+)\s*$/) { $1 } else { } } @tmp; - } - return @disabled; -} - -sub create_fmtutil { - my ($tlpdb,$dest) = @_; - my @lines = $tlpdb->fmtutil_cnf_lines(); - _create_config_files($tlpdb, "texmf-dist/web2c/fmtutil-hdr.cnf", $dest, - undef, 0, '#', \@lines); -} - -sub create_updmap { - my ($tlpdb,$dest) = @_; - check_for_old_updmap_cfg(); - my @tlpdblines = $tlpdb->updmap_cfg_lines(); - _create_config_files($tlpdb, "texmf-dist/web2c/updmap-hdr.cfg", $dest, - undef, 0, '#', \@tlpdblines); -} - -sub check_for_old_updmap_cfg { - chomp( my $tmfsysconf = `kpsewhich -var-value=TEXMFSYSCONFIG` ) ; - my $oldupd = "$tmfsysconf/web2c/updmap.cfg"; - return unless -r $oldupd; # if no such file, good. - - open (OLDUPD, "<$oldupd") || die "open($oldupd) failed: $!"; - my $firstline = <OLDUPD>; - close(OLDUPD); - # cygwin returns undef when reading from an empty file, we have - # to make sure that this is anyway initialized - $firstline = "" if (!defined($firstline)); - chomp ($firstline); - # - if ($firstline =~ m/^# Generated by (install-tl|.*\/tlmgr) on/) { - # assume it was our doing, rename it. - my $nn = "$oldupd.DISABLED"; - if (-r $nn) { - my $fh; - ($fh, $nn) = tl_tmpfile( - "updmap.cfg.DISABLED.XXXXXX", DIR => "$tmfsysconf/web2c"); - } - print "Renaming old config file from - $oldupd -to - $nn -"; - if (rename($oldupd, $nn)) { - if (system("mktexlsr", $tmfsysconf) != 0) { - die "mktexlsr $tmfsysconf failed after updmap.cfg rename, fix fix: $!"; - } - print "No further action should be necessary.\n"; - } else { - print STDERR " -Renaming of - $oldupd -did not succeed. This config file should not be used anymore, -so please do what's necessary to eliminate it. -See the documentation for updmap. -"; - } - - } else { # first line did not match - # that is NOT a good idea, because updmap creates updmap.cfg in - # TEXMFSYSCONFIG when called with --enable Map etc, so we should - # NOT warn here - # print STDERR "Apparently -# $oldupd -# was created by hand. This config file should not be used anymore, -# so please do what's necessary to eliminate it. -# See the documentation for updmap. -# "; - } -} - -sub check_updmap_config_value { - my ($k, $v, $f) = @_; - return 0 if !defined($k); - return 0 if !defined($v); - if (member( $k, qw/dvipsPreferOutline dvipsDownloadBase35 - pdftexDownloadBase14 dvipdfmDownloadBase14/)) { - if ($v eq "true" || $v eq "false") { - return 1; - } else { - tlwarn("Unknown setting for $k in $f: $v\n"); - return 0; - } - } elsif ($k eq "LW35") { - if (member($v, qw/URW URWkb ADOBE ADOBEkb/)) { - return 1; - } else { - tlwarn("Unknown setting for LW35 in $f: $v\n"); - return 0; - } - } elsif ($k eq "kanjiEmbed") { - # any string is fine - return 1; - } else { - return 0; - } -} - -sub create_language_dat { - my ($tlpdb,$dest,$localconf) = @_; - # no checking for disabled stuff for language.dat and .def - my @lines = $tlpdb->language_dat_lines( - get_disabled_local_configs($localconf, '%')); - _create_config_files($tlpdb, "texmf-dist/tex/generic/config/language.us", - $dest, $localconf, 0, '%', \@lines); -} - -sub create_language_def { - my ($tlpdb,$dest,$localconf) = @_; - # no checking for disabled stuff for language.dat and .def - my @lines = $tlpdb->language_def_lines( - get_disabled_local_configs($localconf, '%')); - my @postlines; - push @postlines, "%%% No changes may be made beyond this point.\n"; - push @postlines, "\n"; - push @postlines, "\\uselanguage {USenglish} %%% This MUST be the last line of the file.\n"; - _create_config_files ($tlpdb,"texmf-dist/tex/generic/config/language.us.def", - $dest, $localconf, 1, '%', \@lines, @postlines); -} - -sub create_language_lua { - my ($tlpdb,$dest,$localconf) = @_; - # no checking for disabled stuff for language.dat and .lua - my @lines = $tlpdb->language_lua_lines( - get_disabled_local_configs($localconf, '--')); - my @postlines = ("}\n"); - _create_config_files ($tlpdb,"texmf-dist/tex/generic/config/language.us.lua", - $dest, $localconf, 0, '--', \@lines, @postlines); -} - -sub _create_config_files { - my ($tlpdb, $headfile, $dest,$localconf, $keepfirstline, $cc, - $tlpdblinesref, @postlines) = @_; - my $root = $tlpdb->root; - my @lines = (); - my $usermode = $tlpdb->setting( "usertree" ); - if (-r "$root/$headfile") { - open (INFILE, "<$root/$headfile") - || die "open($root/$headfile) failed, but -r ok: $!"; - @lines = <INFILE>; - close (INFILE); - } elsif (!$usermode) { - # we might be in user mode and then do *not* want the generation - # of the configuration file to just bail out. - tldie ("TLUtils::_create_config_files: giving up, unreadable: " - . "$root/$headfile\n") - } - push @lines, @$tlpdblinesref; - if (defined($localconf) && -r $localconf) { - # - # this should be done more intelligently, but for now only add those - # lines without any duplication check ... - open (FOO, "<$localconf") - || die "strange, -r ok but cannot open $localconf: $!"; - my @tmp = <FOO>; - close (FOO); - push @lines, @tmp; - } - if (@postlines) { - push @lines, @postlines; - } - if ($usermode && -e $dest) { - tlwarn("Updating $dest, backup copy in $dest.backup\n"); - copy("-f", $dest, "$dest.backup"); - } - open(OUTFILE,">$dest") - or die("Cannot open $dest for writing: $!"); - - if (!$keepfirstline) { - print OUTFILE $cc; - printf OUTFILE " Generated by %s on %s\n", "$0", scalar localtime; - } - print OUTFILE @lines; - close(OUTFILE) || warn "close(>$dest) failed: $!"; -} - -sub parse_AddHyphen_line { - my $line = shift; - my %ret; - # default values - my $default_lefthyphenmin = 2; - my $default_righthyphenmin = 3; - $ret{"lefthyphenmin"} = $default_lefthyphenmin; - $ret{"righthyphenmin"} = $default_righthyphenmin; - $ret{"synonyms"} = []; - for my $p (quotewords('\s+', 0, "$line")) { - my ($a, $b) = split /=/, $p; - if ($a eq "name") { - if (!$b) { - $ret{"error"} = "AddHyphen line needs name=something"; - return %ret; - } - $ret{"name"} = $b; - next; - } - if ($a eq "lefthyphenmin") { - $ret{"lefthyphenmin"} = ( $b ? $b : $default_lefthyphenmin ); - next; - } - if ($a eq "righthyphenmin") { - $ret{"righthyphenmin"} = ( $b ? $b : $default_righthyphenmin ); - next; - } - if ($a eq "file") { - if (!$b) { - $ret{"error"} = "AddHyphen line needs file=something"; - return %ret; - } - $ret{"file"} = $b; - next; - } - if ($a eq "file_patterns") { - $ret{"file_patterns"} = $b; - next; - } - if ($a eq "file_exceptions") { - $ret{"file_exceptions"} = $b; - next; - } - if ($a eq "luaspecial") { - $ret{"luaspecial"} = $b; - next; - } - if ($a eq "databases") { - @{$ret{"databases"}} = split /,/, $b; - next; - } - if ($a eq "synonyms") { - @{$ret{"synonyms"}} = split /,/, $b; - next; - } - if ($a eq "comment") { - $ret{"comment"} = $b; - next; - } - # should not be reached at all - $ret{"error"} = "Unknown language directive $a"; - return %ret; - } - # this default value couldn't be set earlier - if (not defined($ret{"databases"})) { - if (defined $ret{"file_patterns"} or defined $ret{"file_exceptions"} - or defined $ret{"luaspecial"}) { - @{$ret{"databases"}} = qw(dat def lua); - } else { - @{$ret{"databases"}} = qw(dat def); - } - } - return %ret; -} - -# -# return hash of items on AddFormat line LINE (which must not have the -# leading "execute AddFormat"). If parse fails, hash will contain a key -# "error" with a message. -# -sub parse_AddFormat_line { - my $line = shift; - my %ret; - $ret{"options"} = ""; - $ret{"patterns"} = "-"; - $ret{"mode"} = 1; - for my $p (quotewords('\s+', 0, "$line")) { - my ($a, $b); - if ($p =~ m/^(name|engine|mode|patterns|options|fmttriggers)=(.*)$/) { - $a = $1; - $b = $2; - } else { - $ret{"error"} = "Unknown format directive $p"; - return %ret; - } - if ($a eq "name") { - if (!$b) { - $ret{"error"} = "AddFormat line needs name=something"; - return %ret; - } - $ret{"name"} = $b; - next; - } - if ($a eq "engine") { - if (!$b) { - $ret{"error"} = "AddFormat line needs engine=something"; - return %ret; - } - $ret{"engine"} = $b; - next; - } - if ($a eq "patterns") { - $ret{"patterns"} = ( $b ? $b : "-" ); - next; - } - if ($a eq "mode") { - $ret{"mode"} = ( $b eq "disabled" ? 0 : 1 ); - next; - } - if ($a eq "options") { - $ret{"options"} = ( $b ? $b : "" ); - next; - } - if ($a eq "fmttriggers") { - my @tl = split(',',$b); - $ret{"fmttriggers"} = \@tl ; - next; - } - # should not be reached at all - $ret{"error"} = "Unknown format directive $p"; - return %ret; - } - return %ret; -} - -=back - -=head2 Logging - -Logging and debugging messages. - -=over 4 - -=item C<logit($out,$level,@rest)> - -Internal routine to write message to both C<$out> (references to -filehandle) and C<$::LOGFILE>, at level C<$level>, of concatenated items -in C<@rest>. If the log file is not initialized yet, the message is -saved to be logged later (unless the log file never comes into existence). - -=cut - -sub logit { - my ($out, $level, @rest) = @_; - _logit($out, $level, @rest) unless $::opt_quiet; - _logit('file', $level, @rest); -} - -sub _logit { - my ($out, $level, @rest) = @_; - if ($::opt_verbosity >= $level) { - # if $out is a ref/glob to STDOUT or STDERR, print it there - if (ref($out) eq "GLOB") { - print $out @rest; - } else { - # we should log it into the logfile, but that might be not initialized - # so either print it to the filehandle $::LOGFILE, or push it onto - # the to be printed log lines @::LOGLINES - if (defined($::LOGFILE)) { - print $::LOGFILE @rest; - } else { - push (@::LOGLINES, join ("", @rest)); - } - } - } -} - -=item C<info ($str1, $str2, ...)> - -Write a normal informational message, the concatenation of the argument -strings. The message will be written unless C<-q> was specified. If -the global C<$::machinereadable> is set (the C<--machine-readable> -option to C<tlmgr>), then output is written to stderr, else to stdout. -If the log file (see L<process_logging_options>) is defined, it also -writes there. - -It is best to use this sparingly, mainly to give feedback during lengthy -operations and for final results. - -=cut - -sub info { - my $str = join("", @_); - my $fh = ($::machinereadable ? \*STDERR : \*STDOUT); - logit($fh, 0, $str); - for my $i (@::info_hook) { - &{$i}($str); - } -} - -=item C<debug ($str1, $str2, ...)> - -Write a debugging message, the concatenation of the argument strings. -The message will be omitted unless C<-v> was specified. If the log -file (see L<process_logging_options>) is defined, it also writes there. - -This first level debugging message reports on the overall flow of -work, but does not include repeated messages about processing of each -package. - -=cut - -sub debug { - my $str = "D:" . join("", @_); - return if ($::opt_verbosity < 1); - logit(\*STDERR, 1, $str); - for my $i (@::debug_hook) { - &{$i}($str); - } -} - -=item C<ddebug ($str1, $str2, ...)> - -Write a deep debugging message, the concatenation of the argument -strings. The message will be omitted unless C<-v -v> (or higher) was -specified. If the log file (see L<process_logging_options>) is defined, -it also writes there. - -This second level debugging message reports messages about processing -each package, in addition to the first level. - -=cut - -sub ddebug { - my $str = "DD:" . join("", @_); - return if ($::opt_verbosity < 2); - logit(\*STDERR, 2, $str); - for my $i (@::ddebug_hook) { - &{$i}($str); - } -} - -=item C<dddebug ($str1, $str2, ...)> - -Write the deepest debugging message, the concatenation of the argument -strings. The message will be omitted unless C<-v -v -v> was specified. -If the log file (see L<process_logging_options>) is defined, it also -writes there. - -In addition to the first and second levels, this third level debugging -message reports messages about processing each line of any tlpdb files -read, and messages about files tested or matched against tlpsrc -patterns. This output is extremely voluminous, so unless you're -debugging those parts of the code, it just gets in the way. - -=cut - -sub dddebug { - my $str = "DDD:" . join("", @_); - return if ($::opt_verbosity < 3); - logit(\*STDERR, 3, $str); - for my $i (@::dddebug_hook) { - &{$i}($str); - } -} - -=item C<log ($str1, $str2, ...)> - -Write a message to the log file (and nowhere else), the concatenation of -the argument strings. The log file may not ever be defined (e.g., the -C<-logfile> option isn't given), in which case the message will never be -written anywhere. - -=cut - -sub log { - my $savequiet = $::opt_quiet; - $::opt_quiet = 0; - _logit('file', -100, @_); - $::opt_quiet = $savequiet; -} - -=item C<tlwarn ($str1, $str2, ...)> - -Write a warning message, the concatenation of the argument strings. -This always and unconditionally writes the message to standard error; if -the log file (see L<process_logging_options>) is defined, it also writes -there. - -=cut - -sub tlwarn { - my $savequiet = $::opt_quiet; - my $str = join("", @_); - $::opt_quiet = 0; - logit (\*STDERR, -100, $str); - $::opt_quiet = $savequiet; - for my $i (@::warn_hook) { - &{$i}($str); - } -} - -=item C<tldie ($str1, $str2, ...)> - -Uses C<tlwarn> to issue a warning for @_ preceded by a newline, then -exits with exit code 1. - -=cut - -sub tldie { - tlwarn("\n", @_); - if ($::gui_mode) { - Tk::exit(1); - } else { - exit(1); - } -} - -=item C<debug_hash_str($label, HASH)> - -Return LABEL followed by HASH elements, followed by a newline, as a -single string. If HASH is a reference, it is followed (but no recursive -derefencing). - -=item C<debug_hash($label, HASH)> - -Write the result of C<debug_hash_str> to stderr. - -=cut - -sub debug_hash_str { - my ($label) = shift; - my (%hash) = (ref $_[0] && $_[0] =~ /.*HASH.*/) ? %{$_[0]} : @_; - - my $str = "$label: {"; - my @items = (); - for my $key (sort keys %hash) { - my $val = $hash{$key}; - $val = ".undef" if ! defined $val; - $key =~ s/\n/\\n/g; - $val =~ s/\n/\\n/g; - push (@items, "$key:$val"); - } - $str .= join (",", @items); - $str .= "}"; - - return "$str\n"; -} - -sub debug_hash { - warn &debug_hash_str(@_); -} - -=item C<backtrace()> - -Return call(er) stack, as a string. - -=cut - -sub backtrace { - my $ret = ""; - - my ($line, $subr); - my $stackframe = 1; # skip ourselves - while ((undef,$filename,$line,$subr) = caller ($stackframe)) { - # the undef is for the package, which is already included in $subr. - $ret .= " -> ${filename}:${line}: ${subr}\n"; - $stackframe++; - } - - return $ret; -} - -=item C<process_logging_options ($texdir)> - -This function handles the common logging options for TeX Live scripts. -It should be called before C<GetOptions> for any program-specific option -handling. For our conventional calling sequence, see (for example) the -L<tlpfiles> script. - -These are the options handled here: - -=over 4 - -=item B<-q> - -Omit normal informational messages. - -=item B<-v> - -Include debugging messages. With one C<-v>, reports overall flow; with -C<-v -v> (or C<-vv>), also reports per-package processing; with C<-v -v --v> (or C<-vvv>), also reports each line read from any tlpdb files. -Further repeats of C<-v>, as in C<-v -v -v -v>, are accepted but -ignored. C<-vvvv> is an error. - -The idea behind these levels is to be able to specify C<-v> to get an -overall idea of what is going on, but avoid terribly voluminous output -when processing many packages, as we often are. When debugging a -specific problem with a specific package, C<-vv> can help. When -debugging problems with parsing tlpdb files, C<-vvv> gives that too. - -=item B<-logfile> I<file> - -Write all messages (informational, debugging, warnings) to I<file>, in -addition to standard output or standard error. In TeX Live, only the -installer sets a log file by default; none of the other standard TeX -Live scripts use this feature, but you can specify it explicitly. - -=back - -See also the L<info>, L<debug>, L<ddebug>, and L<tlwarn> functions, -which actually write the messages. - -=cut - -sub process_logging_options { - $::opt_verbosity = 0; - $::opt_quiet = 0; - my $opt_logfile; - my $opt_Verbosity = 0; - my $opt_VERBOSITY = 0; - # check all the command line options for occurrences of -q and -v; - # do not report errors. - my $oldconfig = Getopt::Long::Configure(qw(pass_through permute)); - GetOptions("logfile=s" => \$opt_logfile, - "v+" => \$::opt_verbosity, - "vv" => \$opt_Verbosity, - "vvv" => \$opt_VERBOSITY, - "q" => \$::opt_quiet); - Getopt::Long::Configure($oldconfig); - - # verbosity level, forcing -v -v instead of -vv is too annoying. - $::opt_verbosity = 2 if $opt_Verbosity; - $::opt_verbosity = 3 if $opt_VERBOSITY; - - # open log file if one was requested. - if ($opt_logfile) { - open(TLUTILS_LOGFILE, ">$opt_logfile") - || die "open(>$opt_logfile) failed: $!\n"; - $::LOGFILE = \*TLUTILS_LOGFILE; - $::LOGFILENAME = $opt_logfile; - } -} - -=back - -=head2 Miscellaneous - -A few ideas from Fabrice Popineau's C<FileUtils.pm>. - -=over 4 - -=item C<sort_uniq(@list)> - -The C<sort_uniq> function sorts the given array and throws away multiple -occurrences of elements. It returns a sorted and unified array. - -=cut - -sub sort_uniq { - my (@l) = @_; - my ($e, $f, @r); - $f = ""; - @l = sort(@l); - foreach $e (@l) { - if ($e ne $f) { - $f = $e; - push @r, $e; - } - } - return @r; -} - - -=item C<push_uniq(\@list, @new_items)> - -The C<push_uniq> function pushes each element in the last argument -@ITEMS to the $LIST referenced by the first argument, if it is not -already in the list. - -=cut - -sub push_uniq { - my ($l, @new_items) = @_; - for my $e (@new_items) { - # turns out this is one of the most-used functions when updating the - # tlpdb, with hundreds of thousands of calls. So let's write it out - # to eliminate the sub overhead. - #if (! &member($e, @$l)) { - if (! scalar grep($_ eq $e, @$l)) { - push (@$l, $e); - } - } -} - -=item C<member($item, @list)> - -The C<member> function returns true if the first argument -is also inclued in the list of the remaining arguments. - -=cut - -sub member { - my $what = shift; - return scalar grep($_ eq $what, @_); -} - -=item C<merge_into(\%to, \%from)> - -Merges the keys of %from into %to. - -=cut - -sub merge_into { - my ($to, $from) = @_; - foreach my $k (keys %$from) { - if (defined($to->{$k})) { - push @{$to->{$k}}, @{$from->{$k}}; - } else { - $to->{$k} = [ @{$from->{$k}} ]; - } - } -} - -=item C<texdir_check($texdir)> - -Test whether installation with TEXDIR set to $texdir should be ok, e.g., -would be a creatable directory. Return 1 if ok, 0 if not. - -Writable or not, we will not allow installation to the root -directory (Unix) or the root of a drive (Windows). - -We also do not allow paths containing various special characters, and -print a message about this if second argument WARN is true. (We only -want to do this for the regular text installer, since spewing output in -a GUI program wouldn't be good; the generic message will have to do for -them.) - -=cut - -sub texdir_check { - my ($orig_texdir,$warn) = @_; - return 0 unless defined $orig_texdir; - - # convert to absolute, for safer parsing. - # also replaces backslashes with slashes on w32. - # The return value may still contain symlinks, - # but no unnecessary terminating '/'. - my $texdir = tl_abs_path($orig_texdir); - return 0 unless defined $texdir; - - # reject the root of a drive, - # assuming that only the canonical form of the root ends with / - return 0 if $texdir =~ m!/$!; - - # Unfortunately we have lots of special characters. - # On Windows, backslashes are normal but will already have been changed - # to slashes by tl_abs_path. And we should only check for : on Unix. - my $colon = win32() ? "" : ":"; - if ($texdir =~ /[,$colon;\\{}\$]/) { - if ($warn) { - print " !! TEXDIR value has problematic characters: $orig_texdir\n"; - print " !! (such as comma, colon, semicolon, backslash, braces\n"; - print " !! and dollar sign; sorry)\n"; - } - # although we could check each character individually and give a - # specific error, it seems plausibly useful to report all the chars - # that cause problems, regardless of which was there. Simpler too. - return 0; - } - # w32: for now, reject the root of a samba share - return 0 if win32() && $texdir =~ m!^//[^/]+/[^/]+$!; - - # if texdir already exists, make sure we can write into it. - return dir_writable($texdir) if (-d $texdir); - - # if texdir doesn't exist, make sure we can write the parent. - (my $texdirparent = $texdir) =~ s!/[^/]*$!!; - #print STDERR "Checking $texdirparent".'[/]'."\n"; - return dir_creatable($texdirparent) if -d dir_slash($texdirparent); - - # ditto for the next level up the tree - (my $texdirpparent = $texdirparent) =~ s!/[^/]*$!!; - #print STDERR "Checking $texdirpparent".'[/]'."\n"; - return dir_creatable($texdirpparent) if -d dir_slash($texdirpparent); - - # doesn't look plausible. - return 0; -} - -=pod - -This function takes a single argument I<path> and returns it with -C<"> chars surrounding it on Unix. On Windows, the C<"> chars are only -added if I<path> contains special characters, since unconditional quoting -leads to errors there. In all cases, any C<"> chars in I<path> itself -are (erroneously) eradicated. - -=cut - -sub quotify_path_with_spaces { - my $p = shift; - my $m = win32() ? '[+=^&();,!%\s]' : '.'; - if ( $p =~ m/$m/ ) { - $p =~ s/"//g; # remove any existing double quotes - $p = "\"$p\""; - } - return($p); -} - -=pod - -This function returns a "Windows-ized" version of its single argument -I<path>, i.e., replaces all forward slashes with backslashes, and adds -an additional C<"> at the beginning and end if I<path> contains any -spaces. It also makes the path absolute. So if $path does not start -with one (arbitrary) characer followed by C<:>, we add the output of -C<`cd`>. - -The result is suitable for running in shell commands, but not file tests -or other manipulations, since in such internal Perl contexts, the quotes -would be considered part of the filename. - -=cut - -sub conv_to_w32_path { - my $p = shift; - # we need absolute paths, too - my $pabs = tl_abs_path($p); - if (not $pabs) { - $pabs = $p; - tlwarn ("sorry, could not determine absolute path of $p!\n". - "using original path instead"); - } - $pabs =~ s!/!\\!g; - $pabs = quotify_path_with_spaces($pabs); - return($pabs); -} - -=pod - -The next two functions are meant for user input/output in installer menus. -They help making the windows user happy by turning slashes into backslashes -before displaying a path, and our code happy by turning backslashes into forwars -slashes after reading a path. They both are no-ops on Unix. - -=cut - -sub native_slashify { - my ($r) = @_; - $r =~ s!/!\\!g if win32(); - return $r; -} - -sub forward_slashify { - my ($r) = @_; - $r =~ s!\\!/!g if win32(); - return $r; -} - -=item C<setup_persistent_downloads()> - -Set up to use persistent connections using LWP/TLDownload, that is look -for a download server. Return the TLDownload object if successful, else -false. - -=cut - -sub setup_persistent_downloads { - if ($TeXLive::TLDownload::net_lib_avail) { - ddebug("setup_persistent_downloads has net_lib_avail set\n"); - if ($::tldownload_server) { - if ($::tldownload_server->initcount() > $TeXLive::TLConfig::MaxLWPReinitCount) { - debug("stop retrying to initialize LWP after 10 failures\n"); - return 0; - } else { - $::tldownload_server->reinit(); - } - } else { - $::tldownload_server = TeXLive::TLDownload->new; - } - if (!defined($::tldownload_server)) { - ddebug("TLUtils:setup_persistent_downloads: failed to get ::tldownload_server\n"); - } else { - ddebug("TLUtils:setup_persistent_downloads: got ::tldownload_server\n"); - } - return $::tldownload_server; - } - return 0; -} - - -=item C<query_ctan_mirror()> - -Return a particular mirror given by the generic CTAN auto-redirecting -default (specified in L<$TLConfig::TexLiveServerURL>) if we get a -response, else the empty string. - -Neither C<TL_DOWNLOAD_PROGRAM> nor <TL_DOWNLOAD_ARGS> is honored (see -L<download_file>), since certain options have to be set to do the job -and the program has to be C<wget> since we parse the output. - -=cut - -sub query_ctan_mirror { - my $wget = $::progs{'wget'}; - if (!defined ($wget)) { - tlwarn("query_ctan_mirror: Programs not set up, trying wget\n"); - $wget = "wget"; - } - - # we need the verbose output, so no -q. - # do not reduce retries here, but timeout still seems desirable. - my $mirror = $TeXLiveServerURL; - my $cmd = "$wget $mirror --timeout=$NetworkTimeout -O " - . (win32() ? "nul" : "/dev/null") . " 2>&1"; - - # - # since we are reading the output of wget to find a mirror - # we have to make sure that the locale is unset - my $saved_lcall; - if (defined($ENV{'LC_ALL'})) { - $saved_lcall = $ENV{'LC_ALL'}; - } - $ENV{'LC_ALL'} = "C"; - # we try 3 times to get a mirror from mirror.ctan.org in case we have - # bad luck with what gets returned. - my $max_trial = 3; - my $mhost; - for (my $i = 1; $i <= $max_trial; $i++) { - my @out = `$cmd`; - # analyze the output for the mirror actually selected. - foreach (@out) { - if (m/^Location: (\S*)\s*.*$/) { - (my $mhost = $1) =~ s,/*$,,; # remove trailing slashes since we add it - return $mhost; - } - } - sleep(1); - } - - # reset LC_ALL to undefined or the previous value - if (defined($saved_lcall)) { - $ENV{'LC_ALL'} = $saved_lcall; - } else { - delete($ENV{'LC_ALL'}); - } - - # we are still here, so three times we didn't get a mirror, give up - # and return undefined - return; -} - -=item C<check_on_working_mirror($mirror)> - -Check if MIRROR is functional. - -=cut - -sub check_on_working_mirror { - my $mirror = shift; - - my $wget = $::progs{'wget'}; - if (!defined ($wget)) { - tlwarn ("check_on_working_mirror: Programs not set up, trying wget\n"); - $wget = "wget"; - } - $wget = quotify_path_with_spaces($wget); - # - # the test is currently not completely correct, because we do not - # use the LWP if it is set up for it, but I am currently too lazy - # to program it, - # so try wget and only check for the return value - # please KEEP the / after $mirror, some ftp mirrors do give back - # an error if the / is missing after ../CTAN/ - my $cmd = "$wget $mirror/ --timeout=$NetworkTimeout -O " - . (win32() ? "nul" : "/dev/null") - . " 2>" . (win32() ? "nul" : "/dev/null"); - my $ret = system($cmd); - # if return value is not zero it is a failure, so switch the meanings - return ($ret ? 0 : 1); -} - -=item C<give_ctan_mirror_base()> - - 1. get a mirror (retries 3 times to contact mirror.ctan.org) - - if no mirror found, use one of the backbone servers - - if it is an http server return it (no test is done) - - if it is a ftp server, continue - 2. if the ftp mirror is good, return it - 3. if the ftp mirror is bad, search for http mirror (5 times) - 4. if http mirror is found, return it (again, no test,) - 5. if no http mirror is found, return one of the backbone servers - -=cut - -sub give_ctan_mirror_base { - # only one backbone has existed for a while (2018). - my @backbone = qw!http://www.ctan.org/tex-archive!; - - # start by selecting a mirror and test its operationality - my $mirror = query_ctan_mirror(); - if (!defined($mirror)) { - # three times calling mirror.ctan.org did not give anything useful, - # return one of the backbone servers - tlwarn("cannot contact mirror.ctan.org, returning a backbone server!\n"); - return $backbone[int(rand($#backbone + 1))]; - } - - if ($mirror =~ m!^https?://!) { # if http mirror, assume good and return. - return $mirror; - } - - # we are still here, so we got a ftp mirror from mirror.ctan.org - if (check_on_working_mirror($mirror)) { - return $mirror; # ftp mirror is working, return. - } - - # we are still here, so the ftp mirror failed, retry and hope for http. - # theory is that if one ftp fails, probably all ftp is broken. - my $max_mirror_trial = 5; - for (my $try = 1; $try <= $max_mirror_trial; $try++) { - my $m = query_ctan_mirror(); - debug("querying mirror, got " . (defined($m) ? $m : "(nothing)") . "\n"); - if (defined($m) && $m =~ m!^https?://!) { - return $m; # got http this time, assume ok. - } - # sleep to make mirror happy, but only if we are not ready to return - sleep(1) if $try < $max_mirror_trial; - } - - # 5 times contacting the mirror service did not return a http server, - # use one of the backbone servers. - debug("no mirror found ... randomly selecting backbone\n"); - return $backbone[int(rand($#backbone + 1))]; -} - - -sub give_ctan_mirror { - return (give_ctan_mirror_base(@_) . "/$TeXLiveServerPath"); -} - -=item C<create_mirror_list()> - -=item C<extract_mirror_entry($listentry)> - -C<create_mirror_list> returns the lists of viable mirrors according to -ctan-mirrors.pl, in a list which also contains continents, and country headers. - -C<extract_mirror_entry> extracts the actual repository data from one -of these entries. - -# KEEP THESE TWO FUNCTIONS IN SYNC!!! - -=cut - -sub create_mirror_list { - our $mirrors; - my @ret = (); - require("installer/ctan-mirrors.pl"); - my @continents = sort keys %$mirrors; - for my $continent (@continents) { - # first push the name of the continent - push @ret, uc($continent); - my @countries = sort keys %{$mirrors->{$continent}}; - for my $country (@countries) { - my @mirrors = sort keys %{$mirrors->{$continent}{$country}}; - my $first = 1; - for my $mirror (@mirrors) { - my $mfull = $mirror; - $mfull =~ s!/$!!; - # do not append the server path part here, but add - # it down there in the extract mirror entry - #$mfull .= "/" . $TeXLive::TLConfig::TeXLiveServerPath; - #if ($first) { - my $country_str = sprintf "%-12s", $country; - push @ret, " $country_str $mfull"; - # $first = 0; - #} else { - # push @ret, " $mfull"; - #} - } - } - } - return @ret; -} - -# extract_mirror_entry is not very intelligent, it assumes that -# the last "word" is the URL -sub extract_mirror_entry { - my $ent = shift; - my @foo = split ' ', $ent; - return $foo[$#foo] . "/" . $TeXLive::TLConfig::TeXLiveServerPath; -} - -=pod - -=item C<< slurp_file($file) >> - -Reads the whole file and returns the content in a scalar. - -=cut - -sub slurp_file { - my $file = shift; - my $file_data = do { - local $/ = undef; - open my $fh, "<", $file || die "open($file) failed: $!"; - <$fh>; - }; - return($file_data); -} - -=pod - -=item C<< download_to_temp_or_file($url) >> - -If C<$url> is a url, tries to download the file into a temporary file. -Otherwise assume that C<$url> is a local file. -In both cases returns the local file. - -Returns the local file name if succeeded, otherwise undef. - -=cut - -sub download_to_temp_or_file { - my $url = shift; - my ($url_fh, $url_file); - if ($url =~ m,^(https?|ftp|file)://, || $url =~ m!$SshURIRegex!) { - ($url_fh, $url_file) = tl_tmpfile(); - # now $url_fh filehandle is open, the file created - # TLUtils::download_file will just overwrite what is there - # on windows that doesn't work, so we close the fh immediately - # this creates a short loophole, but much better than before anyway - close($url_fh); - $ret = download_file($url, $url_file); - } else { - $url_file = $url; - $ret = 1; - } - if ($ret && (-r "$url_file")) { - return $url_file; - } - return; -} - - -=item C<< compare_tlpobjs($tlpA, $tlpB) >> - -Compare the two passed L<TLPOBJ> objects. Returns a hash: - - $ret{'revision'} = "revA:revB" # if revisions differ - $ret{'removed'} = \[ list of files removed from A to B ] - $ret{'added'} = \[ list of files added from A to B ] - $ret{'fmttriggers'} = 1 if the fmttriggers have changed - -=cut - -sub compare_tlpobjs { - my ($tlpA, $tlpB) = @_; - my %ret; - - my $rA = $tlpA->revision; - my $rB = $tlpB->revision; - if ($rA != $rB) { - $ret{'revision'} = "$rA:$rB"; - } - if ($tlpA->relocated) { - $tlpA->replace_reloc_prefix; - } - if ($tlpB->relocated) { - $tlpB->replace_reloc_prefix; - } - my @fA = $tlpA->all_files; - my @fB = $tlpB->all_files; - my %removed; - my %added; - for my $f (@fA) { $removed{$f} = 1; } - for my $f (@fB) { delete($removed{$f}); $added{$f} = 1; } - for my $f (@fA) { delete($added{$f}); } - my @rem = sort keys %removed; - my @add = sort keys %added; - $ret{'removed'} = \@rem if @rem; - $ret{'added'} = \@add if @add; - - # changed dependencies should not trigger a change without a - # change in revision, so for now (until we find a reason why - # we need to) we don't check. - # OTOH, execute statements like - # execute AddFormat name=aleph engine=aleph options=*aleph.ini fmttriggers=cm,hyphen-base,knuth-lib,plain - # might change due to changes in the fmttriggers variables. - # Again, name/engine/options are only defined in the package's - # tlpsrc file, so changes here will trigger revision changes, - # but fmttriggers are defined outside the tlpsrc and thus do - # not trigger an automatic revision change. Check for that! - # No need to record actual changes, just record that it has changed. - my %triggersA; - my %triggersB; - # we sort executes after format/engine like fmtutil does, since this - # should be unique - for my $e ($tlpA->executes) { - if ($e =~ m/AddFormat\s+(.*)\s*/) { - my %r = parse_AddFormat_line("$1"); - if (defined($r{"error"})) { - die "$r{'error'} when comparing packages $tlpA->name execute $e"; - } - for my $t (@{$r{'fmttriggers'}}) { - $triggersA{"$r{'name'}:$r{'engine'}:$t"} = 1; - } - } - } - for my $e ($tlpB->executes) { - if ($e =~ m/AddFormat\s+(.*)\s*/) { - my %r = parse_AddFormat_line("$1"); - if (defined($r{"error"})) { - die "$r{'error'} when comparing packages $tlpB->name execute $e"; - } - for my $t (@{$r{'fmttriggers'}}) { - $triggersB{"$r{'name'}:$r{'engine'}:$t"} = 1; - } - } - } - for my $t (keys %triggersA) { - delete($triggersA{$t}); - delete($triggersB{$t}); - } - if (keys(%triggersA) || keys(%triggersB)) { - $ret{'fmttrigger'} = 1; - } - - return %ret; -} - - -=item C<< compare_tlpdbs($tlpdbA, $tlpdbB, @more_ignored_pkgs) >> - -Compare the two passed L<TLPDB> objects, ignoring the packages -C<00texlive.installer>, C<00texlive.image>, and any passed -C<@more_ignore_pkgs>. Returns a hash: - - $ret{'removed_packages'} = \[ list of removed packages from A to B ] - $ret{'added_packages'} = \[ list of added packages from A to B ] - $ret{'different_packages'}->{$package} = output of compare_tlpobjs - -=cut - -sub compare_tlpdbs { - my ($tlpdbA, $tlpdbB, @add_ignored_packs) = @_; - my @ignored_packs = qw/00texlive.installer 00texlive.image/; - push @ignored_packs, @add_ignored_packs; - - my @inAnotinB; - my @inBnotinA; - my %diffpacks; - my %do_compare; - my %ret; - - for my $p ($tlpdbA->list_packages()) { - my $is_ignored = 0; - for my $ign (@ignored_packs) { - if (($p =~ m/^$ign$/) || ($p =~ m/^$ign\./)) { - $is_ignored = 1; - last; - } - } - next if $is_ignored; - my $tlpB = $tlpdbB->get_package($p); - if (!defined($tlpB)) { - push @inAnotinB, $p; - } else { - $do_compare{$p} = 1; - } - } - $ret{'removed_packages'} = \@inAnotinB if @inAnotinB; - - for my $p ($tlpdbB->list_packages()) { - my $is_ignored = 0; - for my $ign (@ignored_packs) { - if (($p =~ m/^$ign$/) || ($p =~ m/^$ign\./)) { - $is_ignored = 1; - last; - } - } - next if $is_ignored; - my $tlpA = $tlpdbA->get_package($p); - if (!defined($tlpA)) { - push @inBnotinA, $p; - } else { - $do_compare{$p} = 1; - } - } - $ret{'added_packages'} = \@inBnotinA if @inBnotinA; - - for my $p (sort keys %do_compare) { - my $tlpA = $tlpdbA->get_package($p); - my $tlpB = $tlpdbB->get_package($p); - my %foo = compare_tlpobjs($tlpA, $tlpB); - if (keys %foo) { - # some diffs were found - $diffpacks{$p} = \%foo; - } - } - $ret{'different_packages'} = \%diffpacks if (keys %diffpacks); - - return %ret; -} - -sub tlnet_disabled_packages { - my ($root) = @_; - my $disabled_pkgs = "$root/tlpkg/dev/tlnet-disabled-packages.txt"; - my @ret; - if (-r $disabled_pkgs) { - open (DISABLED, "<$disabled_pkgs") || die "Huu, -r but cannot open: $?"; - while (<DISABLED>) { - chomp; - next if /^\s*#/; - next if /^\s*$/; - $_ =~ s/^\s*//; - $_ =~ s/\s*$//; - push @ret, $_; - } - close(DISABLED) || warn ("Cannot close tlnet-disabled-packages.txt: $?"); - } - return @ret; -} - -sub report_tlpdb_differences { - my $rret = shift; - my %ret = %$rret; - - if (defined($ret{'removed_packages'})) { - info ("removed packages from A to B:\n"); - for my $f (@{$ret{'removed_packages'}}) { - info (" $f\n"); - } - } - if (defined($ret{'added_packages'})) { - info ("added packages from A to B:\n"); - for my $f (@{$ret{'added_packages'}}) { - info (" $f\n"); - } - } - if (defined($ret{'different_packages'})) { - info ("different packages from A to B:\n"); - for my $p (keys %{$ret{'different_packages'}}) { - info (" $p\n"); - for my $k (keys %{$ret{'different_packages'}->{$p}}) { - if ($k eq "revision") { - info(" revision differ: $ret{'different_packages'}->{$p}->{$k}\n"); - } elsif ($k eq "removed" || $k eq "added") { - info(" $k files:\n"); - for my $f (@{$ret{'different_packages'}->{$p}->{$k}}) { - info(" $f\n"); - } - } else { - info(" unknown differ $k\n"); - } - } - } - } -} - -sub sort_archs ($$) { - my $aa = $_[0]; - my $bb = $_[1]; - $aa =~ s/^(.*)-(.*)$/$2-$1/; - $bb =~ s/^(.*)-(.*)$/$2-$1/; - $aa cmp $bb ; -} - -# Taken from Text::ParseWords -# -sub quotewords { - my($delim, $keep, @lines) = @_; - my($line, @words, @allwords); - - foreach $line (@lines) { - @words = parse_line($delim, $keep, $line); - return() unless (@words || !length($line)); - push(@allwords, @words); - } - return(@allwords); -} - -sub parse_line { - my($delimiter, $keep, $line) = @_; - my($word, @pieces); - - no warnings 'uninitialized'; # we will be testing undef strings - - $line =~ s/\s+$//; # kill trailing whitespace - while (length($line)) { - $line =~ s/^(["']) # a $quote - ((?:\\.|(?!\1)[^\\])*) # and $quoted text - \1 # followed by the same quote - | # --OR-- - ^((?:\\.|[^\\"'])*?) # an $unquoted text - (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["'])) - # plus EOL, delimiter, or quote - //xs or return; # extended layout - my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4); - return() unless( defined($quote) || length($unquoted) || length($delim)); - - if ($keep) { - $quoted = "$quote$quoted$quote"; - } else { - $unquoted =~ s/\\(.)/$1/sg; - if (defined $quote) { - $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); - $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); - } - } - $word .= substr($line, 0, 0); # leave results tainted - $word .= defined $quote ? $quoted : $unquoted; - - if (length($delim)) { - push(@pieces, $word); - push(@pieces, $delim) if ($keep eq 'delimiters'); - undef $word; - } - if (!length($line)) { - push(@pieces, $word); - } - } - return(@pieces); -} - - -=item C<mktexupd ()> - -Append entries to C<ls-R> files. Usage example: - - my $updLSR=&mktexupd(); - $updLSR->{mustexist}(1); - $updLSR->{add}(file1); - $updLSR->{add}(file2); - $updLSR->{add}(file3); - $updLSR->{exec}(); - -The first line creates a new object. Only one such object should be -created in a program in order to avoid duplicate entries in C<ls-R> files. - -C<add> pushes a filename or a list of filenames to a hash encapsulated -in a closure. Filenames must be specified with the full (absolute) path. -Duplicate entries are ignored. - -C<exec> checks for each component of C<$TEXMFDBS> whether there are files -in the hash which have to be appended to the corresponding C<ls-R> files -and eventually updates the corresponding C<ls-R> files. Files which are -in directories not stated in C<$TEXMFDBS> are silently ignored. - -If the flag C<mustexist> is set, C<exec> aborts with an error message -if a file supposed to be appended to an C<ls-R> file doesn't exist physically -on the file system. This option was added for compatibility with the -C<mktexupd> shell script. This option shouldn't be enabled in scripts, -except for testing, because it degrades performance on non-cached file -systems. - -=cut - -sub mktexupd { - my %files; - my $mustexist=0; - - my $hash={ - "add" => sub { - foreach my $file (@_) { - $file =~ s|\\|/|g; - $files{$file}=1; - } - }, - "reset" => sub { - %files=(); - }, - "mustexist" => sub { - $mustexist=shift; - }, - "exec" => sub { - # check whether files exist - if ($mustexist) { - foreach my $file (keys %files) { - die "mktexupd: exec file does not exist: $file" if (! -f $file); - } - } - my $delim= (&win32)? ';' : ':'; - my $TEXMFDBS; - chomp($TEXMFDBS=`kpsewhich --show-path="ls-R"`); - - my @texmfdbs=split ($delim, "$TEXMFDBS"); - my %dbs; - - foreach my $path (keys %files) { - foreach my $db (@texmfdbs) { - $db=substr($db, -1) if ($db=~m|/$|); # strip leading / - $db = lc($db) if win32(); - $up = (win32() ? lc($path) : $path); - if (substr($up, 0, length("$db/")) eq "$db/") { - # we appended a / because otherwise "texmf" is recognized as a - # substring of "texmf-dist". - my $np = './' . substr($up, length("$db/")); - my ($dir, $file); - $_=$np; - ($dir, $file) = m|(.*)/(.*)|; - $dbs{$db}{$dir}{$file}=1; - } - } - } - foreach my $db (keys %dbs) { - if (! -f "$db" || ! -w "$db/ls-R") { - &mkdirhier ($db); - } - open LSR, ">>$db/ls-R"; - foreach my $dir (keys %{$dbs{$db}}) { - print LSR "\n$dir:\n"; - foreach my $file (keys %{$dbs{$db}{$dir}}) { - print LSR "$file\n"; - } - } - close LSR; - } - } - }; - return $hash; -} - - -=item C<check_sys_user_mode($user,$sys,$tmfc, $tmfsc, $tmfv, $tmfsv)> - -=cut - -sub setup_sys_user_mode { - my ($prg, $optsref, $TEXMFCONFIG, $TEXMFSYSCONFIG, - $TEXMFVAR, $TEXMFSYSVAR) = @_; - - if ($optsref->{'user'} && $optsref->{'sys'}) { - print STDERR "$prg [ERROR]: only one of -sys or -user can be used.\n"; - exit(1); - } - - # check if we are in *hidden* sys mode, in which case we switch - # to sys mode - # Nowdays we use -sys switch instead of simply overriding TEXMFVAR - # and TEXMFCONFIG - # This is used to warn users when they run updmap in usermode the first time. - # But it might happen that this script is called via another wrapper that - # sets TEXMFCONFIG and TEXMFVAR, and does not pass on the -sys option. - # for this case we check whether the SYS and non-SYS variants agree, - # and if, then switch to sys mode (with a warning) - if (($TEXMFSYSCONFIG eq $TEXMFCONFIG) && ($TEXMFSYSVAR eq $TEXMFVAR)) { - if ($optsref->{'user'}) { - print STDERR "$prg [ERROR]: -user mode but path setup is -sys type, bailing out.\n"; - exit(1); - } - if (!$optsref->{'sys'}) { - print STDERR "$prg [WARNING]: hidden sys mode found, switching to sys mode.\n" if (!$optsref->{'quiet'}); - $optsref->{'sys'} = 1; - } - } - - my ($texmfconfig, $texmfvar); - if ($optsref->{'sys'}) { - # we are running as updmap-sys, make sure that the right tree is used - $texmfconfig = $TEXMFSYSCONFIG; - $texmfvar = $TEXMFSYSVAR; - } elsif ($optsref->{'user'}) { - $texmfconfig = $TEXMFCONFIG; - $texmfvar = $TEXMFVAR; - } else { - print STDERR "" . - "$prg [ERROR]: Either -sys or -user mode is required.\n" . - "$prg [ERROR]: In nearly all cases you should use $prg -sys.\n" . - "$prg [ERROR]: For special cases see https://tug.org/texlive/scripts-sys-user.html\n" ; - exit(1); - } - return ($texmfconfig, $texmfvar); -} - - -=item C<prepend_own_path()> - -Prepend the location of the TeX Live binaries to the PATH environment -variable. This is used by (e.g.) C<fmtutil>. The location is found by -calling C<Cwd::abs_path> on C<which('kpsewhich')>. We use kpsewhich -because it is known to be a true binary executable; C<$0> could be a -symlink into (say) C<texmf-dist/scripts/>, which is not a useful -directory for PATH. - -=cut - -sub prepend_own_path { - my $bindir = dirname(Cwd::abs_path(which('kpsewhich'))); - if (win32()) { - $bindir =~ s!\\!/!g; - $ENV{'PATH'} = "$bindir;$ENV{PATH}"; - } else { - $ENV{'PATH'} = "$bindir:$ENV{PATH}"; - } -} - - -=item C<repository_to_array($r)> - -Return hash of tags to urls for space-separated list of repositories -passed in C<$r>. If passed undef or empty string, die. - -=cut - -sub repository_to_array { - my $r = shift; - my %r; - if (!$r) { - # either empty string or undef was passed - # before 20181023 we die here, now we return - # an empty array - return %r; - } - #die "internal error, repository_to_array passed nothing (caller=" - # . caller . ")" if (!$r); - my @repos = split (' ', $r); - if ($#repos == 0) { - # only one repo, this is the main one! - $r{'main'} = $repos[0]; - return %r; - } - for my $rr (@repos) { - my $tag; - my $url; - # decode spaces and % in reverse order - $rr =~ s/%20/ /g; - $rr =~ s/%25/%/g; - $tag = $url = $rr; - if ($rr =~ m/^([^#]+)#(.*)$/) { - $tag = $2; - $url = $1; - } - $r{$tag} = $url; - } - return %r; -} - - -=back - -=head2 JSON - -=over 4 - -=item C<encode_json($ref)> - -Returns the JSON representation of the object C<$ref> is pointing at. -This tries to load the C<JSON> Perl module, and uses it if available, -otherwise falls back to module internal conversion. - -The used backend can be selected by setting the environment variable -C<TL_JSONMODE> to either C<json> or C<texlive> (all other values are -ignored). If C<json> is requested and the C<JSON> module cannot be loaded -the program terminates. - -=cut - -my $TLTrueValue = 1; -my $TLFalseValue = 0; -my $TLTrue = \$TLTrueValue; -my $TLFalse = \$TLFalseValue; -bless $TLTrue, 'TLBOOLEAN'; -bless $TLFalse, 'TLBOOLEAN'; - -our $jsonmode = ""; - -=pod - -=item C<True()> - -=item C<False()> - -These two crazy functions must be used to get proper JSON C<true> and -C<false> in the output independent of the backend used. - -=cut - -sub True { - ensure_json_available(); - if ($jsonmode eq "json") { - return($JSON::true); - } else { - return($TLTrue); - } -} -sub False { - ensure_json_available(); - if ($jsonmode eq "json") { - return($JSON::false); - } else { - return($TLFalse); - } -} - -sub ensure_json_available { - return if ($jsonmode); - # check the environment for mode to use: - # $ENV{'TL_JSONMODE'} = texlive | json - my $envdefined = 0; - if ($ENV{'TL_JSONMODE'}) { - $envdefined = 1; - if ($ENV{'TL_JSONMODE'} eq "texlive") { - $jsonmode = "texlive"; - debug("texlive json module used!\n"); - return; - } elsif ($ENV{'TL_JSONMODE'} eq "json") { - # nothing to do - } else { - tlwarn("Unsupported mode \'$ENV{TL_JSONMODE}\' set in TL_JSONMODE, ignoring it!"); - $envdefined = 0; - } - } - return if ($jsonmode); # was set to texlive - eval { require JSON; }; - if ($@) { - # that didn't work out, use home-grown json - if ($envdefined) { - # environment asks for JSON but cannot be loaded, die! - tldie("envvar TL_JSONMODE request JSON module but cannot be loaded!\n"); - } - $jsonmode = "texlive"; - debug("texlive json module used!\n"); - } else { - $jsonmode = "json"; - my $json = JSON->new; - debug("JSON " . $json->backend . " used!\n"); - } -} - -sub encode_json { - my $val = shift; - ensure_json_available(); - if ($jsonmode eq "json") { - my $utf8_encoded_json_text = JSON::encode_json($val); - return $utf8_encoded_json_text; - } else { - my $type = ref($val); - if ($type eq "") { - tldie("encode_json: accept only refs: $val"); - } elsif ($type eq 'SCALAR') { - return(scalar_to_json($$val)); - } elsif ($type eq 'ARRAY') { - return(array_to_json($val)); - } elsif ($type eq 'HASH') { - return(hash_to_json($val)); - } elsif ($type eq 'REF') { - return(encode_json($$val)); - } elsif (Scalar::Util::blessed($val)) { - if ($type eq "TLBOOLEAN") { - return($$val ? "true" : "false"); - } else { - tldie("encode_json: unsupported blessed object"); - } - } else { - tldie("encode_json: unsupported format $type"); - } - } -} - -sub scalar_to_json { - sub looks_like_numeric { - # code from JSON/backportPP.pm - my $value = shift; - no warnings 'numeric'; - # detect numbers - # string & "" -> "" - # number & "" -> 0 (with warning) - # nan and inf can detect as numbers, so check with * 0 - return unless length((my $dummy = "") & $value); - return unless 0 + $value eq $value; - return 1 if $value * 0 == 0; - return -1; # inf/nan - } - my $val = shift; - if (defined($val)) { - if (looks_like_numeric($val)) { - return("$val"); - } else { - return(string_to_json($val)); - } - } else { - return("null"); - } -} - -sub string_to_json { - my $val = shift; - my %esc = ( - "\n" => '\n', - "\r" => '\r', - "\t" => '\t', - "\f" => '\f', - "\b" => '\b', - "\"" => '\"', - "\\" => '\\\\', - "\'" => '\\\'', - ); - $val =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g; - return("\"$val\""); -} - -sub hash_to_json { - my $hr = shift; - my @retvals; - for my $k (keys(%$hr)) { - my $val = $hr->{$k}; - push @retvals, "\"$k\":" . encode_json(\$val); - } - my $ret = "{" . join(",", @retvals) . "}"; - return($ret); -} - -sub array_to_json { - my $hr = shift; - my $ret = "[" . join(",", map { encode_json(\$_) } @$hr) . "]"; - return($ret); -} - -=pod - -=back - -=cut - -1; -__END__ - -=head1 SEE ALSO - -The other modules in C<Master/tlpkg/TeXLive/> (L<TeXLive::TLConfig> and -the rest), and the scripts in C<Master/tlpg/bin/> (especially -C<tl-update-tlpdb>), the documentation in C<Master/tlpkg/doc/>, etc. - -=head1 AUTHORS AND COPYRIGHT - -This script and its documentation were written for the TeX Live -distribution (L<https://tug.org/texlive>) and both are licensed under the -GNU General Public License Version 2 or later. - -=cut - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Build/source/texk/tests/common-test.pl b/Build/source/texk/tests/common-test.pl deleted file mode 100644 index c936f24f656..00000000000 --- a/Build/source/texk/tests/common-test.pl +++ /dev/null @@ -1,64 +0,0 @@ -# $Id: common-test.pl 16695 2010-01-13 01:18:02Z karl $ -# Public domain. Originally written 2010, Karl Berry. -# Common definitions for Perl tests in TeX Live. We want to use Perl to -# have a chance of running the tests on Windows. - -# absolute path -chomp (my $TL_TESTS_DIR = `cd "$srcdir/../tests" && pwd`); - -# srcdir must be a sibling dir to kpathsea, e.g., web2c. -$ENV{"TEXMFCNF"} = "$srcdir/../kpathsea"; -$ENV{"AFMFONTS"} - = $ENV{"BIBINPUTS"} - = $ENV{"BSTINPUTS"} - = $ENV{"TEXINPUTS"} - = ".:$srcdir/tests:$srcdir/../tests/texmf//"; - - -# Run PROG with ARGS. Return the exit status. -# Die if PROG is not executable. -# -sub test_run { - my ($prog, @args) = @_; - - # Possibly we should check that $prog starts with ./, since we always - # want to run out of the build dir. I think. - die "$0: no program $prog in " . `pwd` if ! -x $prog; - - # use local pm files and kpsewhich. - $ENV{"PERL5LIB"} = $TL_TESTS_DIR; - $ENV{"PATH"} = "../kpathsea:$ENV{PATH}"; - - # Won't be copyable with weird names, but should get the info across. - print "$0: running ", $prog, " ", join (" ", @args), "\n"; - - # Run it. - my $ret = system ($prog, @args); - return $ret; -} - -sub test_file_copy { - my ($srcfile,$dstfile) = @_; - - # don't copy onto itself. - chomp (my $srcdir = `dirname $srcfile`); - chomp ($srcdir = `cd $srcdir && pwd`); - # - chomp (my $dstdir = `dirname $dstfile`); - chomp ($dstdir = `cd $dstdir && pwd`); - return if $srcdir eq $dstdir; - - local *IN; - $IN = "<$srcfile"; - open (IN) || die "open($srcfile) failed: $!"; - my @in = <IN>; - close (IN) || warn "close($srcfile) failed: $!"; - - local *OUT; - $OUT = ">$dstfile"; - open (OUT) || die "open($dstfile) failed: $!"; - print (OUT @in) || die "print($dstfile) failed: $!"; - close (OUT) || warn "close($dstfile) failed: $!"; - - return 0; -} diff --git a/Build/source/texk/tests/texmf/afmtest.afm b/Build/source/texk/tests/texmf/afmtest.afm deleted file mode 100644 index ab46eaa4edd..00000000000 --- a/Build/source/texk/tests/texmf/afmtest.afm +++ /dev/null @@ -1,23 +0,0 @@ -StartFontMetrics 2.0 -Comment $Id$ -Comment Public domain. Originally written by Karl Berry. -Comment Creation Date: 11apr10 -FontName Afmtest -FullName AFM Test -FamilyName Afmtest -Weight Invisible -ItalicAngle 0 -IsFixedPitch false -FontBBox 0 0 0 0 -UnderlinePosition -100 -UnderlineThickness 50 -Version 001.000 -Notice Public domain. -EncodingScheme SpaceOnly -CapHeight 1000 -XHeight 500 -Ascender 1000 -Descender -250 -StartCharMetrics 1 -C 32 ; WX 250 ; N space ; B 0 0 0 0 ; -EndFontMetrics diff --git a/Build/source/texk/tests/texmf/plain.bst b/Build/source/texk/tests/texmf/plain.bst deleted file mode 100644 index 83286c1a803..00000000000 --- a/Build/source/texk/tests/texmf/plain.bst +++ /dev/null @@ -1,1097 +0,0 @@ -% BibTeX standard bibliography style `plain' - % version 0.99a for BibTeX versions 0.99a or later, LaTeX version 2.09. - % Copyright (C) 1985, all rights reserved. - % Copying of this file is authorized only if either - % (1) you make absolutely no changes to your copy, including name, or - % (2) if you do make changes, you name it something other than - % btxbst.doc, plain.bst, unsrt.bst, alpha.bst, and abbrv.bst. - % This restriction helps ensure that all standard styles are identical. - % The file btxbst.doc has the documentation for this style. - -ENTRY - { address - author - booktitle - chapter - edition - editor - howpublished - institution - journal - key - month - note - number - organization - pages - publisher - school - series - title - type - volume - year - } - {} - { label } - -INTEGERS { output.state before.all mid.sentence after.sentence after.block } - -FUNCTION {init.state.consts} -{ #0 'before.all := - #1 'mid.sentence := - #2 'after.sentence := - #3 'after.block := -} - -STRINGS { s t } - -FUNCTION {output.nonnull} -{ 's := - output.state mid.sentence = - { ", " * write$ } - { output.state after.block = - { add.period$ write$ - newline$ - "\newblock " write$ - } - { output.state before.all = - 'write$ - { add.period$ " " * write$ } - if$ - } - if$ - mid.sentence 'output.state := - } - if$ - s -} - -FUNCTION {output} -{ duplicate$ empty$ - 'pop$ - 'output.nonnull - if$ -} - -FUNCTION {output.check} -{ 't := - duplicate$ empty$ - { pop$ "empty " t * " in " * cite$ * warning$ } - 'output.nonnull - if$ -} - -FUNCTION {output.bibitem} -{ newline$ - "\bibitem{" write$ - cite$ write$ - "}" write$ - newline$ - "" - before.all 'output.state := -} - -FUNCTION {fin.entry} -{ add.period$ - write$ - newline$ -} - -FUNCTION {new.block} -{ output.state before.all = - 'skip$ - { after.block 'output.state := } - if$ -} - -FUNCTION {new.sentence} -{ output.state after.block = - 'skip$ - { output.state before.all = - 'skip$ - { after.sentence 'output.state := } - if$ - } - if$ -} - -FUNCTION {not} -{ { #0 } - { #1 } - if$ -} - -FUNCTION {and} -{ 'skip$ - { pop$ #0 } - if$ -} - -FUNCTION {or} -{ { pop$ #1 } - 'skip$ - if$ -} - -FUNCTION {new.block.checka} -{ empty$ - 'skip$ - 'new.block - if$ -} - -FUNCTION {new.block.checkb} -{ empty$ - swap$ empty$ - and - 'skip$ - 'new.block - if$ -} - -FUNCTION {new.sentence.checka} -{ empty$ - 'skip$ - 'new.sentence - if$ -} - -FUNCTION {new.sentence.checkb} -{ empty$ - swap$ empty$ - and - 'skip$ - 'new.sentence - if$ -} - -FUNCTION {field.or.null} -{ duplicate$ empty$ - { pop$ "" } - 'skip$ - if$ -} - -FUNCTION {emphasize} -{ duplicate$ empty$ - { pop$ "" } - { "{\em " swap$ * "}" * } - if$ -} - -INTEGERS { nameptr namesleft numnames } - -FUNCTION {format.names} -{ 's := - #1 'nameptr := - s num.names$ 'numnames := - numnames 'namesleft := - { namesleft #0 > } - { s nameptr "{ff~}{vv~}{ll}{, jj}" format.name$ 't := - nameptr #1 > - { namesleft #1 > - { ", " * t * } - { numnames #2 > - { "," * } - 'skip$ - if$ - t "others" = - { " et~al." * } - { " and " * t * } - if$ - } - if$ - } - 't - if$ - nameptr #1 + 'nameptr := - namesleft #1 - 'namesleft := - } - while$ -} - -FUNCTION {format.authors} -{ author empty$ - { "" } - { author format.names } - if$ -} - -FUNCTION {format.editors} -{ editor empty$ - { "" } - { editor format.names - editor num.names$ #1 > - { ", editors" * } - { ", editor" * } - if$ - } - if$ -} - -FUNCTION {format.title} -{ title empty$ - { "" } - { title "t" change.case$ } - if$ -} - -FUNCTION {n.dashify} -{ 't := - "" - { t empty$ not } - { t #1 #1 substring$ "-" = - { t #1 #2 substring$ "--" = not - { "--" * - t #2 global.max$ substring$ 't := - } - { { t #1 #1 substring$ "-" = } - { "-" * - t #2 global.max$ substring$ 't := - } - while$ - } - if$ - } - { t #1 #1 substring$ * - t #2 global.max$ substring$ 't := - } - if$ - } - while$ -} - -FUNCTION {format.date} -{ year empty$ - { month empty$ - { "" } - { "there's a month but no year in " cite$ * warning$ - month - } - if$ - } - { month empty$ - 'year - { month " " * year * } - if$ - } - if$ -} - -FUNCTION {format.btitle} -{ title emphasize -} - -FUNCTION {tie.or.space.connect} -{ duplicate$ text.length$ #3 < - { "~" } - { " " } - if$ - swap$ * * -} - -FUNCTION {either.or.check} -{ empty$ - 'pop$ - { "can't use both " swap$ * " fields in " * cite$ * warning$ } - if$ -} - -FUNCTION {format.bvolume} -{ volume empty$ - { "" } - { "volume" volume tie.or.space.connect - series empty$ - 'skip$ - { " of " * series emphasize * } - if$ - "volume and number" number either.or.check - } - if$ -} - -FUNCTION {format.number.series} -{ volume empty$ - { number empty$ - { series field.or.null } - { output.state mid.sentence = - { "number" } - { "Number" } - if$ - number tie.or.space.connect - series empty$ - { "there's a number but no series in " cite$ * warning$ } - { " in " * series * } - if$ - } - if$ - } - { "" } - if$ -} - -FUNCTION {format.edition} -{ edition empty$ - { "" } - { output.state mid.sentence = - { edition "l" change.case$ " edition" * } - { edition "t" change.case$ " edition" * } - if$ - } - if$ -} - -INTEGERS { multiresult } - -FUNCTION {multi.page.check} -{ 't := - #0 'multiresult := - { multiresult not - t empty$ not - and - } - { t #1 #1 substring$ - duplicate$ "-" = - swap$ duplicate$ "," = - swap$ "+" = - or or - { #1 'multiresult := } - { t #2 global.max$ substring$ 't := } - if$ - } - while$ - multiresult -} - -FUNCTION {format.pages} -{ pages empty$ - { "" } - { pages multi.page.check - { "pages" pages n.dashify tie.or.space.connect } - { "page" pages tie.or.space.connect } - if$ - } - if$ -} - -FUNCTION {format.vol.num.pages} -{ volume field.or.null - number empty$ - 'skip$ - { "(" number * ")" * * - volume empty$ - { "there's a number but no volume in " cite$ * warning$ } - 'skip$ - if$ - } - if$ - pages empty$ - 'skip$ - { duplicate$ empty$ - { pop$ format.pages } - { ":" * pages n.dashify * } - if$ - } - if$ -} - -FUNCTION {format.chapter.pages} -{ chapter empty$ - 'format.pages - { type empty$ - { "chapter" } - { type "l" change.case$ } - if$ - chapter tie.or.space.connect - pages empty$ - 'skip$ - { ", " * format.pages * } - if$ - } - if$ -} - -FUNCTION {format.in.ed.booktitle} -{ booktitle empty$ - { "" } - { editor empty$ - { "In " booktitle emphasize * } - { "In " format.editors * ", " * booktitle emphasize * } - if$ - } - if$ -} - -FUNCTION {empty.misc.check} -{ author empty$ title empty$ howpublished empty$ - month empty$ year empty$ note empty$ - and and and and and - key empty$ not and - { "all relevant fields are empty in " cite$ * warning$ } - 'skip$ - if$ -} - -FUNCTION {format.thesis.type} -{ type empty$ - 'skip$ - { pop$ - type "t" change.case$ - } - if$ -} - -FUNCTION {format.tr.number} -{ type empty$ - { "Technical Report" } - 'type - if$ - number empty$ - { "t" change.case$ } - { number tie.or.space.connect } - if$ -} - -FUNCTION {format.article.crossref} -{ key empty$ - { journal empty$ - { "need key or journal for " cite$ * " to crossref " * crossref * - warning$ - "" - } - { "In {\em " journal * "\/}" * } - if$ - } - { "In " key * } - if$ - " \cite{" * crossref * "}" * -} - -FUNCTION {format.crossref.editor} -{ editor #1 "{vv~}{ll}" format.name$ - editor num.names$ duplicate$ - #2 > - { pop$ " et~al." * } - { #2 < - 'skip$ - { editor #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" = - { " et~al." * } - { " and " * editor #2 "{vv~}{ll}" format.name$ * } - if$ - } - if$ - } - if$ -} - -FUNCTION {format.book.crossref} -{ volume empty$ - { "empty volume in " cite$ * "'s crossref of " * crossref * warning$ - "In " - } - { "Volume" volume tie.or.space.connect - " of " * - } - if$ - editor empty$ - editor field.or.null author field.or.null = - or - { key empty$ - { series empty$ - { "need editor, key, or series for " cite$ * " to crossref " * - crossref * warning$ - "" * - } - { "{\em " * series * "\/}" * } - if$ - } - { key * } - if$ - } - { format.crossref.editor * } - if$ - " \cite{" * crossref * "}" * -} - -FUNCTION {format.incoll.inproc.crossref} -{ editor empty$ - editor field.or.null author field.or.null = - or - { key empty$ - { booktitle empty$ - { "need editor, key, or booktitle for " cite$ * " to crossref " * - crossref * warning$ - "" - } - { "In {\em " booktitle * "\/}" * } - if$ - } - { "In " key * } - if$ - } - { "In " format.crossref.editor * } - if$ - " \cite{" * crossref * "}" * -} - -FUNCTION {article} -{ output.bibitem - format.authors "author" output.check - new.block - format.title "title" output.check - new.block - crossref missing$ - { journal emphasize "journal" output.check - format.vol.num.pages output - format.date "year" output.check - } - { format.article.crossref output.nonnull - format.pages output - } - if$ - new.block - note output - fin.entry -} - -FUNCTION {book} -{ output.bibitem - author empty$ - { format.editors "author and editor" output.check } - { format.authors output.nonnull - crossref missing$ - { "author and editor" editor either.or.check } - 'skip$ - if$ - } - if$ - new.block - format.btitle "title" output.check - crossref missing$ - { format.bvolume output - new.block - format.number.series output - new.sentence - publisher "publisher" output.check - address output - } - { new.block - format.book.crossref output.nonnull - } - if$ - format.edition output - format.date "year" output.check - new.block - note output - fin.entry -} - -FUNCTION {booklet} -{ output.bibitem - format.authors output - new.block - format.title "title" output.check - howpublished address new.block.checkb - howpublished output - address output - format.date output - new.block - note output - fin.entry -} - -FUNCTION {inbook} -{ output.bibitem - author empty$ - { format.editors "author and editor" output.check } - { format.authors output.nonnull - crossref missing$ - { "author and editor" editor either.or.check } - 'skip$ - if$ - } - if$ - new.block - format.btitle "title" output.check - crossref missing$ - { format.bvolume output - format.chapter.pages "chapter and pages" output.check - new.block - format.number.series output - new.sentence - publisher "publisher" output.check - address output - } - { format.chapter.pages "chapter and pages" output.check - new.block - format.book.crossref output.nonnull - } - if$ - format.edition output - format.date "year" output.check - new.block - note output - fin.entry -} - -FUNCTION {incollection} -{ output.bibitem - format.authors "author" output.check - new.block - format.title "title" output.check - new.block - crossref missing$ - { format.in.ed.booktitle "booktitle" output.check - format.bvolume output - format.number.series output - format.chapter.pages output - new.sentence - publisher "publisher" output.check - address output - format.edition output - format.date "year" output.check - } - { format.incoll.inproc.crossref output.nonnull - format.chapter.pages output - } - if$ - new.block - note output - fin.entry -} - -FUNCTION {inproceedings} -{ output.bibitem - format.authors "author" output.check - new.block - format.title "title" output.check - new.block - crossref missing$ - { format.in.ed.booktitle "booktitle" output.check - format.bvolume output - format.number.series output - format.pages output - address empty$ - { organization publisher new.sentence.checkb - organization output - publisher output - format.date "year" output.check - } - { address output.nonnull - format.date "year" output.check - new.sentence - organization output - publisher output - } - if$ - } - { format.incoll.inproc.crossref output.nonnull - format.pages output - } - if$ - new.block - note output - fin.entry -} - -FUNCTION {conference} { inproceedings } - -FUNCTION {manual} -{ output.bibitem - author empty$ - { organization empty$ - 'skip$ - { organization output.nonnull - address output - } - if$ - } - { format.authors output.nonnull } - if$ - new.block - format.btitle "title" output.check - author empty$ - { organization empty$ - { address new.block.checka - address output - } - 'skip$ - if$ - } - { organization address new.block.checkb - organization output - address output - } - if$ - format.edition output - format.date output - new.block - note output - fin.entry -} - -FUNCTION {mastersthesis} -{ output.bibitem - format.authors "author" output.check - new.block - format.title "title" output.check - new.block - "Master's thesis" format.thesis.type output.nonnull - school "school" output.check - address output - format.date "year" output.check - new.block - note output - fin.entry -} - -FUNCTION {misc} -{ output.bibitem - format.authors output - title howpublished new.block.checkb - format.title output - howpublished new.block.checka - howpublished output - format.date output - new.block - note output - fin.entry - empty.misc.check -} - -FUNCTION {phdthesis} -{ output.bibitem - format.authors "author" output.check - new.block - format.btitle "title" output.check - new.block - "PhD thesis" format.thesis.type output.nonnull - school "school" output.check - address output - format.date "year" output.check - new.block - note output - fin.entry -} - -FUNCTION {proceedings} -{ output.bibitem - editor empty$ - { organization output } - { format.editors output.nonnull } - if$ - new.block - format.btitle "title" output.check - format.bvolume output - format.number.series output - address empty$ - { editor empty$ - { publisher new.sentence.checka } - { organization publisher new.sentence.checkb - organization output - } - if$ - publisher output - format.date "year" output.check - } - { address output.nonnull - format.date "year" output.check - new.sentence - editor empty$ - 'skip$ - { organization output } - if$ - publisher output - } - if$ - new.block - note output - fin.entry -} - -FUNCTION {techreport} -{ output.bibitem - format.authors "author" output.check - new.block - format.title "title" output.check - new.block - format.tr.number output.nonnull - institution "institution" output.check - address output - format.date "year" output.check - new.block - note output - fin.entry -} - -FUNCTION {unpublished} -{ output.bibitem - format.authors "author" output.check - new.block - format.title "title" output.check - new.block - note "note" output.check - format.date output - fin.entry -} - -FUNCTION {default.type} { misc } - -MACRO {jan} {"January"} - -MACRO {feb} {"February"} - -MACRO {mar} {"March"} - -MACRO {apr} {"April"} - -MACRO {may} {"May"} - -MACRO {jun} {"June"} - -MACRO {jul} {"July"} - -MACRO {aug} {"August"} - -MACRO {sep} {"September"} - -MACRO {oct} {"October"} - -MACRO {nov} {"November"} - -MACRO {dec} {"December"} - -MACRO {acmcs} {"ACM Computing Surveys"} - -MACRO {acta} {"Acta Informatica"} - -MACRO {cacm} {"Communications of the ACM"} - -MACRO {ibmjrd} {"IBM Journal of Research and Development"} - -MACRO {ibmsj} {"IBM Systems Journal"} - -MACRO {ieeese} {"IEEE Transactions on Software Engineering"} - -MACRO {ieeetc} {"IEEE Transactions on Computers"} - -MACRO {ieeetcad} - {"IEEE Transactions on Computer-Aided Design of Integrated Circuits"} - -MACRO {ipl} {"Information Processing Letters"} - -MACRO {jacm} {"Journal of the ACM"} - -MACRO {jcss} {"Journal of Computer and System Sciences"} - -MACRO {scp} {"Science of Computer Programming"} - -MACRO {sicomp} {"SIAM Journal on Computing"} - -MACRO {tocs} {"ACM Transactions on Computer Systems"} - -MACRO {tods} {"ACM Transactions on Database Systems"} - -MACRO {tog} {"ACM Transactions on Graphics"} - -MACRO {toms} {"ACM Transactions on Mathematical Software"} - -MACRO {toois} {"ACM Transactions on Office Information Systems"} - -MACRO {toplas} {"ACM Transactions on Programming Languages and Systems"} - -MACRO {tcs} {"Theoretical Computer Science"} - -READ - -FUNCTION {sortify} -{ purify$ - "l" change.case$ -} - -INTEGERS { len } - -FUNCTION {chop.word} -{ 's := - 'len := - s #1 len substring$ = - { s len #1 + global.max$ substring$ } - 's - if$ -} - -FUNCTION {sort.format.names} -{ 's := - #1 'nameptr := - "" - s num.names$ 'numnames := - numnames 'namesleft := - { namesleft #0 > } - { nameptr #1 > - { " " * } - 'skip$ - if$ - s nameptr "{vv{ } }{ll{ }}{ ff{ }}{ jj{ }}" format.name$ 't := - nameptr numnames = t "others" = and - { "et al" * } - { t sortify * } - if$ - nameptr #1 + 'nameptr := - namesleft #1 - 'namesleft := - } - while$ -} - -FUNCTION {sort.format.title} -{ 't := - "A " #2 - "An " #3 - "The " #4 t chop.word - chop.word - chop.word - sortify - #1 global.max$ substring$ -} - -FUNCTION {author.sort} -{ author empty$ - { key empty$ - { "to sort, need author or key in " cite$ * warning$ - "" - } - { key sortify } - if$ - } - { author sort.format.names } - if$ -} - -FUNCTION {author.editor.sort} -{ author empty$ - { editor empty$ - { key empty$ - { "to sort, need author, editor, or key in " cite$ * warning$ - "" - } - { key sortify } - if$ - } - { editor sort.format.names } - if$ - } - { author sort.format.names } - if$ -} - -FUNCTION {author.organization.sort} -{ author empty$ - { organization empty$ - { key empty$ - { "to sort, need author, organization, or key in " cite$ * warning$ - "" - } - { key sortify } - if$ - } - { "The " #4 organization chop.word sortify } - if$ - } - { author sort.format.names } - if$ -} - -FUNCTION {editor.organization.sort} -{ editor empty$ - { organization empty$ - { key empty$ - { "to sort, need editor, organization, or key in " cite$ * warning$ - "" - } - { key sortify } - if$ - } - { "The " #4 organization chop.word sortify } - if$ - } - { editor sort.format.names } - if$ -} - -FUNCTION {presort} -{ type$ "book" = - type$ "inbook" = - or - 'author.editor.sort - { type$ "proceedings" = - 'editor.organization.sort - { type$ "manual" = - 'author.organization.sort - 'author.sort - if$ - } - if$ - } - if$ - " " - * - year field.or.null sortify - * - " " - * - title field.or.null - sort.format.title - * - #1 entry.max$ substring$ - 'sort.key$ := -} - -ITERATE {presort} - -SORT - -STRINGS { longest.label } - -INTEGERS { number.label longest.label.width } - -FUNCTION {initialize.longest.label} -{ "" 'longest.label := - #1 'number.label := - #0 'longest.label.width := -} - -FUNCTION {longest.label.pass} -{ number.label int.to.str$ 'label := - number.label #1 + 'number.label := - label width$ longest.label.width > - { label 'longest.label := - label width$ 'longest.label.width := - } - 'skip$ - if$ -} - -EXECUTE {initialize.longest.label} - -ITERATE {longest.label.pass} - -FUNCTION {begin.bib} -{ preamble$ empty$ - 'skip$ - { preamble$ write$ newline$ } - if$ - "\begin{thebibliography}{" longest.label * "}" * write$ newline$ -} - -EXECUTE {begin.bib} - -EXECUTE {init.state.consts} - -ITERATE {call.type$} - -FUNCTION {end.bib} -{ newline$ - "\end{thebibliography}" write$ newline$ -} - -EXECUTE {end.bib} diff --git a/Build/source/texk/tests/texmf/plain.tex b/Build/source/texk/tests/texmf/plain.tex deleted file mode 100644 index 2b72027dff8..00000000000 --- a/Build/source/texk/tests/texmf/plain.tex +++ /dev/null @@ -1,1241 +0,0 @@ -% This is the plain TeX format that's described in The TeXbook. -% N.B.: A version number is defined at the very end of this file; -% please change that number whenever the file is modified! -% And don't modify the file unless you change its name: -% Everybody's "plain.tex" file should be the same, worldwide. - -% Unlimited copying and redistribution of this file are permitted as long -% as this file is not modified. Modifications are permitted, but only if -% the resulting file is not named plain.tex. - -\catcode`\{=1 % left brace is begin-group character -\catcode`\}=2 % right brace is end-group character -\catcode`\$=3 % dollar sign is math shift -\catcode`\&=4 % ampersand is alignment tab -\catcode`\#=6 % hash mark is macro parameter character -\catcode`\^=7 \catcode`\^^K=7 % circumflex and uparrow are for superscripts -\catcode`\_=8 \catcode`\^^A=8 % underline and downarrow are for subscripts -\catcode`\^^I=10 % ascii tab is a blank space -\chardef\active=13 \catcode`\~=\active % tilde is active -\catcode`\^^L=\active \outer\def^^L{\par} % ascii form-feed is "\outer\par" - -\message{Preloading the plain format: codes,} - -% We had to define the \catcodes right away, before the message line, -% since \message uses the { and } characters. -% When INITEX (the TeX initializer) starts up, -% it has defined the following \catcode values: -% \catcode`\^^@=9 % ascii null is ignored -% \catcode`\^^M=5 % ascii return is end-line -% \catcode`\\=0 % backslash is TeX escape character -% \catcode`\%=14 % percent sign is comment character -% \catcode`\ =10 % ascii space is blank space -% \catcode`\^^?=15 % ascii delete is invalid -% \catcode`\A=11 ... \catcode`\Z=11 % uppercase letters -% \catcode`\a=11 ... \catcode`\z=11 % lowercase letters -% all others are type 12 (other) - -% Here is a list of the characters that have been specially catcoded: -\def\dospecials{\do\ \do\\\do\{\do\}\do\$\do\&% - \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~} -% (not counting ascii null, tab, linefeed, formfeed, return, delete) -% Each symbol in the list is preceded by \do, which can be defined -% if you want to do something to every item in the list. - -% We make @ signs act like letters, temporarily, to avoid conflict -% between user names and internal control sequences of plain format. -\catcode`@=11 - -% INITEX sets up \mathcode x=x, for x=0..255, except that -% \mathcode x=x+"7100, for x = `A to `Z and `a to `z; -% \mathcode x=x+"7000, for x = `0 to `9. -% The following changes define internal codes as recommended -% in Appendix C of The TeXbook: -\mathcode`\^^@="2201 % \cdot -\mathcode`\^^A="3223 % \downarrow -\mathcode`\^^B="010B % \alpha -\mathcode`\^^C="010C % \beta -\mathcode`\^^D="225E % \land -\mathcode`\^^E="023A % \lnot -\mathcode`\^^F="3232 % \in -\mathcode`\^^G="0119 % \pi -\mathcode`\^^H="0115 % \lambda -\mathcode`\^^I="010D % \gamma -\mathcode`\^^J="010E % \delta -\mathcode`\^^K="3222 % \uparrow -\mathcode`\^^L="2206 % \pm -\mathcode`\^^M="2208 % \oplus -\mathcode`\^^N="0231 % \infty -\mathcode`\^^O="0140 % \partial -\mathcode`\^^P="321A % \subset -\mathcode`\^^Q="321B % \supset -\mathcode`\^^R="225C % \cap -\mathcode`\^^S="225B % \cup -\mathcode`\^^T="0238 % \forall -\mathcode`\^^U="0239 % \exists -\mathcode`\^^V="220A % \otimes -\mathcode`\^^W="3224 % \leftrightarrow -\mathcode`\^^X="3220 % \leftarrow -\mathcode`\^^Y="3221 % \rightarrow -\mathcode`\^^Z="8000 % \ne -\mathcode`\^^[="2205 % \diamond -\mathcode`\^^\="3214 % \le -\mathcode`\^^]="3215 % \ge -\mathcode`\^^^="3211 % \equiv -\mathcode`\^^_="225F % \lor -\mathcode`\ ="8000 % \space -\mathcode`\!="5021 -\mathcode`\'="8000 % ^\prime -\mathcode`\(="4028 -\mathcode`\)="5029 -\mathcode`\*="2203 % \ast -\mathcode`\+="202B -\mathcode`\,="613B -\mathcode`\-="2200 -\mathcode`\.="013A -\mathcode`\/="013D -\mathcode`\:="303A -\mathcode`\;="603B -\mathcode`\<="313C -\mathcode`\=="303D -\mathcode`\>="313E -\mathcode`\?="503F -\mathcode`\[="405B -\mathcode`\\="026E % \backslash -\mathcode`\]="505D -\mathcode`\_="8000 % \_ -\mathcode`\{="4266 -\mathcode`\|="026A -\mathcode`\}="5267 -\mathcode`\^^?="1273 % \smallint - -% INITEX sets \uccode`x=`X and \uccode `X=`X for all letters x, -% and \lccode`x=`x, \lccode`X=`x; all other values are zero. -% No changes to those tables are needed in plain TeX format. - -% INITEX sets \sfcode x=1000 for all x, except that \sfcode`X=999 -% for uppercase letters. The following changes are needed: -\sfcode`\)=0 \sfcode`\'=0 \sfcode`\]=0 -% The \nonfrenchspacing macro will make further changes to \sfcode values. - -% Finally, INITEX sets all \delcode values to -1, except \delcode`.=0 -\delcode`\(="028300 -\delcode`\)="029301 -\delcode`\[="05B302 -\delcode`\]="05D303 -\delcode`\<="26830A -\delcode`\>="26930B -\delcode`\/="02F30E -\delcode`\|="26A30C -\delcode`\\="26E30F -% N.B. { and } should NOT get delcodes; otherwise parameter grouping fails! - -% To make the plain macros more efficient in time and space, -% several constant values are declared here as control sequences. -% If they were changed, anything could happen; so they are private symbols. -\chardef\@ne=1 -\chardef\tw@=2 -\chardef\thr@@=3 -\chardef\sixt@@n=16 -\chardef\@cclv=255 -\mathchardef\@cclvi=256 -\mathchardef\@m=1000 -\mathchardef\@M=10000 -\mathchardef\@MM=20000 - -% Allocation of registers - -% Here are macros for the automatic allocation of \count, \box, \dimen, -% \skip, \muskip, and \toks registers, as well as \read and \write -% stream numbers, \fam codes, \language codes, and \insert numbers. - -\message{registers,} - -% When a register is used only temporarily, it need not be allocated; -% grouping can be used, making the value previously in the register return -% after the close of the group. The main use of these macros is for -% registers that are defined by one macro and used by others, possibly at -% different nesting levels. All such registers should be defined through -% these macros; otherwise conflicts may occur, especially when two or more -% macro packages are being used at once. - -% The following counters are reserved: -% 0 to 9 page numbering -% 10 count allocation -% 11 dimen allocation -% 12 skip allocation -% 13 muskip allocation -% 14 box allocation -% 15 toks allocation -% 16 read file allocation -% 17 write file allocation -% 18 math family allocation -% 19 language allocation -% 20 insert allocation -% 21 the most recently allocated number -% 22 constant -1 -% New counters are allocated starting with 23, 24, etc. Other registers are -% allocated starting with 10. This leaves 0 through 9 for the user to play -% with safely, except that counts 0 to 9 are considered to be the page and -% subpage numbers (since they are displayed during output). In this scheme, -% \count 10 always contains the number of the highest-numbered counter that -% has been allocated, \count 14 the highest-numbered box, etc. -% Inserts are given numbers 254, 253, etc., since they require a \count, -% \dimen, \skip, and \box all with the same number; \count 20 contains the -% lowest-numbered insert that has been allocated. Of course, \box255 is -% reserved for \output; \count255, \dimen255, and \skip255 can be used freely. - -% It is recommended that macro designers always use -% \global assignments with respect to registers numbered 1, 3, 5, 7, 9, and -% always non-\global assignments with respect to registers 0, 2, 4, 6, 8, 255. -% This will prevent ``save stack buildup'' that might otherwise occur. - -\count10=22 % allocates \count registers 23, 24, ... -\count11=9 % allocates \dimen registers 10, 11, ... -\count12=9 % allocates \skip registers 10, 11, ... -\count13=9 % allocates \muskip registers 10, 11, ... -\count14=9 % allocates \box registers 10, 11, ... -\count15=9 % allocates \toks registers 10, 11, ... -\count16=-1 % allocates input streams 0, 1, ... -\count17=-1 % allocates output streams 0, 1, ... -\count18=3 % allocates math families 4, 5, ... -\count19=0 % allocates \language codes 1, 2, ... -\count20=255 % allocates insertions 254, 253, ... -\countdef\insc@unt=20 % the insertion counter -\countdef\allocationnumber=21 % the most recent allocation -\countdef\m@ne=22 \m@ne=-1 % a handy constant -\def\wlog{\immediate\write\m@ne} % write on log file (only) - -% Here are abbreviations for the names of scratch registers -% that don't need to be allocated. - -\countdef\count@=255 -\dimendef\dimen@=0 -\dimendef\dimen@i=1 % global only -\dimendef\dimen@ii=2 -\skipdef\skip@=0 -\toksdef\toks@=0 - -% Now, we define \newcount, \newbox, etc. so that you can say \newcount\foo -% and \foo will be defined (with \countdef) to be the next counter. -% To find out which counter \foo is, you can look at \allocationnumber. -% Since there's no \boxdef command, \chardef is used to define a \newbox, -% \newinsert, \newfam, and so on. - -\outer\def\newcount{\alloc@0\count\countdef\insc@unt} -\outer\def\newdimen{\alloc@1\dimen\dimendef\insc@unt} -\outer\def\newskip{\alloc@2\skip\skipdef\insc@unt} -\outer\def\newmuskip{\alloc@3\muskip\muskipdef\@cclvi} -\outer\def\newbox{\alloc@4\box\chardef\insc@unt} -\let\newtoks=\relax % we do this to allow plain.tex to be read in twice -\outer\def\newhelp#1#2{\newtoks#1#1\expandafter{\csname#2\endcsname}} -\outer\def\newtoks{\alloc@5\toks\toksdef\@cclvi} -\outer\def\newread{\alloc@6\read\chardef\sixt@@n} -\outer\def\newwrite{\alloc@7\write\chardef\sixt@@n} -\outer\def\newfam{\alloc@8\fam\chardef\sixt@@n} -\outer\def\newlanguage{\alloc@9\language\chardef\@cclvi} -\def\alloc@#1#2#3#4#5{\global\advance\count1#1by\@ne - \ch@ck#1#4#2% make sure there's still room - \allocationnumber=\count1#1% - \global#3#5=\allocationnumber - \wlog{\string#5=\string#2\the\allocationnumber}} -\outer\def\newinsert#1{\global\advance\insc@unt by\m@ne - \ch@ck0\insc@unt\count - \ch@ck1\insc@unt\dimen - \ch@ck2\insc@unt\skip - \ch@ck4\insc@unt\box - \allocationnumber=\insc@unt - \global\chardef#1=\allocationnumber - \wlog{\string#1=\string\insert\the\allocationnumber}} -\def\ch@ck#1#2#3{\ifnum\count1#1<#2% - \else\errmessage{No room for a new #3}\fi} - -% Here are some examples of allocation. -\newdimen\maxdimen \maxdimen=16383.99999pt % the largest legal <dimen> -\newskip\hideskip \hideskip=-1000pt plus 1fill % negative but can grow -\newskip\centering \centering=0pt plus 1000pt minus 1000pt -\newdimen\p@ \p@=1pt % this saves macro space and time -\newdimen\z@ \z@=0pt % can be used both for 0pt and 0 -\newskip\z@skip \z@skip=0pt plus0pt minus0pt -\newbox\voidb@x % permanently void box register - -% And here's a different sort of allocation: -% For example, \newif\iffoo creates \footrue, \foofalse to go with \iffoo. -\outer\def\newif#1{\count@\escapechar \escapechar\m@ne - \expandafter\expandafter\expandafter - \def\@if#1{true}{\let#1=\iftrue}% - \expandafter\expandafter\expandafter - \def\@if#1{false}{\let#1=\iffalse}% - \@if#1{false}\escapechar\count@} % the condition starts out false -\def\@if#1#2{\csname\expandafter\if@\string#1#2\endcsname} -{\uccode`1=`i \uccode`2=`f \uppercase{\gdef\if@12{}}} % `if' is required - -% Assign initial values to TeX's parameters - -\message{parameters,} - -% All of TeX's numeric parameters are listed here, -% but the code is commented out if no special value needs to be set. -% INITEX makes all parameters zero except where noted. - -\pretolerance=100 -\tolerance=200 % INITEX sets this to 10000 -\hbadness=1000 -\vbadness=1000 -\linepenalty=10 -\hyphenpenalty=50 -\exhyphenpenalty=50 -\binoppenalty=700 -\relpenalty=500 -\clubpenalty=150 -\widowpenalty=150 -\displaywidowpenalty=50 -\brokenpenalty=100 -\predisplaypenalty=10000 -% \postdisplaypenalty=0 -% \interlinepenalty=0 -% \floatingpenalty=0, set during \insert -% \outputpenalty=0, set before TeX enters \output -\doublehyphendemerits=10000 -\finalhyphendemerits=5000 -\adjdemerits=10000 -% \looseness=0, cleared by TeX after each paragraph -% \pausing=0 -% \holdinginserts=0 -% \tracingonline=0 -% \tracingmacros=0 -% \tracingstats=0 -% \tracingparagraphs=0 -% \tracingpages=0 -% \tracingoutput=0 -\tracinglostchars=1 -% \tracingcommands=0 -% \tracingrestores=0 -% \language=0 -\uchyph=1 -% \lefthyphenmin=2 \righthyphenmin=3 set below -% \globaldefs=0 -% \maxdeadcycles=25 % INITEX does this -% \hangafter=1 % INITEX does this, also TeX after each paragraph -% \fam=0 -% \mag=1000 % INITEX does this -% \escapechar=`\\ % INITEX does this -\defaulthyphenchar=`\- -\defaultskewchar=-1 -% \endlinechar=`\^^M % INITEX does this -\newlinechar=-1 -\delimiterfactor=901 -% \time=now % TeX does this at beginning of job -% \day=now % TeX does this at beginning of job -% \month=now % TeX does this at beginning of job -% \year=now % TeX does this at beginning of job -\showboxbreadth=5 -\showboxdepth=3 -\errorcontextlines=5 - -\hfuzz=0.1pt -\vfuzz=0.1pt -\overfullrule=5pt -\hsize=6.5in -\vsize=8.9in -\maxdepth=4pt -\splitmaxdepth=\maxdimen -\boxmaxdepth=\maxdimen -% \lineskiplimit=0pt, changed by \normalbaselines -\delimitershortfall=5pt -\nulldelimiterspace=1.2pt -\scriptspace=0.5pt -% \mathsurround=0pt -% \predisplaysize=0pt, set before TeX enters $$ -% \displaywidth=0pt, set before TeX enters $$ -% \displayindent=0pt, set before TeX enters $$ -\parindent=20pt -% \hangindent=0pt, zeroed by TeX after each paragraph -% \hoffset=0pt -% \voffset=0pt - -% \baselineskip=0pt, changed by \normalbaselines -% \lineskip=0pt, changed by \normalbaselines -\parskip=0pt plus 1pt -\abovedisplayskip=12pt plus 3pt minus 9pt -\abovedisplayshortskip=0pt plus 3pt -\belowdisplayskip=12pt plus 3pt minus 9pt -\belowdisplayshortskip=7pt plus 3pt minus 4pt -% \leftskip=0pt -% \rightskip=0pt -\topskip=10pt -\splittopskip=10pt -% \tabskip=0pt -% \spaceskip=0pt -% \xspaceskip=0pt -\parfillskip=0pt plus 1fil - -\thinmuskip=3mu -\medmuskip=4mu plus 2mu minus 4mu -\thickmuskip=5mu plus 5mu - -% We also define special registers that function like parameters: -\newskip\smallskipamount \smallskipamount=3pt plus 1pt minus 1pt -\newskip\medskipamount \medskipamount=6pt plus 2pt minus 2pt -\newskip\bigskipamount \bigskipamount=12pt plus 4pt minus 4pt -\newskip\normalbaselineskip \normalbaselineskip=12pt -\newskip\normallineskip \normallineskip=1pt -\newdimen\normallineskiplimit \normallineskiplimit=0pt -\newdimen\jot \jot=3pt -\newcount\interdisplaylinepenalty \interdisplaylinepenalty=100 -\newcount\interfootnotelinepenalty \interfootnotelinepenalty=100 - -% Definitions for preloaded fonts - -\def\magstephalf{1095 } -\def\magstep#1{\ifcase#1 \@m\or 1200\or 1440\or 1728\or 2074\or 2488\fi\relax} - -% Fonts assigned to \preloaded are not part of "plain TeX", -% but they are preloaded so that other format packages can use them. -% For example, if another set of macros says "\font\ninerm=cmr9", -% TeX will not have to reload the font metric information for cmr9. - -\message{fonts,} - -\font\tenrm=cmr10 % roman text -\font\preloaded=cmr9 -\font\preloaded=cmr8 -\font\sevenrm=cmr7 -\font\preloaded=cmr6 -\font\fiverm=cmr5 - -\font\teni=cmmi10 % math italic -\font\preloaded=cmmi9 -\font\preloaded=cmmi8 -\font\seveni=cmmi7 -\font\preloaded=cmmi6 -\font\fivei=cmmi5 - -\font\tensy=cmsy10 % math symbols -\font\preloaded=cmsy9 -\font\preloaded=cmsy8 -\font\sevensy=cmsy7 -\font\preloaded=cmsy6 -\font\fivesy=cmsy5 - -\font\tenex=cmex10 % math extension - -\font\preloaded=cmss10 % sans serif -\font\preloaded=cmssq8 - -\font\preloaded=cmssi10 % sans serif italic -\font\preloaded=cmssqi8 - -\font\tenbf=cmbx10 % boldface extended -\font\preloaded=cmbx9 -\font\preloaded=cmbx8 -\font\sevenbf=cmbx7 -\font\preloaded=cmbx6 -\font\fivebf=cmbx5 - -\font\tentt=cmtt10 % typewriter -\font\preloaded=cmtt9 -\font\preloaded=cmtt8 - -\font\preloaded=cmsltt10 % slanted typewriter - -\font\tensl=cmsl10 % slanted roman -\font\preloaded=cmsl9 -\font\preloaded=cmsl8 - -\font\tenit=cmti10 % text italic -\font\preloaded=cmti9 -\font\preloaded=cmti8 -\font\preloaded=cmti7 - -\message{more fonts,} -\font\preloaded=cmu10 % unslanted text italic - -\font\preloaded=cmmib10 % bold math italic -\font\preloaded=cmbsy10 % bold math symbols - -\font\preloaded=cmcsc10 % caps and small caps - -\font\preloaded=cmssbx10 % sans serif bold extended - -\font\preloaded=cmdunh10 % Dunhill style - -\font\preloaded=cmr7 scaled \magstep4 % for titles -\font\preloaded=cmtt10 scaled \magstep2 -\font\preloaded=cmssbx10 scaled \magstep2 - -\font\preloaded=manfnt % METAFONT logo and dragon curve and special symbols - -% Additional \preloaded fonts can be specified here. -% (And those that were \preloaded above can be eliminated.) - -\let\preloaded=\undefined % preloaded fonts must be declared anew later. - -\skewchar\teni='177 \skewchar\seveni='177 \skewchar\fivei='177 -\skewchar\tensy='60 \skewchar\sevensy='60 \skewchar\fivesy='60 - -\textfont0=\tenrm \scriptfont0=\sevenrm \scriptscriptfont0=\fiverm -\def\rm{\fam\z@\tenrm} -\textfont1=\teni \scriptfont1=\seveni \scriptscriptfont1=\fivei -\def\mit{\fam\@ne} \def\oldstyle{\fam\@ne\teni} -\textfont2=\tensy \scriptfont2=\sevensy \scriptscriptfont2=\fivesy -\def\cal{\fam\tw@} -\textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex -\newfam\itfam \def\it{\fam\itfam\tenit} % \it is family 4 -\textfont\itfam=\tenit -\newfam\slfam \def\sl{\fam\slfam\tensl} % \sl is family 5 -\textfont\slfam=\tensl -\newfam\bffam \def\bf{\fam\bffam\tenbf} % \bf is family 6 -\textfont\bffam=\tenbf \scriptfont\bffam=\sevenbf -\scriptscriptfont\bffam=\fivebf -\newfam\ttfam \def\tt{\fam\ttfam\tentt} % \tt is family 7 -\textfont\ttfam=\tentt - -% Macros for setting ordinary text -\message{macros,} - -\def\frenchspacing{\sfcode`\.\@m \sfcode`\?\@m \sfcode`\!\@m - \sfcode`\:\@m \sfcode`\;\@m \sfcode`\,\@m} -\def\nonfrenchspacing{\sfcode`\.3000\sfcode`\?3000\sfcode`\!3000% - \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 } - -\def\normalbaselines{\lineskip\normallineskip - \baselineskip\normalbaselineskip \lineskiplimit\normallineskiplimit} - -\def\^^M{\ } % control <return> = control <space> -\def\^^I{\ } % same for <tab> - -\def\lq{`} \def\rq{'} -\def\lbrack{[} \def\rbrack{]} - -\let\endgraf=\par \let\endline=\cr - -\def\space{ } -\def\empty{} -\def\null{\hbox{}} - -\let\bgroup={ \let\egroup=} - -% In \obeylines, we say `\let^^M=\par' instead of `\def^^M{\par}' -% since this allows, for example, `\let\par=\cr \obeylines \halign{...' -{\catcode`\^^M=\active % these lines must end with % - \gdef\obeylines{\catcode`\^^M\active \let^^M\par}% - \global\let^^M\par} % this is in case ^^M appears in a \write -\def\obeyspaces{\catcode`\ \active} -{\obeyspaces\global\let =\space} - -\def\loop#1\repeat{\def\body{#1}\iterate} -\def\iterate{\body \let\next\iterate \else\let\next\relax\fi \next} -\let\repeat=\fi % this makes \loop...\if...\repeat skippable - -\def\thinspace{\kern .16667em } -\def\negthinspace{\kern-.16667em } -\def\enspace{\kern.5em } - -\def\enskip{\hskip.5em\relax} -\def\quad{\hskip1em\relax} -\def\qquad{\hskip2em\relax} - -\def\smallskip{\vskip\smallskipamount} -\def\medskip{\vskip\medskipamount} -\def\bigskip{\vskip\bigskipamount} - -\def\nointerlineskip{\prevdepth-1000\p@} -\def\offinterlineskip{\baselineskip-1000\p@ - \lineskip\z@ \lineskiplimit\maxdimen} - -\def\topglue{\nointerlineskip\vglue-\topskip\vglue} % for top of page -\def\vglue{\afterassignment\vgl@\skip@=} -\def\vgl@{\par \dimen@\prevdepth \hrule height\z@ - \nobreak\vskip\skip@ \prevdepth\dimen@} -\def\hglue{\afterassignment\hgl@\skip@=} -\def\hgl@{\leavevmode \count@\spacefactor \vrule width\z@ - \nobreak\hskip\skip@ \spacefactor\count@} - -\def~{\penalty\@M \ } % tie -\def\slash{/\penalty\exhyphenpenalty} % a `/' that acts like a `-' - -\def\break{\penalty-\@M} -\def\nobreak{\penalty \@M} -\def\allowbreak{\penalty \z@} - -\def\filbreak{\par\vfil\penalty-200\vfilneg} -\def\goodbreak{\par\penalty-500 } -\def\eject{\par\break} -\def\supereject{\par\penalty-\@MM} - -\def\removelastskip{\ifdim\lastskip=\z@\else\vskip-\lastskip\fi} -\def\smallbreak{\par\ifdim\lastskip<\smallskipamount - \removelastskip\penalty-50\smallskip\fi} -\def\medbreak{\par\ifdim\lastskip<\medskipamount - \removelastskip\penalty-100\medskip\fi} -\def\bigbreak{\par\ifdim\lastskip<\bigskipamount - \removelastskip\penalty-200\bigskip\fi} - -\def\line{\hbox to\hsize} -\def\leftline#1{\line{#1\hss}} -\def\rightline#1{\line{\hss#1}} -\def\centerline#1{\line{\hss#1\hss}} - -\def\rlap#1{\hbox to\z@{#1\hss}} -\def\llap#1{\hbox to\z@{\hss#1}} - -\def\m@th{\mathsurround\z@} -\def\underbar#1{$\setbox\z@\hbox{#1}\dp\z@\z@ - \m@th \underline{\box\z@}$} - -\newbox\strutbox -\setbox\strutbox=\hbox{\vrule height8.5pt depth3.5pt width\z@} -\def\strut{\relax\ifmmode\copy\strutbox\else\unhcopy\strutbox\fi} - -\def\hidewidth{\hskip\hideskip} % for alignment entries that can stick out -\def\ialign{\everycr{}\tabskip\z@skip\halign} % initialized \halign -\newcount\mscount -\def\multispan#1{\omit \mscount#1\relax - \loop\ifnum\mscount>\@ne \sp@n\repeat} -\def\sp@n{\span\omit\advance\mscount\m@ne} - -\newif\ifus@ \newif\if@cr -\newbox\tabs \newbox\tabsyet \newbox\tabsdone - -\def\cleartabs{\global\setbox\tabsyet\null \setbox\tabs\null} -\def\settabs{\setbox\tabs\null \futurelet\next\sett@b} -\let\+=\relax % in case this file is being read in twice -\def\sett@b{\ifx\next\+\def\nxt{\afterassignment\s@tt@b\let\nxt}% - \else\let\nxt\s@tcols\fi \let\next\relax \nxt} -\def\s@tt@b{\let\nxt\relax \us@false\m@ketabbox} -\def\tabalign{\us@true\m@ketabbox} % non-\outer version of \+ -\outer\def\+{\tabalign} -\def\s@tcols#1\columns{\count@#1\dimen@\hsize - \loop\ifnum\count@>\z@ \@nother \repeat} -\def\@nother{\dimen@ii\dimen@ \divide\dimen@ii\count@ - \setbox\tabs\hbox{\hbox to\dimen@ii{}\unhbox\tabs}% - \advance\dimen@-\dimen@ii \advance\count@\m@ne} - -\def\m@ketabbox{\begingroup - \global\setbox\tabsyet\copy\tabs - \global\setbox\tabsdone\null - \def\cr{\@crtrue\crcr\egroup\egroup - \ifus@\unvbox\z@\lastbox\fi\endgroup - \setbox\tabs\hbox{\unhbox\tabsyet\unhbox\tabsdone}}% - \setbox\z@\vbox\bgroup\@crfalse - \ialign\bgroup&\t@bbox##\t@bb@x\crcr} - -\def\t@bbox{\setbox\z@\hbox\bgroup} -\def\t@bb@x{\if@cr\egroup % now \box\z@ holds the column - \else\hss\egroup \global\setbox\tabsyet\hbox{\unhbox\tabsyet - \global\setbox\@ne\lastbox}% now \box\@ne holds its size - \ifvoid\@ne\global\setbox\@ne\hbox to\wd\z@{}% - \else\setbox\z@\hbox to\wd\@ne{\unhbox\z@}\fi - \global\setbox\tabsdone\hbox{\box\@ne\unhbox\tabsdone}\fi - \box\z@} - -\def\hang{\hangindent\parindent} -\def\textindent#1{\indent\llap{#1\enspace}\ignorespaces} -\def\item{\par\hang\textindent} -\def\itemitem{\par\indent \hangindent2\parindent \textindent} -\def\narrower{\advance\leftskip\parindent - \advance\rightskip\parindent} - -\outer\def\beginsection#1\par{\vskip\z@ plus.3\vsize\penalty-250 - \vskip\z@ plus-.3\vsize\bigskip\vskip\parskip - \message{#1}\leftline{\bf#1}\nobreak\smallskip\noindent} -\outer\def\proclaim #1. #2\par{\medbreak - \noindent{\bf#1.\enspace}{\sl#2\par}% - \ifdim\lastskip<\medskipamount \removelastskip\penalty55\medskip\fi} - -\def\raggedright{\rightskip\z@ plus2em \spaceskip.3333em \xspaceskip.5em\relax} -\def\ttraggedright{\tt\rightskip\z@ plus2em\relax} % for use with \tt only - -\chardef\%=`\% -\chardef\&=`\& -\chardef\#=`\# -\chardef\$=`\$ -\chardef\ss="19 -\chardef\ae="1A -\chardef\oe="1B -\chardef\o="1C -\chardef\AE="1D -\chardef\OE="1E -\chardef\O="1F -\chardef\i="10 \chardef\j="11 % dotless letters -\def\aa{\accent23a} -\def\l{\char32l} -\def\L{\leavevmode\setbox0\hbox{L}\hbox to\wd0{\hss\char32L}} - -\def\leavevmode{\unhbox\voidb@x} % begins a paragraph, if necessary -\def\_{\leavevmode \kern.06em \vbox{\hrule width.3em}} -\def\AA{\leavevmode\setbox0\hbox{!}\dimen@\ht0\advance\dimen@-1ex% - \rlap{\raise.67\dimen@\hbox{\char'27}}A} - -\def\mathhexbox#1#2#3{\leavevmode - \hbox{$\m@th \mathchar"#1#2#3$}} -\def\dag{\mathhexbox279} -\def\ddag{\mathhexbox27A} -\def\S{\mathhexbox278} -\def\P{\mathhexbox27B} -\def\Orb{\mathhexbox20D} - -\def\oalign#1{\leavevmode\vtop{\baselineskip\z@skip \lineskip.25ex% - \ialign{##\crcr#1\crcr}}} \def\o@lign{\lineskiplimit\z@ \oalign} -\def\ooalign{\lineskiplimit-\maxdimen \oalign} % chars over each other -{\catcode`p=12 \catcode`t=12 \gdef\\#1pt{#1}} \let\getf@ctor=\\ -\def\sh@ft#1{\dimen@#1\kern\expandafter\getf@ctor\the\fontdimen1\font - \dimen@} % kern by #1 times the current slant -\def\d#1{{\o@lign{\relax#1\crcr\hidewidth\sh@ft{-1ex}.\hidewidth}}} -\def\b#1{{\o@lign{\relax#1\crcr\hidewidth\sh@ft{-3ex}% - \vbox to.2ex{\hbox{\char22}\vss}\hidewidth}}} -\def\c#1{{\setbox\z@\hbox{#1}\ifdim\ht\z@=1ex\accent24 #1% - \else\ooalign{\unhbox\z@\crcr\hidewidth\char24\hidewidth}\fi}} -\def\copyright{{\ooalign{\hfil\raise.07ex\hbox{c}\hfil\crcr\Orb}}} - -\def\dots{\relax\ifmmode\ldots\else$\m@th\ldots\,$\fi} -\def\TeX{T\kern-.1667em\lower.5ex\hbox{E}\kern-.125emX} - -\def\`#1{{\accent18 #1}} -\def\'#1{{\accent19 #1}} -\def\v#1{{\accent20 #1}} \let\^^_=\v -\def\u#1{{\accent21 #1}} \let\^^S=\u -\def\=#1{{\accent22 #1}} -\def\^#1{{\accent94 #1}} \let\^^D=\^ -\def\.#1{{\accent95 #1}} -\def\H#1{{\accent"7D #1}} -\def\~#1{{\accent"7E #1}} -\def\"#1{{\accent"7F #1}} -\def\t#1{{\edef\next{\the\font}\the\textfont1\accent"7F\next#1}} - -\def\hrulefill{\leaders\hrule\hfill} -\def\dotfill{\cleaders\hbox{$\m@th \mkern1.5mu.\mkern1.5mu$}\hfill} -\def\rightarrowfill{$\m@th\smash-\mkern-7mu% - \cleaders\hbox{$\mkern-2mu\smash-\mkern-2mu$}\hfill - \mkern-7mu\mathord\rightarrow$} -\def\leftarrowfill{$\m@th\mathord\leftarrow\mkern-7mu% - \cleaders\hbox{$\mkern-2mu\smash-\mkern-2mu$}\hfill - \mkern-7mu\smash-$} -\mathchardef\braceld="37A \mathchardef\bracerd="37B -\mathchardef\bracelu="37C \mathchardef\braceru="37D -\def\downbracefill{$\m@th \setbox\z@\hbox{$\braceld$}% - \braceld\leaders\vrule height\ht\z@ depth\z@\hfill\braceru - \bracelu\leaders\vrule height\ht\z@ depth\z@\hfill\bracerd$} -\def\upbracefill{$\m@th \setbox\z@\hbox{$\braceld$}% - \bracelu\leaders\vrule height\ht\z@ depth\z@\hfill\bracerd - \braceld\leaders\vrule height\ht\z@ depth\z@\hfill\braceru$} - -\outer\def\bye{\par\vfill\supereject\end} - -% Macros for math setting -\message{math definitions,} - -\let\sp=^ \let\sb=_ -\def\,{\mskip\thinmuskip} -\def\>{\mskip\medmuskip} -\def\;{\mskip\thickmuskip} -\def\!{\mskip-\thinmuskip} -\def\*{\discretionary{\thinspace\the\textfont2\char2}{}{}} -{\catcode`\'=\active \gdef'{^\bgroup\prim@s}} -\def\prim@s{\prime\futurelet\next\pr@m@s} -\def\pr@m@s{\ifx'\next\let\nxt\pr@@@s \else\ifx^\next\let\nxt\pr@@@t - \else\let\nxt\egroup\fi\fi \nxt} -\def\pr@@@s#1{\prim@s} \def\pr@@@t#1#2{#2\egroup} -{\catcode`\^^Z=\active \gdef^^Z{\not=}} % ^^Z is like \ne in math - -{\catcode`\_=\active \global\let_=\_} % _ in math is either subscript or \_ - -\mathchardef\alpha="010B -\mathchardef\beta="010C -\mathchardef\gamma="010D -\mathchardef\delta="010E -\mathchardef\epsilon="010F -\mathchardef\zeta="0110 -\mathchardef\eta="0111 -\mathchardef\theta="0112 -\mathchardef\iota="0113 -\mathchardef\kappa="0114 -\mathchardef\lambda="0115 -\mathchardef\mu="0116 -\mathchardef\nu="0117 -\mathchardef\xi="0118 -\mathchardef\pi="0119 -\mathchardef\rho="011A -\mathchardef\sigma="011B -\mathchardef\tau="011C -\mathchardef\upsilon="011D -\mathchardef\phi="011E -\mathchardef\chi="011F -\mathchardef\psi="0120 -\mathchardef\omega="0121 -\mathchardef\varepsilon="0122 -\mathchardef\vartheta="0123 -\mathchardef\varpi="0124 -\mathchardef\varrho="0125 -\mathchardef\varsigma="0126 -\mathchardef\varphi="0127 -\mathchardef\Gamma="7000 -\mathchardef\Delta="7001 -\mathchardef\Theta="7002 -\mathchardef\Lambda="7003 -\mathchardef\Xi="7004 -\mathchardef\Pi="7005 -\mathchardef\Sigma="7006 -\mathchardef\Upsilon="7007 -\mathchardef\Phi="7008 -\mathchardef\Psi="7009 -\mathchardef\Omega="700A - -\mathchardef\aleph="0240 -\def\hbar{{\mathchar'26\mkern-9muh}} -\mathchardef\imath="017B -\mathchardef\jmath="017C -\mathchardef\ell="0160 -\mathchardef\wp="017D -\mathchardef\Re="023C -\mathchardef\Im="023D -\mathchardef\partial="0140 -\mathchardef\infty="0231 -\mathchardef\prime="0230 -\mathchardef\emptyset="023B -\mathchardef\nabla="0272 -\def\surd{{\mathchar"1270}} -\mathchardef\top="023E -\mathchardef\bot="023F -\def\angle{{\vbox{\ialign{$\m@th\scriptstyle##$\crcr - \not\mathrel{\mkern14mu}\crcr - \noalign{\nointerlineskip} - \mkern2.5mu\leaders\hrule height.34pt\hfill\mkern2.5mu\crcr}}}} -\mathchardef\triangle="0234 -\mathchardef\forall="0238 -\mathchardef\exists="0239 -\mathchardef\neg="023A \let\lnot=\neg -\mathchardef\flat="015B -\mathchardef\natural="015C -\mathchardef\sharp="015D -\mathchardef\clubsuit="027C -\mathchardef\diamondsuit="027D -\mathchardef\heartsuit="027E -\mathchardef\spadesuit="027F - -\mathchardef\coprod="1360 -\mathchardef\bigvee="1357 -\mathchardef\bigwedge="1356 -\mathchardef\biguplus="1355 -\mathchardef\bigcap="1354 -\mathchardef\bigcup="1353 -\mathchardef\intop="1352 \def\int{\intop\nolimits} -\mathchardef\prod="1351 -\mathchardef\sum="1350 -\mathchardef\bigotimes="134E -\mathchardef\bigoplus="134C -\mathchardef\bigodot="134A -\mathchardef\ointop="1348 \def\oint{\ointop\nolimits} -\mathchardef\bigsqcup="1346 -\mathchardef\smallint="1273 - -\mathchardef\triangleleft="212F -\mathchardef\triangleright="212E -\mathchardef\bigtriangleup="2234 -\mathchardef\bigtriangledown="2235 -\mathchardef\wedge="225E \let\land=\wedge -\mathchardef\vee="225F \let\lor=\vee -\mathchardef\cap="225C -\mathchardef\cup="225B -\mathchardef\ddagger="227A -\mathchardef\dagger="2279 -\mathchardef\sqcap="2275 -\mathchardef\sqcup="2274 -\mathchardef\uplus="225D -\mathchardef\amalg="2271 -\mathchardef\diamond="2205 -\mathchardef\bullet="220F -\mathchardef\wr="226F -\mathchardef\div="2204 -\mathchardef\odot="220C -\mathchardef\oslash="220B -\mathchardef\otimes="220A -\mathchardef\ominus="2209 -\mathchardef\oplus="2208 -\mathchardef\mp="2207 -\mathchardef\pm="2206 -\mathchardef\circ="220E -\mathchardef\bigcirc="220D -\mathchardef\setminus="226E % for set difference A\setminus B -\mathchardef\cdot="2201 -\mathchardef\ast="2203 -\mathchardef\times="2202 -\mathchardef\star="213F - -\mathchardef\propto="322F -\mathchardef\sqsubseteq="3276 -\mathchardef\sqsupseteq="3277 -\mathchardef\parallel="326B -\mathchardef\mid="326A -\mathchardef\dashv="3261 -\mathchardef\vdash="3260 -\mathchardef\nearrow="3225 -\mathchardef\searrow="3226 -\mathchardef\nwarrow="322D -\mathchardef\swarrow="322E -\mathchardef\Leftrightarrow="322C -\mathchardef\Leftarrow="3228 -\mathchardef\Rightarrow="3229 -\def\neq{\not=} \let\ne=\neq -\mathchardef\leq="3214 \let\le=\leq -\mathchardef\geq="3215 \let\ge=\geq -\mathchardef\succ="321F -\mathchardef\prec="321E -\mathchardef\approx="3219 -\mathchardef\succeq="3217 -\mathchardef\preceq="3216 -\mathchardef\supset="321B -\mathchardef\subset="321A -\mathchardef\supseteq="3213 -\mathchardef\subseteq="3212 -\mathchardef\in="3232 -\mathchardef\ni="3233 \let\owns=\ni -\mathchardef\gg="321D -\mathchardef\ll="321C -\mathchardef\not="3236 -\mathchardef\leftrightarrow="3224 -\mathchardef\leftarrow="3220 \let\gets=\leftarrow -\mathchardef\rightarrow="3221 \let\to=\rightarrow -\mathchardef\mapstochar="3237 \def\mapsto{\mapstochar\rightarrow} -\mathchardef\sim="3218 -\mathchardef\simeq="3227 -\mathchardef\perp="323F -\mathchardef\equiv="3211 -\mathchardef\asymp="3210 -\mathchardef\smile="315E -\mathchardef\frown="315F -\mathchardef\leftharpoonup="3128 -\mathchardef\leftharpoondown="3129 -\mathchardef\rightharpoonup="312A -\mathchardef\rightharpoondown="312B - -\def\joinrel{\mathrel{\mkern-3mu}} -\def\relbar{\mathrel{\smash-}} % \smash, because - has the same height as + -\def\Relbar{\mathrel=} -\mathchardef\lhook="312C \def\hookrightarrow{\lhook\joinrel\rightarrow} -\mathchardef\rhook="312D \def\hookleftarrow{\leftarrow\joinrel\rhook} -\def\bowtie{\mathrel\triangleright\joinrel\mathrel\triangleleft} -\def\models{\mathrel|\joinrel=} -\def\Longrightarrow{\Relbar\joinrel\Rightarrow} -\def\longrightarrow{\relbar\joinrel\rightarrow} -\def\longleftarrow{\leftarrow\joinrel\relbar} -\def\Longleftarrow{\Leftarrow\joinrel\Relbar} -\def\longmapsto{\mapstochar\longrightarrow} -\def\longleftrightarrow{\leftarrow\joinrel\rightarrow} -\def\Longleftrightarrow{\Leftarrow\joinrel\Rightarrow} -\def\iff{\;\Longleftrightarrow\;} - -\mathchardef\ldotp="613A % ldot as a punctuation mark -\mathchardef\cdotp="6201 % cdot as a punctuation mark -\mathchardef\colon="603A % colon as a punctuation mark -\def\ldots{\mathinner{\ldotp\ldotp\ldotp}} -\def\cdots{\mathinner{\cdotp\cdotp\cdotp}} -\def\vdots{\vbox{\baselineskip4\p@ \lineskiplimit\z@ - \kern6\p@\hbox{.}\hbox{.}\hbox{.}}} -\def\ddots{\mathinner{\mkern1mu\raise7\p@\vbox{\kern7\p@\hbox{.}}\mkern2mu - \raise4\p@\hbox{.}\mkern2mu\raise\p@\hbox{.}\mkern1mu}} - -\def\acute{\mathaccent"7013 } -\def\grave{\mathaccent"7012 } -\def\ddot{\mathaccent"707F } -\def\tilde{\mathaccent"707E } -\def\bar{\mathaccent"7016 } -\def\breve{\mathaccent"7015 } -\def\check{\mathaccent"7014 } -\def\hat{\mathaccent"705E } -\def\vec{\mathaccent"017E } -\def\dot{\mathaccent"705F } -\def\widetilde{\mathaccent"0365 } -\def\widehat{\mathaccent"0362 } -\def\overrightarrow#1{\vbox{\m@th\ialign{##\crcr - \rightarrowfill\crcr\noalign{\kern-\p@\nointerlineskip} - $\hfil\displaystyle{#1}\hfil$\crcr}}} -\def\overleftarrow#1{\vbox{\m@th\ialign{##\crcr - \leftarrowfill\crcr\noalign{\kern-\p@\nointerlineskip} - $\hfil\displaystyle{#1}\hfil$\crcr}}} -\def\overbrace#1{\mathop{\vbox{\m@th\ialign{##\crcr\noalign{\kern3\p@} - \downbracefill\crcr\noalign{\kern3\p@\nointerlineskip} - $\hfil\displaystyle{#1}\hfil$\crcr}}}\limits} -\def\underbrace#1{\mathop{\vtop{\m@th\ialign{##\crcr - $\hfil\displaystyle{#1}\hfil$\crcr\noalign{\kern3\p@\nointerlineskip} - \upbracefill\crcr\noalign{\kern3\p@}}}}\limits} -\def\skew#1#2#3{{\muskip\z@#1mu\divide\muskip\z@\tw@ \mkern\muskip\z@ - #2{\mkern-\muskip\z@{#3}\mkern\muskip\z@}\mkern-\muskip\z@}{}} - -\def\lmoustache{\delimiter"437A340 } % top from (, bottom from ) -\def\rmoustache{\delimiter"537B341 } % top from ), bottom from ( -\def\lgroup{\delimiter"462833A } % extensible ( with sharper tips -\def\rgroup{\delimiter"562933B } % extensible ) with sharper tips -\def\arrowvert{\delimiter"26A33C } % arrow without arrowheads -\def\Arrowvert{\delimiter"26B33D } % double arrow without arrowheads -\def\bracevert{\delimiter"77C33E } % the vertical bar that extends braces -\def\Vert{\delimiter"26B30D } \let\|=\Vert -\def\vert{\delimiter"26A30C } -\def\uparrow{\delimiter"3222378 } -\def\downarrow{\delimiter"3223379 } -\def\updownarrow{\delimiter"326C33F } -\def\Uparrow{\delimiter"322A37E } -\def\Downarrow{\delimiter"322B37F } -\def\Updownarrow{\delimiter"326D377 } -\def\backslash{\delimiter"26E30F } % for double coset G\backslash H -\def\rangle{\delimiter"526930B } -\def\langle{\delimiter"426830A } -\def\rbrace{\delimiter"5267309 } \let\}=\rbrace -\def\lbrace{\delimiter"4266308 } \let\{=\lbrace -\def\rceil{\delimiter"5265307 } -\def\lceil{\delimiter"4264306 } -\def\rfloor{\delimiter"5263305 } -\def\lfloor{\delimiter"4262304 } - -\def\bigl{\mathopen\big} -\def\bigm{\mathrel\big} -\def\bigr{\mathclose\big} -\def\Bigl{\mathopen\Big} -\def\Bigm{\mathrel\Big} -\def\Bigr{\mathclose\Big} -\def\biggl{\mathopen\bigg} -\def\biggm{\mathrel\bigg} -\def\biggr{\mathclose\bigg} -\def\Biggl{\mathopen\Bigg} -\def\Biggm{\mathrel\Bigg} -\def\Biggr{\mathclose\Bigg} -\def\big#1{{\hbox{$\left#1\vbox to8.5\p@{}\right.\n@space$}}} -\def\Big#1{{\hbox{$\left#1\vbox to11.5\p@{}\right.\n@space$}}} -\def\bigg#1{{\hbox{$\left#1\vbox to14.5\p@{}\right.\n@space$}}} -\def\Bigg#1{{\hbox{$\left#1\vbox to17.5\p@{}\right.\n@space$}}} -\def\n@space{\nulldelimiterspace\z@ \m@th} - -\def\choose{\atopwithdelims()} -\def\brack{\atopwithdelims[]} -\def\brace{\atopwithdelims\{\}} - -\def\sqrt{\radical"270370 } - -\def\mathpalette#1#2{\mathchoice{#1\displaystyle{#2}}% - {#1\textstyle{#2}}{#1\scriptstyle{#2}}{#1\scriptscriptstyle{#2}}} -\newbox\rootbox -\def\root#1\of{\setbox\rootbox - \hbox{$\m@th\scriptscriptstyle{#1}$}\mathpalette\r@@t} -\def\r@@t#1#2{\setbox\z@\hbox{$\m@th#1\sqrt{#2}$}\dimen@\ht\z@ - \advance\dimen@-\dp\z@ - \mkern5mu\raise.6\dimen@\copy\rootbox \mkern-10mu\box\z@} -\newif\ifv@ \newif\ifh@ -\def\vphantom{\v@true\h@false\ph@nt} -\def\hphantom{\v@false\h@true\ph@nt} -\def\phantom{\v@true\h@true\ph@nt} -\def\ph@nt{\ifmmode\def\next{\mathpalette\mathph@nt}% - \else\let\next\makeph@nt\fi\next} -\def\makeph@nt#1{\setbox\z@\hbox{#1}\finph@nt} -\def\mathph@nt#1#2{\setbox\z@\hbox{$\m@th#1{#2}$}\finph@nt} -\def\finph@nt{\setbox\tw@\null - \ifv@ \ht\tw@\ht\z@ \dp\tw@\dp\z@\fi - \ifh@ \wd\tw@\wd\z@\fi \box\tw@} -\def\mathstrut{\vphantom(} -\def\smash{\relax % \relax, in case this comes first in \halign - \ifmmode\def\next{\mathpalette\mathsm@sh}\else\let\next\makesm@sh - \fi\next} -\def\makesm@sh#1{\setbox\z@\hbox{#1}\finsm@sh} -\def\mathsm@sh#1#2{\setbox\z@\hbox{$\m@th#1{#2}$}\finsm@sh} -\def\finsm@sh{\ht\z@\z@ \dp\z@\z@ \box\z@} - -\def\cong{\mathrel{\mathpalette\@vereq\sim}} % congruence sign -\def\@vereq#1#2{\lower.5\p@\vbox{\lineskiplimit\maxdimen\lineskip-.5\p@ - \ialign{$\m@th#1\hfil##\hfil$\crcr#2\crcr=\crcr}}} -\def\notin{\mathrel{\mathpalette\c@ncel\in}} -\def\c@ncel#1#2{\m@th\ooalign{$\hfil#1\mkern1mu/\hfil$\crcr$#1#2$}} -\def\rightleftharpoons{\mathrel{\mathpalette\rlh@{}}} -\def\rlh@#1{\vcenter{\m@th\hbox{\ooalign{\raise2pt - \hbox{$#1\rightharpoonup$}\crcr - $#1\leftharpoondown$}}}} -\def\buildrel#1\over#2{\mathrel{\mathop{\kern\z@#2}\limits^{#1}}} -\def\doteq{\buildrel\textstyle.\over=} - -\def\log{\mathop{\rm log}\nolimits} -\def\lg{\mathop{\rm lg}\nolimits} -\def\ln{\mathop{\rm ln}\nolimits} -\def\lim{\mathop{\rm lim}} -\def\limsup{\mathop{\rm lim\,sup}} -\def\liminf{\mathop{\rm lim\,inf}} -\def\sin{\mathop{\rm sin}\nolimits} -\def\arcsin{\mathop{\rm arcsin}\nolimits} -\def\sinh{\mathop{\rm sinh}\nolimits} -\def\cos{\mathop{\rm cos}\nolimits} -\def\arccos{\mathop{\rm arccos}\nolimits} -\def\cosh{\mathop{\rm cosh}\nolimits} -\def\tan{\mathop{\rm tan}\nolimits} -\def\arctan{\mathop{\rm arctan}\nolimits} -\def\tanh{\mathop{\rm tanh}\nolimits} -\def\cot{\mathop{\rm cot}\nolimits} -\def\coth{\mathop{\rm coth}\nolimits} -\def\sec{\mathop{\rm sec}\nolimits} -\def\csc{\mathop{\rm csc}\nolimits} -\def\max{\mathop{\rm max}} -\def\min{\mathop{\rm min}} -\def\sup{\mathop{\rm sup}} -\def\inf{\mathop{\rm inf}} -\def\arg{\mathop{\rm arg}\nolimits} -\def\ker{\mathop{\rm ker}\nolimits} -\def\dim{\mathop{\rm dim}\nolimits} -\def\hom{\mathop{\rm hom}\nolimits} -\def\det{\mathop{\rm det}} -\def\exp{\mathop{\rm exp}\nolimits} -\def\Pr{\mathop{\rm Pr}} -\def\gcd{\mathop{\rm gcd}} -\def\deg{\mathop{\rm deg}\nolimits} - -\def\bmod{\nonscript\mskip-\medmuskip\mkern5mu - \mathbin{\rm mod}\penalty900\mkern5mu\nonscript\mskip-\medmuskip} -\def\pmod#1{\allowbreak\mkern18mu({\rm mod}\,\,#1)} - -\def\cases#1{\left\{\,\vcenter{\normalbaselines\m@th - \ialign{$##\hfil$&\quad##\hfil\crcr#1\crcr}}\right.} -\def\matrix#1{\null\,\vcenter{\normalbaselines\m@th - \ialign{\hfil$##$\hfil&&\quad\hfil$##$\hfil\crcr - \mathstrut\crcr\noalign{\kern-\baselineskip} - #1\crcr\mathstrut\crcr\noalign{\kern-\baselineskip}}}\,} -\def\pmatrix#1{\left(\matrix{#1}\right)} -\newdimen\p@renwd -\setbox0=\hbox{\tenex B} \p@renwd=\wd0 % width of the big left ( -\def\bordermatrix#1{\begingroup \m@th - \setbox\z@\vbox{\def\cr{\crcr\noalign{\kern2\p@\global\let\cr\endline}}% - \ialign{$##$\hfil\kern2\p@\kern\p@renwd&\thinspace\hfil$##$\hfil - &&\quad\hfil$##$\hfil\crcr - \omit\strut\hfil\crcr\noalign{\kern-\baselineskip}% - #1\crcr\omit\strut\cr}}% - \setbox\tw@\vbox{\unvcopy\z@\global\setbox\@ne\lastbox}% - \setbox\tw@\hbox{\unhbox\@ne\unskip\global\setbox\@ne\lastbox}% - \setbox\tw@\hbox{$\kern\wd\@ne\kern-\p@renwd\left(\kern-\wd\@ne - \global\setbox\@ne\vbox{\box\@ne\kern2\p@}% - \vcenter{\kern-\ht\@ne\unvbox\z@\kern-\baselineskip}\,\right)$}% - \null\;\vbox{\kern\ht\@ne\box\tw@}\endgroup} - -\def\openup{\afterassignment\@penup\dimen@=} -\def\@penup{\advance\lineskip\dimen@ - \advance\baselineskip\dimen@ - \advance\lineskiplimit\dimen@} -\def\eqalign#1{\null\,\vcenter{\openup\jot\m@th - \ialign{\strut\hfil$\displaystyle{##}$&$\displaystyle{{}##}$\hfil - \crcr#1\crcr}}\,} -\newif\ifdt@p -\def\displ@y{\global\dt@ptrue\openup\jot\m@th - \everycr{\noalign{\ifdt@p \global\dt@pfalse \ifdim\prevdepth>-1000\p@ - \vskip-\lineskiplimit \vskip\normallineskiplimit \fi - \else \penalty\interdisplaylinepenalty \fi}}} -\def\@lign{\tabskip\z@skip\everycr{}} % restore inside \displ@y -\def\displaylines#1{\displ@y \tabskip\z@skip - \halign{\hbox to\displaywidth{$\@lign\hfil\displaystyle##\hfil$}\crcr - #1\crcr}} -\def\eqalignno#1{\displ@y \tabskip\centering - \halign to\displaywidth{\hfil$\@lign\displaystyle{##}$\tabskip\z@skip - &$\@lign\displaystyle{{}##}$\hfil\tabskip\centering - &\llap{$\@lign##$}\tabskip\z@skip\crcr - #1\crcr}} -\def\leqalignno#1{\displ@y \tabskip\centering - \halign to\displaywidth{\hfil$\@lign\displaystyle{##}$\tabskip\z@skip - &$\@lign\displaystyle{{}##}$\hfil\tabskip\centering - &\kern-\displaywidth\rlap{$\@lign##$}\tabskip\displaywidth\crcr - #1\crcr}} - -% Definitions related to output - -\message{output routines,} - -\countdef\pageno=0 \pageno=1 % first page is number 1 -\newtoks\headline \headline={\hfil} % headline is normally blank -\newtoks\footline \footline={\hss\tenrm\folio\hss} - % footline is normally a centered page number in font \tenrm -\newif\ifr@ggedbottom -\def\raggedbottom{\topskip 10\p@ plus60\p@ \r@ggedbottomtrue} -\def\normalbottom{\topskip 10\p@ \r@ggedbottomfalse} % undoes \raggedbottom -\def\folio{\ifnum\pageno<\z@ \romannumeral-\pageno \else\number\pageno \fi} -\def\nopagenumbers{\footline{\hfil}} % blank out the footline -\def\advancepageno{\ifnum\pageno<\z@ \global\advance\pageno\m@ne - \else\global\advance\pageno\@ne \fi} % increase |pageno| - -\newinsert\footins -\def\footnote#1{\let\@sf\empty % parameter #2 (the text) is read later - \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi - #1\@sf\vfootnote{#1}} -\def\vfootnote#1{\insert\footins\bgroup - \interlinepenalty\interfootnotelinepenalty - \splittopskip\ht\strutbox % top baseline for broken footnotes - \splitmaxdepth\dp\strutbox \floatingpenalty\@MM - \leftskip\z@skip \rightskip\z@skip \spaceskip\z@skip \xspaceskip\z@skip - \textindent{#1}\footstrut\futurelet\next\fo@t} -\def\fo@t{\ifcat\bgroup\noexpand\next \let\next\f@@t - \else\let\next\f@t\fi \next} -\def\f@@t{\bgroup\aftergroup\@foot\let\next} -\def\f@t#1{#1\@foot} -\def\@foot{\strut\egroup} -\def\footstrut{\vbox to\splittopskip{}} -\skip\footins=\bigskipamount % space added when footnote is present -\count\footins=1000 % footnote magnification factor (1 to 1) -\dimen\footins=8in % maximum footnotes per page - -\newinsert\topins -\newif\ifp@ge \newif\if@mid -\def\topinsert{\@midfalse\p@gefalse\@ins} -\def\midinsert{\@midtrue\@ins} -\def\pageinsert{\@midfalse\p@getrue\@ins} -\skip\topins=\z@skip % no space added when a topinsert is present -\count\topins=1000 % magnification factor (1 to 1) -\dimen\topins=\maxdimen % no limit per page -\def\@ins{\par\begingroup\setbox\z@\vbox\bgroup} % start a \vbox -\def\endinsert{\egroup % finish the \vbox - \if@mid \dimen@\ht\z@ \advance\dimen@\dp\z@ \advance\dimen@12\p@ - \advance\dimen@\pagetotal \advance\dimen@-\pageshrink - \ifdim\dimen@>\pagegoal\@midfalse\p@gefalse\fi\fi - \if@mid \bigskip\box\z@\bigbreak - \else\insert\topins{\penalty100 % floating insertion - \splittopskip\z@skip - \splitmaxdepth\maxdimen \floatingpenalty\z@ - \ifp@ge \dimen@\dp\z@ - \vbox to\vsize{\unvbox\z@\kern-\dimen@}% depth is zero - \else \box\z@\nobreak\bigskip\fi}\fi\endgroup} - -\output{\plainoutput} -\def\plainoutput{\shipout\vbox{\makeheadline\pagebody\makefootline}% - \advancepageno - \ifnum\outputpenalty>-\@MM \else\dosupereject\fi} -\def\pagebody{\vbox to\vsize{\boxmaxdepth\maxdepth \pagecontents}} -\def\makeheadline{\vbox to\z@{\vskip-22.5\p@ - \line{\vbox to8.5\p@{}\the\headline}\vss}\nointerlineskip} -\def\makefootline{\baselineskip24\p@\lineskiplimit\z@\line{\the\footline}} -\def\dosupereject{\ifnum\insertpenalties>\z@ % something is being held over - \line{}\kern-\topskip\nobreak\vfill\supereject\fi} - -\def\pagecontents{\ifvoid\topins\else\unvbox\topins\fi - \dimen@=\dp\@cclv \unvbox\@cclv % open up \box255 - \ifvoid\footins\else % footnote info is present - \vskip\skip\footins - \footnoterule - \unvbox\footins\fi - \ifr@ggedbottom \kern-\dimen@ \vfil \fi} -\def\footnoterule{\kern-3\p@ - \hrule width 2truein \kern 2.6\p@} % the \hrule is .4pt high - -% Hyphenation, miscellaneous macros, and initial values for standard layout -\message{hyphenation} - -\lefthyphenmin=2 \righthyphenmin=3 % disallow x- or -xx breaks -\input hyphen - -\def\magnification{\afterassignment\m@g\count@} -\def\m@g{\mag\count@ - \hsize6.5truein\vsize8.9truein\dimen\footins8truein} - -\def\loggingall{\tracingcommands\tw@\tracingstats\tw@ - \tracingpages\@ne\tracingoutput\@ne\tracinglostchars\@ne - \tracingmacros\tw@\tracingparagraphs\@ne\tracingrestores\@ne - \showboxbreadth\maxdimen\showboxdepth\maxdimen} -\def\tracingall{\tracingonline\@ne\loggingall} - -\def\showhyphens#1{\setbox0\vbox{\parfillskip\z@skip\hsize\maxdimen\tenrm - \pretolerance\m@ne\tolerance\m@ne\hbadness0\showboxdepth0\ #1}} - -\normalbaselines\rm % select roman font -\nonfrenchspacing % punctuation affects the spacing -\catcode`@=12 % at signs are no longer letters - -\def\fmtname{plain}\def\fmtversion{3.141592653} % identifies the current format |