summaryrefslogtreecommitdiff
path: root/Master
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2008-01-21 11:52:26 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2008-01-21 11:52:26 +0000
commit735395574f35a6abc15d5ee4b3a5d63ad93a32b1 (patch)
treed99e0ae85fbad3eabe25ddf617b69167e65fcbfd /Master
parentfc49516987e1a5d3b03c9418d1c62cc520d8c50b (diff)
TLWinGoo:
- added broadcast_env - exports fewer functions, but maybe still too many - added error flag; not yet used in install-tl git-svn-id: svn://tug.org/texlive/trunk@6345 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm154
1 files changed, 117 insertions, 37 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index 0a5bbba2908..de2f6255b60 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -5,6 +5,11 @@
# This file is licensed under the GNU General Public License version 2
# or any later version.
+# code for broadcast_env adopted from Win32::Env:
+# Copyright 2006 Oleg "Rowaa[SR13]" V. Volkov, all rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
package TeXLive::TLWinGoo;
=pod
@@ -17,15 +22,18 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows
use TeXLive::TLWinGoo;
+ TeXLive::TLWinGoo::wg_error;
TeXLive::TLWinGoo::admin;
TeXLive::TLWinGoo::dir_writable($d);
TeXLive::TLWinGoo::expand_string($s);
TeXLive::TLWinGoo::global_tmpdir;
TeXLive::TLWinGoo::get_system_path;
TeXLive::TLWinGoo::get_user_path;
- TeXLive::TLWinGoo::win_which_dir($prog);
TeXLive::TLWinGoo::add_texbindir_to_path($texpath);
TeXLive::TLWinGoo::register_script_type($extension, $command);
+ TeXLive::TLWinGoo::broadcast_env;
+
+All exported functions return forward slashes.
=head2 DESCRIPTION
@@ -38,18 +46,20 @@ BEGIN {
use vars qw( @ISA @EXPORT $Registry);
@ISA = qw( Exporter );
@EXPORT = qw(
+ &wg_error
&admin
&dir_writable
&expand_string
&global_tmpdir
&get_system_path
&get_user_path
- &win_which_dir
&add_texbindir_to_path
&register_script_type
+ &broadcast_env
);
if ($^O=~/^MSWin(32|64)$/i) {
+ require Win32::API;
require Win32::TieRegistry;
Win32::TieRegistry->import( qw( $Registry
REG_SZ REG_EXPAND_SZ KEY_READ KEY_WRITE KEY_ALL_ACCESS
@@ -60,6 +70,14 @@ BEGIN {
}
}
+#########################################
+# Variables storing status information.
+
+# error status stored in wg_errno and wg_errmess
+
+my $wg_error = 0;
+my $wg_error_message = "";
+
my $is_win = $^O=~/^MSWin(32|64)$/i;
# Under Windows, the variables below are calculated while loading this module.
@@ -80,9 +98,10 @@ sub get_system_env {
{Access => sys_access_permissions()});
}
-# $is_admin was set to true. With this value, sys-access_permissions returns
-# full access permissions. If that doesn't work out then apparently
-# we aren't administrator, so we set $is_admin to 0.
+# $is_admin was set to true originally. With this value,
+# sys-access_permissions returns full access permissions. If that
+# doesn't work out then apparently we aren't administrator, so we
+# set $is_admin to 0.
if ($is_win) {
$is_admin = 0 if not get_system_env();
@@ -92,6 +111,24 @@ sub get_user_env {
return $Registry -> Open("CUser/Environment", {Access => KEY_ALL_ACCESS()});
}
+# error handling
+
+=pod
+
+=item C<wg_error>
+
+Returns WinGoo error status, in the shape of an array (number,
+message) and clears the error status. No error <=> error numer 0
+
+=cut
+
+sub wg_error {
+ my @retval = ($wg_error, $wg_error_message);
+ $wg_error = 0;
+ $wg_error_message = "";
+ return @retval;
+}
+
=pod
=item C<admin>
@@ -173,12 +210,12 @@ sub global_tmpdir { return $global_tmp; }
sub is_a_texdir {
my $d = shift;
- my $xd = expand_string($d);
- $xd =~ s/\\/\//g;
- $xd =~ s/\/$//;
- my $xd1 = $xd . '/pdftex.exe';
- my $xd2 = $xd . '/tex.exe';
- return ((-e $xd1) or (-e $xd2));
+ #my $xd = expand_string($d);
+ $d =~ s/\\/\//g;
+ $d =~ s/\/$//;
+ my $d1 = $d . '/pdftex.exe';
+ my $d2 = $d . '/tex.exe';
+ return ((-e $d1) or (-e $d2));
}
=pod
@@ -193,6 +230,8 @@ forward slashes.
sub get_system_path {
my $value = get_system_env() -> {'/Path'};
$value =~ s/\\/\//g;
+ # Remove terminating zero bytes; there may be several, at least
+ # under w2k, and the FixSzNulls option only removes one.
$value =~ s/[\s\x00]+$//;
return $value;
}
@@ -215,16 +254,16 @@ sub get_user_path {
return $value;
}
-=pod
-
-=item C<win_which_dir>
-
-More or less the same as which, except that 1. it returns a
-directory, 2. it consults the path stored in the registry rather
-than the path of the current process, and 3. it assumes that the
-filename includes an extension.
-
-=cut
+#=pod
+#
+#=item C<win_which_dir>
+#
+#More or less the same as which, except that 1. it returns a
+#directory, 2. it consults the path stored in the registry rather
+#than the path of the current process, and 3. it assumes that the
+#filename includes an extension. Currently not used.
+#
+#=cut
sub win_which_dir {
my $prog = shift;
@@ -240,14 +279,14 @@ sub win_which_dir {
return 0;
}
-=pod
-
-=item C<add_to_path>
-
-Returns its arguments joined with C<;> as separator, or returns the second
-argument if the first is an empty string.
-
-=cut
+#=pod
+#
+#=item C<add_to_path>
+#
+#Returns its arguments joined with C<;> as separator, or returns the second
+#argument if the first is an empty string.
+#
+#=cut
sub add_to_path {
my $old_path = shift @_;
@@ -262,18 +301,29 @@ sub add_to_path {
Remove any TeX directories from system path (if possible) and user
path. A directory is a TeX directory if it contains tex.exe or
pdftex.exe. Then add desired TeX directory; to system path if
-admin, otherwise to user path.
+admin, otherwise to user path. wg_error gets set if there is a
+connflicting tex directory which cannot be removed from the path.
=cut
sub add_texbindir_to_path {
+ $wg_error = 0; # clear error status
$texbindir = shift;
my $syspath_temp = "";
+ my $d_exp;
foreach $d (split (';', get_system_path())) {
- print "Warning: possibly conflicting [pdf]TeX program found at ".
- expand_string($d)."\n" if is_a_texdir($d) and !$is_admin;
- $syspath_temp = add_to_path($syspath_temp, $d)
- if (not is_a_texdir($d)) and $is_admin;
+ $d_exp = expand_string($d);
+ $d_exp =~ s/\\/\//g;
+ $d_exp =~ s/\/$//;
+ if (is_a_texdir($d_exp)) {
+ if (!$is_admin and (uc($d_exp) ne uc($texbindir))) {
+ $wg_error = 1;
+ $wg_error_message =
+ "Warning: possibly conflicting [pdf]TeX program found at $d_exp\n";
+ }
+ } elsif ($is_admin) {
+ $syspath_temp = add_to_path($syspath_temp, $d);
+ }
}
if ($is_admin) {
@@ -290,11 +340,13 @@ sub add_texbindir_to_path {
my $userpath_temp = "";
foreach $d (split (';', get_user_path())) {
- $userpath_temp = add_to_path($userpath_temp, $d) if (not is_a_texdir($d));
+ $d_exp = expand_string($d);
+ $userpath_temp = add_to_path($userpath_temp, $d) if (not is_a_texdir($d_exp));
}
$userpath_temp = add_to_path($userpath_temp, $texbindir) if !$is_admin;
if ($userpath_temp) {
+ $userpath_temp =~ s/\//\\/g;
my $user_env = get_user_env();
$user_env->ArrayValues(1); # use value_data, value_type pairs
$user_env -> {"/Path"} = [ $userpath_temp,
@@ -311,8 +363,6 @@ sub add_texbindir_to_path {
Add registry entries to associate $extension with $command and make
$extension an executable file type. Slashes are flipped where necessary.
-=back
-
=cut
sub register_script_type {
@@ -350,6 +400,36 @@ sub register_script_type {
SetValue("", $command.' "%1" %*');
}
+=pod
+
+=item C<broadcast_env>
+
+Broadcasts system message that enviroment has changed. This only has
+an effect on newly-started programs, not on running programs and the
+processes they spawn.
+
+=cut
+
+sub broadcast_env() {
+ use constant HWND_BROADCAST => 0xffff;
+ use constant WM_SETTINGCHANGE => 0x001A;
+ my @proto = ('SendMessage', 'LLPP', 'L');
+ my $result = "";
+ my $SendMessage;
+ $wg_error = 0;
+ print "Broadcasting \"Enviroment settings changed\" message...\n";
+ $SendMessage = new Win32::API('user32', @proto);
+ $result = $SendMessage->Call(HWND_BROADCAST, WM_SETTINGCHANGE,
+ 0, 'Environment') if $SendMessage;
+ print "Broadcast complete; result: $result.\n";
+}
+
+=pod
+
+=back
+
+=cut
+
# needs a terminal 1 for require to succeed!
1;