X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/87ae21858adc173c129ff8dfec8ce74cd82e77be..9bf31d1d3f35880c652f76509d1e27d33e454121:/lib-src/etags.c

diff --git a/lib-src/etags.c b/lib-src/etags.c
index 182cb4cc87..1c85a79289 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -35,8 +35,8 @@ This file is not considered part of GNU Emacs.
 
 This program 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 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
 
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -112,7 +112,6 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
 
 #ifdef WINDOWSNT
 # include <direct.h>
-# define MAXPATHLEN _MAX_PATH
 # undef HAVE_NTGUI
 # undef  DOS_NT
 # define DOS_NT
@@ -680,8 +679,8 @@ static const char *Objc_suffixes [] =
 static const char Objc_help [] =
 "In Objective C code, tags include Objective C definitions for classes,\n\
 class categories, methods and protocols.  Tags for variables and\n\
-functions in classes are named 'CLASS::VARIABLE' and 'CLASS::FUNCTION'.\n\
-(Use --help --lang=c --lang=objc --lang=java for full help.)";
+functions in classes are named 'CLASS::VARIABLE' and 'CLASS::FUNCTION'.\
+\n(Use --help --lang=c --lang=objc --lang=java for full help.)";
 
 static const char *Pascal_suffixes [] =
   { "p", "pas", NULL };
@@ -971,11 +970,12 @@ Relative ones are stored relative to the output file's directory.\n");
 	in some languages.");
 
   puts ("-Q, --class-qualify\n\
-        Qualify tag names with their class name in C++, ObjC, and Java.\n\
+        Qualify tag names with their class name in C++, ObjC, Java, and Perl.\n\
         This produces tag names of the form \"class::member\" for C++,\n\
         \"class(category)\" for Objective C, and \"class.member\" for Java.\n\
         For Objective C, this also produces class methods qualified with\n\
-        their arguments, as in \"foo:bar:baz:more\".");
+        their arguments, as in \"foo:bar:baz:more\".\n\
+        For Perl, this produces \"package::member\".");
   puts ("-r REGEXP, --regex=REGEXP or --regex=@regexfile\n\
         Make a tag for each line matching a regular expression pattern\n\
 	in the following files.  {LANGUAGE}REGEXP uses REGEXP for LANGUAGE\n\
@@ -1342,7 +1342,7 @@ main (int argc, char **argv)
     {
       char *cmd =
 	xmalloc (strlen (tagfile) + whatlen_max +
-		 sizeof "mv..OTAGS;fgrep -v '\t\t' OTAGS >;rm OTAGS");
+		 sizeof "mv..OTAGS;grep -Fv '\t\t' OTAGS >;rm OTAGS");
       for (i = 0; i < current_arg; ++i)
 	{
 	  switch (argbuffer[i].arg_type)
@@ -1355,7 +1355,7 @@ main (int argc, char **argv)
 	    }
 	  char *z = stpcpy (cmd, "mv ");
 	  z = stpcpy (z, tagfile);
-	  z = stpcpy (z, " OTAGS;fgrep -v '\t");
+	  z = stpcpy (z, " OTAGS;grep -Fv '\t");
 	  z = stpcpy (z, argbuffer[i].what);
 	  z = stpcpy (z, "\t' OTAGS >");
 	  z = stpcpy (z, tagfile);
@@ -4069,13 +4069,13 @@ Yacc_entries (FILE *inf)
   ((assert ("" kw), true)   /* syntax error if not a literal string */	\
    && strneq ((cp), kw, sizeof (kw)-1)		/* cp points at kw */	\
    && notinname ((cp)[sizeof (kw)-1])		/* end of kw */		\
-   && ((cp) = skip_spaces ((cp)+sizeof (kw)-1))) /* skip spaces */
+   && ((cp) = skip_spaces ((cp) + sizeof (kw) - 1), true)) /* skip spaces */
 
 /* Similar to LOOKING_AT but does not use notinname, does not skip */
 #define LOOKING_AT_NOCASE(cp, kw) /* the keyword is a literal string */	\
   ((assert ("" kw), true) /* syntax error if not a literal string */	\
    && strncaseeq ((cp), kw, sizeof (kw)-1)	/* cp points at kw */	\
-   && ((cp) += sizeof (kw)-1))			/* skip spaces */
+   && ((cp) += sizeof (kw) - 1, true))		/* skip spaces */
 
 /*
  * Read a file, but do no processing.  This is used to do regexp
@@ -4534,10 +4534,21 @@ Perl_functions (FILE *inf)
 	    continue;		/* nothing found */
 	  pos = strchr (sp, ':');
 	  if (pos && pos < cp && pos[1] == ':')
-	    /* The name is already qualified. */
-	    make_tag (sp, cp - sp, true,
-		      lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
-	  else
+	    {
+	      /* The name is already qualified. */
+	      if (!class_qualify)
+		{
+		  char *q = pos + 2, *qpos;
+		  while ((qpos = strchr (q, ':')) != NULL
+			 && qpos < cp
+			 && qpos[1] == ':')
+		    q = qpos + 2;
+		  sp = q;
+		}
+	      make_tag (sp, cp - sp, true,
+			lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+	    }
+	  else if (class_qualify)
 	    /* Qualify it. */
 	    {
 	      char savechar, *name;
@@ -4550,6 +4561,9 @@ Perl_functions (FILE *inf)
 			lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
 	      free (name);
 	    }
+	  else
+	    make_tag (sp, cp - sp, true,
+		      lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
 	}
       else if (LOOKING_AT (cp, "use constant")
 	       || LOOKING_AT (cp, "use constant::defer"))