path: root/Master/tlpkg/etc/dev.postaction-in-tlpsrc.patch

Index: tlpkg/TeXLive/TLConfig.pm
===================================================================
--- tlpkg/TeXLive/TLConfig.pm	(revision 12142)
+++ tlpkg/TeXLive/TLConfig.pm	(working copy)
@@ -28,6 +28,7 @@
     $WinSpecialUpdatePackagesRegexp
     @CriticalPackagesList
     @AllowedConfigOptions
+    $WindowsMainMenuName
   );
   @EXPORT = @EXPORT_OK;
 }
@@ -82,6 +83,8 @@
   autobackup
   /;
 
+our $WindowsMainMenuName = "TeX Live 2008";
+
 1;
 
 
Index: tlpkg/TeXLive/TLPSRC.pm
===================================================================
--- tlpkg/TeXLive/TLPSRC.pm	(revision 12142)
+++ tlpkg/TeXLive/TLPSRC.pm	(working copy)
@@ -30,6 +30,7 @@
     srcpatterns => $params{'srcpatterns'},
     docpatterns => $params{'docpatterns'},
     binpatterns => $params{'binpatterns'},
+    postactions => $params{'postactions'},
     executes    => defined($params{'executes'}) ? $params{'executes'} : [],
     depends     => defined($params{'depends'}) ? $params{'depends'} : [],
   };
@@ -67,6 +68,7 @@
   my $catalogue = "";
   my (@executes, @depends);
   my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns);
+  my (@postactions);
   my $started = 0;
   my $finished = 0;
   my $savedline = "";
@@ -132,6 +134,9 @@
       } elsif ($line =~ /^depend\s+(.*)\s*$/) {
         push @depends, $1 if ($1 ne "");
         next;
+      } elsif ($line =~ /^postaction\s+(.*)\s*$/) {
+        push @postactions, $1 if ($1 ne "");
+        next;
       } else {
         tlwarn("$srcfile:$.: unknown tlpsrc directive, please fix: $line\n");
       }
@@ -149,6 +154,7 @@
   $self->docpatterns(@docpatterns) if @docpatterns;
   $self->executes(@executes) if @executes;
   $self->depends(@depends) if @depends;
+  $self->postactions(@postactions) if @postactions;
 }
 
 
@@ -175,6 +181,11 @@
       print $fd "execute $_\n";
     }
   }
