Split win32 filetypes in extension<=>filetype and filetype<=>command

git-svn-id: svn://tug.org/texlive/trunk@8236 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 104 insertions, 53 deletions

diff --git a/Master/tlpkg/TeXLive/TLPostActions.pm b/Master/tlpkg/TeXLive/TLPostActions.pm
index 173cf6bb447..2f6e16f7cf4 100644
--- a/Master/tlpkg/TeXLive/TLPostActions.pm
+++ b/Master/tlpkg/TeXLive/TLPostActions.pm
@@ -28,7 +28,7 @@ our %PostRemove;
 
 #
 # bin-xetex
-# 
+#
 sub do_install_bin_xetex {
   my ($texdir) = @_;
   #
@@ -37,11 +37,11 @@ sub do_install_bin_xetex {
   # - updated the installation path in bin/win32/conf/fonts.conf
   # - call fc-cache -v
   if (-r "$texdir/bin/win32/conf/fonts.conf") {
-    open(FONTSCONF, "<$texdir/bin/win32/conf/fonts.conf") 
+    open(FONTSCONF, "<$texdir/bin/win32/conf/fonts.conf")
       or die("Cannot open $texdir/bin/win32/conf/fonts.conf");
     my @lines = <FONTSCONF>;
     close(FONTSCONF);
-    open(FONTSCONF, ">$texdir/bin/win32/conf/fonts.conf") 
+    open(FONTSCONF, ">$texdir/bin/win32/conf/fonts.conf")
       or die("Cannot open $texdir/bin/win32/conf/fonts.conf for writing");
     foreach (@lines) {
       $_ =~ s!c:/Program Files/texlive/2008!$texdir!;
@@ -112,6 +112,10 @@ sub do_install_bin_tlpsv_win32 {
       '', # no args
       'batgui', # any non-null value to hide command-prompt
     );
+    register_extension(".ps", "PostScript");
+    register_extension(".eps", "PostScript");
+    register_file_type("PostScript", $texdir.'/bin/win32/psv.bat');
+    update_assocs();
   }
 }
 sub do_remove_bin_tlpsv_win32 {
@@ -119,6 +123,10 @@ sub do_remove_bin_tlpsv_win32 {
   if (win32()) {
     remove_desktop_shortcut('PS_View');
     remove_menu_shortcut($mainmenu, 'PS_View');
+    unregister_extension(".ps");
+    unregister_extension(".eps");
+    unregister_file_type("PostScript");
+    update_assocs();
   }
 }
 $PostRemove{'bin-tlpsv.win32'} = \&do_remove_bin_tlpsv_win32;
@@ -377,9 +385,9 @@ sub do_bin_dvipdfm {
   }
   # fix up dvipdfm config file to contain the right # piping command
   mkdirhier("$TEXMFSYSVAR/dvipdfm/config");
-  open(DVIPDFMCONFIGDIST, "<$TEXDIR/texmf/dvipdfm/config/config") 
+  open(DVIPDFMCONFIGDIST, "<$TEXDIR/texmf/dvipdfm/config/config")
     or die("Cannot open $TEXDIR/texmf/dvipdfm/config/config");
-  open(DVIPDFMCONFIGINST, ">$TEXMFSYSVAR/dvipdfm/config/config") 
+  open(DVIPDFMCONFIGINST, ">$TEXMFSYSVAR/dvipdfm/config/config")
     or die("Cannot open $TEXMFSYSVAR/dvipdfm/config/config");
   while (<DVIPDFMCONFIGDIST>) {
     if (m/^D /) {
@@ -401,9 +409,9 @@ sub do_bin_dvipdfmx {
     chomp($TEXMFSYSVAR);
   }
   # dvipdfmx.cfg
-  open(DVIPDFMCONFIGDIST, "<$TEXDIR/texmf/dvipdfm/dvipdfmx.cfg") 
+  open(DVIPDFMCONFIGDIST, "<$TEXDIR/texmf/dvipdfm/dvipdfmx.cfg")
     or die("Cannot open $TEXDIR/texmf/dvipdfm/dvipdfmx.cfg");
-  open(DVIPDFMCONFIGINST, ">$TEXMFSYSVAR/dvipdfm/dvipdfmx.cfg") 
+  open(DVIPDFMCONFIGINST, ">$TEXMFSYSVAR/dvipdfm/dvipdfmx.cfg")
     or die("Cannot open $TEXMFSYSVAR/dvipdfm/dvipdfmx.cfg");
   while (<DVIPDFMCONFIGDIST>) {
     # current dvipdfmx.cfg already contains the right rungs incantation
@@ -456,7 +464,7 @@ sub do_context {
     chomp($TEXMFSYSVAR);
   }
   # old installer did this, should we do this, TOO????
-  copy ("$TEXDIR/texmf-dist/tex/context/config/cont-usr.tex", 
+  copy ("$TEXDIR/texmf-dist/tex/context/config/cont-usr.tex",
         "$TEXMFSYSVAR/tex/context/config");
 }
 # $PostInstall{"context"} = \&do_context;
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index 513c5c0724e..9a5b512c914 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -45,8 +45,10 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows
   TeXLive::TLWinGoo::unsetenv_reg($env_var);
   TeXLive::TLWinGoo::add_texbindir_to_path($texpath);
   TeXLive::TLWinGoo::remove_texbindirs_from_path;
-  TeXLive::TLWinGoo::register_script_type($extension, $command);
-  TeXLive::TLWinGoo::unregister_script_type($extension);
+  TeXLive::TLWinGoo::register_extension($extension, $file_type);
+  TeXLive::TLWinGoo::unregister_extension($extension);
+  TeXLive::TLWinGoo::register_file_type($file_type, $command);
+  TeXLive::TLWinGoo::unregister_file_type($file_type);
 
 =head2 ACTIVATING CHANGES IMMEDIATELY
 
@@ -96,8 +98,10 @@ BEGIN {
     &unsetenv_reg
     &add_texbindir_to_path
     &remove_texbindirs_from_path
-    &register_script_type
-    &unregister_script_type
+    &register_extension
+    &unregister_extension
+    &register_file_type
+    &unregister_file_type
     &broadcast_env
     &update_assocs
     &add_desktop_shortcut
@@ -641,85 +645,59 @@ sub reg_delete_recurse {
 
 =pod
 
-=pod
-
-=item C<register_script_type($extension, $command)>
+=item C<register_extension($extension, $file_type)>
 
-Add registry entries to associate $extension with $command. Slashes
+Add registry entry to associate $extension with $file_type. Slashes
 are flipped where necessary.
 
 =cut
 
-# todo:
-# split ftype and assoc
-# non-admin: add to startup script
-
-sub register_script_type {
+sub register_extension {
   my $extension = shift;
   $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot
   $extension = uc($extension);
-  my $command = shift;
-  $command =~s/\//\\/g;
-  debug("Linking $extension to $command\n");
-  my $user_env = get_user_env();
-  my $system_env = get_system_env();
+  my $file_type = shift;
+  debug("Linking $extension to $file_type\n");
   my ($classes_key, $k);
 
-  # file type
   $extension = lc($extension);
   if ($is_admin) {
     $classes_key = $Registry -> Open("LMachine/Software/Classes/",
       {Access => KEY_ALL_ACCESS()}) or die "Cannot open classpath";
     $k = $classes_key->CreateKey($extension);
     $k -> ArrayValues(0);
-    $k -> {"/"} = "script".$extension;
-    $k = $classes_key->CreateKey("script".$extension."/Shell/Open/Command/");
-    $k -> ArrayValues(1);
-    $k -> {"/"} = [ '"'.$command.'" "%1" %*',
-      ($command =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
-    # delete possibly conflicting values from HKCU/software
+    $k -> {"/"} = $file_type;
+    # delete possibly conflicting value from HKCU/software
     $classes_key = $Registry -> Open("CUser/Software/Classes/",
         {Access => KEY_ALL_ACCESS()});
     delete $classes_key -> {$extension};
-    reg_delete_recurse($classes_key, "script".$extension);
   } else {
     $classes_key = $Registry -> Open("CUser/Software/Classes/",
         {Access => KEY_ALL_ACCESS()});
     $k = $classes_key->CreateKey($extension);
     $k -> ArrayValues(0);
-    $k -> {"/"} = "script".$extension;
-    $k = $classes_key->CreateKey("script".$extension."/Shell/Open/Command/");
-    $k -> ArrayValues(1);
-    $k -> {"/"} = [ '"'.$command.'" "%1" %*',
-      ($command =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
+    $k -> {"/"} = $file_type;
   }
 }
 
 =pod
 
-=item C<unregister_script_type($extension)>
+=item C<unregister_extension($extension)>
 
-Reversal of register_script_type.
+Reversal of register_extension.
 
 =cut
 
-sub unregister_script_type {
+sub unregister_extension {
   # we don't error check; we just do the best we can.
   my $extension = shift;
   $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot
   $extension = uc($extension);
   debug("unregistering $extension\n");
-  #my $user_env = get_user_env();
-  #my $system_env = get_system_env();
-
-  # file type
-  debug("Deleting texlua filetype\n");
-  $extension = lc($extension);
   my $classes_key = $Registry -> Open("CUser/Software/Classes/",
     {Access => KEY_ALL_ACCESS()});
   if ($classes_key) {
     reg_delete_recurse ($classes_key, $extension."/");
-    reg_delete_recurse ($classes_key, "script".$extension."/");
   } else {
     debug("Cannot open HKCU classes for write\n");
   }
@@ -728,11 +706,76 @@ sub unregister_script_type {
     {Access => KEY_ALL_ACCESS()});
     if ($classes_key) {
       reg_delete_recurse ($classes_key, $extension."/");
-      reg_delete_recurse ($classes_key, "script".$extension."/");
     } else {
     debug("Cannot open HKLM classes for write\n");
     }
-    reg_delete_recurse ($classes_key, "script$extension");
+  }
+}
+
+=pod
+
+=item C<register_file_type($file_type, $command)>
+
+Add registry entries to associate $file_type with $command. Slashes
+are flipped where necessary.
+
+=cut
+
+sub register_file_type {
+  my $file_type = shift;
+  my $command = shift;
+  $command =~s/\//\\/g;
+  debug ("Linking $file_type to $command\n");
+  my ($classes_key, $k);
+
+  if ($is_admin) {
+    $classes_key = $Registry -> Open("LMachine/Software/Classes/",
+      {Access => KEY_ALL_ACCESS()}) or die "Cannot open classpath";
+    $k = $classes_key->CreateKey($file_type."/Shell/Open/Command/");
+    $k -> {"/"} = '"'.$command.'" "%1" %*';
+    $k -> ArrayValues(0);
+    # delete possibly conflicting values from HKCU/software
+    $classes_key = $Registry -> Open("CUser/Software/Classes/",
+        {Access => KEY_ALL_ACCESS()});
+    reg_delete_recurse($classes_key, $file_type);
+  } else {
+    $classes_key = $Registry -> Open("CUser/Software/Classes/",
+        {Access => KEY_ALL_ACCESS()});
+    $k = $classes_key->CreateKey($file_type."/Shell/Open/Command/");
+    $k -> ArrayValues(0);
+    $k -> {"/"} = '"'.$command.'" "%1" %*';
+  }
+}
+
+=pod
+
+=item C<unregister_file_type($file_type)>
+
+Reversal of register_script_type.
+
+=cut
+
+sub unregister_file_type {
+  # we don't error check; we just do the best we can.
+  my $file_type = shift;
+  debug ("unregistering $file_type\n");
+
+  my $classes_key = $Registry -> Open("CUser/Software/Classes/",
+    {Access => KEY_ALL_ACCESS()});
+  if ($classes_key) {
+    reg_delete_recurse ($classes_key, $file_type."/");
+  } else {
+     ("Cannot open HKCU classes for write\n");
+  }
+  if ($is_admin) {
+    $classes_key = $Registry -> Open("LMachine/Software/Classes/",
+    {Access => KEY_ALL_ACCESS()});
+    if ($classes_key) {
+      reg_delete_recurse ($classes_key, $file_type."/");
+    } else {
+    debug ("Cannot open HKLM classes for write\n");
+    }
+    #reg_delete_recurse ($classes_key, $file_type);
   }
 }
 
@@ -849,7 +892,7 @@ sub add_desktop_shortcut {
   # create shortcut
   my ($shc, $shpath, $shfile);
   $shc = new Win32::Shortcut();
-  $shc->{'IconLocation'} = $icon;
+  $shc->{'IconLocation'} = $icon if -f $icon;
   $shc->{'Path'} = $prog;
   $shc->{'Arguments'} = $args;
   $shc->{'ShowCmd'} = SW_SHOWMINNOACTIVE if $batgui;
@@ -882,7 +925,7 @@ sub add_menu_shortcut {
 
   my ($shc, $shpath, $shfile);
   $shc = new Win32::Shortcut();
-  $shc->{'IconLocation'} = $icon;
+  $shc->{'IconLocation'} = $icon if -f $icon;
   $shc->{'Path'} = $prog;
   $shc->{'Arguments'} = $args;
   $shc->{'ShowCmd'} = SW_SHOWMINNOACTIVE if $batgui;
diff --git a/Master/tlpkg/tlpsv/psv_1.ico b/Master/tlpkg/tlpsv/psv_1.ico
new file mode 100644
index 00000000000..cb28890edc7
--- /dev/null
+++ b/Master/tlpkg/tlpsv/psv_1.ico