Commit | Line | Data |
---|---|---|
d8875586 MBT |
1 | #!/usr/bin/perl |
2 | eval "exec perl -S $0 $*" | |
3 | if $running_under_some_shell; | |
4 | ||
5 | # $Id: makegloss.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 | # Original Author: Larry Wall <lwall@netlabs.com> | |
16 | # | |
17 | # $Log: makegloss.SH,v $ | |
18 | # Revision 3.0.1.3 1994/01/24 14:17:49 ram | |
19 | # patch16: now understands internal-use only defined variables | |
20 | # | |
21 | # Revision 3.0.1.2 1993/10/16 13:50:39 ram | |
22 | # patch12: updated to support new ?M: lines | |
23 | # | |
24 | # Revision 3.0.1.1 1993/08/19 06:42:21 ram | |
25 | # patch1: leading config.sh searching was not aborting properly | |
26 | # | |
27 | # Revision 3.0 1993/08/18 12:10:12 ram | |
28 | # Baseline for dist 3.0 netwide release. | |
29 | # | |
30 | ||
31 | open(G,">Glossary") || die "Can't create Glossary.\n"; | |
32 | print G | |
33 | '[This Glossary is automatically generated from the Unit files. Do not edit | |
34 | this file or your changes will be lost. Edit the appropriate Unit instead.] | |
35 | ||
36 | This file contains a listing of all the C preprocessor symbols and shell | |
37 | variables whose value can be determined by a Configure script. For the | |
38 | most part, any symbol in UPPERCASE is a C preprocessor symbol, and | |
39 | will be defined in config.h. Symbols in lowercase are shell variables, | |
40 | and are defined in config.sh. | |
41 | ||
42 | If you write your shell scripts and C programs in terms of these symbols, | |
43 | metaconfig can automatically build you a Configure script that will determine | |
44 | the value of those symbols. See the README file for a description of how | |
45 | to use metaconfig. | |
46 | ||
47 | In the following listing, the Unit: line indicates the name of the unit | |
48 | where this symbol is defined, and the Wants: line indicates what other | |
49 | symbols must be determined in order to figure out the value of this one. | |
50 | If there is an "(Also defines ...)" entry, it indicates what other symbols | |
51 | are defined by the Unit other than the one corresponding to the unit name. | |
52 | ||
53 | Variable of the form d_* either have the value "define" or "/*define", and | |
54 | control whether some C preprocessor symbol gets defined or not. | |
55 | ||
56 | '; | |
57 | ||
58 | @ARGV = <U/*.U>; | |
59 | while (<>) { | |
60 | if (/^\?[\w\-]+:/) { # We may have found a control line | |
61 | # Long lines may be escaped with a final backslash | |
62 | $_ .= &complete_line if s/\\\s*$//; | |
63 | } | |
64 | if (/^\?MAKE:.*:/) { | |
65 | ($also, $wants) = /^\?MAKE:\s*(.*):\s*(.*)/; | |
66 | ($unit = $ARGV) =~ s|.*/(.*)\.U$|$1|; | |
67 | @Also = split(/ /, $also); | |
68 | $also = ''; | |
69 | $internal = ''; | |
70 | foreach (@Also) { | |
71 | if (s/^\+//) { | |
72 | $internal .= "$_ "; | |
73 | } else { | |
74 | $also .= "$_ "; | |
75 | } | |
76 | } | |
77 | $also =~ s/$unit\s//; | |
78 | chop($also); | |
79 | chop($internal); | |
80 | @Wants = split(/ /, $wants); | |
81 | $wants = ''; | |
82 | $option = ''; | |
83 | foreach (@Wants) { | |
84 | if (s/^\+//) { | |
85 | $option .= "$_ "; | |
86 | } else { | |
87 | $wants .= "$_ "; | |
88 | } | |
89 | } | |
90 | chop($option); | |
91 | chop($wants); | |
92 | $head = ''; | |
93 | $_ = "Unit: $unit"; | |
94 | $_ .= " (Also defines $also)" if $also; | |
95 | $_ .= " (With private $internal)" if $internal; | |
96 | $head .= &format($_); | |
97 | if ($wants) { | |
98 | $_ = "Wants: $wants"; | |
99 | $head .= &format($_); | |
100 | } | |
101 | if ($option) { | |
102 | $_ = "Optional: $option"; | |
103 | $head .= &format($_); | |
104 | } | |
105 | $head .= "\n"; | |
106 | } | |
107 | ||
108 | # Example of expression matched by the following pattern: | |
109 | # ?C:symbol ~ alias (obsolete list): | |
110 | # The main symbol (optionally aliased) can be followed by a list of | |
111 | # obsolete symbols (the list is space separated). | |
112 | ||
113 | if (/^\?[CS]:(\w+)(\s*~\s*\S+)?\s*(\(.*\))?:\s*$/) { | |
114 | $sym = $1; | |
115 | $obsoleted = $3; | |
116 | push(@syms, $sym); | |
117 | $header{$sym} .= $head; | |
118 | if ($obsoleted =~ s/^\((.*)\)$/$1/) { | |
119 | @obsoleted = split(' ', $obsoleted); | |
120 | foreach $obs (@obsoleted) { | |
121 | push(@syms, $obs); | |
122 | $header{$obs} = "\tObsoleted by $sym.\n\n"; | |
123 | } | |
124 | } | |
125 | } | |
126 | elsif (s/^\?[CS]://) { # Must be inside definition | |
127 | if (/^\.$/) { # Closing line | |
128 | $def{$sym} .= "\n"; | |
129 | $sym = ''; | |
130 | } | |
131 | else { | |
132 | s/^(\t| ? ? ? ? ? ? ?)//; | |
133 | $def{$sym} .= "\t" . $_; | |
134 | } | |
135 | } | |
136 | elsif (/^\?M:(\w+):\s*([\w\s]*)\n$/) { # Magic mapping introduction | |
137 | $sym = $1; | |
138 | $cdep = $2; | |
139 | push(@syms, $sym); | |
140 | $cdep =~ s/^\s*//; | |
141 | $cdep = ", needs: $cdep" if $cdep ne ''; | |
142 | $header{$sym} = "\tMagic symbol$cdep\n" . $head; | |
143 | } | |
144 | elsif (s/^\?M://) { # Must be a magic mapping definition | |
145 | if (/^\.$/) { # Closing line | |
146 | $def{$sym} .= "\n"; | |
147 | $sym = ''; | |
148 | } else { | |
149 | $def{$sym} .= "\t" . $_; | |
150 | } | |
151 | } | |
152 | } | |
153 | ||
154 | foreach $sym (sort @syms) { | |
155 | print G "$sym:\n"; | |
156 | print G $header{$sym}; | |
157 | print G $def{$sym}; | |
158 | } | |
159 | close G; | |
160 | ||
161 | # Format $_ to fit in 80 columns (70 + size of tabs) | |
162 | # Long lines are split, and the all but the first are indented | |
163 | # by two leading spaces. The whole thing is then indented by | |
164 | # one tab. | |
165 | sub format { | |
166 | local($tmp); | |
167 | local($head) = ''; | |
168 | local($_) = shift(@_); | |
169 | while (length($_) > 70) { | |
170 | $tmp = substr($_,0,70); | |
171 | $tmp =~ s/^(.*) .*/$1/; | |
172 | $head .= "\t$tmp\n"; | |
173 | $_ = ' ' . substr($_,length($tmp),9999); | |
174 | } | |
175 | $head .= "\t$_\n"; | |
176 | } | |
177 | ||
178 | # The first line was escaped with a final \ character. Every following line | |
179 | # is to be appended to it (until we found a real \n not escaped). Note that | |
180 | # the leading spaces of the continuation line are removed, so any space should | |
181 | # be added before the former \ if needed. | |
182 | sub complete_line { | |
183 | local($_); | |
184 | local($read) = ''; # Concatenation of all the continuation lines found | |
185 | while (<>) { | |
186 | s/^\s+//; # Remove leading spaces | |
187 | if (s/\\\s*$//) { # Still followed by a continuation line | |
188 | $read .= $_; | |
189 | } else { # We've reached the end of the continuation | |
190 | return $read . $_; | |
191 | } | |
192 | } | |
193 | } | |
194 |