+  if (defined($self->{'postactions'})) {
+    foreach (@{$self->{'postactions'}}) {
+      print $fd "postaction $_\n";
+    }
+  }
   if (defined($self->{'srcpatterns'}) && (@{$self->{'srcpatterns'}})) {
     foreach (sort @{$self->{'srcpatterns'}}) {
       print $fd "srcpattern $_\n";
@@ -213,6 +224,7 @@
   $tlp->longdesc($self->{'longdesc'}) if (defined($self->{'longdesc'}));
   $tlp->catalogue($self->{'catalogue'}) if (defined($self->{'catalogue'}));
   $tlp->executes(@{$self->{'executes'}}) if (defined($self->{'executes'}));
+  $tlp->postactions(@{$self->{'postactions'}}) if (defined($self->{'postactions'}));
   $tlp->depends(@{$self->{'depends'}}) if (defined($self->{'depends'}));
   $tlp->revision(0);
   my $filemax;
@@ -540,6 +552,11 @@
   if (@_) { @{ $self->{'executes'} } = @_ }
   return @{ $self->{'executes'} };
 }
+sub postactions {
+  my $self = shift;
+  if (@_) { @{ $self->{'postactions'} } = @_ }
+  return @{ $self->{'postactions'} };
+}
 
 format multilineformat =
 longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
@@ -580,7 +597,7 @@
 
 where I<key> can be C<name>, C<category>, C<shortdesc>, C<longdesc>,
 C<catalogue>, C<runpattern>, C<srcpattern>, C<docpattern>, C<binpattern>,
-C<execute>, or C<depend>.
+C<execute>, C<postaction>, or C<depend>.
 
 Continuation lines are supported via a trailing backslash.  That is, if
 the C<.tlpsrc> file contains two physical lines like this:
@@ -743,6 +760,38 @@
 
 =back
 
+=item <postaction>
+
+gives a free from entry of post install and removal actions to be
+executed. The difference to the C<execute> statement is that 
+C<postaction> is concerned with system integration, i.e., adjusting
+things outside the installation directory, while C<execute> touches
+only things within the installation.
+
+Currently the following C<postaction>s are understood:
+
+=over 4
+
+=item C<postaction shortcut name=I<name> type=menu|desktop icon=I<path> cmd=I<cmd> args=I<args> hide=0|1>
+
+On W32 creates a shortcut either in the main TeX Live menu or on the
+desktop. Please see the documentation of TeXLive::TLWinGoo for details
+on the parameters.
+
+=item C<postaction filetype name=I<name> cmd=I<cmd>>
+
+On W32 associates the file type I<name> with the command I<cmd>.
+
+=item C<postaction fileassoc extension=I<.ext> filetype=I<name>>
+
+On W32 declares files with the extenstion I<.ext> of file type I<name>.
+
+=item C<postaction code I<arg>>
+
+TODO TODO I don't know how we want to do that
+
+=back
+
 =item C<(src|run|doc|bin)pattern> I<pattern>
 
 adds a pattern (next section) to the respective list of patterns.
Index: tlpkg/TeXLive/TLPOBJ.pm
===================================================================
--- tlpkg/TeXLive/TLPOBJ.pm	(revision 12142)
+++ tlpkg/TeXLive/TLPOBJ.pm	(working copy)
@@ -29,6 +29,7 @@
     docfiles    => defined($params{'docfiles'}) ? $params{'docfiles'} : [],
     docsize   => $params{'docsize'},
     executes    => defined($params{'executes'}) ? $params{'executes'} : [],
+    postactions => defined($params{'postactions'}) ? $params{'postactions'} : [],
     # note that binfiles is a HASH with keys of $arch!
     binfiles    => defined($params{'binfiles'}) ? $params{'binfiles'} : {},
     binsize     => defined($params{'binsize'}) ? $params{'binsize'} : {},
@@ -92,6 +93,7 @@
            ($lastcmd eq "docfiles") ||
            ($lastcmd eq "srcfiles") ||
            ($lastcmd eq "executes") ||
+           ($lastcmd eq "postaction") ||
            ($lastcmd eq "depend") ) {
         $line =~ s/^ /${lastcmd}continued /;
       } else {
@@ -216,6 +218,10 @@
         push @{$self->{'executes'}}, "$2" unless "$2" eq "";
         $lastcmd = "execute";
         next;
+      } elsif ($line =~ /^postaction(continued)?\s*(.*)\s*/o) {
+        push @{$self->{'postactions'}}, "$2" unless "$2" eq "";
+        $lastcmd = "postaction";
+        next;
       } elsif ($line =~ /^depend(continued)?\s*(.*)\s*/o) {
         push @{$self->{'depends'}}, "$2" unless "$2" eq "";
         $lastcmd = "depend";
@@ -316,6 +322,11 @@
       print $fd "execute $_\n";
     }
   }
+  if (defined($self->{'postactions'})) {
+    foreach (@{$self->{'postactions'}}) {
+      print $fd "postaction $_\n";
+    }
+  }
   if (defined($self->{'containersize'})) {
     print $fd "containersize $self->{'containersize'}\n";
   }
@@ -388,6 +399,11 @@
       print $fd "execute $_\n";
     }
   }
+  if (defined($self->{'postactions'})) {
+    foreach (@{$self->{'postactions'}}) {
+      print $fd "postaction $_\n";
+    }
+  }
   if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
     print $fd "docfiles\n";
     foreach (sort @{$self->{'docfiles'}}) {
@@ -1026,6 +1042,11 @@
   if (@_) { $self->{'executes'} = [ @_ ] }
   return @{ $self->{'executes'} };
 }
+sub postactions {
+  my $self = shift;
+  if (@_) { $self->{'postactions'} = [ @_ ] }
+  return @{ $self->{'postactions'} };
+}
 sub containerdir {
   my @self = shift;
   if (@_) { $_containerdir = $_[0] }
Index: tlpkg/TeXLive/TLUtils.pm
===================================================================
--- tlpkg/TeXLive/TLUtils.pm	(revision 12142)
+++ tlpkg/TeXLive/TLUtils.pm	(working copy)
@@ -56,6 +56,7 @@
   TeXLive::TLUtils::create_language_def($tlpdb,$dest,$localconf);
   TeXLive::TLUtils::install_packages($from_tlpdb,$media,$to_tlpdb,$what,$opt_src, $opt_doc)>);
   TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform);
