/[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 - (hide 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 wakaba 1.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