]> code.delx.au - gnu-emacs/blobdiff - lib-src/etags.c
(Fget_char_property_and_overlay): Doc fix.
[gnu-emacs] / lib-src / etags.c
index e435c4d392681108a94d26b0dad1136cde6ead07..e206443f39b82579c2a41bcc12b4f3db45fd6172 100644 (file)
@@ -1,6 +1,7 @@
 /* Tags file maker to go with GNU Emacs           -*- coding: latin-1 -*-
-   Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2001, 2002
-   Free Software Foundation, Inc. and Ken Arnold
+   Copyright (C) 1984, 1987, 1988, 1989, 1993, 1994, 1995,
+                 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc. and Ken Arnold
 
  This file is not considered part of GNU Emacs.
 
@@ -16,7 +17,7 @@
 
  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software Foundation,
- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
 
 /*
  * Authors:
@@ -40,7 +41,7 @@
  * configuration file containing regexp definitions for etags.
  */
 
-char pot_etags_version[] = "@(#) pot revision number is 17.5";
+char pot_etags_version[] = "@(#) pot revision number is 17.17";
 
 #define        TRUE    1
 #define        FALSE   0
@@ -342,6 +343,7 @@ static void Cobol_paragraphs __P((FILE *));
 static void Cplusplus_entries __P((FILE *));
 static void Cstar_entries __P((FILE *));
 static void Erlang_functions __P((FILE *));
+static void Forth_words __P((FILE *));
 static void Fortran_functions __P((FILE *));
 static void HTML_labels __P((FILE *));
 static void Lisp_functions __P((FILE *));
@@ -475,6 +477,11 @@ static bool cplusplus;             /* .[hc] means C++, not C */
 static bool ignoreindent;      /* -I: ignore indentation in C */
 static bool packages_only;     /* --packages-only: in Ada, only tag packages*/
 
+/* STDIN is defined in LynxOS system headers */
+#ifdef STDIN
+# undef STDIN
+#endif
+
 #define STDIN 0x1001           /* returned by getopt_long on --parse-stdin */
 static bool parsing_stdin;     /* --parse-stdin used */
 