+  TeXLive::TLUtils::do_postaction_code($how, $tlpdb, $TEXDIR, $TEXDIRW, $TEXMFSYSVAR, $TEXMFLOCAL);
 
 =head2 Miscellaneous
 
@@ -1224,7 +1225,111 @@
   return 1;
 }
 
+=item C<do_postaction_code($how, $tlpobj)>
 
+Evaluates the C<postaction> code in the C<$tlpobj> 
+MISSING DOCUMENTATION TODO TODO
+
+Returns 1 on success, and 0 on failure.
+
+=cut
+
+sub do_postaction_code {
+  my ($how, $tlpobj) = @_;
+  my $ret = 1;
+  if (!defined($tlpobj)) {
+    tlwarn("do_postaction_code: didn't get a tlpobj\n");
+    return 0;
+  }
+  for my $pa ($tlpobj->postactions) {
+    if ($pa =~ m/^\s*shortcut\s+(.*)\s*$/) {
+      $ret &&= _do_postaction_shortcut($how, $tlpobj, $1);
+    } elsif ($pa =~ m/\s*filetype\s+(.*)\s*$/) {
+      $ret &&= _do_postaction_filetype($how, $tlpobj, $1);
+    } elsif ($pa =~ m/\s*fileassoc\s+(.*)\s*$/) {
+      $ret &&= _do_postaction_fileassoc($how, $tlpobj, $1);
+    } elsif ($pa =~ m/\s*code\s+(.*)\s*$/) {
+      $ret &&= _do_postaction_code($how, $tlpobj, $1);
+    } else {
+      tlwarn("do_postaction_code: don't know how to do $pa\n");
+      $ret = 0;
+    }
+  }
+  # nothing to do
+  return $ret;
+}
+
+sub _do_postaction_shortcut {
+  my ($how, $tlpobj, $pa) = @_;
+  my @words = quotewords('\s+', 0, "$pa");
+  my $type;
+  my $icon = '';
+  my $cmd = '';
+  my $args = '';
+  my $name;
+  my $hide = '0';
+  while (@words) {
+    $_ = shift @words;
+    if (/^type=(.*)$/) {
+      $type = $1;
+      if (($type ne "menu") && ($type ne "desktop")) {
+        tlwarn("type of shortcut postaction $type is unknown (menu, desktop)\n");
+        return 0;
+      }
+    } elsif (/^name=(.*)$/) {
+      $name = $1;
+    } elsif (/^icon=(.*)$/) {
+      $icon = $1;
+    } elsif (/^cmd=(.*)$/) {
+      $cmd = $1;
+    } elsif (/^args=(.*)$/) {
+      $args = $1;
+    } elsif (/^hide=(.*)$/) {
+      $hide = $1;
+      if (($hide ne "0") && ($hide ne "1")) {
+        tlwarn("hide of shortcut postaction $hide is unknown (0, 1)\n");
+        return 0;
+      }
+    } else {
+      tlwarn("Unknown tag for postaction shortcut $pa: $_\n");
+      return 0;
+    }
+  }
+  if ($how eq "install") {
+    my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`
+    chomp($texdir);
+    my $texdir_bsl = conv_to_w32_path($texdir);
+    $icon =~ s!^TEXDIR/!$texdir/!;
+    $args =~ s!^TEXDIR/!$texdir/!;
+    $args = conv_to_w32_path($args);
+    if ($type eq "menu") {
+      add_menu_shortcut($TeXLive::TLConfig::WindowsMainMenuName, 
+                        $name, $icon, $cmd, $args, $hide);
+    } elsif ($type eq "desktop") {
+      # $texdirw here is only used for updating the unshort.bat script
+      # we could call all the TLPostRemove actions in the uninstall_w32.pl
+      # and get rid of the $texdirw completely...
+      add_desktop_shortcut(TODO $texdirw TODO, $name, $icon, $cmd, $args, $hide);
+    } else {
+      tlwarn("Unknown type of shortcut: $type\n");
+      return 0;
+    }
+  } elsif ($how eq "remove") {
+    if ($type eq "menu") {
+      remove_menu_shortcut($TeXLive::TLConfig::WindowsMainMenuName, $name);
+    } elsif ($type eq "desktop") {
+      remove_desktop_shortcut($name);
+    } else {
+      tlwarn("Unknown type of shortcut: $type\n");
+      return 0;
+    }
+  } else {
+    tlwarn("Unknown mode $how\n");
+    return 0;
+  }
+  return 1;
+}
+
 =item C<untar($tarfile,$targetdir, $remove_tarfile)>
 
 Unpacked C<$tarfile> in C<$targetdir> (changing directories to
Index: install-tl
===================================================================
--- install-tl	(revision 12142)
+++ install-tl	(working copy)
@@ -1052,6 +1052,11 @@
   # post install actions
   #
 
+  # in case we are running from DVD we use the tlpdb from the DVD, otherwise
+  # the one we have locally created, for all the further actions
+  my $usedtlpdb = $vars{'from_dvd'} ? $tlpdb : $localtlpdb;
+
+
   if (win32()) {
     debug "Actual environment:\n".`set`."\n\n";
     debug 'Effective TEXMFCNF: '.`kpsewhich -expand-path=\$TEXMFCNF`."\n";
@@ -1063,12 +1068,20 @@
     init_unshortbat($TEXDIRW);
   }
 
+  # Run the post installation code in TLPostAction.pm
   foreach my $package (sort keys %install) {
     if ($install{$package} && defined($PostInstall{$package})) {
       info("running post install action for $package\n");
       &{$PostInstall{$package}}($TEXDIR, $TEXDIRW, $TEXMFSYSVAR, $TEXMFLOCAL);
     }
   }
+  # Run the post installation code in the postaction tlpsrc entries
+  foreach my $package (sort keys %install) {
+    if ($install{$package}) {
+      do_postaction_code("install", $usedtlpdb->get_package($package));
+    }
+  }
+
   # $opt_portable: no %install but we still want xetex postinstall
   &{$PostInstall{'xetex'}}($TEXDIR, $TEXDIRW, $TEXMFSYSVAR, $TEXMFLOCAL)
     if $opt_portable;
@@ -1085,25 +1098,25 @@
   # texconfig generate * but Win32 does not have texconfig. But we have
   # $localtlpdb and this is simple code, so do it directly, i.e., duplicate
   # the code from the various generate-*.pl scripts
+
   info("writing fmtutil.cnf data to $TEXMFSYSVAR/web2c/fmtutil.cnf\n");
-  my $tlp = $vars{'from_dvd'} ? $tlpdb : $localtlpdb;
-  TeXLive::TLUtils::create_fmtutil($tlp, #$localtlpdb,
+  TeXLive::TLUtils::create_fmtutil($usedtlpdb,
     "$TEXMFSYSVAR/web2c/fmtutil.cnf",
     "$TEXMFLOCAL/web2c/fmtutil-local.cnf");
 
   mkdirhier "$vars{'TEXMFSYSCONFIG'}/web2c";
   info("writing updmap.cfg to $TEXMFSYSCONFIG/web2c/updmap.cfg\n");
-  TeXLive::TLUtils::create_updmap ($tlp, #$localtlpdb,
+  TeXLive::TLUtils::create_updmap ($usedtlpdb,
     "$TEXMFSYSCONFIG/web2c/updmap.cfg",
     "$TEXMFLOCAL/web2c/updmap-local.cfg");
 
   info("writing language.dat data to $TEXMFSYSVAR/tex/generic/config/language.dat\n");
-  TeXLive::TLUtils::create_language_dat($tlp, #$localtlpdb,
+  TeXLive::TLUtils::create_language_dat($usedtlpdb,
     "$TEXMFSYSVAR/tex/generic/config/language.dat",
     "$TEXMFLOCAL/tex/generic/config/language-local.dat");
 
   info("writing language.def data to $TEXMFSYSVAR/tex/generic/config/language.def\n");
-  TeXLive::TLUtils::create_language_def($tlp, #$localtlpdb,
+  TeXLive::TLUtils::create_language_def($usedtlpdb,
     "$TEXMFSYSVAR/tex/generic/config/language.def",
     "$TEXMFLOCAL/tex/generic/config/language-local.def");