|
428
|
1 : #-*- Perl -*-
|
|
|
2 # Copyright (C) 1998 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 # This file is part of XEmacs.
|
|
|
5 #
|
|
|
6 # XEmacs is free software; you can redistribute it and/or modify it
|
|
|
7 # under the terms of the GNU General Public License as published by the
|
|
|
8 # Free Software Foundation; either version 2, or (at your option) any
|
|
|
9 # later version.
|
|
|
10 #
|
|
|
11 # XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
13 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
14 # for more details.
|
|
|
15 #
|
|
|
16 # You should have received a copy of the GNU General Public License
|
|
|
17 # along with XEmacs; see the file COPYING. If not, write to
|
|
|
18 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
19 # Boston, MA 02111-1307, USA.
|
|
|
20
|
|
|
21 # Author: Martin Buchholz
|
|
|
22 eval 'exec perl -w -S $0 ${1+"$@"}'
|
|
|
23 if 0;
|
|
|
24
|
|
|
25 use strict;
|
|
|
26 my ($myName, $srcdir);
|
|
|
27
|
|
|
28 ($myName = $0) =~ s@.*/@@; my $usage ="
|
|
|
29 Usage: $myName
|
|
|
30
|
|
|
31 Generates header file fragments from the Emacs sources
|
|
|
32 and writes them to stdout.\n";
|
|
|
33
|
|
|
34 die $usage if @ARGV;
|
|
|
35
|
|
|
36 ($srcdir = $0) =~ s@[^/]+$@@;
|
|
|
37 chdir $srcdir or die "$srcdir: $!";
|
|
|
38
|
|
|
39 # Find include dependencies
|
|
|
40 my (%exists, %uses);
|
|
|
41 opendir SRCDIR, "." or die "$srcdir: $!";
|
|
|
42 for (grep (/\.[ch]$/, readdir (SRCDIR))) { $exists{$_} = 1; }
|
|
|
43 closedir SRCDIR;
|
|
|
44 {
|
|
|
45 my %generated_header;
|
|
|
46 for (qw (config.h sheap-adjust.h paths.h Emacs.ad.h)) {
|
|
|
47 $generated_header{$_} = 1;
|
|
|
48 }
|
|
|
49
|
|
|
50 for my $file (keys %exists) {
|
|
|
51 open (FILE, $file) or die "$file: $!";
|
|
|
52 undef $/; $_ = <FILE>;
|
|
|
53 RemoveComments ($_);
|
|
|
54 s/[ \t]+//g;
|
|
|
55 for (/^\#include([^\n]+)/gmo) {
|
|
|
56 if (m@^\"([A-Za-z0-9_-]+\.h)\"@) {
|
|
|
57 $uses{$file}{$1} = 1 if exists $exists{$1};
|
|
|
58 } elsif (m@<([A-Za-z0-9_-]+\.h)>@) {
|
|
|
59 $uses{$file}{$1} = 1 if exists $generated_header{$1};
|
|
|
60 } elsif (m@\"../lwlib/([A-Za-z0-9_-]+\.h)\"@) {
|
|
|
61 $uses{$file}{"\$(LWLIB_SRCDIR)/lwlib.h"} = 1;
|
|
|
62 }
|
|
|
63 }
|
|
|
64 }
|
|
|
65
|
|
|
66 # Make transitive closure of %uses
|
|
|
67 while (1) {
|
|
|
68 my $changedP = 0;
|
|
|
69 for my $x (keys %uses) {
|
|
|
70 for my $y (keys %{$uses{$x}}) {
|
|
|
71 for my $z (keys %{$uses{$y}}) {
|
|
|
72 if (! exists $uses{$x}{$z}) {
|
|
|
73 $uses{$x}{$z} = 1;
|
|
|
74 $changedP = 1;
|
|
|
75 }
|
|
|
76 }
|
|
|
77 }
|
|
|
78 }
|
|
|
79 last if !$changedP;
|
|
|
80 }
|
|
|
81 } # End of finding include dependencies
|
|
|
82
|
|
|
83 my (%used, %maxargs);
|
|
|
84 my $minargs = '(?:[0-8])';
|
|
|
85 my $maxargs = '(?:[0-8]|MANY|UNEVALLED)';
|
|
|
86 my $doc = "(?:0|STR)";
|
|
|
87 my $fun = '(?:\\bF[a-z0-9_]+X?\\b)';
|
|
|
88 my $defun = "^DEFUN\\s*\\(\\s+STR\\s+($fun)\\s+$minargs\\s+($maxargs)\\s+$doc\\s+\\(";
|
|
|
89 my $var = '(?:\\b(?:Q[KS]?[a-z0-9_]+D?|V(?:[a-z0-9_]+)|Q_TT[A-Z]+)\\b)';
|
|
|
90 my $pat = "(?:$var|$fun)";
|
|
|
91 my %automagic;
|
|
|
92 my (%decl_file, %defn_file);
|
|
|
93
|
|
|
94 for my $file (keys %exists) {
|
|
|
95 open (FILE, $file) or die "$file: $!";
|
|
|
96 undef $/; $_ = <FILE>;
|
|
|
97 RemoveComments($_);
|
|
|
98 RemoveStrings ($_);
|
|
|
99 s/,/ /gmo;
|
|
|
100 s/^\s*EXFUN[^\n]+//gmo;
|
|
|
101
|
|
|
102 # Now search for DECLARE_LRECORD to find types for predicates
|
|
|
103 for my $sym (/^DECLARE_LRECORD\s*\(\s*([a-z_]+)\s+struct /gmo) {
|
|
|
104 $automagic{"Q${sym}p"} = 1;
|
|
|
105 }
|
|
|
106
|
|
|
107 if ($file =~ /\.c$/) {
|
|
|
108 my @match = (/$defun/gmo);
|
|
|
109 while (my $fun = shift @match) {
|
|
|
110 $defn_file{$fun} = $file;
|
|
|
111 $maxargs{$fun} = shift @match;
|
|
|
112 }
|
|
|
113
|
|
|
114 # Now do Lisp_Object variables
|
|
|
115 for my $defs (/^\s*Lisp_Object\s+((?:$var\s*)+)\s*;/gmo) {
|
|
|
116 for my $var (split (' ',$defs)) {
|
|
|
117 $defn_file{$var} = $file;
|
|
|
118 }
|
|
|
119 }
|
|
|
120 }
|
|
|
121
|
|
|
122 # Remove declarations of Lisp_Objects
|
|
|
123 s/^extern\s+Lisp_Object\s+(?:$var\s*)+\s*;//gmo;
|
|
|
124
|
|
|
125 # Remove declarations of functions
|
|
|
126 s/^Lisp_Object $fun//;
|
|
|
127
|
|
|
128 # Find all uses of symbols
|
|
|
129 for (/($pat)/gmo) { $used{$_}{$file} = 1; }
|
|
|
130 }
|
|
|
131
|
|
|
132 my %candidates;
|
|
|
133 for my $file (keys %exists) {
|
|
|
134 @{$candidates{$file}} = ();
|
|
|
135 my $header1 = $file; $header1 =~ s/\.c$/.h/;
|
|
|
136 my $header2 = $header1; $header2 =~ s/-\w+\././;
|
|
|
137 push @{$candidates{$file}}, $header1 if exists $exists{$header1};
|
|
|
138 push @{$candidates{$file}}, $header2 if exists $exists{$header2} &&
|
|
|
139 $header1 ne $header2;
|
|
|
140 }
|
|
|
141
|
|
|
142 SYM: for my $sym (keys %used) {
|
|
|
143 next SYM unless my $defn_file = $defn_file{$sym};
|
|
|
144 my @users = keys %{$used{$sym}};
|
|
|
145 if (@users == 1) {
|
|
|
146 die "$sym\n" unless $defn_file eq $users[0];
|
|
|
147 next SYM;
|
|
|
148 }
|
|
|
149 for my $candidate (@{$candidates{$defn_file}}) {
|
|
|
150 if (!grep (!exists $uses{$_}{$candidate}, @users)) {
|
|
|
151 $decl_file{$sym} = $candidate;
|
|
|
152 next SYM;
|
|
|
153 }
|
|
|
154 }
|
|
|
155 $decl_file{$sym} = 'lisp.h';
|
|
|
156 }
|
|
|
157
|
|
|
158 # Print global Lisp_Objects
|
|
|
159 {
|
|
|
160 my $line;
|
|
|
161 sub flushvars {
|
|
|
162 if (defined $line) {
|
|
|
163 print "extern Lisp_Object $line;\n";
|
|
|
164 undef $line;
|
|
|
165 }
|
|
|
166 }
|
|
|
167
|
|
|
168 sub printvar {
|
|
|
169 my $var = shift;
|
|
|
170 if (!defined $line) { $line = $var; return; }
|
|
|
171 if ($var =~ /^Vcharset_/) {
|
|
|
172 flushvars ();
|
|
|
173 $line = $var;
|
|
|
174 flushvars ();
|
|
|
175 return;
|
|
|
176 }
|
|
|
177 if (length "$line, $var" > 59) {
|
|
|
178 flushvars (); $line = $var; return;
|
|
|
179 }
|
|
|
180 $line = "$line, $var";
|
|
|
181 }
|
|
|
182 END { flushvars (); }
|
|
|
183 }
|
|
|
184
|
|
|
185 delete @decl_file{ keys %automagic, qw(Qzero Qnull_pointer)};
|
|
|
186
|
|
|
187 # Print Lisp_Object var declarations
|
|
|
188 for my $file (keys %exists) {
|
|
|
189
|
|
|
190 # Print EXFUNs
|
|
|
191 if (my @funs = grep ($decl_file{$_} eq $file && exists $maxargs{$_},
|
|
|
192 keys %decl_file)) {
|
|
|
193 print "\n\n$file:\n\n";
|
|
|
194 for $fun (sort @funs) {
|
|
|
195 print "EXFUN ($fun, $maxargs{$fun});\n";
|
|
|
196 }
|
|
|
197 print "\n";
|
|
|
198 }
|
|
|
199
|
|
|
200 if (my @vars = grep ($decl_file{$_} eq $file && /^[QV]/, keys %decl_file)) {
|
|
|
201 print "\n\n$file:\n\n";
|
|
|
202 for $var (sort @vars) {
|
|
|
203 printvar ($var);
|
|
|
204 }
|
|
|
205 flushvars ();
|
|
|
206 print "\n\n";
|
|
|
207 }
|
|
|
208 }
|
|
|
209
|
|
|
210 #for my $var (sort grep (keys %{$used{$_}} > 1 , keys %defn_file)) {
|
|
|
211 # printvar ($var);
|
|
|
212 #}
|
|
|
213
|
|
|
214 sub RemoveComments {
|
|
|
215 $_[0] =~
|
|
|
216 s{ (
|
|
|
217 [^\"\'/]+ |
|
|
|
218 (?:\"[^\"\\]*(?:\\.[^\"\\]*)*\" [^\"\'/]*)+ |
|
|
|
219 (?:\'[^\'\\]*(?:\\.[^\'\\]*)*\' [^\"\'/]*)+
|
|
|
220 )
|
|
|
221 | / (?:
|
|
|
222 \*[^*]*\*+(?:[^/*][^*]*\*+)*/
|
|
|
223 |
|
|
|
224 /[^\n]*
|
|
|
225 )
|
|
|
226 }{defined $1 ? $1 : ""}gsxeo;
|
|
|
227 }
|
|
|
228
|
|
|
229 sub RemoveStrings {
|
|
|
230 $_[0] =~
|
|
|
231 s{ (
|
|
|
232 (?:\"[^\"\\]*(?:\\.[^\"\\]*)*\") |
|
|
|
233 (?:\'[^\'\\]*(?:\\.[^\'\\]*)*\')
|
|
|
234 )
|
|
|
235 }{ STR }gxo;
|
|
|
236 }
|
