This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
U/perl/i_wchar.U: Fix typo
[metaconfig.git] / dist / bindex
1 #!/usr/bin/perl
2         eval 'exec perl -S $0 "$@"'
3                 if $runnning_under_some_shell;
4
5 # $Id: bindex.SH 1 2006-08-24 12:32:52Z rmanfredi $
6 #
7 #  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
8 #  
9 #  You may redistribute only under the terms of the Artistic Licence,
10 #  as specified in the README file that comes with the distribution.
11 #  You may reuse parts of this distribution only within the terms of
12 #  that same Artistic Licence; a copy of which may be found at the root
13 #  of the source tree for dist 4.0.
14 #
15 # $Log: bindex.SH,v $
16 # Revision 3.0.1.1  1993/08/19  06:42:12  ram
17 # patch1: leading config.sh searching was not aborting properly
18 #
19 # Revision 3.0  1993/08/18  12:04:13  ram
20 # Baseline for dist 3.0 netwide release.
21 #
22
23 $file = "files/Jmake.rules";
24
25 open(INDEX, ">Index") || die "Cannot create Index.\n";
26 open(RULES, "$file") || die "Cannot open $file.\n";
27
28 print INDEX
29 "[This Index is automatically generated from Jmake.rules file. Do not
30 edit this file or your changes will be lost. Edit Jmake.rules instead.]
31
32 This file contains a listing of all the macros that can be used in a
33 Jmakefile. Only a few of these should be used in the Jmakefile (they
34 are the top-level macros). However, some low-level ones may be useful,
35 but it is up to you to make that decision. This explains why this file
36 holds all the available macros for jmake.
37
38 In the following listing, the macros are separated by a line of dashes.
39 The signature of the macro is given, then a small comment of what it
40 does precedes the actual definition.
41
42 Lines preceded by '->' show the set of symbols defined when the macro is
43 used. Initialization lines are shown as-is, i.e. have the form SYM = val
44 while concatenation is shown by SYM += val (which means val is added to
45 the value of SYM).
46
47 Conditional lines are preceded by tests like (if SYM). This means the line
48 is to be kept if and only if the symbol SYM is defined. Other internal
49 requests are not formatted yet.
50
51 ";
52 $inrule = 0;                    # Not inside a rule at the beginning
53 $incomment = 0;                 # Not inside a comment
54 $last_was_text = 0;             # Last line was not a rule text
55 while (<RULES>) {
56         $inrule || next unless /^\s\*\s(\w+)\s*:/;
57         if ($inrule) {          # We are already in a rule
58                 if ($incomment) {
59                         if (m|^\s*\*/|) {       # End of comment
60                                 $incomment = 0;
61                                 $Comment{$current} .= "\n";
62                         } else {
63                                 s/^\s*\*\s*//;  # Remove leading comment sign
64                                 $Comment{$current} .= "    $_";
65                         }
66                         next;           # Anyway, go to next line
67                 }
68                 if (/^\s*$/) {          # Empty line = end of rule
69                         $inrule = 0;
70                         next;
71                 }
72                 # Here, we have to print the body of the rule, after some cleaning
73                 s/(@#|@@|@!)\\$//;              # Remove final continuations
74                 s/^(#define.*)\\/$1/;   # Remove single '\' on first rule line
75                 s/\|rule:\s*$/\n/;
76                 s/\|rule:\s+/    /;             # Remove rule markers
77                 s/\|rule://;
78                 s/%(\w+):\|skip/#ifdef $1/;             # Deal with ugly skip syntax
79                 s/\?(\w+):\|skip/#ifndef $1/;   # Deal with ugly skip syntax
80                 s/\-skip/#endif/;
81                 s/\?(\w+):/(if $1) /;   # Simple '?' test
82                 s/%(\w+):/(not $1) /;   # Simple '%' test
83                 s/\|suffix/.SUFFIXES:/; # Make suffix command explicit
84                 s/\t/    /g;                    # Expand all tabs to 4 chars
85                 s/\s*$/\n/;                             # Remove any trailing space
86                 s|\^\^\^|/***/|;                # Change ^^^ to the more visual /***/
87                 s|\^\^|/**/|;                   # Restore ^^ to the more visual /**/
88                 if (/^$/) {                             # If empty line
89                         $Index{$current} .= "\n" if $last_was_text;
90                         $last_was_text = 0;
91                         next;
92                 }
93                 if (/^[>+]/) {                  # Special commands
94                         if (s/^>\s*//) {                                                # Wanted symbol
95                                 chop;
96                                 $Wants{$current} .= " $_";
97                         } elsif (/^\+\+\s*(\S+)\s*(.*)/) {              # Added symbol
98                                 $Added{$current} .= "\t$1 += $2\n";
99                         } else {
100                                 s/^\+\s*(.*)//;
101                                 $Init{$current} .= "\t$1\n";
102                         }
103                         next;
104                 }
105                 if (s/^#define\s+//) {  # Definition of the rule
106                         chop;
107                         $Sig{$current} = $_;                    # Signature of rule
108                 } else {
109                         $Index{$current} .= "    $_";   # Rule's body
110                         $last_was_text = 1;
111                 }
112         } else {                        # We've just entered a rule
113                 $current = $1;
114                 next if $current =~ /patch\d/;  # Skip RCS log messages
115                 $inrule = 1;
116                 $incomment = 1; # We're still in the leading comment
117                 $Seen{$current} = 1;
118                 $last_was_text = 0;
119         }
120 }
121 close RULES;
122
123 # Now sort the rules in alphabetical order
124
125 print INDEX '-' x 72, "\n";
126 foreach $rule (sort(keys %Seen)) {
127         print INDEX "$Sig{$rule}:\n";
128         print INDEX $Comment{$rule};
129         $line = $Wants{$rule};
130         if (length($line)) {
131                 $line = "->$line.";
132                 $line = &format($line);
133                 print INDEX "$line\n";
134         }
135         $line = $Init{$rule};
136         print INDEX "$line\n" if length($line);
137         $line = $Added{$rule};
138         print INDEX "$line\n" if length($line);
139         $line = $Index{$rule};
140         print INDEX $line;
141         print INDEX "\n" if (length($line));
142         print INDEX '-' x 72, "\n";
143 }
144
145 close INDEX;
146
147 # Format $_ to fit in 80 columns (70 + size of tabs)
148 # Long lines are split, and the all but the first are indented
149 # by two leading spaces. The whole thing is then indented by
150 # one tab.
151 sub format {
152         local($tmp);
153         local($head) = '';
154         local($_) = shift(@_);
155         while (length($_) > 70) {
156                 $tmp = substr($_,0,70);
157                 $tmp =~ s/^(.*) .*/$1/;
158                 $head .= "\t$tmp\n";
159                 $_ = ' ' . substr($_,length($tmp),9999);
160         }
161         $head .= "\t$_\n";
162 }