summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm293
1 files changed, 293 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm b/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm
new file mode 100644
index 00000000000..3c3cba71c09
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm
@@ -0,0 +1,293 @@
+package Tk::MakeDepend;
+use strict;
+use vars qw(%define);
+use Config;
+
+my @include;
+
+use Carp;
+
+$SIG{__DIE__} = \&Carp::confess;
+
+
+use vars qw($VERSION);
+#$VERSION = sprintf '4.%03d', q$Revision: #13 $ =~ /\D(\d+)\s*$/;
+$VERSION = '4.014';
+
+sub scan_file;
+
+sub do_include
+{
+ my ($inc,$dep,@include) = @_;
+ foreach my $dir (@include)
+ {
+ my $path = "$dir/$inc";
+ if (-f $path)
+ {
+ scan_file($path,$dep) unless exists $dep->{$path};
+ return;
+ }
+ }
+ warn "Cannot find '$inc' assume made\n";
+ $dep->{$inc} = 1;
+}
+
+sub remove_comment
+{
+ s#^\s*/\*.*?\*/\s*##g;
+}
+
+
+sub term
+{
+ remove_comment();
+ return !term() if s/^\s*!//;
+ return exists($define{$1}) if s/^\s*defined\s*\(([_A-Za-z][_\w]*)\s*\)//;
+ return exists($define{$1}) if s/^\s*defined\s*([_A-Za-z][_\w]*)//;
+ return eval "$1" if s/^\s*(0x[0-9a-f]+)L?//i;
+ return $1 if s/^\s*(\d+)L?//;
+ return $define{$1} || 0 if s/^\s*([_A-Za-z][_\w]*)//;
+ if (s/^\s*\(//)
+ {
+ my $val = expression(0);
+ warn "Missing ')'\n" unless s/^\s*\)//;
+ return $val;
+ }
+ warn "Invalid term:$_";
+ return undef;
+}
+
+my %pri = ( '&&' => 4,
+ '||' => 3,
+ '>=' => 2, '<=' => 2, '<' => 2, '>' => 2,
+ '==' => 1, '!=' => 1 );
+
+sub expression
+{
+ my $pri = shift;
+ # printf STDERR "%d# expr . $_\n";
+ my $invert = 0;
+ my $lhs = term() || 0;
+ remove_comment();
+ while (/^\s*(&&|\|\||>=?|<=?|==|!=)/)
+ {
+ my $op = $1;
+ last unless ($pri{$op} >= $pri);
+ s/^\s*\Q$op\E//;
+ # printf STDERR "%d# $lhs $op . $_\n";
+ my $rhs = expression($pri{$op}) || 0;
+ my $e = "$lhs $op $rhs";
+ $lhs = eval "$e" || 0;
+ die "'$e' $@" if $@;
+ remove_comment();
+ }
+ return $lhs;
+}
+
+sub do_if
+{
+ my ($key,$expr) = @_;
+ chomp($expr);
+ if ($key eq 'ifdef' || $key eq 'ifndef')
+ {
+ if ($expr =~ /^\s*(\w+)/)
+ {
+ my $val = exists $define{$1};
+ $val = !$val if ($key eq 'ifndef');
+# printf STDERR "%d from $key $expr\n",$val;
+ return $val;
+ }
+ }
+ else
+ {
+ local $_ = $expr;
+ my $val = expression(0) != 0;
+ warn "trailing: $_" if /\S/;
+ #printf STDERR "%d from $key $expr\n",$val;
+ return $val;
+ }
+}
+
+sub scan_file
+{
+ no strict 'refs';
+ my ($file,$dep) = @_;
+ open($file,"<$file") || die "Cannot open $file:$!";
+ local $_;
+ my ($srcdir) = $file =~ m#^(.*)[\\/][^\\/]*$#;
+ $srcdir = '.' unless defined $srcdir;
+ my $live = 1;
+ $dep->{$file} = 1;
+ my @stack;
+ while (<$file>)
+ {
+ $_ .= <$file> while (s/\\\n/ /);
+ if (/^\s*#\s*(\w+)\s*(.*?)\s*$/)
+ {
+ my $ol = $live;
+ my $key = $1;
+ my $rest = $2;
+ if ($key =~ /^if(.*)$/)
+ {
+ push(@stack,$live);
+ $live &&= do_if($key,$rest);
+ }
+ elsif ($key eq 'elif')
+ {
+ $live = ($live) ? 0 : $stack[-1];
+ $live &&= do_if('if',$rest);
+ }
+ elsif ($key eq 'else')
+ {
+ $live = ($live) ? 0 : $stack[-1];
+ }
+ elsif ($key eq 'endif')
+ {
+ if (@stack)
+ {
+ $live = pop(@stack);
+ }
+ else
+ {
+ die "$file:$.: Mismatched #endif\n";
+ }
+ }
+ elsif ($live)
+ {
+ if ($key eq 'include')
+ {
+ do_include($1,$dep,$srcdir,@include) if $rest =~ /^"(.*)"/;
+ }
+ elsif ($key eq 'define')
+ {
+ if ($rest =~ /^\s*([_A-Za-z][\w_]*)\s*(.*)$/)
+ {
+ my $sym = $1;
+ my $val = $2 || 1;
+ $val =~ s#\s*/\*.*?\*/\s*# #g;
+ $define{$sym} = $val;
+ }
+ else
+ {
+ warn "ignore '$key $rest'\n";
+ }
+ }
+ elsif ($key eq 'undef')
+ {
+ if ($rest =~ /^\s*([_A-Za-z][\w_]*)/)
+ {
+ delete $define{$1};
+ }
+ }
+ elsif ($key =~ /^(line|pragma)$/)
+ {
+
+ }
+ else
+ {
+ warn "ignore '$key $rest'\n";
+ }
+ }
+ # printf STDERR "$file:$.: %d $key $rest\n",$live if ($ol != $live);
+ }
+ else
+ {
+ # print if $live;
+ }
+ }
+ close($file);
+ if (@stack)
+ {
+ warn "$file:$.: unclosed #if\n";
+ }
+}
+
+sub command_line
+{
+ @include = ();
+ local %define = ('__STDC__' => 1 );
+ my $data = '';
+ my @files;
+ while (@_ && $_[-1] !~ /^-/)
+ {
+ unshift(@files,pop(@_));
+ }
+ my $flags = $Config{ccflags};
+ $flags =~ s/^\s+|\s+$//g;
+ my @opt = (@_, split(/\s+/,$flags));
+ while (@opt)
+ {
+ local $_ = shift(@opt);
+ if (/^-I(.*)$/)
+ {
+ push @include,$1;
+ }
+ elsif (/^-D([^=]+)(?:=(.*))?$/)
+ {
+ $define{$1} = $2 || 1;
+ }
+ elsif (/^-U(.*)$/)
+ {
+ delete $define{$1};
+ }
+ elsif (/^(-.*)$/)
+ {
+ # Some option
+ if ($opt[0] !~ /^-/)
+ {
+ # next arg does not start with '-' assume it
+ # belongs to this option and discard it silently
+ shift(@opt);
+ }
+ }
+ else
+ {
+ # We got confused
+ warn "Ignoring $1\n";
+ }
+ }
+ # force /usr/include to be last element of @include
+ push @include, $Config{'usrinc'}
+ if (defined $Config{'usrinc'} and $Config{'usrinc'} ne '');
+ # warn "Include:@include\n";
+ while (@files)
+ {
+ local $_ = shift(@files);
+ unless (/^(.*)\.[^\.]+$/)
+ {
+ warn "Skip $_";
+ next;
+ }
+ local %define = %define;
+ my $base = $1;
+ my $file = $_;
+ my %dep;
+ warn "Finding dependencies for $file\n";
+ scan_file($_,\%dep);
+ my $str = "\n$base\$(OBJ_EXT) : $base.c";
+ delete $dep{$file};
+ my @dep = (sort(keys %dep));
+ while (@dep)
+ {
+ my $dep = shift(@dep);
+ $dep =~ s#^\./##;
+ if (length($str)+length($dep) > 70)
+ {
+ $data .= "$str \\\n";
+ $str = ' ';
+ }
+ else
+ {
+ $str .= ' ';
+ }
+ $str .= $dep;
+ }
+ $data .= "$str\n";
+ }
+ return $data;
+}
+
+1;
+__END__
+
+