From d11e99ad008ba1e3fbeb4c74a61b3b5979a100b7 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Mon, 19 May 2008 16:35:29 +0000 Subject: Split win32 filetypes in extension<=>filetype and filetype<=>command git-svn-id: svn://tug.org/texlive/trunk@8236 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLWinGoo.pm | 133 ++++++++++++++++++++++++++------------- 1 file changed, 88 insertions(+), 45 deletions(-) (limited to 'Master/tlpkg/TeXLive/TLWinGoo.pm') 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 -- 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 - ®ister_script_type - &unregister_script_type + ®ister_extension + &unregister_extension + ®ister_file_type + &unregister_file_type &broadcast_env &update_assocs &add_desktop_shortcut @@ -641,85 +645,59 @@ sub reg_delete_recurse { =pod -=pod - -=item C +=item C -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 +=item C -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 + +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 + +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; -- cgit v1.2.3