Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: gtk2-old
Fetching contributors…

Cannot retrieve contributors at this time

executable file 159 lines (138 sloc) 3.857 kB
#!/usr/bin/env perl
use Getopt::Long;
# Convert the templates to either GTK2 or GTK3 version.
# In the high-level modules, differences between the GTK2.x and GTK3.x
# versions of the code are maintained in files called <name>-tmpl.f90 where
# Lines only to be used in specific versions are prefixed by
# (e.g.) !!$GTK<=3.0.0! or !!$GLIB>2.32!
# GTK specifies a GTK/GDK version, GLIB a GLIB version, others will be
# added as needed. Allowed operators are >, <, >=, <=.
# This routine removes the relevant comment
# flags and generates <name>.f90. If <name>.f90 already exists, then
# it is renamed to <name>.f90.old.
#
# Usage:
# mk_gtk_hl.pl --gtk=<gtkver> --glib=<glibver> <template files>
my @gtkver;
my @glibver;
my $gtkvers, $glibvers;
my $tmpl, $f90, $tflag, $op, $cmp, $line;
my @flist, @vers;
GetOptions('gtk=s' => \$gtkvers,
'glib=s' => \$glibvers);
if (!defined($gtkvers)) {
print "Enter target GTK+ version:_";
chomp($gtkvers = <STDIN>);
}
@gtkver = &extend_version(split(/\./, $gtkvers));
if (!defined($glibvers)) {
print "Enter target GLIB version:_";
chomp($glibvers = <STDIN>);
}
@glibver = &extend_version(split(/\./, $glibvers));
if ($#ARGV < 0) {
opendir(DIR,'.') || die "Failed to open current directory: $!\n";
@flist=readdir(DIR);
closedir(DIR);
} else {
@flist = @ARGV[0 .. $#ARGV];
}
# Loop over the files
foreach (@flist) {
/^(.+)-tmpl\.f90$/ || next; # If it's not a template file then continue
# Generate the input & output names
$tmpl = $_;
$f90 = $1.".f90";
$tflag = 0;
print "Input: $tmpl, Output: $f90\n";
# Make a backup of the existing file (Just in case the program is broken)
if (-e $f90) {
rename($f90, "$f90.old") ||
die "Failed to rename $f90: $!\n";
print "Renamed $f90 to $f90.old\n";
}
open(IN, $tmpl) || die "Failed to open $tmpl: $!\n";
open(OUT, '>'.$f90) || die "Failed to open $f90: $!\n";
$line = 0;
while (<IN>) {
$line++;
if (/^!!\$T/) {
if ($tflag == 0) {
&put_message;
$tflag=1;
}
next;
}
if (/^!!\$(G[A-Z]+) *([<>=]+) *([\.0-9]+)!(.+)/) {
@vers = &extend_version(split(/\./, $3));
$op = $2;
if ($1 eq 'GTK') {
$cmp = &compare_versions(@gtkver, @vers);
} elsif ($1 eq 'GLIB') {
$cmp = &compare_versions(@glibver, @vers);
} else {
print "Unknown conditional $1 at line $line in $tmpl\n";
}
if ($op eq ">") {
if ($cmp == 1) {
print OUT $4,"\n";
} else {
print OUT $_;
}
} elsif ($op eq ">=") {
if ($cmp >= 0) {
print OUT $4,"\n";
} else {
print OUT $_;
}
} elsif ($op eq "<=") {
if ($cmp <= 0) {
print OUT $4,"\n";
} else {
print OUT $_;
}
} elsif ($op eq "<") {
if ($cmp == -1) {
print OUT $4,"\n";
} else {
print OUT $_;
}
} else {
print "Unknown operator $op at line $line in $tmpl\n";
}
} else {
print OUT $_;
}
}
close(IN);
close(OUT);
}
sub put_message {
print OUT "! --------------------------------------------------------\n";
print OUT "! $f90\n";
print OUT "! Generated: ".gmtime." GMT\n";
print OUT "! Please do not edit this file directly,\n";
print OUT "! Edit $tmpl, and use $0 to regenerate.\n";
print OUT "! Generated for GTK+ version: $gtkver[0].$gtkver[1].$gtkver[2].\n";
print OUT "! Generated for GLIB version: $glibver[0].$glibver[1].$glibver[2].\n";
print OUT "! --------------------------------------------------------\n";
}
sub compare_versions {
my @a1 = @_[0..2];
my @a2 = @_[3..5];
for ($i = 0; $i < 3; $i++) {
if ($a1[$i] > $a2[$i]) {
return(1);
} elsif ($a1[$i] < $a2[$i]) {
return(-1);
}
}
return(0);
}
sub extend_version {
my @vn = @_;
while ($#vn < 2) {
@vn[$#vn+1] = "0";
}
return(@vn);
}
Jump to Line
Something went wrong with that request. Please try again.