registry.pl

   1 #! /usr/bin/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                'wix'   => ['WiX', 'WiX Project'],
  41               );
  42
  43 # ******************************************************************
  44 # Subroutine Section
  45 # ******************************************************************
  46
  47 sub set_ext_icon {
  48   my($ext, $num) = @_;
  49   my $extf = $ext . 'file';
  50   $Registry->{"HKEY_CLASSES_ROOT/.$ext/"} = {'/' => $extf};
  51   $Registry->{"HKEY_CLASSES_ROOT/$extf/"} = {};
  52   $Registry->{"HKEY_CLASSES_ROOT/$extf/DefaultIcon/"} =
  53                            {'/' => "$MPC_ROOT\\MPC.ico,$num"};
  54 }
  55
  56
  57 sub set_dir_command {
  58   my($type, $desc) = @_;
  59   my $shell = 'HKEY_CLASSES_ROOT/Directory/shell';
  60   my $hash = $Registry->{$shell};
  61
  62   ## If there is no shell setting, just create an empty one.  However,
  63   ## this isn't very likely.
  64   if (!defined $hash) {
  65     $Registry->{$shell} = {};
  66     $hash = $Registry->{$shell};
  67   }
  68
  69   ## Create an entry for this project type (vc6, vc7, etc.)
  70   my $key = 'MPC' . uc($type) . '/';
  71   $hash->{$key} = {'/' => "MPC -> $desc"};
  72
  73   ## Now store the command for creating a workspace for this project
  74   ## type.
  75   $key .= 'command/';
  76   $hash->{$key} = {'/' => "cmd /c \"cd %L && $MPC_ROOT\\mwc.pl -type $type -recurse || pause\""};
  77 }
  78
  79
  80 sub set_mwc_command {
  81   my($type, $desc) = @_;
  82   my $shell = 'HKEY_CLASSES_ROOT/mwcfile/shell';
  83   my $hash = $Registry->{$shell};
  84
  85   ## Create the new entry for the mwc files.  This is likely to not
  86   ## exist.
  87   if (!defined $hash) {
  88     $Registry->{$shell} = {};
  89     $hash = $Registry->{$shell};
  90   }
  91
  92   ## Create an entry for this project type (vc6, vc7, etc.)
  93   my $key = 'MPC' . uc($type) . '/';
  94   $hash->{$key} = {'/' => "MPC -> $desc"};
  95
  96   ## Now store the command for creating a workspace for this project
  97   ## type.
  98   $key .= 'command/';
  99   $hash->{$key} = {'/' => "cmd /c \"$MPC_ROOT\\mwc.pl -type $type %L || pause\""};
 100
 101   ## Since MPC will create a workspace out of a directory, we want to do
 102   ## the same thing for directories too.
 103   set_dir_command($type, $desc);
 104 }
 105
 106
 107 sub set_mpc_command {
 108   my($type, $desc) = @_;
 109   my $shell = 'HKEY_CLASSES_ROOT/mpcfile/shell';
 110   my $hash = $Registry->{$shell};
 111
 112   ## Create the new entry for the mpc files.  This is likely to not
 113   ## exist.
 114   if (!defined $hash) {
 115     $Registry->{$shell} = {};
 116     $hash = $Registry->{$shell};
 117   }
 118
 119   ## Create an entry for this project type (vc6, vc7, etc.)
 120   my $key = 'MPC' . uc($type) . '/';
 121   $hash->{$key} = {'/' => "MPC -> $desc"};
 122
 123   ## Now store the command for creating a single project for this project
 124   ## type.
 125   $key .= 'command/';
 126   $hash->{$key} = {'/' => "cmd /c \"$MPC_ROOT\\mpc.pl -type $type %L || pause\""};
 127 }
 128
 129
 130 sub delete_key {
 131   my $key = shift;
 132   my $val = $Registry->{$key};
 133
 134   ## Delete everything associated with this key (recursively traversing
 135   ## each key).
 136   if (UNIVERSAL::isa($val, 'HASH')) {
 137     foreach my $k (keys %$val) {
 138       delete_key($key . $k);
 139     }
 140   }
 141
 142   ## Now get the key itself.
 143   delete $Registry->{$key};
 144 }
 145
 146 # ******************************************************************
 147 # Main Section
 148 # ******************************************************************
 149
 150 if ($^O eq 'MSWin32') {
 151   ## Pull in the registry modules and import the necessary items.
 152   require Win32::TieRegistry;
 153   Win32::TieRegistry->import(TiedRef => \$Registry,
 154                              Delimiter => '/');
 155 }
 156 else {
 157   ## Currently, no other registry type is supported.
 158   print "ERROR: This script will only run on Windows.\n";
 159   exit(1);
 160 }
 161
 162 if (defined $ARGV[0]) {
 163   if ($ARGV[0] eq '-r') {
 164     ## Get rid of the MPC_ROOT environment variable.
 165     delete $Registry->{'HKEY_CURRENT_USER/Environment/MPC_ROOT'};
 166
 167     ## Now delete all the keys that this script knows how to make.
 168     delete_key('HKEY_CLASSES_ROOT/.mwc/');
 169     delete_key('HKEY_CLASSES_ROOT/mwcfile/');
 170     delete_key('HKEY_CLASSES_ROOT/.mpc/');
 171     delete_key('HKEY_CLASSES_ROOT/mpcfile/');
 172     delete_key('HKEY_CLASSES_ROOT/.mpb/');
 173     delete_key('HKEY_CLASSES_ROOT/mpbfile/');
 174
 175     foreach my $type (keys %types) {
 176       delete_key('HKEY_CLASSES_ROOT/Directory/shell/MPC' . uc($type) . '/');
 177     }
 178
 179     exit(0);
 180   }
 181   else {
 182     print STDERR "registry v$version\n",
 183                  "Usage: ", basename($0), " [-r]\n\n",
 184                  "       -r  Remove MPC related registry keys.\n\n",
 185                  "Set the MPC_ROOT environment variable to the location of this script.\n",
 186                  "Also, add context menus for .mwc files and directories.\n";
 187     exit(0);
 188   }
 189 }
 190
 191 ## Set the MPC_ROOT environment variable.
 192 $Registry->{'HKEY_CURRENT_USER/Environment/MPC_ROOT'} = [$MPC_ROOT, 'REG_SZ'];
 193
 194 ## Associate the icons with the various MPC file types.
 195 set_ext_icon('mwc', 0);
 196 set_ext_icon('mpc', 1);
 197 set_ext_icon('mpb', 1);
 198
 199 ## Create the command settings for each type
 200 foreach my $type (keys %types) {
 201   set_mwc_command($type, $types{$type}->[0]);
 202   set_mpc_command($type, $types{$type}->[1]);
 203 }
 204
 205 print "You may need to log out and then ",
 206       "log back in for some of these settings to take effect.\n";
 207
 208 exit(0);