From 2fd99762c5a0bb67a16df56cc53cebe999758fcc Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 15 May 2008 09:41:16 +0000 Subject: Support for Windows shortcuts; demo shortcuts in install-tl git-svn-id: svn://tug.org/texlive/trunk@8153 c570f23f-e606-0410-a88d-b1316a301751 --- Master/install-tl | 38 ++- Master/texmf/scripts/texlive/uninstall-win32.pl | 8 +- Master/tlpkg/TeXLive/TLWinGoo.pm | 196 +++++++++---- Master/tlpkg/installer/perllib/Win32/Shortcut.pm | 323 +++++++++++++++++++++ .../perllib/auto/Win32/Shortcut/Shortcut.bs | 0 .../perllib/auto/Win32/Shortcut/Shortcut.dll | Bin 0 -> 29184 bytes 6 files changed, 506 insertions(+), 59 deletions(-) create mode 100644 Master/tlpkg/installer/perllib/Win32/Shortcut.pm create mode 100644 Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.bs create mode 100644 Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.dll diff --git a/Master/install-tl b/Master/install-tl index a41ee9cfeaf..cd804abc671 100755 --- a/Master/install-tl +++ b/Master/install-tl @@ -75,6 +75,9 @@ if (win32) { &unregister_script_type &broadcast_env &update_assocs + &add_tl_shortcut + &clear_unshortbat + &make_tl_shortcuts &create_uninstaller )); } @@ -175,8 +178,8 @@ GetOptions("media=s" => \$opt_media, "help|?" => \$opt_help) or pod2usage(1); if (win32()) { - pod2usage(-exitstatus => 0, - -verbose => 2, + pod2usage(-exitstatus => 0, + -verbose => 2, -noperldoc => 1, -output => \*STDOUT) if $opt_help; } else { @@ -834,7 +837,7 @@ operations might be disturbed.\n\n"; foreach my $tmv (@TMFVARS0) { delete $ENV{$tmv} if (defined($ENV{$tmv})); } - if (!$opt_portable) { + if (!$opt_portable) { foreach my $tmv (@TMFVARS1) { delete $ENV{$tmv} if (defined($ENV{$tmv})); } @@ -872,6 +875,10 @@ operations might be disturbed.\n\n"; # # post install actions # + + # clear batchfile for uninstalling shortcuts + clear_unshortbat($vars{'TEXDIR'}) if win32; + foreach my $package (sort keys %install) { if ($install{$package} && defined($PostInstall{$package})) { tllog($::LOG_NORMAL, "running post install action for $package\n"); @@ -975,6 +982,31 @@ operations might be disturbed.\n\n"; } } + if (win32) { + add_tl_shortcut( + 'Desktop', + 'TeXdoc', + $vars{'TEXDIR'}.'/bin/win32/texdoctk.bat', + "", + 'batgui', # any non-null value ok + ); + add_tl_shortcut( + 'Desktop', + 'PS_View', + $vars{'TEXDIR'}.'/bin/win32/psv.bat', + "%*", + 'batgui', + ); + add_tl_shortcut( + 'TeXLive', + 'TeXLive Manager', + $vars{'TEXDIR'}.'/bin/win32/tlmgr.bat', + "gui", + 'batgui', + ); + make_tl_shortcuts($vars{'TEXDIR'}); + } + # old installer: #$config && texconfig-sys init #$config || echo "PLEASE RUN texconfig or texconfig-sys to make new formats." diff --git a/Master/texmf/scripts/texlive/uninstall-win32.pl b/Master/texmf/scripts/texlive/uninstall-win32.pl index f82ee343051..4f69e7667aa 100644 --- a/Master/texmf/scripts/texlive/uninstall-win32.pl +++ b/Master/texmf/scripts/texlive/uninstall-win32.pl @@ -11,7 +11,7 @@ my $Master; BEGIN { $^W = 1; - $Master = `kpsewhich -var-value=SELFAUTOPARENT`; + $Master = `%COMSPEC% /c kpsewhich -var-value=SELFAUTOPARENT`; chomp($Master); unshift (@INC, "$Master/tlpkg"); } @@ -22,7 +22,7 @@ use Tk::Dialog; my $mw = MainWindow->new(-title => "remove tlmgr 2008"); -my $lab = $mw->Label(-justify => 'left', +my $lab = $mw->Label(-justify => 'left', -text => "Do you really want to remove TeX Live 2008?"); $lab->pack(-padx => "10m", -pady => "5m"); @@ -30,9 +30,9 @@ $lab->pack(-padx => "10m", -pady => "5m"); my $f = $mw->Frame; $f->pack(-padx => "10m", -pady => "5m"); -my $ok = $f->Button(-text => "Ok", +my $ok = $f->Button(-text => "Ok", -command => sub { $mw->destroy; doit(); exit(0); }); -my $cancel = $f->Button(-text => "Cancel", +my $cancel = $f->Button(-text => "Cancel", -command => sub { $mw->destroy; exit(0); }); $ok->pack(-side => 'left', -padx => "3m"); diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index 7917a7fb651..5b54aa89e66 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -5,7 +5,7 @@ # This file is licensed under the GNU General Public License version 2 # or any later version. -# code for broadcast_env adopted from Win32::Env: +# code for broadcast_env adapted 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. @@ -47,14 +47,23 @@ C -- Additional utilities for Windows TeXLive::TLWinGoo::remove_texbindirs_from_path; TeXLive::TLWinGoo::register_script_type($extension, $command); TeXLive::TLWinGoo::unregister_script_type($extension); - TeXLive::TLWinGoo::create_uninstaller; - TeXLive::TLWinGoo::unregister_uninstaller; =head2 ACTIVATING CHANGES IMMEDIATELY TeXLive::TLWinGoo::broadcast_env; TeXLive::TLWinGoo::update_assocs; +=head2 SHORTCUTS + + TeXLive::TLWinGoo::add_tl_shortcut($place, $name, $prog, $args, $batgui); + TeXLive::TLWinGoo::clear_unshortbat($texdir); + TeXLive::TLWinGoo::make_tl_shortcuts($texdir); + +=head2 UNINSTALLER + + TeXLive::TLWinGoo::create_uninstaller; + TeXLive::TLWinGoo::unregister_uninstaller; + All exported functions return forward slashes. =head2 DESCRIPTION @@ -87,6 +96,9 @@ BEGIN { &unregister_script_type &broadcast_env &update_assocs + &add_tl_shortcut + &clear_unshortbat + &make_tl_shortcuts &create_uninstaller &unregister_uninstaller ); @@ -99,8 +111,6 @@ BEGIN { &global_tmpdir ); if ($^O=~/^MSWin(32|64)$/i) { - #require Win32; - #Win32->import( qw( GetOSVersion ) ); require Win32::API; require Win32::TieRegistry; Win32::TieRegistry->import( qw( $Registry @@ -109,10 +119,13 @@ BEGIN { $Registry->Delimiter('/'); $Registry->ArrayValues(0); $Registry->FixSzNulls(1); + require Win32::Shortcut; + Win32::Shortcut->import( qw( SW_SHOWNORMAL SW_SHOWMINNOACTIVE ) ); } } use TeXLive::TLUtils; +TeXLive::TLUtils->import( qw( mkdirhier ) ); my $is_win = $^O=~/^MSWin(32|64)$/i; @@ -626,11 +639,15 @@ sub reg_delete_recurse { =item C -Add registry entries to associate $extension with $command and make -$extension an executable file type. Slashes are flipped where necessary. +Add registry entries to associate $extension with $command. Slashes +are flipped where necessary. =cut +# todo: +# split ftype and assoc +# non-admin: add to startup script + sub register_script_type { my $extension = shift; $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot @@ -716,50 +733,8 @@ sub unregister_script_type { $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot $extension = uc($extension); tllog ($::LOG_DDEBUG, "unregistering $extension\n"); - my $user_env = get_user_env(); - my $system_env = get_system_env(); - my ($pathext, @newpe, $newpex, $e); - - # pathext - if (!$::opt_portable) { - tllog ($::LOG_DDEBUG, "Reverting PATHEXT\n"); - if ($is_admin) { - $pathext = $system_env -> {'/PATHEXT'}; - @newpe = (); - foreach $e (split(/;/,$pathext)) { - push @newpe, $e unless (uc($e) eq $extension); - } - $newpex = join(";",@newpe); - setenv_reg("PATHEXT", $newpex, "system"); - - $pathext = $user_env -> {'/PATHEXT'}; - if ($pathext) { - @newpe = (); - foreach $e (split(/;/,$pathext)) { - push @newpe, $e unless (uc($e) eq $extension); - } - $newpex = join(";",@newpe); - if ($newpex eq ($system_env -> {"/PATHEXT"})) { - unsetenv_reg("PATHEXT", "user"); - } else { - setenv_reg("PATHEXT", $newpex, "user"); - } - } - } else { - $pathext = $user_env -> {'/PATHEXT'}; - $pathext = $system_env -> {'/PATHEXT'} unless $pathext; - @newpe = (); - foreach $e (split(/;/,$pathext)) { - push @newpe, $e unless (uc($e) eq $extension); - } - $newpex = join(";",@newpe); - if ($newpex eq ($system_env -> {"/PATHEXT"})) { - unsetenv_reg("PATHEXT", "user"); - } else { - setenv_reg("PATHEXT", $newpex, "user"); - } - } - } + #my $user_env = get_user_env(); + #my $system_env = get_system_env(); # file type tllog ($::LOG_DDEBUG, "Deleting texlua filetype\n"); @@ -837,6 +812,122 @@ sub update_assocs() { =pod +=head2 SHORTCUTS + +=item C + +Specify a to be added shortcut at $place (relative to +Start/Programs), with name $name, pointing to program $prog with +parameters $args (a string). $place can also be the string +'Desktop'. Use a non-null batgui parameter if the shortcut starts a +gui program via a batchfile. Then the inevitable command prompt will +be hidden rightaway, leaving only the gui program visible. + +=cut + +#my @shortcuts = (); + +sub add_tl_shortcut { + my ($place, $name, $prog, $args, $batgui) = @_; + $place =~ s!\\!/!g; + my $newshort = { + 'place' => $place, + 'name' => $name, + 'prog' => $prog, + 'args' => $args, + 'batgui' => $batgui, + }; + push @shortcuts, $newshort; +} + +=pod + +=item C + +Delete any existing shortcut remover. + +=cut + +sub clear_unshortbat { + my $td = shift; + unlink $td.'/tlpkg/installer/unshort.bat'; +} + +=cut + +=pod + +=item C + +This one does the actual shortcut creation. + +=cut + +sub make_tl_shortcuts { + return if $#shortcuts < 0; + + # TEXDIR + my $tdfw = shift; + $tdfw =~ s![\\/]$!!; + my $td = $tdfw; + $td =~ s!/!\\!g; + + # batchfile for uninstalling shortcuts + open UNSHORT, ">>$tdfw/tlpkg/installer/unshort.bat"; + + # desktop- and menu directories + my ($shell_key, $shortpath, $deskpath); + if (admin()) { + $shell_key = $Registry->Open( + "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", + {Access => KEY_READ}); + $deskpath = $shell_key -> {"/Common Desktop"}; + $shortpath = $shell_key -> {"/Common Programs"}; + } else { + $shell_key = $Registry->Open( + "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", + {Access => KEY_READ}); + $deskpath = $shell_key -> {"/Desktop"}; + $shortpath = $shell_key -> {"/Programs"}; + } + my $deskpathfw = $deskpath; $deskpathfw =~ s!\\!/!g; + my $shortpathfw = $shortpath; $shortpathfw =~ s!\\!/!g; + + my @desktop_shortcuts = (); + + foreach my $s (@shortcuts) { + my ($shc, $shpath, $shfile); + $shc = new Win32::Shortcut(); + $shc->{'Path'} = $s->{'prog'}; + $shc->{'Arguments'} = $s->{'args'}; + $shc->{'ShowCmd'} = SW_SHOWMINNOACTIVE if $s->{'batgui'}; + if ($s->{'place'} =~ 'Desktop') { + $shfile = $deskpathfw.'/'.$s->{'name'}.'.lnk'; + $shc->Save($shfile); + $shfile =~ s!/!\\!g; + print UNSHORT 'del "'.$shfile."\" 2>nul\n"; + } else { + $shpath = $s->{'place'}; + $shpath =~ s!\\!/!g; + $shpath = '/'.$shpath unless $shpath =~ m!^/!; + $shpath = $shortpathfw . $shpath; + $shfile = $shpath.'/'.$s->{'name'}.'.lnk'; + if ((-e $shpath) and not (-d $shpath)) { + next; # fail silently and don't worry about it + } elsif (not (-d $shpath)) { + mkdirhier ($shpath); + } + $shc->Save($shfile); + } + } + print UNSHORT 'rmdir /s /q "'.$shortpath."\\TeXLive\" 2>nul\n"; + close UNSHORT; +} + +=pod + +=head2 UNINSTALLER + =item C Writes registry entries for add/remove programs which reference @@ -846,7 +937,7 @@ the job. =cut sub create_uninstaller { - my $tdfw = shift; + my $tdfw = shift; # TEXDIR $tdfw =~ s![\\/]$!!; my $td = $tdfw; $td =~ s!/!\\!g; @@ -865,6 +956,7 @@ sub create_uninstaller { \@echo off set PERL5LIB= \"$td\\tlpkg\\tlperl\\bin\\perl.exe\" \"$td\\texmf\\scripts\\texlive\\uninstall-win32.pl\" +call \"$td\\tlpkg\\installer\\unshort.bat\" copy \"$td\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\" \"\%TEMP\%\\uninst2.bat\" UNEND diff --git a/Master/tlpkg/installer/perllib/Win32/Shortcut.pm b/Master/tlpkg/installer/perllib/Win32/Shortcut.pm new file mode 100644 index 00000000000..d4dadafdcf2 --- /dev/null +++ b/Master/tlpkg/installer/perllib/Win32/Shortcut.pm @@ -0,0 +1,323 @@ +package Win32::Shortcut; +####################################################################### +# +# Win32::Shortcut - Perl Module for Shell Link Interface +# ^^^^^^^^^^^^^^^ +# This module creates an object oriented interface to the Win32 +# Shell Links (IShellLink interface). +# +####################################################################### + +$VERSION = "0.04"; + +require Exporter; +require DynaLoader; + +@ISA= qw( Exporter DynaLoader ); +@EXPORT = qw( + SW_SHOWMAXIMIZED + SW_SHOWMINNOACTIVE + SW_SHOWNORMAL +); + + +####################################################################### +# This AUTOLOAD is used to 'autoload' constants from the constant() +# XS function. If a constant is not found then control is passed +# to the AUTOLOAD in AutoLoader. +# + +sub AUTOLOAD { + my($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + #reset $! to zero to reset any current errors. + local $!; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($!) { + my(undef, $file, $line) = caller; + die "Win32::Shortcut::$constname is not defined, used at $file line $line."; + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + + +####################################################################### +# PUBLIC METHODS +# + +#======== +sub new { +#======== + my($class, $file) = @_; + my $self = {}; + my $ilink = 0; + my $ifile = 0; + + ($ilink, $ifile) = _Instance(); + + if($ilink and $ifile) { + $self->{'ilink'} = $ilink; + $self->{'ifile'} = $ifile; + bless $self; + # Initialize properties + $self->{'File'} = ""; + $self->{'Path'} = ""; + $self->{'Arguments'} = ""; + $self->{'WorkingDirectory'} = ""; + $self->{'Description'} = ""; + $self->{'ShowCmd'} = 0; + $self->{'Hotkey'} = 0; + $self->{'IconLocation'} = ""; + $self->{'IconNumber'} = 0; + + $self->Load($file) if $file; + + } else { + return undef; + } + $self; +} + +#========= +sub Load { +#========= + my($self, $file) = @_; + return undef unless ref($self); + + my $result = _Load($self->{'ilink'}, $self->{'ifile'}, $file); + + if ($result) { + + # fill the properties of $self + $self->{'File'} = $file; + $self->{'Path'} = _GetPath($self->{'ilink'}, $self->{'ifile'},0); + $self->{'ShortPath'} = _GetPath($self->{'ilink'}, $self->{'ifile'},1); + $self->{'Arguments'} = _GetArguments($self->{'ilink'}, $self->{'ifile'}); + $self->{'WorkingDirectory'} = _GetWorkingDirectory($self->{'ilink'}, $self->{'ifile'}); + $self->{'Description'} = _GetDescription($self->{'ilink'}, $self->{'ifile'}); + $self->{'ShowCmd'} = _GetShowCmd($self->{'ilink'}, $self->{'ifile'}); + $self->{'Hotkey'} = _GetHotkey($self->{'ilink'}, $self->{'ifile'}); + ($self->{'IconLocation'}, + $self->{'IconNumber'}) = _GetIconLocation($self->{'ilink'}, $self->{'ifile'}); + } + return $result; +} + + +#======== +sub Set { +#======== + my($self, $path, $arguments, $dir, $description, $show, $hotkey, + $iconlocation, $iconnumber) = @_; + return undef unless ref($self); + + $self->{'Path'} = $path; + $self->{'Arguments'} = $arguments; + $self->{'WorkingDirectory'} = $dir; + $self->{'Description'} = $description; + $self->{'ShowCmd'} = $show; + $self->{'Hotkey'} = $hotkey; + $self->{'IconLocation'} = $iconlocation; + $self->{'IconNumber'} = $iconnumber; + return 1; +} + + +#========= +sub Save { +#========= + my($self, $file) = @_; + return unless ref($self); + + $file = $self->{'File'} unless $file; + return unless $file; + + require Win32 unless defined &Win32::GetFullPathName; + $file = Win32::GetFullPathName($file); + + _SetPath($self->{'ilink'}, $self->{'ifile'}, $self->{'Path'}); + _SetArguments($self->{'ilink'}, $self->{'ifile'}, $self->{'Arguments'}); + _SetWorkingDirectory($self->{'ilink'}, $self->{'ifile'}, $self->{'WorkingDirectory'}); + _SetDescription($self->{'ilink'}, $self->{'ifile'}, $self->{'Description'}); + _SetShowCmd($self->{'ilink'}, $self->{'ifile'}, $self->{'ShowCmd'}); + _SetHotkey($self->{'ilink'}, $self->{'ifile'}, $self->{'Hotkey'}); + _SetIconLocation($self->{'ilink'}, $self->{'ifile'}, + $self->{'IconLocation'}, $self->{'IconNumber'}); + + my $result = _Save($self->{'ilink'}, $self->{'ifile'}, $file); + if ($result) { + $self->{'File'} = $file unless $self->{'File'}; + } + return $result; +} + +#============ +sub Resolve { +#============ + my($self, $flags) = @_; + return undef unless ref($self); + $flags = 1 unless defined($flags); + my $result = _Resolve($self->{'ilink'}, $self->{'ifile'}, $flags); + return $result; +} + + +#========== +sub Close { +#========== + my($self) = @_; + return undef unless ref($self); + + my $result = _Release($self->{'ilink'}, $self->{'ifile'}); + $self->{'released'} = 1; + return $result; +} + +#========= +sub Path { +#========= + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'Path'}; + } else { + $self->{'Path'} = $value; + } + return $self->{'Path'}; +} + +#============== +sub ShortPath { +#============== + my($self) = @_; + return undef unless ref($self); + return $self->{'ShortPath'}; +} + +#============== +sub Arguments { +#============== + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'Arguments'}; + } else { + $self->{'Arguments'} = $value; + } + return $self->{'Arguments'}; +} + +#===================== +sub WorkingDirectory { +#===================== + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'WorkingDirectory'}; + } else { + $self->{'WorkingDirectory'} = $value; + } + return $self->{'WorkingDirectory'}; +} + + +#================ +sub Description { +#================ + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'Description'}; + } else { + $self->{'Description'} = $value; + } + return $self->{'Description'}; +} + +#============ +sub ShowCmd { +#============ + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'ShowCmd'}; + } else { + $self->{'ShowCmd'} = $value; + } + return $self->{'ShowCmd'}; +} + +#=========== +sub Hotkey { +#=========== + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'Hotkey'}; + } else { + $self->{'Hotkey'} = $value; + } + return $self->{'Hotkey'}; +} + +#================= +sub IconLocation { +#================= + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'IconLocation'}; + } else { + $self->{'IconLocation'} = $value; + } + return $self->{'IconLocation'}; +} + +#=============== +sub IconNumber { +#=============== + my($self, $value) = @_; + return undef unless ref($self); + + if(not defined($value)) { + return $self->{'IconNumber'}; + } else { + $self->{'IconNumber'} = $value; + } + return $self->{'IconNumber'}; +} + +#============ +sub Version { +#============ + # [dada] to get rid of the "used only once" warning... + return $VERSION; +} + + +####################################################################### +# PRIVATE METHODS +# + +#============ +sub DESTROY { +#============ + my($self) = @_; + + if (not $self->{'released'}) { + _Release($self->{'ilink'}, $self->{'ifile'}); + $self->{'released'} = 1; + } +} + +bootstrap Win32::Shortcut; + +1; diff --git a/Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.bs b/Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.bs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.dll b/Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.dll new file mode 100644 index 00000000000..17889059886 Binary files /dev/null and b/Master/tlpkg/installer/perllib/auto/Win32/Shortcut/Shortcut.dll differ -- cgit v1.2.3