2006-12-22 Mark Rowe <bdash@webkit.org>
[WebKit-https.git] / WebKitTools / Scripts / prepare-ChangeLog
1 #!/usr/bin/perl -w
2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2  -*-
3
4 #
5 #  Copyright (C) 2000, 2001 Eazel, Inc.
6 #  Copyright (C) 2002, 2003, 2004, 2005, 2006 Apple Computer, Inc.
7 #
8 #  prepare-ChangeLog is free software; you can redistribute it and/or
9 #  modify it under the terms of the GNU General Public
10 #  License as published by the Free Software Foundation; either
11 #  version 2 of the License, or (at your option) any later version.
12 #
13 #  prepare-ChangeLog is distributed in the hope that it will be useful,
14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 #  General Public License for more details.
17 #
18 #  You should have received a copy of the GNU General Public
19 #  License along with this program; if not, write to the Free
20 #  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 #
22
23
24 # Perl script to create a ChangeLog entry with names of files
25 # and functions from a diff.
26 #
27 # Darin Adler <darin@bentspoon.com>, started 20 April 2000
28 # Java support added by Maciej Stachowiak <mjs@eazel.com>
29 # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>
30
31
32 #
33 # TODO:
34 #   List functions that have been removed too.
35 #   Decide what a good logical order is for the changed files
36 #     other than a normal text "sort" (top level first?)
37 #     (group directories?) (.h before .c?)
38 #   Handle yacc source files too (other languages?).
39 #   Help merge when there are ChangeLog conflicts or if there's
40 #     already a partly written ChangeLog entry.
41 #   Add command line option to put the ChangeLog into a separate
42 #     file or just spew it out stdout.
43 #   Add SVN version numbers for commit (can't do that until
44 #     the changes are checked in, though).
45 #   Work around diff stupidity where deleting a function that starts
46 #     with a comment makes diff think that the following function
47 #     has been changed (if the following function starts with a comment
48 #     with the same first line, such as /**)
49 #   Work around diff stupidity where deleting an entire function and
50 #     the blank lines before it makes diff think you've changed the
51 #     previous function.
52
53 use strict;
54 use warnings;
55
56 use File::Basename;
57 use File::Spec;
58 use File::Temp;
59 use Getopt::Long;
60
61 sub canonicalizePath($);
62 sub get_function_line_ranges($$);
63 sub get_function_line_ranges_for_c($$);
64 sub get_function_line_ranges_for_java($$);
65 sub method_decl_to_selector($);
66 sub processPaths(\@);
67
68 my $openChangeLogs = 0;
69 my $showHelp = 0;
70 my $updateChangeLogs = 1;
71 my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
72 my $parseOptionsResult =
73     GetOptions("diff|d!" => \$spewDiff,
74                "help|h!" => \$showHelp,
75                "open|o!" => \$openChangeLogs,
76                "update!" => \$updateChangeLogs);
77 if (!$parseOptionsResult || $showHelp)
78   {
79     print STDERR basename($0) . " [-d|--diff] [-h|--help] [-o|--open] [svndir1 [svndir2 ...]]\n";
80     print STDERR "  -d|--diff      Spew diff to stdout when running\n";
81     print STDERR "  -h|--help      Show this help message\n";
82     print STDERR "  -o|--open      Open ChangeLogs in an editor when done\n";
83     print STDERR "  --[no-]update  Update ChangeLogs from svn before adding entry (default: update)\n";
84     exit 1;
85   }
86
87 my %paths = processPaths(@ARGV);
88
89 # Find the list of modified files
90 my @changed_files;
91 my $changed_files_string;
92 my %changed_line_ranges;
93 my %function_lists;
94 my @conflict_files;
95
96 my $SVN = "svn";
97
98 my %statusDescription = (
99     "A" => " Added.",
100     "D" => " Removed.",
101     "M" => "",
102     "R" => " Replaced.",
103 );
104
105 my $changedLayoutTests = 0;
106
107 my $DIFFOUT = new File::Temp(TEMPLATE => basename($0) . "-XXXXXXXX",
108                              DIR => ($ENV{'TMPDIR'} || "/tmp"),
109                              SUFFIX => ".diff");
110 my $diffTempFile = $DIFFOUT->filename();
111 my @diffFiles;
112
113 print STDERR "  Running 'svn diff' to find changed, added, or removed files.\n";
114 open SVNDIFF, "$SVN diff --diff-cmd diff -x -N '" . join("' '", keys %paths) . "'|"
115     or die "The svn diff failed: $!.\n";
116 while (<SVNDIFF>)
117   {
118     print $DIFFOUT $_;
119     if (/^Index: (.+)$/)
120       {
121         push @diffFiles, $1;
122       }
123   }
124 close SVNDIFF;
125 close $DIFFOUT;
126
127 if (@diffFiles)
128   {
129     my $diffFilesString = "'" . join ("' '", @diffFiles) . "'";
130     print STDERR "  Running 'svn stat' on changed, added, or removed files.\n";
131     open SVNSTAT, "$SVN stat $diffFilesString 2> /dev/stdout |" or die "The svn stat failed: $!.\n";
132     while(<SVNSTAT>)
133       {
134         if (/^([A-Z]).+\s+(.+)$/)
135           {
136               my $status = $1;
137               my $file = $2;
138               if ($status eq "A" || $status eq "M")
139                 {
140                   my @components = File::Spec->splitdir($file);
141                   $changedLayoutTests = 1 if $components[0] eq "LayoutTests";
142                   push @changed_files, $file if $components[$#components] ne "ChangeLog";
143                 }
144               push @conflict_files, $file if $status eq "C";
145               $function_lists{$file} = $statusDescription{$status} if exists $statusDescription{$status};
146           }
147         else
148           {
149             print;  # error output from svn stat
150           }
151       }
152     close SVNSTAT;
153   }
154
155 if (!@diffFiles || !%function_lists)
156   {
157     print STDERR "  No changes found.\n";
158     exit 1;
159   }
160
161 if (@conflict_files)
162   {
163     print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
164     print STDERR join("\n", @conflict_files), "\n";
165     exit 1;
166   }
167
168 if (@changed_files)
169   {
170     $changed_files_string = "'" . join ("' '", @changed_files) . "'";
171
172     # For each file, build a list of modified lines.
173     # Use line numbers from the "after" side of each diff.
174     print STDERR "  Reviewing 'svn diff' to determine which lines changed.\n";
175     my $file;
176     open DIFF, "< $diffTempFile" or die "Opening $diffTempFile failed: $!.\n";
177     while (<DIFF>)
178       {
179         $file = $1 if /^Index: (\S+)$/;
180         if (defined $file) {
181           if (/^\d+(,\d+)?[acd](\d+)(,(\d+))?/) {
182             push @{$changed_line_ranges{$file}}, [ $2, $4 || $2 ];
183           } elsif (/DO_NOT_COMMIT/) {
184             print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
185           }
186         }
187       }
188     close DIFF;
189   }
190
191 # For each source file, convert line range to function list.
192 if (%changed_line_ranges)
193   {
194     print STDERR "  Extracting affected function names from source files.\n";
195     foreach my $file (keys %changed_line_ranges)
196       {
197         # Only look for function names in .c files.
198         next unless $file =~ /\.(c|cpp|m|mm|h|java)/;
199     
200         # Find all the functions in the file.
201         open SOURCE, $file or next;
202         my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
203         close SOURCE;
204     
205         # Find all the modified functions.
206         my @functions;
207         my %saw_function;
208         my @change_ranges = (@{$changed_line_ranges{$file}}, []);
209         my @change_range = (0, 0);
210         FUNCTION: foreach my $function_range_ref (@function_ranges)
211           {
212             my @function_range = @$function_range_ref;
213     
214             # Advance to successive change ranges.
215             for (;; @change_range = @{shift @change_ranges})
216               {
217                 last FUNCTION unless @change_range;
218     
219                 # If past this function, move on to the next one.
220                 next FUNCTION if $change_range[0] > $function_range[1];
221     
222                 # If an overlap with this function range, record the function name.
223                 if ($change_range[1] >= $function_range[0]
224                     and $change_range[0] <= $function_range[1])
225                   {
226                     if (!$saw_function{$function_range[2]})
227                       {
228                         $saw_function{$function_range[2]} = 1;
229                         push @functions, $function_range[2];
230                       }
231                     next FUNCTION;
232                   }
233               }
234           }
235     
236         # Format the list of functions now.
237
238         if (@functions) {
239             $function_lists{$file} = "" if !defined $function_lists{$file};
240             $function_lists{$file} .= "\n        (" . join("):\n        (", @functions) . "):";
241         }
242       }
243   }
244
245 # Get some parameters for the ChangeLog we are about to write.
246 my $date = sprintf "%d-%02d-%02d",
247   1900 + (localtime $^T)[5], # year
248   1 + (localtime $^T)[4], # month
249   (localtime $^T)[3]; # day within month
250 my $name = $ENV{CHANGE_LOG_NAME}
251   || $ENV{REAL_NAME}
252   || (getpwuid $<)[6]
253   || "set REAL_NAME environment variable";
254 my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}
255   || $ENV{EMAIL_ADDRESS}
256   || "set EMAIL_ADDRESS environment variable";
257
258 # Remove trailing parenthesized notes from user name (bit of hack).
259 $name =~ s/\(.*?\)\s*$//g;
260
261 # Find the change logs.
262 my %has_log;
263 my %files;
264 foreach my $file (sort keys %function_lists)
265   {
266     my $prefix = $file;
267     my $has_log = 0;
268     while ($prefix)
269       {
270         $prefix =~ s-/[^/]+/?$-/- or $prefix = "";
271         $has_log = $has_log{$prefix};
272         if (!defined $has_log)
273           {
274             $has_log = -f "${prefix}ChangeLog";
275             $has_log{$prefix} = $has_log;
276           }
277         last if $has_log;
278       }
279     if (!$has_log)
280       {
281         print STDERR "No ChangeLog found for $file.\n";
282       }
283     else
284       {
285         push @{$files{$prefix}}, $file;
286       }
287   }
288
289 # Get the latest ChangeLog files from svn.
290 my $logs = "";
291 foreach my $prefix (sort keys %files)
292   {
293     $logs .= " ${prefix}ChangeLog";
294   }
295 if ($logs && $updateChangeLogs)
296   {
297     print STDERR "  Running 'svn update' to update ChangeLog files.\n";
298     open ERRORS, "$SVN update -q$logs |" or die "The svn update of ChangeLog files failed: $!.\n";
299     print STDERR "    $_" while <ERRORS>;
300     close ERRORS;
301   }
302
303 # Write out a new ChangeLog file.
304 foreach my $prefix (sort keys %files)
305   {
306     print STDERR "  Editing the ${prefix}ChangeLog file.\n";
307     open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n";
308     # It's less efficient to read the whole thing into memory than it would be
309     # to read it while we prepend to it later, but I like doing this part first.
310     my @old_change_log = <OLD_CHANGE_LOG>;
311     close OLD_CHANGE_LOG;
312     open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n.";
313     print CHANGE_LOG "$date  $name  <$email_address>\n\n";
314     print CHANGE_LOG "        Reviewed by NOBODY (OO" . "PS!).\n\n";
315     if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
316         print CHANGE_LOG "        WARNING: NO TEST CASES ADDED OR CHANGED\n\n" unless $changedLayoutTests;
317     }
318
319     foreach my $file (sort @{$files{$prefix}})
320       {
321         my $file_stem = substr $file, length $prefix;
322         print CHANGE_LOG "        * $file_stem:$function_lists{$file}\n";
323       }
324     print CHANGE_LOG "\n", @old_change_log;
325     close CHANGE_LOG;
326   }
327
328 # Write out another diff.
329 if ($spewDiff && @changed_files)
330   {
331     print STDERR "  Running 'svn diff' to help you write the ChangeLog entries.\n";
332     open DIFF, "$SVN diff $changed_files_string |" or die "The svn diff failed: $!.\n";
333     while (<DIFF>) { print; }
334     close DIFF;
335   }
336
337 # Open ChangeLogs.
338 if ($openChangeLogs && $logs)
339   {
340     print STDERR "  Opening the edited ChangeLog files.\n";
341     my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};
342     if ($editor) {
343         system "open -a '$editor'$logs";
344     } else {
345         system "open -e$logs";
346     }
347   }
348
349 # Done.
350 exit;
351
352 sub canonicalizePath($)
353   {
354     my ($file) = @_;
355
356     # Remove extra slashes and '.' directories in path
357     $file = File::Spec->canonpath($file);
358
359     # Remove '..' directories in path
360     my @dirs = ();
361     foreach my $dir (File::Spec->splitdir($file))
362       {
363         if ($dir eq '..' && $#dirs >= 0 && $dirs[$#dirs] ne '..')
364           {
365             pop(@dirs);
366           }
367         else
368           {
369             push(@dirs, $dir);
370           }
371       }
372     return ($#dirs >= 0) ? File::Spec->catdir(@dirs) : ".";
373   }
374
375 sub get_function_line_ranges($$)
376   {
377     my ($file_handle, $file_name) = @_;
378
379     if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {
380         return get_function_line_ranges_for_c ($file_handle, $file_name);
381     } elsif ($file_name =~ /\.java$/) {
382         return get_function_line_ranges_for_java ($file_handle, $file_name);
383     }
384     return ();
385   }
386
387
388 sub method_decl_to_selector($)
389   {
390     (my $method_decl) = @_;
391
392     $_ = $method_decl;
393
394     if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) 
395       {
396         $_ = $comment_stripped;
397       }
398
399     s/,\s*...//;
400
401     if (/:/) 
402       {
403         my @components = split /:/;
404         pop @components if (scalar @components > 1);
405         $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';
406       } else {
407         s/\s*$//;
408         s/.*[^[:word:]]//;
409       }
410
411     return $_;
412   }
413
414
415
416 # Read a file and get all the line ranges of the things that look like C functions.
417 # A function name is the last word before an open parenthesis before the outer
418 # level open brace. A function starts at the first character after the last close
419 # brace or semicolon before the function name and ends at the close brace.
420 # Comment handling is simple-minded but will work for all but pathological cases.
421 #
422 # Result is a list of triples: [ start_line, end_line, function_name ].
423
424 sub get_function_line_ranges_for_c($$)
425   {
426     my ($file_handle, $file_name) = @_;
427
428     my @ranges;
429
430     my $in_comment = 0;
431     my $in_macro = 0;
432     my $in_method_declaration = 0;
433     my $in_parentheses = 0;
434     my $in_braces = 0;
435     my $brace_start = 0;
436     my $brace_end = 0;
437     my $skip_til_brace_or_semicolon = 0;
438
439     my $word = "";
440     my $interface_name = "";
441
442     my $potential_method_char = "";
443     my $potential_method_spec = "";
444
445     my $potential_start = 0;
446     my $potential_name = "";
447
448     my $start = 0;
449     my $name = "";
450
451     my $next_word_could_be_namespace = 0;
452     my $potential_namespace = "";
453     my @namespaces;
454
455     while (<$file_handle>)
456       {
457         # Handle continued multi-line comment.
458         if ($in_comment)
459           {
460             next unless s-.*\*/--;
461             $in_comment = 0;
462           }
463
464         # Handle continued macro.
465         if ($in_macro)
466           {
467             $in_macro = 0 unless /\\$/;
468             next;
469           }
470
471         # Handle start of macro (or any preprocessor directive).
472         if (/^\s*\#/)
473           {
474             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
475             next;
476           }
477
478         # Handle comments and quoted text.
479         while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
480           {
481             my $match = $1;
482             if ($match eq "/*")
483               {
484                 if (!s-/\*.*?\*/--)
485                   {
486                     s-/\*.*--;
487                     $in_comment = 1;
488                   }
489               }
490             elsif ($match eq "//")
491               {
492                 s-//.*--;
493               }
494             else # ' or "
495               {
496                 if (!s-$match([^\\]|\\.)*?$match--)
497                   {
498                     warn "mismatched quotes at line $. in $file_name\n";
499                     s-$match.*--;
500                   }
501               }
502           }
503
504
505         # continued method declaration
506         if ($in_method_declaration) 
507           {
508               my $original = $_;
509               my $method_cont = $_;
510
511               chomp $method_cont;
512               $method_cont =~ s/[;\{].*//;
513               $potential_method_spec = "${potential_method_spec} ${method_cont}";
514
515               $_ = $original;
516               if (/;/) 
517                 {
518                   $potential_start = 0;
519                   $potential_method_spec = "";
520                   $potential_method_char = "";
521                   $in_method_declaration = 0;
522                   s/^[^;\{]*//;
523                 } elsif (/{/) {
524                   my $selector = method_decl_to_selector ($potential_method_spec);
525                   $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
526                   
527                   $potential_method_spec = "";
528                   $potential_method_char = "";
529                   $in_method_declaration = 0;
530   
531                   $_ = $original;
532                   s/^[^;{]*//;
533                 } elsif (/\@end/) {
534                   $in_method_declaration = 0;
535                   $interface_name = "";
536                   $_ = $original;
537                 } else {
538                   next;
539                 }
540           }
541
542         
543         # start of method declaration
544         if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&)
545           {
546             my $original = $_;
547
548             if ($interface_name) 
549               {
550                 chomp $method_spec;
551                 $method_spec =~ s/\{.*//;
552             
553                 $potential_method_char = $method_char;
554                 $potential_method_spec = $method_spec;
555                 $potential_start = $.;
556                 $in_method_declaration = 1;
557               } else { 
558                 warn "declaring a method but don't have interface on line $. in $file_name\n";
559               }
560             $_ = $original;
561             if (/\{/) {
562               my $selector = method_decl_to_selector ($potential_method_spec);
563               $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
564               
565               $potential_method_spec = "";
566               $potential_method_char = "";
567               $in_method_declaration = 0;
568               $_ = $original;
569               s/^[^{]*//;
570             } elsif (/\@end/) {
571               $in_method_declaration = 0;
572               $interface_name = "";
573               $_ = $original;
574             } else {
575               next;
576             }
577           }
578
579
580         # Find function, interface and method names.
581         while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g)
582           {
583             # interface name
584             if ($2) 
585               {
586                 $interface_name = $2;
587                 next;
588               }
589
590             # Open parenthesis.
591             if ($1 eq "(")
592               {
593                 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;
594                 $in_parentheses++;
595                 next;
596               }
597
598             # Close parenthesis.
599             if ($1 eq ")")
600               {
601                 $in_parentheses--;
602                 next;
603               }
604
605             # C++ constructor initializers
606             if ($1 eq ":")
607               {
608                   $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
609               }
610
611             # Open brace.
612             if ($1 eq "{")
613               {
614                 $skip_til_brace_or_semicolon = 0;
615
616                 if ($potential_namespace) {
617                     push @namespaces, $potential_namespace;
618                     $potential_namespace = "";
619                     next;
620                 }
621
622                 # Promote potential name to real function name at the
623                 # start of the outer level set of braces (function body?).
624                 if (!$in_braces and $potential_start)
625                   {
626                     $start = $potential_start;
627                     $name = $potential_name;
628                     if (@namespaces && (length($name) < 2 || substr($name,1,1) ne "[")) {
629                         $name = join ('::', @namespaces, $name);
630                     }
631                   }
632
633                 $in_method_declaration = 0;
634
635                 $brace_start = $. if (!$in_braces);
636                 $in_braces++;
637                 next;
638               }
639
640             # Close brace.
641             if ($1 eq "}")
642               {
643                 if (!$in_braces && @namespaces) {
644                     pop @namespaces;
645                     next;
646                 }
647
648                 $in_braces--;
649                 $brace_end = $. if (!$in_braces);
650
651                 # End of an outer level set of braces.
652                 # This could be a function body.
653                 if (!$in_braces and $name)
654                   {
655                     push @ranges, [ $start, $., $name ];
656                     $name = "";
657                   }
658
659                 $potential_start = 0;
660                 $potential_name = "";
661                 next;
662               }
663
664             # Semicolon.
665             if ($1 eq ";")
666               {
667                 $skip_til_brace_or_semicolon = 0;
668                 $potential_start = 0;
669                 $potential_name = "";
670                 $in_method_declaration = 0;
671                 next;
672               }
673
674             # Ignore "const" method qualifier.
675             if ($1 eq "const") {
676                 next;
677             }
678
679             if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
680                 $next_word_could_be_namespace = 1;
681                 next;
682             }
683
684             # Word.
685             $word = $1;
686             if (!$skip_til_brace_or_semicolon) {
687               if ($next_word_could_be_namespace) {
688                 $potential_namespace = $word;
689                 $next_word_could_be_namespace = 0;
690               } elsif ($potential_namespace) {
691                 $potential_namespace = "";
692               }
693
694               if (!$in_parentheses) {
695                 $potential_start = 0;
696                 $potential_name = "";
697               }
698               if (!$potential_start) {
699                 $potential_start = $.;
700                 $potential_name = "";
701               }
702             }
703           }
704       }
705
706     warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
707     warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
708
709     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
710
711     return @ranges;
712   }
713
714
715
716 # Read a file and get all the line ranges of the things that look like Java
717 # classes, interfaces and methods.
718 #
719 # A class or interface name is the word that immediately follows
720 # `class' or `interface' when followed by an open curly brace and not
721 # a semicolon. It can appear at the top level, or inside another class
722 # or interface block, but not inside a function block
723 #
724 # A class or interface starts at the first character after the first close
725 # brace or after the function name and ends at the close brace.
726 #
727 # A function name is the last word before an open parenthesis before
728 # an open brace rather than a semicolon. It can appear at top level or
729 # inside a class or interface block, but not inside a function block.
730 #
731 # A function starts at the first character after the first close
732 # brace or after the function name and ends at the close brace.
733 #
734 # Comment handling is simple-minded but will work for all but pathological cases.
735 #
736 # Result is a list of triples: [ start_line, end_line, function_name ].
737
738 sub get_function_line_ranges_for_java($$)
739   {
740     my ($file_handle, $file_name) = @_;
741
742     my @current_scopes;
743
744     my @ranges;
745
746     my $in_comment = 0;
747     my $in_macro = 0;
748     my $in_parentheses = 0;
749     my $in_braces = 0;
750     my $in_non_block_braces = 0;
751     my $class_or_interface_just_seen = 0;
752
753     my $word = "";
754
755     my $potential_start = 0;
756     my $potential_name = "";
757     my $potential_name_is_class_or_interface = 0;
758
759     my $start = 0;
760     my $name = "";
761     my $current_name_is_class_or_interface = 0;
762
763     while (<$file_handle>)
764       {
765         # Handle continued multi-line comment.
766         if ($in_comment)
767           {
768             next unless s-.*\*/--;
769             $in_comment = 0;
770           }
771
772         # Handle continued macro.
773         if ($in_macro)
774           {
775             $in_macro = 0 unless /\\$/;
776             next;
777           }
778
779         # Handle start of macro (or any preprocessor directive).
780         if (/^\s*\#/)
781           {
782             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
783             next;
784           }
785
786         # Handle comments and quoted text.
787         while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
788           {
789             my $match = $1;
790             if ($match eq "/*")
791               {
792                 if (!s-/\*.*?\*/--)
793                   {
794                     s-/\*.*--;
795                     $in_comment = 1;
796                   }
797               }
798             elsif ($match eq "//")
799               {
800                 s-//.*--;
801               }
802             else # ' or "
803               {
804                 if (!s-$match([^\\]|\\.)*?$match--)
805                   {
806                     warn "mismatched quotes at line $. in $file_name\n";
807                     s-$match.*--;
808                   }
809               }
810           }
811
812         # Find function names.
813         while (m-(\w+|[(){};])-g)
814           {
815             # Open parenthesis.
816             if ($1 eq "(")
817               {
818                 if (!$in_parentheses) {
819                     $potential_name = $word;
820                     $potential_name_is_class_or_interface = 0;
821                 }
822                 $in_parentheses++;
823                 next;
824               }
825
826             # Close parenthesis.
827             if ($1 eq ")")
828               {
829                 $in_parentheses--;
830                 next;
831               }
832
833             # Open brace.
834             if ($1 eq "{")
835               {
836                 # Promote potential name to real function name at the
837                 # start of the outer level set of braces (function/class/interface body?).
838                 if (!$in_non_block_braces
839                     and (!$in_braces or $current_name_is_class_or_interface)
840                     and $potential_start)
841                   {
842                     if ($name)
843                       {
844                           push @ranges, [ $start, ($. - 1),
845                                           join ('.', @current_scopes) ];
846                       }
847
848
849                     $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
850
851                     $start = $potential_start;
852                     $name = $potential_name;
853
854                     push (@current_scopes, $name);
855                   } else {
856                       $in_non_block_braces++;
857                   }
858
859                 $potential_name = "";
860                 $potential_start = 0;
861
862                 $in_braces++;
863                 next;
864               }
865
866             # Close brace.
867             if ($1 eq "}")
868               {
869                 $in_braces--;
870
871                 # End of an outer level set of braces.
872                 # This could be a function body.
873                 if (!$in_non_block_braces)
874                   {
875                     if ($name)
876                       {
877                         push @ranges, [ $start, $.,
878                                         join ('.', @current_scopes) ];
879
880                         pop (@current_scopes);
881
882                         if (@current_scopes)
883                           {
884                             $current_name_is_class_or_interface = 1;
885
886                             $start = $. + 1;
887                             $name =  $current_scopes[$#current_scopes-1];
888                           }
889                         else
890                           {
891                             $current_name_is_class_or_interface = 0;
892                             $start = 0;
893                             $name =  "";
894                           }
895                     }
896                   }
897                 else
898                   {
899                     $in_non_block_braces-- if $in_non_block_braces;
900                   }
901
902                 $potential_start = 0;
903                 $potential_name = "";
904                 next;
905               }
906
907             # Semicolon.
908             if ($1 eq ";")
909               {
910                 $potential_start = 0;
911                 $potential_name = "";
912                 next;
913               }
914
915             if ($1 eq "class" or $1 eq "interface")
916               {
917                 $class_or_interface_just_seen = 1;
918                 next;
919               }
920
921             # Word.
922             $word = $1;
923             if (!$in_parentheses)
924               {
925                 if ($class_or_interface_just_seen) {
926                     $potential_name = $word;
927                     $potential_start = $.;
928                     $class_or_interface_just_seen = 0;
929                     $potential_name_is_class_or_interface = 1;
930                     next;
931                 }
932               }
933             if (!$potential_start)
934               {
935                 $potential_start = $.;
936                 $potential_name = "";
937               }
938             $class_or_interface_just_seen = 0;
939           }
940       }
941
942     warn "mismatched braces in $file_name\n" if $in_braces;
943     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
944
945     return @ranges;
946   }
947
948 sub processPaths(\@)
949   {
950     my ($paths) = @_;
951     return ("." => 1) if (!@{$paths});
952
953     my %result = ();
954
955     for my $file (@{$paths})
956       {
957         die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);
958         die "can't handle empty string path\n" if $file eq "";
959         die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)
960
961         my $untouchedFile = $file;
962
963         $file = canonicalizePath($file);
964
965         die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;
966
967         $result{$file} = 1;
968       }
969
970     return ("." => 1) if ($result{"."});
971
972     # Remove any paths that also have a parent listed.
973     for my $path (keys %result)
974       {
975         for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent))
976          {
977             if ($result{$parent})
978               {
979                 delete $result{$path};
980                 last;
981               }
982           }
983       }
984
985     return %result;
986   }