@@ -488,6 +495,7 @@ static bool need_filebuf;   /* some regexes are multi-line */
 #if LONG_OPTIONS
 static struct option longopts[] =
 {
+  { "append",            no_argument,       NULL,               'a'   },
   { "packages-only",      no_argument,      &packages_only,     TRUE  },
   { "c++",               no_argument,       NULL,               'C'   },
   { "declarations",      no_argument,       &declarations,      TRUE  },
@@ -507,7 +515,7 @@ static struct option longopts[] =
   { "parse-stdin",        required_argument, NULL,               STDIN },
   { "version",           no_argument,       NULL,               'V'   },
 
-#if CTAGS /* Etags options */
+#if CTAGS /* Ctags options */
   { "backward-search",   no_argument,       NULL,               'B'   },
   { "cxref",             no_argument,       NULL,               'x'   },
   { "defines",           no_argument,       NULL,               'd'   },
@@ -518,8 +526,7 @@ static struct option longopts[] =
   { "vgrind",            no_argument,       NULL,               'v'   },
   { "no-warn",           no_argument,       NULL,               'w'   },
 
-#else /* Ctags options */
-  { "append",            no_argument,       NULL,               'a'   },
+#else /* Etags options */
   { "no-defines",        no_argument,       NULL,               'D'   },
   { "no-globals",        no_argument,       &globals,           FALSE },
   { "include",           required_argument, NULL,               'i'   },
@@ -630,6 +637,12 @@ static char Erlang_help [] =
 "In Erlang code, the tags are the functions, records and macros\n\
 defined in the file.";
 
+char *Forth_suffixes [] =
+  { "fth", "tok", NULL };
+static char Forth_help [] =
+"In Forth code, tags are words defined by `:',\n\
+constant, code, create, defer, value, variable, buffer:, field.";
+
 static char *Fortran_suffixes [] =
   { "F", "f", "f90", "for", NULL };
 static char Fortran_help [] =
@@ -777,6 +790,7 @@ static language lang_names [] =
   { "c*",        no_lang_help,   Cstar_entries,     Cstar_suffixes     },
   { "cobol",     Cobol_help,     Cobol_paragraphs,  Cobol_suffixes     },
   { "erlang",    Erlang_help,    Erlang_functions,  Erlang_suffixes    },
+  { "forth",     Forth_help,     Forth_words,       Forth_suffixes     },
   { "fortran",   Fortran_help,   Fortran_functions, Fortran_suffixes   },
   { "html",      HTML_help,      HTML_labels,       HTML_suffixes      },
   { "java",      Cjava_help,     Cjava_entries,     Cjava_suffixes     },
@@ -844,7 +858,7 @@ static void
 print_version ()
 {
   printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION);
-  puts ("Copyright (C) 2002 Free Software Foundation, Inc. and Ken Arnold");
+  puts ("Copyright (C) 2006 Free Software Foundation, Inc. and Ken Arnold");
   puts ("This program is distributed under the same terms as Emacs");
 
   exit (EXIT_SUCCESS);
@@ -880,8 +894,7 @@ linked with GNU getopt.");
 Absolute names are stored in the output file as they are.\n\
 Relative ones are stored relative to the output file's directory.\n");
 
-  if (!CTAGS)
-    puts ("-a, --append\n\
+  puts ("-a, --append\n\
         Append tag entries to existing tags file.");
 
   puts ("--packages-only\n\
@@ -981,9 +994,9 @@ Relative ones are stored relative to the output file's directory.\n");
   if (CTAGS)
     {
       puts ("-v, --vgrind\n\
-        Generates an index of items intended for human consumption,\n\
-        similar to the output of vgrind.  The index is sorted, and\n\
-        gives the page number of each item.");
+        Print on the standard output an index of items intended for\n\
+        human consumption, similar to the output of vgrind.  The index\n\
+        is sorted, and gives the page number of each item.");
       puts ("-w, --no-warn\n\
         Suppress warning messages about entries defined in multiple\n\
         files.");
@@ -1179,17 +1192,19 @@ main (argc, argv)
       globals = TRUE;
     }
 
+  /* When the optstring begins with a '-' getopt_long does not rearrange the
+     non-options arguments to be at the end, but leaves them alone. */
   optstring = "-";
 #ifdef ETAGS_REGEXPS
   optstring = "-r:Rc:";
 #endif /* ETAGS_REGEXPS */
-  if (LONG_OPTIONS)
-    optstring += 1;
+  if (!LONG_OPTIONS)
+    optstring += 1;            /* remove the initial '-' */
   optstring = concat (optstring,
-                     "Cf:Il:o:SVhH",
-                     (CTAGS) ? "BxdtTuvw" : "aDi:");
+                     "aCf:Il:o:SVhH",
+                     (CTAGS) ? "BxdtTuvw" : "Di:");
 
-  while ((opt = getopt_long (argc, argv, optstring, longopts, 0)) != EOF)
+  while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF)
     switch (opt)
       {
       case 0:
@@ -1217,6 +1232,7 @@ main (argc, argv)
        break;
 
        /* Common options. */
+      case 'a': append_to_tagfile = TRUE;      break;
       case 'C': cplusplus = TRUE;              break;
       case 'f':                /* for compatibility with old makefiles */
       case 'o':
@@ -1266,7 +1282,6 @@ main (argc, argv)
        break;
 
        /* Etags options */
-      case 'a': append_to_tagfile = TRUE;                      break;
       case 'D': constantypedefs = FALSE;                       break;
       case 'i': included_files[nincluded_files++] = optarg;    break;
 
@@ -1284,6 +1299,7 @@ main (argc, argv)
        /* NOTREACHED */
       }
 
+  /* No more options.  Store the rest of arguments. */
   for (; optind < argc; optind++)
     {
       argbuffer[current_arg].arg_type = at_filename;
@@ -1400,8 +1416,6 @@ main (argc, argv)
           this_file = argbuffer[i].what;
           process_file (stdin, this_file, lang);
           break;
-       case at_end:
-         break;
        }
     }
 
@@ -1414,7 +1428,8 @@ main (argc, argv)
 
   if (!CTAGS || cxref_style)
     {
-      put_entries (nodehead);  /* write the remainig tags (ETAGS) */
+      /* Write the remaining tags to tagf (ETAGS) or stdout (CXREF). */
+      put_entries (nodehead);
       free_tree (nodehead);
       nodehead = NULL;
       if (!CTAGS)
@@ -1428,10 +1443,11 @@ main (argc, argv)
 
          while (nincluded_files-- > 0)
            fprintf (tagf, "\f\n%s,include\n", *included_files++);
+
+         if (fclose (tagf) == EOF)
+           pfatal (tagfile);
        }
 
-      if (fclose (tagf) == EOF)
-       pfatal (tagfile);
       exit (EXIT_SUCCESS);
     }
 
@@ -1466,12 +1482,13 @@ main (argc, argv)
   if (fclose (tagf) == EOF)
     pfatal (tagfile);
 
-  if (update)
-    {
-      char cmd[2*BUFSIZ+10];
-      sprintf (cmd, "sort -o %.*s %.*s", BUFSIZ, tagfile, BUFSIZ, tagfile);
-      exit (system (cmd));
-    }
+  if (CTAGS)
+    if (append_to_tagfile || update)
+      {
+       char cmd[2*BUFSIZ+10];
+       sprintf (cmd, "sort -o %.*s %.*s", BUFSIZ, tagfile, BUFSIZ, tagfile);
+       exit (system (cmd));
+      }
   return EXIT_SUCCESS;
 }
 
