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