diff options
| -rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 43 |
1 files changed, 34 insertions, 9 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index 10ef2e9e0f3..48c8a32dbb4 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -626,11 +626,22 @@ sub lm_root { return $k; } +sub cl_root { + my $k = $Registry -> Open("Classes", { + Access => KEY_READ(), Delimiter => '/' + }); + die "Cannot open HKCR for reading" unless $k; + return $k; +} + # write a registry key under HKCU or HKLM, depending on privilege level +# If admin, $remove_cu means to delete the corresponding HKCU entry. +# This parameter is ignored in the non-admin case sub do_write_regkey { my $keypath = shift; # modulo cu/lm my $keyhash = shift; # ref to a possibly nested hash; empty hash allowed + my $remove_cu = shift; die "No regkey specified" unless $keypath && defined($keyhash); # for error reporting: my $hivename = $is_admin ? 'HKLM' : 'HKCU'; @@ -680,7 +691,7 @@ sub do_write_regkey { tlwarn "Failure to create $hivename/$keypath\n"; return 0; } - if ($is_admin and $cu_key->{$keypath}) { + if ($is_admin and $cu_key->{$keypath} and $remove_cu) { # delete possibly conflicting cu key tlwarn "Failure to delete $hivename/$keypath key\n" unless reg_delete_recurse ($cu_key->{$parentpath}, $keyname); @@ -692,6 +703,7 @@ sub do_write_regkey { sub do_remove_regkey { my $keypath = shift; # key or value + my $remove_cu = shift; my $hivename = $is_admin ? 'HKLM' : 'HKCU'; my $parentpath = ""; @@ -807,12 +819,21 @@ sub active_file_type { my $extension = shift; # assume leading dot my $file_type = current_valdata("$extension//"); my $is_active = 0; + debug("active_file_type called for $extension and $file_type\n"); if ($is_admin) { $is_active = 1 if ($file_type and lm_root()->{"Software/Classes/$file_type/shell/"}); } else { + if ($::opt_verbosity) { + my $cmd = cl_root()->{"$file_type/shell/open/command//"}; + if ($cmd) { + debug("Action: $cmd\n"); + } else { + debug("No open command for $extension and $file_type\n"); + } + } $is_active = 1 if ($file_type and - $Registry->{"Classes/$file_type/shell/"}); + cl_root()->{"$file_type/shell/"}); } $file_type = "" unless $is_active; return $file_type; @@ -850,21 +871,24 @@ sub register_extension { my $regkey; my $old_file_type = active_file_type($extension); + # admin: whether to remove HKCU entry. admin never _writes_ to HKCU + my $remove_cu = ($mode == 2) && is_admin(); + # can do the following safely: + debug ("Adding $file_type to OpenWithProgIds of $extension\n"); + add_to_progids ($extension, $file_type); 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"); + debug ("Moving $old_file_type to OpenWithProgIds\n"); add_to_progids ($extension, $old_file_type); $regkey = {'/' => $file_type}; - do_write_regkey("Software/Classes/$extension/", $regkey); - remove_from_progids($extension, $file_type); + do_write_regkey("Software/Classes/$extension/", $regkey, $remove_cu); } } else { $regkey = {'/' => $file_type}; - do_write_regkey("Software/Classes/$extension/", $regkey); + do_write_regkey("Software/Classes/$extension/", $regkey, $remove_cu); } } @@ -881,7 +905,7 @@ sub unregister_extension { my $mode = shift; return 1 if $mode == 0; # mode 1 and 2 treated identically: - # only unregister if the value is as expected + # only unregister if the current value is as expected my $extension = shift; my $file_type = shift; $extension = '.'.$extension unless $extension =~ /^\./; @@ -909,7 +933,8 @@ caller if necessary. sub register_file_type { my $file_type = shift; my $command = shift; - $command =~s/\//\\/g; + tlwarn "register_file_type called with empty command\n" unless $command; + $command =~s!/!\\!g; debug ("Linking $file_type to $command\n"); my $keyhash = { "shell/" => { |