@@ -2902,8 +2919,6 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
      case tkeyseen:
        switch (toktype)
         {
-        default:
-          break;
         case st_none:
         case st_C_class:
         case st_C_struct:
@@ -2921,16 +2936,12 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
      case tend:
        switch (toktype)
         {
-        default:
-          break;
         case st_C_class:
         case st_C_struct:
         case st_C_enum:
           return FALSE;
         }
        return TRUE;
-     default:
-       break;
      }
 
    /*
@@ -2968,8 +2979,6 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
             fvdef = fvnone;
         }
        return FALSE;
-     default:
-       break;
      }
 
    if (structdef == skeyseen)
@@ -2993,8 +3002,6 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
         case st_C_objimpl:
           objdef = oimplementation;
           return FALSE;
-        default:
-          break;
         }
        break;
      case oimplementation:
@@ -3051,8 +3058,6 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
           objdef = onone;
         }
        return FALSE;
-     default:
-       break;
      }
 
    /* A function, variable or enum constant? */
@@ -3105,8 +3110,6 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
                   return FALSE;
                 }
               break;
-            default:
-              break;
             }
          /* FALLTHRU */
          case fvnameseen:
@@ -3123,12 +3126,8 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var)
          fvdef = fvnameseen;   /* function or variable */
          *is_func_or_var = TRUE;
          return TRUE;
-       default:
-          break;
        }
       break;
-    default:
-      break;
     }
 
   return FALSE;
@@ -3604,8 +3603,6 @@ C_entries (c_ext, inf)
                          fvdef = fignore;
                        }
                      break;
-                   default:
-                     break;
                    }
                  if (structdef == stagseen && !cjava)
                    {
@@ -3616,8 +3613,6 @@ C_entries (c_ext, inf)
                case dsharpseen:
                  savetoken = token;
                  break;
-               default:
-                 break;
                }
              if (!yacc_rules || lp == newlb.buffer + 1)
                {
@@ -3656,8 +3651,6 @@ C_entries (c_ext, inf)
              linebuffer_setlen (&token_name, token_name.len + 1);
              strcat (token_name.buffer, ":");
              break;
-           default:
-             break;
            }
          if (structdef == stagseen)
            {
@@ -3735,8 +3728,6 @@ C_entries (c_ext, inf)
              make_C_tag (TRUE); /* an Objective C method */
              objdef = oinbody;
              break;
-           default:
-             break;
            }
          switch (fvdef)
            {
@@ -3807,8 +3798,6 @@ C_entries (c_ext, inf)
                  fvdef = fvnone;
                }
              break;
-           default:
-             break;
            }
          break;
        case '(':
@@ -3842,8 +3831,6 @@ C_entries (c_ext, inf)
            case flistseen:
              fvdef = finlist;
              break;
-           default:
-             break;
            }
          parlev++;
          break;
@@ -3869,8 +3856,6 @@ C_entries (c_ext, inf)
                case finlist:
                  fvdef = flistseen;
                  break;
-               default:
-                 break;
                }
              if (!instruct
                  && (typdef == tend
@@ -3920,8 +3905,6 @@ C_entries (c_ext, inf)
                    bracelev = -1;
                }
              break;
-           default:
-             break;
            }
          switch (structdef)
            {
@@ -3935,8 +3918,6 @@ C_entries (c_ext, inf)
              structdef = snone;
              make_C_tag (FALSE);  /* a struct or enum */
              break;
-           default:
-             break;
            }
          bracelev++;
          break;
@@ -4112,10 +4093,18 @@ Yacc_entries (inf)
            char_pointer = line_buffer.buffer,                          \
           TRUE);                                                       \
       )
