src/src-headers

   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 }