/[suikacvs]/www/ie/iemenu/mkreg.pl
Suika

Contents of /www/ie/iemenu/mkreg.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Sat Mar 30 13:47:56 2002 UTC (22 years, 8 months ago) by wakaba
Branch: MAIN, wakaba
CVS Tags: initiali, HEAD
Branch point for: experimental
Changes since 1.1: +0 -0 lines
File MIME type: text/plain

1 use strict;
2 use Cwd;
3 my $argv = shift (@ARGV) if $ARGV[0] =~ /^--/;
4
5 my $directory = $ARGV[0] || cwd;
6 $directory =~ tr/\x2F/\x5C/;
7 $directory .= "\x5C" unless $directory =~ /\x5C$/;
8 opendir DIR, $directory;
9 my @files = map {$directory.$_} grep {/\.ht(?:ml?|t)$/} readdir(DIR);
10 close DIR;
11
12 unless ($argv eq '--remove') {
13 print "REGEDIT4\n\n";
14 } else {
15 print "var wsh = WScript.CreateObject ('WScript.Shell');\n";
16 }
17 for my $file (@files) {
18 my %option;
19 open SRC, $file;
20 while (<SRC>) {
21 if (/^#([a-z]+)\x20+(.+)$/) {
22 $option{$1} = $2;
23 }
24 }
25 close SRC;
26 next unless $option{name};
27 my (@f,%f) = split /[\x20\x09]+/, $option{context}, $option{flag};
28 for (@f) {$f{$_} = 1}
29 unless ($argv eq '--remove') {
30 print scalar mkregsection ($option{name} => $file, %f);
31 } else {
32 print scalar mkremovejs ($option{name});
33 }
34 }
35
36 sub mkregsection ($$;%) {
37 my ($menuname, $filename, %option) = @_;
38 $menuname =~ s/\x5C/\x5C\x5C/g;
39 $filename =~ s/\x5C/\x5C\x5C/g;
40 my $s = sprintf <<'EOH', $menuname, $filename;
41 [HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\%s]
42 @="%s"
43 EOH
44 my ($contexts, $flags) = (0, 0);
45 $contexts |= 0x1 if $option{default};
46 $contexts |= 0x2 if $option{image};
47 $contexts |= 0x4 if $option{control};
48 $contexts |= 0x8 if $option{table};
49 $contexts |= 0x10 if $option{textselect};
50 $contexts |= 0x20 if $option{anchor};
51 $contexts |= 0x40 if $option{unknown};
52 $flags |= 0x1 if $option{showdialog};
53 $s .= sprintf ("\"Contexts\"=dword:%08X\n", $contexts || 1);
54 $s .= sprintf "\"Flags\"=dword:%08X\n", $flags if $flags;
55 $s."\n";
56 }
57
58 sub mkremovejs ($) {
59 my $s = 'HKCU\Software\Microsoft\Internet Explorer\MenuExt\\';
60 $s .= shift;
61 $s =~ s/\x5C/\x5C\x5C/g;
62 $s =~ s/\x27/\x5C\x27/g;
63 "wsh.RegDelete ('$s\\\\');\n";
64 }
65
66 =head1 LICENSE
67
68 Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
69
70 This program is free software; you can redistribute it and/or modify
71 it under the terms of the GNU General Public License as published by
72 the Free Software Foundation; either version 2 of the License, or
73 (at your option) any later version.
74
75 This program is distributed in the hope that it will be useful,
76 but WITHOUT ANY WARRANTY; without even the implied warranty of
77 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
78 GNU General Public License for more details.
79
80 You should have received a copy of the GNU General Public License
81 along with this program; see the file COPYING. If not, write to
82 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83 Boston, MA 02111-1307, USA.
84
85 =head1 CHANGE
86
87 See ChangeLog.
88 $Date: $
89
90 =cut

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24