registry.pl

   1 #!/usr/bin/env perl
   2 eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
   3     & eval 'exec perl -w -S $0 $argv:q'
   4     if 0;
   5
   6 # ******************************************************************
   7 #  Author: Chad Elliott
   8 #    Date: 12/05/2005
   9 # ******************************************************************
  10
  11 # ******************************************************************
  12 # Pragma Section
  13 # ******************************************************************
  14
  15 use strict;
  16 use FindBin;
  17 use FileHandle;
  18 use File::Basename;
  19
  20 # ******************************************************************
  21 # Data Section
  22 # ******************************************************************
  23
  24 my $Registry;
  25 my $MPC_ROOT = $FindBin::Bin;
  26 $MPC_ROOT =~ s!/!\\!g;
  27
  28 my $version = '1.4';
  29 my %types   = ('nmake' => ['NMAKE', 'NMAKE'],
  30                'bmake' => ['Borland Make', 'Borland Make'],
  31                'vc6'   => ['DSW', 'DSP'],
  32                'vc71'  => ['SLN 7.1', 'VCPROJ 7.1'],
  33                'vc8'   => ['SLN 8.0', 'VCPROJ 8.0'],
  34                'vc9'   => ['SLN 9.0', 'VCPROJ 9.0'],
  35                'vc10'  => ['SLN 10.0', 'VCPROJ 10.0'],
  36                'vc11'  => ['SLN 11.0', 'VCPROJ 11.0'],
  37                'vc12'  => ['SLN 12.0', 'VCPROJ 12.0'],
  38                'vc14'  => ['SLN 14.0', 'VCPROJ 14.0'],
  39                'vs2017' => ['SLN 2017', 'PROJ 2017'],
  40                'vs2019' => ['SLN 2019', 'PROJ 2019'],
  41                'vs2022' => ['SLN 2022', 'PROJ 2022'],
  42                'wix'   => ['WiX', 'WiX Project'],
  43               );
  44
  45 # ******************************************************************
  46 # Subroutine Section
  47 # ******************************************************************
  48
  49 sub set_ext_icon {
  50   my($ext, $num) = @_;
  51   my $extf = $ext . 'file';
  52   $Registry->{"HKEY_CLASSES_ROOT/.$ext/"} = {'/' => $extf};
  53   $Registry->{"HKEY_CLASSES_ROOT/$extf/"} = {};
  54   $Registry->{"HKEY_CLASSES_ROOT/$extf/DefaultIcon/"} =
  55                            {'/' => "$MPC_ROOT\\MPC.ico,$num"};
  56 }
  57
  58
  59 sub set_dir_command {
  60   my($type, $desc) = @_;
  61   my $shell = 'HKEY_CLASSES_ROOT/Directory/shell';
  62   my $hash = $Registry->{$shell};
  63
  64   ## If there is no shell setting, just create an empty one.  However,
  65   ## this isn't very likely.
  66   if (!defined $hash) {
  67     $Registry->{$shell} = {};
  68     $hash = $Registry->{$shell};
  69   }
  70
  71   ## Create an entry for this project type (vc6, vc7, etc.)
  72   my $key = 'MPC' . uc($type) . '/';
  73   $hash->{$key} = {'/' => "MPC -> $desc"};
  74
  75   ## Now store the command for creating a workspace for this project
  76   ## type.
  77   $key .= 'command/';
  78   $hash->{$key} = {'/' => "cmd /c \"cd %L && $MPC_ROOT\\mwc.pl -type $type -recurse || pause\""};
  79 }
  80
  81
  82 sub set_mwc_command {
  83   my($type, $desc) = @_;
  84   my $shell = 'HKEY_CLASSES_ROOT/mwcfile/shell';
  85   my $hash = $Registry->{$shell};
  86
  87   ## Create the new entry for the mwc files.  This is likely to not
  88   ## exist.
  89   if (!defined $hash) {
  90     $Registry->{$shell} = {};
  91     $hash = $Registry->{$shell};
  92   }
  93
  94   ## Create an entry for this project type (vc6, vc7, etc.)
  95   my $key = 'MPC' . uc($type) . '/';
  96   $hash->{$key} = {'/' => "MPC -> $desc"};
  97
  98   ## Now store the command for creating a workspace for this project
  99   ## type.
 100   $key .= 'command/';
 101   $hash->{$key} = {'/' => "cmd /c \"$MPC_ROOT\\mwc.pl -type $type %L || pause\""};
 102
 103   ## Since MPC will create a workspace out of a directory, we want to do
 104   ## the same thing for directories too.
 105   set_dir_command($type, $desc);
 106 }
 107
 108
 109 sub set_mpc_command {
 110   my($type, $desc) = @_;
 111   my $shell = 'HKEY_CLASSES_ROOT/mpcfile/shell';
 112   my $hash = $Registry->{$shell};
 113
 114   ## Create the new entry for the mpc files.  This is likely to not
 115   ## exist.
 116   if (!defined $hash) {
 117     $Registry->{$shell} = {};
 118     $hash = $Registry->{$shell};
 119   }
 120
 121   ## Create an entry for this project type (vc6, vc7, etc.)
 122   my $key = 'MPC' . uc($type) . '/';
 123   $hash->{$key} = {'/' => "MPC -> $desc"};
 124
 125   ## Now store the command for creating a single project for this project
 126   ## type.
 127   $key .= 'command/';
 128   $hash->{$key} = {'/' => "cmd /c \"$MPC_ROOT\\mpc.pl -type $type %L || pause\""};
 129 }
 130
 131
 132 sub delete_key {
 133   my $key = shift;
 134   my $val = $Registry->{$key};
 135
 136   ## Delete everything associated with this key (recursively traversing
 137   ## each key).
 138   if (UNIVERSAL::isa($val, 'HASH')) {
 139     foreach my $k (keys %$val) {
 140       delete_key($key . $k);
 141     }
 142   }
 143
 144   ## Now get the key itself.
 145   delete $Registry->{$key};
 146 }
 147
 148 # ******************************************************************
 149 # Main Section
 150 # ******************************************************************
 151
 152 if ($^O eq 'MSWin32') {
 153   ## Pull in the registry modules and import the necessary items.
 154   require Win32::TieRegistry;
 155   Win32::TieRegistry->import(TiedRef => \$Registry,
 156                              Delimiter => '/');
 157 }
 158 else {
 159   ## Currently, no other registry type is supported.
 160   print "ERROR: This script will only run on Windows.\n";
 161   exit(1);
 162 }
 163
 164 if (defined $ARGV[0]) {
 165   if ($ARGV[0] eq '-r') {
 166     ## Get rid of the MPC_ROOT environment variable.
 167     delete $Registry->{'HKEY_CURRENT_USER/Environment/MPC_ROOT'};
 168
 169     ## Now delete all the keys that this script knows how to make.
 170     delete_key('HKEY_CLASSES_ROOT/.mwc/');
 171     delete_key('HKEY_CLASSES_ROOT/mwcfile/');
 172     delete_key('HKEY_CLASSES_ROOT/.mpc/');
 173     delete_key('HKEY_CLASSES_ROOT/mpcfile/');
 174     delete_key('HKEY_CLASSES_ROOT/.mpb/');
 175     delete_key('HKEY_CLASSES_ROOT/mpbfile/');
 176
 177     foreach my $type (keys %types) {
 178       delete_key('HKEY_CLASSES_ROOT/Directory/shell/MPC' . uc($type) . '/');
 179     }
 180
 181     exit(0);
 182   }
 183   else {
 184     print STDERR "registry v$version\n",
 185                  "Usage: ", basename($0), " [-r]\n\n",
 186                  "       -r  Remove MPC related registry keys.\n\n",
 187                  "Set the MPC_ROOT environment variable to the location of this script.\n",
 188                  "Also, add context menus for .mwc files and directories.\n";
 189     exit(0);
 190   }
 191 }
 192
 193 ## Set the MPC_ROOT environment variable.
 194 $Registry->{'HKEY_CURRENT_USER/Environment/MPC_ROOT'} = [$MPC_ROOT, 'REG_SZ'];
 195
 196 ## Associate the icons with the various MPC file types.
 197 set_ext_icon('mwc', 0);
 198 set_ext_icon('mpc', 1);
 199 set_ext_icon('mpb', 1);
 200
 201 ## Create the command settings for each type
 202 foreach my $type (keys %types) {
 203   set_mwc_command($type, $types{$type}->[0]);
 204   set_mpc_command($type, $types{$type}->[1]);
 205 }
 206
 207 print "You may need to log out and then ",
 208       "log back in for some of these settings to take effect.\n";
 209
 210 exit(0);