-#define LOOKING_AT(cp, keyword)        /* keyword is a constant string */      \
-  (strneq ((cp), keyword, sizeof(keyword)-1) /* cp points at keyword */        \
-   && notinname ((cp)[sizeof(keyword)-1])      /* end of keyword */    \
-   && ((cp) = skip_spaces((cp)+sizeof(keyword)-1))) /* skip spaces */
+
+#define LOOKING_AT(cp, kw)  /* kw is the keyword, a literal string */  \
+  ((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 */
+
+/* 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 */
 
 /*
  * Read a file, but do no processing.  This is used to do regexp
@@ -4554,6 +4543,7 @@ Perl_functions (inf)
                    lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
        }
     }
+  free (package);
 }
 
 
@@ -4993,7 +4983,7 @@ Lua_functions (inf)
 
 \f
 /*
- * Postscript tag functions
+ * Postscript tags
  * Just look for lines where the first character is '/'
  * Also look at "defineps" for PSWrap
  * Ideas by:
@@ -5022,6 +5012,43 @@ PS_functions (inf)
     }
 }
 
+\f
+/*
+ * Forth tags
+ * Ignore anything after \ followed by space or in ( )
+ * Look for words defined by :
+ * Look for constant, code, create, defer, value, and variable
+ * OBP extensions:  Look for buffer:, field,
+ * Ideas by Eduardo Horvath <eeh@netbsd.org> (2004)
+ */
+static void
+Forth_words (inf)
+     FILE *inf;
+{
+  register char *bp;
+
+  LOOP_ON_INPUT_LINES (inf, lb, bp)
+    while ((bp = skip_spaces (bp))[0] != '\0')
+      if (bp[0] == '\\' && iswhite(bp[1]))
+       break;                  /* read next line */
+      else if (bp[0] == '(' && iswhite(bp[1]))
+       do                      /* skip to ) or eol */
+         bp++;
+       while (*bp != ')' && *bp != '\0');
+      else if ((bp[0] == ':' && iswhite(bp[1]) && bp++)
+              || LOOKING_AT_NOCASE (bp, "constant")
+              || LOOKING_AT_NOCASE (bp, "code")
+              || LOOKING_AT_NOCASE (bp, "create")
+              || LOOKING_AT_NOCASE (bp, "defer")
+              || LOOKING_AT_NOCASE (bp, "value")
+              || LOOKING_AT_NOCASE (bp, "variable")
+              || LOOKING_AT_NOCASE (bp, "buffer:")
+              || LOOKING_AT_NOCASE (bp, "field"))
+       get_tag (skip_spaces (bp), NULL); /* Yay!  A definition! */
+      else
+       bp = skip_non_spaces (bp);
+}
+
 \f
 /*
  * Scheme tag functions
@@ -5031,7 +5058,6 @@ PS_functions (inf)
  *          (set! xyzzy
  * Original code by Ken Haase (1985?)
  */
-
 static void
 Scheme_functions (inf)
      FILE *inf;
@@ -5250,11 +5276,6 @@ Texinfo_nodes (inf)
 }
 
 \f
-/* Similar to LOOKING_AT but does not use notinname, does not skip */
-#define LOOKING_AT_NOCASE(cp, kw)      /* kw is a constant string */   \
-  (strncaseeq ((cp), kw, sizeof(kw)-1) /* cp points at kw */           \
-   && ((cp) += sizeof(kw)-1))          /* skip spaces */
-
 /*
  * HTML support.
  * Contents of <title>, <h1>, <h2>, <h3> are tags.
@@ -5421,6 +5442,8 @@ Prolog_functions (inf)
          last[len] = '\0';
        }
     }
+  if (last != NULL)
+    free (last);
 }
 
 
@@ -5471,7 +5494,7 @@ prolog_pr (s, last)
        || (s[pos] == '(' && (pos += 1))
        || (s[pos] == ':' && s[pos + 1] == '-' && (pos += 2)))
       && (last == NULL         /* save only the first clause */
-         || len != strlen (last)
+         || len != (int)strlen (last)
          || !strneq (s, last, len)))
        {
          make_tag (s, len, TRUE, s, pos, lineno, linecharno);
@@ -5577,7 +5600,11 @@ Erlang_functions (inf)
       else if (cp[0] == '-')   /* attribute, e.g. "-define" */
        {
          erlang_attribute (cp);
-         last = NULL;
+         if (last != NULL)
+           {
+             free (last);
+             last = NULL;
+           }
        }
       else if ((len = erlang_func (cp, last)) > 0)
        {
@@ -5594,6 +5621,8 @@ Erlang_functions (inf)
          last[len] = '\0';
        }
     }
+  if (last != NULL)
+    free (last);
 }
 
 
@@ -6539,7 +6568,7 @@ etags_strncasecmp (s1, s2, n)
            : *s1 - *s2);
 }
 
-/* Skip spaces, return new pointer. */
+/* Skip spaces (end of string is not space), return new pointer. */
 static char *
 skip_spaces (cp)
      char *cp;
@@ -6549,7 +6578,7 @@ skip_spaces (cp)
   return cp;
 }
 
-/* Skip non spaces, return new pointer. */
+/* Skip non spaces, except end of string, return new pointer. */
 static char *
 skip_non_spaces (cp)
      char *cp;
@@ -6867,7 +6896,6 @@ xrealloc (ptr, size)
 
 /*
  * Local Variables:
- * c-indentation-style: gnu
  * indent-tabs-mode: t
  * tab-width: 8
  * fill-column: 79