*** empty log message ***
This commit is contained in:
Gerd Moellmann
parent
b76dfd21ba
commit
30b50b5cca
5 changed files with 670 additions and 0 deletions
3
admin/README
Normal file
3
admin/README
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
This directory contains scripts and other things useful for
|
||||
maintaining Emacs. These files are not part of Emacs releases because
|
||||
they are not deemed generally useful.
|
||||
70
admin/build-configs
Executable file
70
admin/build-configs
Executable file
|
|
@ -0,0 +1,70 @@
|
|||
#! /usr/bin/perl
|
||||
|
||||
# Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is part of GNU Emacs.
|
||||
#
|
||||
# GNU Emacs is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
#
|
||||
# GNU Emacs is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
# Boston, MA 02111-1307, USA.
|
||||
|
||||
# Build Emacs in several different configurations.
|
||||
|
||||
@configs =
|
||||
(
|
||||
["--without-x", "--optim"],
|
||||
["--without-x-toolkit", "--optim"],
|
||||
["--without-toolkit-scroll-bars", "--optim"],
|
||||
["--with-x-toolkit=lucid", "--optim"],
|
||||
["--with-x-toolkit=motif", "--optim"],
|
||||
["--with-x-toolkit=motif", "--enable-checking"],
|
||||
["--with-x-toolkit=motif", "--gcc3"],
|
||||
["--with-x-toolkit=motif", ""],
|
||||
);
|
||||
|
||||
$log = "/tmp/$$.out";
|
||||
print "Using log file $log\n";
|
||||
unlink $log;
|
||||
|
||||
$root = $ENV{"EMACS_ROOT"};
|
||||
$root = "/gd/gnu/emacs" unless $root;
|
||||
chdir ($root) or die "Cannot chdir to emacs";
|
||||
|
||||
foreach $config (@configs)
|
||||
{
|
||||
my $configure_options = @$config[0];
|
||||
my $make_options = @$config[1];
|
||||
my $rc;
|
||||
|
||||
print "$configure_options, $make_options\n";
|
||||
unlink "config.cache";
|
||||
|
||||
$rc = system ("$root/configure $configure_options >>$log 2>&1");
|
||||
if ($rc != 0)
|
||||
{
|
||||
print "configure failed\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
$rc = system ("make-emacs --all $make_options >>$log 2>&1");
|
||||
if ($rc != 0)
|
||||
{
|
||||
print "Make failed\n";
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# End:
|
||||
300
admin/check-doc-strings
Executable file
300
admin/check-doc-strings
Executable file
|
|
@ -0,0 +1,300 @@
|
|||
: #-*- Perl -*-
|
||||
eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
|
||||
if 0; # Author: Martin Buchholz
|
||||
|
||||
use strict;
|
||||
use POSIX;
|
||||
|
||||
(my $myName = $0) =~ s@.*/@@; my $usage="
|
||||
Usage: $myName
|
||||
|
||||
Finds DOCSTRING arg mismatches between
|
||||
formal parameters, docstrings, and lispref texi.
|
||||
|
||||
This program is in the public domain.\n";
|
||||
|
||||
die $usage if @ARGV;
|
||||
die $usage unless -r "src/alloc.c" && -d "CVS" && -d "lisp";
|
||||
|
||||
my %texi_funtype;
|
||||
my %texi_arglist;
|
||||
|
||||
my %code_funtype;
|
||||
my %code_arglist;
|
||||
|
||||
sub FileContents {
|
||||
local $/ = undef;
|
||||
open (FILE, "< $_[0]") or die "$_[0]: $!";
|
||||
return scalar <FILE>;
|
||||
}
|
||||
|
||||
sub Show_details {
|
||||
my ($show_details, $function, $parms, $docstring) = @_;
|
||||
if ($show_details) {
|
||||
print "function = $function $parms\n$docstring\n", "-" x 70, "\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub Check_texi_function {
|
||||
my ($function, $funtype, $docstring, @parms) = @_;
|
||||
my %docstring_parm;
|
||||
my %docstring_word;
|
||||
my %arglist_parm;
|
||||
my $show_details = 0;
|
||||
|
||||
if (exists $texi_funtype{$function}) {
|
||||
print "duplicate texidoc: $function @parms\n";
|
||||
return; # later definition likely bogus package def
|
||||
}
|
||||
|
||||
$texi_funtype{$function} = $funtype;
|
||||
$texi_arglist{$function} = "@parms";
|
||||
|
||||
foreach my $parm (@parms) {
|
||||
next if $parm eq '&optional' || $parm eq '&rest';
|
||||
$arglist_parm{$parm} = 1;
|
||||
}
|
||||
|
||||
foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) {
|
||||
$docstring_parm{$parm} = 1;
|
||||
}
|
||||
|
||||
foreach my $hit ($docstring =~ /[^\`]\`[A-Za-z-]+\'/g)
|
||||
{
|
||||
print "texi \@code missing: $function: $hit\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
|
||||
# (my $raw_docstring = $docstring) =~ s/\@var{[^{}]+}//g;
|
||||
# $raw_docstring =~ s/[^a-zA-Z_-]+/ /g;
|
||||
# foreach my $word (split (' ', $raw_docstring)) {
|
||||
# if ($word =~ /^[A-Z][A-Z-]+$/) {
|
||||
# print "Missing \@var: $function: $word\n";
|
||||
# }
|
||||
# }
|
||||
|
||||
foreach my $parm (keys %docstring_parm) {
|
||||
if (! exists $arglist_parm{$parm}) {
|
||||
print "bogus texi parm: $function: $parm\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $parm (keys %arglist_parm) {
|
||||
if (! exists $docstring_parm{$parm}) {
|
||||
print "undocumented texi parm: $function: $parm\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
}
|
||||
|
||||
Show_details $show_details, $function, "@parms", $docstring;
|
||||
}
|
||||
|
||||
sub Check_function {
|
||||
my ($function, $funtype, $docstring, @parms) = @_;
|
||||
my %docstring_parm;
|
||||
my %arglist_parm;
|
||||
my $show_details = 0;
|
||||
|
||||
if (exists $code_funtype{$function}) {
|
||||
print "duplicate codedef: $function @parms\n";
|
||||
return; # later definition likely bogus package def
|
||||
}
|
||||
|
||||
$code_funtype{$function} = $funtype;
|
||||
$code_arglist{$function} = "@parms";
|
||||
#foreach my $parm ($parms =~ /\b[a-z0-9-]{3,}\b/g) {
|
||||
# $arglist_parm{$parm} = 1;
|
||||
#}
|
||||
foreach my $parm (@parms) {
|
||||
next if $parm eq '&optional' || $parm eq '&rest';
|
||||
$arglist_parm{$parm} = 1;
|
||||
}
|
||||
my $doc_tmp = $docstring;
|
||||
$doc_tmp =~ s/[^A-Za-z0-9_-]/ /g;
|
||||
foreach my $parm (split (' ', $doc_tmp)) {
|
||||
if ($parm =~ /^[A-Z][A-Z0-9-]*$/) {
|
||||
next if $parm =~ /I18N/;
|
||||
next if $parm =~ /M17N/;
|
||||
$parm =~ tr[A-Z][a-z];
|
||||
$docstring_parm{$parm} = 1;
|
||||
}
|
||||
}
|
||||
# foreach my $parm ($docstring =~ /\b[A-Z0-9-]{1,}\b/g) {
|
||||
# next if $parm =~ /-$/;
|
||||
# $parm =~ tr[A-Z][a-z];
|
||||
# $docstring_parm{$parm} = 1;
|
||||
# }
|
||||
foreach my $parm (keys %docstring_parm) {
|
||||
next if $parm eq 'tty';
|
||||
next if $parm eq 'fsf';
|
||||
next if $parm eq 'note';
|
||||
next if $parm eq 'warning';
|
||||
next if $parm eq 'bug';
|
||||
next if $parm eq 'ascii';
|
||||
next if $parm eq 'iso';
|
||||
next if $parm eq 'and';
|
||||
next if $parm eq 'absolutely';
|
||||
next if $parm eq 'doc';
|
||||
next if $parm eq 'user';
|
||||
next if $parm eq 'not';
|
||||
next if $parm eq 'must';
|
||||
next if $parm eq 'nil';
|
||||
next if $parm eq 'esc';
|
||||
next if $parm eq 'lfd';
|
||||
next if $parm eq 'gpm';
|
||||
next if $parm eq 'primary';
|
||||
next if $parm eq 'secondary';
|
||||
next if $parm eq 'clipboard';
|
||||
next if length $parm < 3;
|
||||
if (! exists $arglist_parm{$parm}) {
|
||||
print "bogus parm: $function: $parm\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
}
|
||||
foreach my $parm (keys %arglist_parm) {
|
||||
if (! exists $docstring_parm{$parm}) {
|
||||
print "Undocumented parm: $function: $parm\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
}
|
||||
|
||||
if ($docstring !~ /[\]}!\)\.]\s*\Z/m &&
|
||||
$docstring =~ /\S/ &&
|
||||
$docstring !~ /Keywords supported/)
|
||||
{
|
||||
print "Missing trailing period: $function\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
|
||||
if (exists $texi_arglist{$function}
|
||||
and "@parms" ne $texi_arglist{$function}
|
||||
and not ("@parms" eq 'int nargs Lisp-Object *args'
|
||||
&& $texi_arglist{$function} =~ /&rest/)) {
|
||||
my @texi_parms = split (' ', $texi_arglist{$function});
|
||||
my @a = ("@parms" =~ /&optional/g);
|
||||
my @b = ("@parms" =~ /&rest/g);
|
||||
my @c = ("@texi_parms" =~ /&optional/g);
|
||||
my @d = ("@texi_parms" =~ /&rest/g);
|
||||
if (@parms != @texi_parms
|
||||
|| (@a != @c) || (@b != @d)) {
|
||||
print "serious mismatch: $function: @parms --- @texi_parms\n";
|
||||
} else {
|
||||
print "texi mismatch: $function: @parms --- $texi_arglist{$function}\n";
|
||||
}
|
||||
$show_details = 1;
|
||||
}
|
||||
|
||||
if (exists $texi_funtype{$function}
|
||||
&& $texi_funtype{$function} ne $funtype) {
|
||||
print "interactiveness mismatch: $function: $funtype --- $texi_funtype{$function}\n";
|
||||
$show_details = 1;
|
||||
}
|
||||
|
||||
Show_details $show_details, $function, "@parms", $docstring;
|
||||
}
|
||||
|
||||
my $lisprefdir;
|
||||
if (-d "man/lispref") { $lisprefdir = "man/lispref"; }
|
||||
elsif (-d "lispref") { $lisprefdir = "lispref"; }
|
||||
else { die "Can't find lispref texi directory.\n"; }
|
||||
|
||||
open (FIND, "find $lisprefdir -name '*.texi' -print |") or die;
|
||||
while (my $file = <FIND>) {
|
||||
my @matches = ((FileContents $file) =~
|
||||
/\@(def(?:fn|un))([^\n]+)\n(.*?)\n\@end def(?:un|fn)/sgo);
|
||||
# /^\@(def(?:un|fn))\s+(.*)\n([.|\n]*?)^\@end def(?:un|fn)\n/mgo);
|
||||
while (@matches) {
|
||||
my ($defform, $defn, $docstring) = splice (@matches, 0, 3);
|
||||
#print "defform = $defform\n";
|
||||
#print "defn = $defn\n";
|
||||
#print "docstring = $docstring\n";
|
||||
my ($function, @parms, $funtype);
|
||||
if ($defform eq 'defun') {
|
||||
($funtype, $function, @parms) = ('Function', split (' ', $defn));
|
||||
} else {
|
||||
die unless $defform eq 'deffn';
|
||||
($funtype, $function, @parms) = split (' ', $defn);
|
||||
}
|
||||
next if $funtype eq '{Syntax' or $funtype eq '{Prefix';
|
||||
|
||||
Check_texi_function $function, $funtype, $docstring, @parms;
|
||||
}
|
||||
}
|
||||
|
||||
open (FIND, "find src -name '*.c' -print |") or die;
|
||||
while (my $file = <FIND>) {
|
||||
my @matches =
|
||||
((FileContents $file) =~
|
||||
/\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
|
||||
while (@matches) {
|
||||
my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6);
|
||||
$docstring =~ s/^\n+//s;
|
||||
$docstring =~ s/\n+$//s;
|
||||
$parms =~ s/,/ /g;
|
||||
my @parms = split (' ',$parms);
|
||||
for (@parms) { tr/_/-/; s/-$//; }
|
||||
if ($parms !~ /Lisp_Object/) {
|
||||
if ($minargs < @parms) {
|
||||
if ($maxargs =~ /^\d+$/) {
|
||||
die unless $maxargs eq @parms;
|
||||
splice (@parms, $minargs, 0, '&optional');
|
||||
}
|
||||
}
|
||||
}
|
||||
my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
|
||||
Check_function $function, $funtype, $docstring, @parms;
|
||||
}
|
||||
}
|
||||
|
||||
my @pkgs;
|
||||
if (-d "../xemacs-packages") {
|
||||
@pkgs = qw (libs/edebug libs/xemacs-base comm/eudc oa/edit-utils);
|
||||
} else {
|
||||
@pkgs = ();
|
||||
}
|
||||
for (@pkgs) { s@^@../xemacs-packages/@; }
|
||||
open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
|
||||
while (my $file = <FIND>) {
|
||||
my $contents = FileContents $file;
|
||||
$contents =~ s/(?:\s|;);.*//mog;
|
||||
my @matches =
|
||||
($contents =~
|
||||
/\((def(?:un|subst|macro))\s+(\S+)\s+\(([^()]*)\)\s+\"((?:[^\\\"]|\\.)+)\"(.*?)\)/sgo);
|
||||
while (@matches) {
|
||||
my ($defform, $function, $parms, $docstring, $code_fragment) = splice (@matches, 0, 5);
|
||||
|
||||
my $funtype =
|
||||
$defform eq 'defmacro' ? 'Macro' :
|
||||
$code_fragment =~ /^\s*\(interactive\b/so ? 'Command' :
|
||||
'Function';
|
||||
|
||||
$docstring =~ s/^\n+//s;
|
||||
$docstring =~ s/\n+$//s;
|
||||
|
||||
my @parms = split (' ', $parms);
|
||||
|
||||
Check_function $function, $funtype, $docstring, @parms;
|
||||
}
|
||||
}
|
||||
|
||||
open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
|
||||
while (my $file = <FIND>) {
|
||||
my $contents = FileContents $file;
|
||||
$contents =~ s/(?:\s|;);.*//mog;
|
||||
|
||||
my @matches = ($contents =~ /^\((?:defalias|fset|define-function)\s+\'([A-Za-z0-9_-]+)\s+\'([A-Za-z0-9_-]+)/mog);
|
||||
while (@matches) {
|
||||
my ($alias, $aliasee) = splice (@matches, 0, 2);
|
||||
print "alias $alias aliasee $aliasee\n";
|
||||
if (exists $code_funtype{$aliasee}) { $code_funtype{$alias} = $code_funtype{$aliasee}; }
|
||||
if (exists $code_arglist{$aliasee}) { $code_arglist{$alias} = $code_arglist{$aliasee}; }
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $fun (sort keys %texi_funtype) {
|
||||
if (not exists $code_funtype{$fun}) {
|
||||
print "nuke-this-doc: $fun $texi_funtype{$fun}\n";
|
||||
}
|
||||
}
|
||||
|
||||
175
admin/make-emacs
Executable file
175
admin/make-emacs
Executable file
|
|
@ -0,0 +1,175 @@
|
|||
#! /usr/bin/perl
|
||||
|
||||
# Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is part of GNU Emacs.
|
||||
#
|
||||
# GNU Emacs is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
#
|
||||
# GNU Emacs is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
# Boston, MA 02111-1307, USA.
|
||||
|
||||
# Build Emacs with various options for profiling, debugging,
|
||||
# with and without warnings enabled etc.
|
||||
|
||||
require 5;
|
||||
use Getopt::Long;
|
||||
use File::Basename;
|
||||
use Cwd;
|
||||
|
||||
# Default CVS sandbox directory. Only used when called from outside
|
||||
# of the sandbox.
|
||||
|
||||
$root = $ENV{"EMACS_ROOT"};
|
||||
$root = "/gd/gnu/emacs" unless $root;
|
||||
|
||||
# Default make command.
|
||||
|
||||
$make = $ENV{"EMACS_MAKE"};
|
||||
$make = "gmake" unless $make;
|
||||
|
||||
$rc = GetOptions ("help" => \$help,
|
||||
"enable-checking" => \$enable_checking,
|
||||
"no-warn" => \$no_warn,
|
||||
"check-marked" => \$check_marked,
|
||||
"all" => \$all,
|
||||
"no-optim" => \$no_optim,
|
||||
"union-type" => \$union_type,
|
||||
"gprof" => \$profile,
|
||||
"malloc-check" => \$malloc_check,
|
||||
"no-mcheck" => \$no_mcheck,
|
||||
"alias" => \$aliasing,
|
||||
"wall" => \$wall,
|
||||
"gcc3" => \$gcc3,
|
||||
"trace-selection" => \$trace_selection,
|
||||
"stabs" => \$use_stabs,
|
||||
"optim" => \$optim);
|
||||
|
||||
if ($rc == 0 || $help)
|
||||
{
|
||||
print <<USAGE;
|
||||
make-emacs [options] ...
|
||||
|
||||
Build Emacs.
|
||||
|
||||
--help show this help
|
||||
--all make clean versionclean first
|
||||
--enable-checking ENABLE_CHECKING=1 (implies Lisp union type)
|
||||
--no-warn disable warnings
|
||||
--check-marked GC_CHECK_MARKED_OBJECTS=1
|
||||
--optim no debug defines
|
||||
--gprof make Emacs for profiling
|
||||
--union-type define USE_LISP_UNION_TYPE (bad for GDB)
|
||||
--malloc-check define GC_MALLOC_CHECK
|
||||
--no-mcheck dont define GC_MCHECK
|
||||
--wall compile with -Wall
|
||||
--gcc3 use GCC 3.0 (30% slower compilation, slower code)
|
||||
--trace-selection print traces in xselect.c
|
||||
--stabs use -gstabs instead -g
|
||||
|
||||
Default is to compile with warnings, with -DGC_MCHECK=1, and
|
||||
with -DGLYPH_DEBUG=1.
|
||||
|
||||
USAGE
|
||||
exit 1;
|
||||
}
|
||||
|
||||
# Chdir to the top-level directory of the tree. If not in a tree
|
||||
# containing Emacs, use the default.
|
||||
|
||||
while (! -f "src/emacs.c" && cwd () ne "/")
|
||||
{
|
||||
chdir "..";
|
||||
}
|
||||
|
||||
chdir $root if cwd () eq "/";
|
||||
chdir "./src";
|
||||
print "Build in ", cwd (), "\n";
|
||||
|
||||
# If first arg is `all' or if `--all' specified, ensure a clean
|
||||
# build.
|
||||
|
||||
if (@ARGV && $ARGV[0] eq "all")
|
||||
{
|
||||
$all = 1;
|
||||
shift @ARGV;
|
||||
}
|
||||
|
||||
system ("$make clean versionclean") if $all;
|
||||
|
||||
if ($wall)
|
||||
{
|
||||
$warn = "-Wall";
|
||||
}
|
||||
elsif (!$no_warn)
|
||||
{
|
||||
$warn = "-Wpointer-arith -Wchar-subscripts -Wformat -Wimplicit-int";
|
||||
$warn = "$warn -Wreturn-type -Wswitch -Wuninitialized";
|
||||
}
|
||||
|
||||
$defs = "-DGLYPH_DEBUG=1" unless $optim;
|
||||
$defs = "$defs -DGC_CHECK_MARKED_OBJECTS=1" if $check_marked;
|
||||
$defs = "$defs -DENABLE_CHECKING=1" if $enable_checking;
|
||||
|
||||
if ($profile)
|
||||
{
|
||||
$opts = "-pg";
|
||||
$defs = "$defs -DPROFILING=1";
|
||||
}
|
||||
else
|
||||
{
|
||||
if ($use_stabs)
|
||||
{
|
||||
$opts = "-gstabs";
|
||||
}
|
||||
else
|
||||
{
|
||||
$opts = "-g";
|
||||
}
|
||||
}
|
||||
|
||||
$defs = "$defs -DUSE_LISP_UNION_TYPE" if $union_type;
|
||||
$defs = "$defs -DGC_MALLOC_CHECK=1 -DGC_PROTECT_MALLOC_STATE=1" if $malloc_check;
|
||||
$defs = "$defs -DGC_MCHECK=1" unless $no_mcheck;
|
||||
|
||||
$defs = "$defs -DTRACE_SELECTION" if $trace_selection;
|
||||
|
||||
# arch=pentium leads to slightly faster code than without.
|
||||
$opts = "$opts -march=pentiumpro";
|
||||
|
||||
if ($optim)
|
||||
{
|
||||
$opts = "$opts -pipe -O3";
|
||||
}
|
||||
elsif ($no_optim)
|
||||
{
|
||||
$opts = "$opts -pipe -fno-inline";
|
||||
}
|
||||
else
|
||||
{
|
||||
$opts = "$opts -O -pipe -fno-inline";
|
||||
}
|
||||
|
||||
$opts = "$opts -fstrict-aliasing" if $aliasing;
|
||||
|
||||
$opts = "$opts $defs" if $defs;
|
||||
$opts = "$opts $warn" if $warn;
|
||||
|
||||
$cc = "/usr/bin/gcc";
|
||||
$cc = "/gd/local/bin/gcc" if $gcc3;
|
||||
|
||||
exit system "$make CC=\"$cc\" CFLAGS=\"$opts\" @ARGV";
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# End:
|
||||
122
admin/revdiff
Executable file
122
admin/revdiff
Executable file
|
|
@ -0,0 +1,122 @@
|
|||
#! /usr/bin/perl
|
||||
|
||||
# Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is part of GNU Emacs.
|
||||
#
|
||||
# GNU Emacs is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
#
|
||||
# GNU Emacs is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
# Boston, MA 02111-1307, USA.
|
||||
|
||||
use File::Basename;
|
||||
|
||||
if (@ARGV < 3)
|
||||
{
|
||||
print <<USAGE;
|
||||
revdiff FILE OLD NEW
|
||||
|
||||
Get a diff of FILE between revisions OLD and NEW. Store the
|
||||
diff in a file named FILE-OLD-NEW.diff. If NEW is +<number>
|
||||
or -<number>, build diffs between revisions OLD and OLD +/- <number>.
|
||||
OLD being `-' means use FILE's current revision.
|
||||
|
||||
Examples:
|
||||
|
||||
revdiff FILE - -1 get the latest change of FILE
|
||||
revdiff FILE 1.500 +2 get diffs 1.500-1.501 and 1.501-1.502.
|
||||
|
||||
USAGE
|
||||
exit 1;
|
||||
}
|
||||
|
||||
$file = shift @ARGV;
|
||||
$old = shift @ARGV;
|
||||
|
||||
sub diffit
|
||||
{
|
||||
my ($old, $new) = @_;
|
||||
print "cvs diff -r$old -r$new $file >$file-$old-$new.diff\n";
|
||||
system "cvs diff -r$old -r$new $file >$file-$old-$new.diff";
|
||||
}
|
||||
|
||||
sub current_revision ($)
|
||||
{
|
||||
my ($file) = @_;
|
||||
my $dir = dirname ($file);
|
||||
my $base = basename ($file);
|
||||
my $entries = "$dir/CVS/Entries";
|
||||
die "Can't find $entries" unless -f $entries;
|
||||
open (IN, "<$entries") or die "Cannot open $entries";
|
||||
my $rev;
|
||||
while ($line = <IN>)
|
||||
{
|
||||
if ($line =~ m,/$base/([^/]+),)
|
||||
{
|
||||
$rev = $1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
die "Cannot determine current revision of $file" unless $rev;
|
||||
close (IN);
|
||||
return $rev;
|
||||
}
|
||||
|
||||
if ($old eq "-")
|
||||
{
|
||||
$old = current_revision ($file);
|
||||
}
|
||||
|
||||
while (@ARGV)
|
||||
{
|
||||
my $new = shift @ARGV;
|
||||
if ($new =~ /^[+]\d+$/)
|
||||
{
|
||||
my $n = $new;
|
||||
for ($i = 0; $i < $n; ++$i)
|
||||
{
|
||||
unless ($old =~ /(.*)\.(\d+)$/)
|
||||
{
|
||||
die "Internal error";
|
||||
}
|
||||
my $j = $2 + 1;
|
||||
$new = "$1.$j";
|
||||
diffit ($old, $new);
|
||||
$old = $new;
|
||||
}
|
||||
}
|
||||
elsif ($new =~ /^[-]\d+$/)
|
||||
{
|
||||
my $n = - $new;
|
||||
for ($i = 0; $i < $n; ++$i)
|
||||
{
|
||||
unless ($old =~ /(.*)\.(\d+)$/)
|
||||
{
|
||||
die "Internal error";
|
||||
}
|
||||
my $j = $2 - 1;
|
||||
$new = "$1.$j";
|
||||
diffit ($new, $old);
|
||||
$old = $new;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
diffit ($old, $new);
|
||||
$old = $new;
|
||||
}
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# End:
|
||||
Loading…
Add table
Reference in a new issue