TLWinGoo/TLUtils: use OpenWithProgIds instead of OpenWithList

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

2 files changed, 250 insertions, 201 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 547f9a70edc..28e0baab29d 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -1515,9 +1515,9 @@ sub do_postaction {
     } elsif ($pa =~ m/\s*fileassoc\s+(.*)\s*$/) {
       $ret &&= _do_postaction_fileassoc($how, $do_fileassocs, $tlpobj, $1);
       next;
-    } elsif ($pa =~ m/\s*appreg\s+(.*)\s*$/) {
+    } elsif ($pa =~ m/\s*progid\s+(.*)\s*$/) {
       next unless $do_fileassocs;
-      $ret &&= _do_postaction_application($how, $tlpobj, $1);
+      $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);
@@ -1611,63 +1611,37 @@ sub _do_postaction_filetype {
   return 1;
 }
 
-sub _do_postaction_application {
+sub _do_postaction_progid {
   my ($how, $tlpobj, $pa) = @_;
   return 1 unless win32();
   my ($errors, %keyval) =
-    parse_into_keywords($pa, qw/prog cmd exts/);
+    parse_into_keywords($pa, qw/extension filetype/);
 
   if ($errors) {
     tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
     return 0;
   }
 
-  # prog
-  if (!defined($keyval{'prog'})) {
-    tlwarn("prog of appreg postaction not given\n");
+  # name can be an arbitrary string
+  if (!defined($keyval{'extension'})) {
+    tlwarn("extension of progid postaction not given\n");
     return 0;
   }
-  my $prog = $keyval{'prog'};
+  my $extension = $keyval{'extension'};
 
-  if (!defined($keyval{'cmd'})) {
-    tlwarn("cmd of appreg postaction not given\n");
+  # cmd can be an arbitrary string
+  if (!defined($keyval{'filetype'})) {
+    tlwarn("filetype of progid postaction not given\n");
     return 0;
   }
-  my $cmd = $keyval{'cmd'};
-
-  my $exts_arr = [];
-  my $e;
-  my $exts = '';
-  if (!defined($keyval{'exts'})) {
-    tlwarn("exts of appreg postaction not given\n");
-  } else {
-    $exts = $keyval{'exts'};
-    foreach $e (split /\|/, $exts) {
-      if ($e =~ /^\./) {
-        push @$exts_arr, $e;
-      } else {
-        tlwarn("Invalid extension $e for $prog ignored\n");
-      }
-    }
-  }
-
-  my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`;
-  chomp($texdir);
-  my $texdir_bsl = conv_to_w32_path($texdir);
-  $cmd =~ s!^("?)TEXDIR/!$1$texdir/!g;
+  my $filetype = $keyval{'filetype'};
 
-  &log("postaction $how appreg for " . $tlpobj->name .
-    ": $prog, $cmd, $exts\n");
+  &log("postaction $how progid for " . $tlpobj->name .
+    ": $extension, $filetype\n");
   if ($how eq "install") {
-    TeXLive::TLWinGoo::register_application($prog, $cmd, $exts_arr);
-    foreach $e (@$exts_arr) {
-      TeXLive::TLWinGoo::add_to_openwithlist($e, $prog);
-    }
+    TeXLive::TLWinGoo::add_to_progids($extension, $filetype);
   } elsif ($how eq "remove") {
-    TeXLive::TLWinGoo::unregister_application($prog);
-    foreach $e (@$exts_arr) {
-      TeXLive::TLWinGoo::remove_from_openwithlist($e, $prog);
-    }
+    TeXLive::TLWinGoo::remove_from_progids($extension, $filetype);
   } else {
     tlwarn("Unknown mode $how\n");
     return 0;
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index 8a4cc591f96..2c6c15d2289 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -49,14 +49,14 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows
   TeXLive::TLWinGoo::setenv_reg($env_var, $env_data);
   TeXLive::TLWinGoo::unsetenv_reg($env_var);
   TeXLive::TLWinGoo::adjust_reg_path_for_texlive($action, $texbindir, $mode);
+  TeXLive::TLWinGoo::add_to_progids($ext, $filetype);
+  TeXLive::TLWinGoo::remove_from_progids($ext, $filetype);
   TeXLive::TLWinGoo::register_extension($mode, $extension, $file_type);
   TeXLive::TLWinGoo::unregister_extension($mode, $extension);
   TeXLive::TLWinGoo::register_file_type($file_type, $command);
   TeXLive::TLWinGoo::unregister_file_type($file_type);
   TeXLive::TLWinGoo::register_application($prog, $cmd, $exts);
-  TeXLive::TLWinGoo::unregister_application($prog);
-  TeXLive::TLWinGoo::add_to_openwithlist($ext, $prog);
-  TeXLive::TLWinGoo::remove_from_openwithlist($ext, $prog);
+  TeXLive::TLWinGoo::unregister_application($prog, $cmd);
 
 =head2 ACTIVATING CHANGES IMMEDIATELY
 
@@ -103,14 +103,12 @@ BEGIN {
     &setenv_reg
     &unsetenv_reg
     &adjust_reg_path_for_texlive
+    &add_to_progids
+    &remove_from_progids
     &register_extension
     &unregister_extension
     &register_file_type
     &unregister_file_type
-    &register_application
-    &unregister_application
-    &add_to_openwithlist
-    &remove_from_openwithlist
     &broadcast_env
     &update_assocs
     &shell_folder
@@ -135,7 +133,7 @@ BEGIN {
     require Win32::API;
     require Win32::TieRegistry;
     Win32::TieRegistry->import( qw( $Registry
-      REG_SZ REG_EXPAND_SZ  KEY_READ KEY_WRITE KEY_ALL_ACCESS
+      REG_SZ REG_EXPAND_SZ REG_NONE KEY_READ KEY_WRITE KEY_ALL_ACCESS
          KEY_ENUMERATE_SUB_KEYS ) );
     $Registry->Delimiter('/');
     $Registry->ArrayValues(0);
@@ -553,8 +551,22 @@ sub adjust_reg_path_for_texlive {
 
 ### helper subs for file types ###
 
-# delete a registry key recursively.
-# the key parameter should be a string, not a registry object.
+# merge recursive hashes such as occur in the registry
+
+sub hash_merge {
+  my $target = shift; # the recursive hash ref to be modified by $mods
+  my $mods = shift; # the recursive hash ref to be merged into $target
+  my $k;
+  foreach $k (keys %$mods) {
+    if (ref($target->{$k}) eq 'HASH' and ref($mods->{$k}) eq 'HASH') {
+      hash_merge($target->{$k}, $mods->{$k});
+    } else {
+      $target->{$k} = $mods->{$k};
+    }
+  }
+}
+
+# prevent catastrophies during testing; not to be used in production code
 
 sub getans {
   my $prompt = shift;
@@ -565,6 +577,9 @@ sub getans {
   die "Aborting as requested";
 }
 
+# delete a registry key recursively.
+# the key parameter should be a string, not a registry object.
+
 sub reg_delete_recurse {
   my $parent = shift;
   my $childname = shift;
@@ -573,17 +588,18 @@ sub reg_delete_recurse {
   my $child;
   if ($childname !~ '^/') { # subkey
     $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()});
-    return unless $child;
+    return 1 unless defined($child);
     foreach my $v (keys %$child) {
       if ($v =~ '^/') { # value
         delete $child->{$v};
       } else { # subkey
-        reg_delete_recurse ($child, $v);
+        return 0 unless reg_delete_recurse ($child, $v);
       }
     }
-    delete $child->{'/'};
+    #delete $child->{'/'};
   }
   delete $parent->{$childname};
+  return 1;
 }
 
 sub cu_root {
@@ -604,22 +620,15 @@ sub lm_root {
   return $k;
 }
 
-# write a registry key or not, depending on
-# mode, existing keys and privilege level
+# write a registry key under HKCU or HKLM, depending on privilege level
 
 sub do_write_regkey {
-  my $mode = shift;
   my $keypath = shift; # modulo cu/lm
-  my $keyhash = shift; # ref to a possibly nested hash
+  my $keyhash = shift; # ref to a possibly nested hash; empty hash allowed
   die "No regkey specified" unless $keypath && defined($keyhash);
   # for error reporting:
   my $hivename = $is_admin ? 'HKLM' : 'HKCU';
 
-  if ($mode == 0) {
-    ddebug "Mode 0: not writing $hivename/$keypath key\n";
-    return 1;
-  }
-
   # split into parent and final subkey
   # remove initial slash from parent
   # ensure subkey ends with slash
@@ -627,7 +636,7 @@ sub do_write_regkey {
   if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) {
     ($parentpath, $keyname) = ($1, $2);
     $keyname .= '/';
-    debug "key - $hivename - $parentpath - $keyname\n";
+    debug ("key - $hivename - $parentpath - $keyname\n");
   } else {
     die "Cannot determine final component of $keypath";
   }
@@ -635,26 +644,9 @@ sub do_write_regkey {
   my $cu_key = cu_root();
   my $lm_key = lm_root();
   # cu_root() and lm_root() already die upon failure
-  my $do_create = 1;
-  if ($mode == 1) {
-    if ($is_admin) {
-      if ($lm_key->{$keypath}) {
-        $do_create = 0;
-        debug "Not writing HKLM/$keypath because already present\n";
-      }
-    } else {
-      if ($cu_key->{$keypath}) {
-        $do_create = 0;
-        debug "Not writing HKCU/$keypath because already present\n";
-      } elsif ($lm_key->{$keypath}) {
-        $do_create = 0;
-        debug "Not writing HKCU/$keypath because ".
-            "HKLM/$keypath already present\n";
-      }
-    }
-  };
-  return 1 unless $do_create;
   my $parentkey;
+
+  # make sure parent exists
   if ($is_admin) {
     $parentkey = $lm_key->Open($parentpath);
     if (!$parentkey) {
@@ -671,49 +663,38 @@ sub do_write_regkey {
     tlwarn "Cannot create parent of $hivename/$keypath\n";
     return 0;
   }
-  if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);}
-  $parentkey->{$keyname} = $keyhash;
+
+  # create or merge key
+  if ($parentkey->{$keyname}) {
+    hash_merge($parentkey->{$keyname}, $keyhash);
+  } else {
+    $parentkey->{$keyname} = $keyhash;
+  }
   if (!$parentkey->{$keyname}) {
-    tlwarn "Failure to create HKLM/$keypath\n";
+    tlwarn "Failure to create $hivename/$keypath\n";
     return 0;
   }
   if ($is_admin and $cu_key->{$keypath}) {
     # delete possibly conflicting cu key
-    reg_delete_recurse ($cu_key->{$parentpath}, $keyname);
-  }
-  if (!$parentkey) {
-    $parentkey = $cu_key->CreateKey($parentpath);
-    if (!$parentkey) {
-      tlwarn "Cannot create parentpath of HKCU/$keypath\n";
-      return 0;
-    }
-  }
-  if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);}
-  $parentkey->{$keyname} = $keyhash;
-  if (!$parentkey->{$keyname}) {
-    tlwarn "Failure to create $hivename/$keypath\n";
-    return 0;
+    tlwarn "Failure to delete $hivename/$keypath key\n" unless
+      reg_delete_recurse ($cu_key->{$parentpath}, $keyname);
   }
   return 1;
 }
 
 sub do_remove_regkey {
-  my $mode = shift;
-  my $keypath = shift;
-  my $testhash = shift;
-  # hashref of subkey/value => data pairs
-  # mode 1: if any is present and does not match, then do not remove
-  # ATM we assume REG_SZ data
-  # In future, a we might use a subroutine reference instead.
+  my $keypath = shift; # key or value
   my $hivename = $is_admin ? 'HKLM' : 'HKCU';
 
-  if ($mode == 0) {
-    ddebug "Mode 0: not removing $hivename/$keypath key\n";
-    return 1;
-  }
-
-  my ($parentpath, $keyname);
-  if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) {
+  my $parentpath = "";
+  my $keyname = "";
+  my $valname = "";
+  # two successive delimiters: value.
+  # *? = non-greedy match: want FIRST double delimiter
+  if ($keypath =~ /^(.*?\/)(\/.*)$/) {
+    ($parentpath, $valname) = ($1, $2);
+    $parentpath =~ s!^/!!; # remove leading delimiter
+  } elsif ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) {
     ($parentpath, $keyname) = ($1, $2);
     $keyname .= '/';
   } else {
@@ -722,12 +703,6 @@ sub do_remove_regkey {
 
   my $cu_key = cu_root();
   my $lm_key = lm_root();
-  if ($is_admin) {
-    return 0 unless $lm_key;
-  } else {
-    return 0 unless $cu_key;
-  }
-  my $do_remove = 1;
   my ($parentkey, $k, $skv, $d);
   if ($is_admin) {
     $parentkey = $lm_key->Open($parentpath);
@@ -735,40 +710,103 @@ sub do_remove_regkey {
     $parentkey = $cu_key->Open($parentpath);
   }
   if (!$parentkey) {
-    $do_remove = 0;
-    debug "$hivename/$parentpath not present or not writable so not removed\n";
+    debug ("$hivename/$parentpath not present or not writable".
+      " so $keypath not removed\n");
     return 1;
   }
-  if ($mode == 1) {
-    $k = $parentkey->{$keyname};
-    if ($k) {
-      if ($testhash) {foreach $skv (keys %$testhash) {
-        $d = $k->{$keyname.$skv};
-        if ($d and $d ne $test->{$skv}) {
-          $do_remove = 0;
-          debug "$hivename/$keypath modified; not deleting\n";
-          last;
-        }
-      }}
-    } else {
-      $do_remove = 0;
-      debug "$hivename/$keypath not present or not writable so not removed\n";
+  if ($keyname) {
+    #getans("Deleting $parentpath$keyname regkey? ");
+    reg_delete_recurse($parentkey, $keyname);
+    if ($parentkey->{$keyname}) {
+      tlwarn "Failure to delete $hivename/$keypath\n";
+      return 0;
+    }
+    if ($is_admin and $cu_key->{$parentpath}) {
+      reg_delete_recurse($cu_key->{$parentpath}, $keyname);
+      if ($cu_key->{$parentpath}->{$keyname}) {
+        tlwarn "Failure to delete HKCU/$keypath\n";
+        return 0;
+      }
+    }
+  } else {
+    delete $parentkey->{$valname};
+    if ($parentkey->{$valname}) {
+      tlwarn "Failure to delete $hivename/$keypath\n";
+      return 0;
+    }
+    if ($is_admin and $cu_key->{$parentpath}) {
+      delete $cu_key->{$parentpath}->{$valname};
+      if ($cu_key->{$parentpath}->{$valname}) {
+        tlwarn "Failure to delete HKCU/$keypath\n";
+        return 0;
+      }
     }
-  };
-  return 1 unless $do_remove;
-  #getans("Deleting $parentpath$keyname regkey? ");
-  reg_delete_recurse($parentkey, $keyname);
-  if ($parentkey->{$keyname}) {
-    tlwarn "Failure to delete $hivename/$keypath\n";
-    return 0;
-  }
-  if ($is_admin and $cu_key->{$parentpath}) {
-    reg_delete_recurse($cu_key->{$parentpath}, $keyname);
-    # no errorchecking this once
   }
   return 1;
 }
 
+sub current_valdata {
+  my $value_path = shift;
+  die "Illegal value path $value_path"
+      unless $value_path =~ /\/\//;
+  my $valdata = "";
+  if ($is_admin) {
+    $valdata = lm_root()->{"Software/Classes/$value_path"};
+  } else {
+    $valdata = $Registry->{"Classes/$value_path"};
+  }
+  $valdata = "" unless defined($valdata);
+  return $valdata;
+}
+
+=pod
+
+=item C<add_to_progids($ext, $filetype)>
+
+Add $filetype to the list of programs which open $ext files
+
+=cut
+
+sub add_to_progids {
+  my $ext = shift;
+  my $filetype = shift;
+  $Registry->ArrayValues(1);
+  do_write_regkey("Software/Classes/$ext/OpenWithProgIds/",
+      {"/$filetype" => [0, REG_NONE()]});
+  $Registry->ArrayValues(0);
+}
+
+=pod
+
+=item C<remove_from_progids($ext, $filetype)>
+
+Remove $filetype from the list of programs which open $ext files
+
+=cut
+
+sub remove_from_progids {
+  my $ext = shift;
+  my $filetype = shift;
+  do_remove_regkey("Software/Classes/$ext/OpenWithProgIds//$filetype");
+}
+
+sub active_file_type {
+  # current filetype, except
+  # return empty string if no action associated with it
+  my $extension = shift; # assume leading dot
+  my $file_type = current_valdata("$extension//");
+  my $is_active = 0;
+  if ($is_admin) {
+    $is_active = 1 if ($file_type and
+      lm_root()->{"Software/Classes/$file_type/shell/"});
+  } else {
+    $is_active = 1 if ($file_type and
+      $Registry->{"Classes/$file_type/shell/"});
+  }
+  $file_type = "" unless $is_active;
+  return $file_type;
+}
+
 =pod
 
 =item C<register_extension($mode, $extension, $file_type)>
@@ -776,29 +814,50 @@ sub do_remove_regkey {
 Add registry entry to associate $extension with $file_type. Slashes
 are flipped where necessary.
 
-If $mode is 0, nothing is actually done. If $mode is 1, only not-present
-keys of keys that are matching the given key are (re)created. If $mode
-is 2 then keys are (re)created in any case.
+If $mode is 0, nothing is actually done.
+
+For $mode 1, the filetype for the extension is preserved, but only
+if shell actions are defined for it. This is slightly changed from
+previous versions. Because that Windows often creates filetypes for
+extensions automatically, it seems better to ignore filetypes
+without actions.
+
+For $mode 2, the filetype is always overwritten.
 
 =cut
 
 sub register_extension {
   my $mode = shift;
+  return 1 if $mode == 0;
   my $extension = shift;
   # ensure leading dot
   $extension = '.'.$extension unless $extension =~ /^\./;
   $extension = lc($extension);
-
   my $file_type = shift;
-  debug("Linking $extension to $file_type\n");
-
-  my $regkey = {'/' => $file_type};
-  do_write_regkey($mode, "Software/Classes/$extension/", $regkey);
+  my $regkey;
+
+  my $old_file_type = active_file_type($extension);
+  if ($old_file_type and $old_file_type ne $file_type) {
+    if ($mode == 1) {
+      debug ("Not overwriting $old_file_type with $file_type for $extension\n");
+      debug ("Adding to OpenWithProgIds instead\n");
+      add_to_progids ($extension, $file_type);
+    } else {
+      debug("Linking $extension to $file_type\n");
+      add_to_progids ($extension, $old_file_type);
+      $regkey = {'/' => $file_type};
+      do_write_regkey("Software/Classes/$extension/", $regkey);
+      remove_from_progids($extension, $file_type);
+    }
+  } else {
+    $regkey = {'/' => $file_type};
+    do_write_regkey("Software/Classes/$extension/", $regkey);
+  }
 }
 
 =pod
 
-=item C<unregister_extension($mode, $extension, $filetype)>
+=item C<unregister_extension($mode, $extension, $file_type)>
 
 Reversal of register_extension.
 
@@ -807,15 +866,21 @@ Reversal of register_extension.
 sub unregister_extension {
   # we don't error check; we just do the best we can.
   my $mode = shift;
-  # mode 0: continue anyhow and let do_remove_regkey
-  # bail out with a debug message.
+  return 1 if $mode == 0;
+  # mode 1 and 2 treated identically:
+  # only unregister if the value is as expected
   my $extension = shift;
-  my $filetype = shift;
+  my $file_type = shift;
   $extension = '.'.$extension unless $extension =~ /^\./;
-  debug("unregistering $extension\n");
-
-  $testhash = {"/" => $filetype};
-  do_remove_regkey($mode, "Software/Classes/".$extension, $testhash);
+  remove_from_progids($extension, $file_type);
+  my $old_file_type = current_valdata("$extension//");
+  if ($old_file_type ne $file_type) {
+    debug("Filetype $extension now $old_file_type; not ours, so not removed\n");
+    return 1;
+  } else {
+    debug("unregistering extension $extension\n");
+    do_remove_regkey("Software/Classes/$extension//");
+  }
 }
 
 =pod
@@ -842,7 +907,7 @@ sub register_file_type {
       }
     }
   };
-  do_write_regkey(2, "Software/Classes/$file_type", $keyhash);
+  do_write_regkey("Software/Classes/$file_type", $keyhash);
 }
 
 =pod
@@ -855,9 +920,11 @@ Reversal of register_script_type.
 
 sub unregister_file_type {
   # we don't error check; we just do the best we can.
+  # All our filetypes start with 'TL.' so we consider them
+  # our own even if they have been tampered with.
   my $file_type = shift;
   debug ("unregistering $file_type\n");
-  do_remove_regkey(2, "Software/Classes/$file_type/");
+  do_remove_regkey("Software/Classes/$file_type/");
 }
 
 =pod
@@ -876,8 +943,6 @@ sub register_application {
 
   my $hsh;
   foreach my $e (@$exts) {$hsh->{"/$e"} = "";}
-  #my $prog = TeXLive::TLUtils::basename($path);
-  # $cmd = "\"$path\" \"%1\""; # done by caller
   $cmd =~ s!/!\\!g;
   my $keyhash = {
     "shell/" => {
@@ -889,49 +954,56 @@ sub register_application {
     },
     "SupportedTypes" => $hsh
   };
-  do_write_regkey(2, "Software/Classes/Applications/$prog", $keyhash);
+  do_write_regkey("Software/Classes/Applications/$prog", $keyhash);
 }
 
 =pod
 
-=item C<unregister_application($prog)>
+=item C<unregister_application($prog, $cmd)>
 
-Reversal of register_application
+Reversal of register_application. Return value: key no longer exists.
 
 =cut
 
 sub unregister_application {
   my $prog = shift;
-  do_remove_regkey(2, "Software/Classes/Applications/$prog");
-}
-
-=pod
-
-=item C<add_to_openwithlist($ext, $prog)>
-
-Add $prog to the list of programs which open $ext files
-
-=cut
-
-sub add_to_openwithlist {
-  my $ext = shift;
-  my $prog = shift;
-  do_write_regkey(2, "Software/Classes/$ext/OpenWithList/$prog", {});
-}
-
-=pod
-
-=item C<remove_from_openwithlist($ext, $prog)>
-
-Remove $prog from the list of programs which open $ext files
-
-=cut
-
-sub remove_from_openwithlist {
-  my $ext = shift;
-  my $prog = shift;
-  do_remove_regkey(2, "Software/Classes/$ext/OpenWithList/$prog");
+  my $cmd = shift;
+  my $hive = $is_admin ? "LMachine" : "CUser";
+  my $regpath = "Software/Classes/Applications/$prog";
+  my $regkey = $Registry->{"$hive/$regpath/"};
+  return 1 unless $regkey;
+  my $current_cmd = $regkey->{"shell/open/command//"};
+  do_remove_regkey("$hive/$regpath/") if $cmd eq $current_cmd;
+  return !defined($regkey);
 }
+#
+#=pod
+#
+#=item C<add_to_openwithlist($ext, $prog)>
+#
+#Add $prog to the list of programs which open $ext files
+#
+#=cut
+#
+#sub add_to_openwithlist {
+#  my $ext = shift;
+#  my $prog = shift;
+#  do_write_regkey("Software/Classes/$ext/OpenWithList/$prog", {});
+#}
+#
+#=pod
+#
+#=item C<remove_from_openwithlist($ext, $prog)>
+#
+#Remove $prog from the list of programs which open $ext files
+#
+#=cut
+#
+#sub remove_from_openwithlist {
+#  my $ext = shift;
+#  my $prog = shift;
+#  do_remove_regkey("Software/Classes/$ext/OpenWithList/$prog");
+#}
 
 =pod
 
@@ -1254,8 +1326,11 @@ sub unregister_uninstaller {
     "/software/microsoft/windows/currentversion/uninstall/";
   my $regkey_uninst = $Registry->Open($regkey_uninst_path,
     {Access => KEY_ALL_ACCESS()});
-  reg_delete_recurse($regkey_uninst, "TeXLive$::TeXLive::TLConfig::ReleaseYear/") 
+  reg_delete_recurse(
+    $regkey_uninst, "TeXLive$::TeXLive::TLConfig::ReleaseYear/") 
     if $regkey_uninst;
+  tlwarn "Failure to unregister uninstaller\n" if
+    $regkey_uninst->{"TeXLive$::TeXLive::TLConfig::ReleaseYear/"};
 }
 
 =pod