[Emacs-diffs] Changes to emacs/lib-src/etags.c

[Francesco Potortì]

Index: emacs/lib-src/etags.c
diff -c emacs/lib-src/etags.c:3.46 emacs/lib-src/etags.c:3.47
*** emacs/lib-src/etags.c:3.46  Sun Aug  7 10:44:16 2005
--- emacs/lib-src/etags.c       Tue Sep 27 13:23:47 2005
***************
*** 41,47 ****
   * configuration file containing regexp definitions for etags.
   */
  
! char pot_etags_version[] = "@(#) pot revision number is 17.5";
  
  #define       TRUE    1
  #define       FALSE   0
--- 41,47 ----
   * configuration file containing regexp definitions for etags.
   */
  
! char pot_etags_version[] = "@(#) pot revision number is 17.13";
  
  #define       TRUE    1
  #define       FALSE   0
***************
*** 343,348 ****
--- 343,349 ----
  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 *));
***************
*** 489,494 ****
--- 490,496 ----
  #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  },
***************
*** 508,514 ****
    { "parse-stdin",        required_argument, NULL,               STDIN },
    { "version",                  no_argument,       NULL,               'V'   
},
  
! #if CTAGS /* Etags options */
    { "backward-search",          no_argument,       NULL,               'B'   
},
    { "cxref",            no_argument,       NULL,               'x'   },
    { "defines",                  no_argument,       NULL,               'd'   
},
--- 510,516 ----
    { "parse-stdin",        required_argument, NULL,               STDIN },
    { "version",                  no_argument,       NULL,               'V'   
},
  
! #if CTAGS /* Ctags options */
    { "backward-search",          no_argument,       NULL,               'B'   
},
    { "cxref",            no_argument,       NULL,               'x'   },
    { "defines",                  no_argument,       NULL,               'd'   
},
***************
*** 519,526 ****
    { "vgrind",           no_argument,       NULL,               'v'   },
    { "no-warn",                  no_argument,       NULL,               'w'   
},
  
! #else /* Ctags options */
!   { "append",           no_argument,       NULL,               'a'   },
    { "no-defines",       no_argument,       NULL,               'D'   },
    { "no-globals",       no_argument,       &globals,           FALSE },
    { "include",                  required_argument, NULL,               'i'   
},
--- 521,527 ----
    { "vgrind",           no_argument,       NULL,               'v'   },
    { "no-warn",                  no_argument,       NULL,               'w'   
},
  
! #else /* Etags options */
    { "no-defines",       no_argument,       NULL,               'D'   },
    { "no-globals",       no_argument,       &globals,           FALSE },
    { "include",                  required_argument, NULL,               'i'   
},
***************
*** 631,636 ****
--- 632,643 ----
  "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 [] =
***************
*** 778,783 ****
--- 785,791 ----
    { "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     },
***************
*** 881,888 ****
  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\
          Append tag entries to existing tags file.");
  
    puts ("--packages-only\n\
--- 889,895 ----
  Absolute names are stored in the output file as they are.\n\
  Relative ones are stored relative to the output file's directory.\n");
  
!   puts ("-a, --append\n\
          Append tag entries to existing tags file.");
  
    puts ("--packages-only\n\
***************
*** 1180,1196 ****
        globals = TRUE;
      }
  
    optstring = "-";
  #ifdef ETAGS_REGEXPS
    optstring = "-r:Rc:";
  #endif /* ETAGS_REGEXPS */
    if (!LONG_OPTIONS)
!     optstring += 1;
    optstring = concat (optstring,
!                     "Cf:Il:o:SVhH",
!                     (CTAGS) ? "BxdtTuvw" : "aDi:");
  
!   while ((opt = getopt_long (argc, argv, optstring, longopts, 0)) != EOF)
      switch (opt)
        {
        case 0:
--- 1187,1205 ----
        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;           /* remove the initial '-' */
    optstring = concat (optstring,
!                     "aCf:Il:o:SVhH",
!                     (CTAGS) ? "BxdtTuvw" : "Di:");
  
!   while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF)
      switch (opt)
        {
        case 0:
***************
*** 1218,1223 ****
--- 1227,1233 ----
        break;
  
        /* Common options. */
+       case 'a': append_to_tagfile = TRUE;     break;
        case 'C': cplusplus = TRUE;             break;
        case 'f':               /* for compatibility with old makefiles */
        case 'o':
***************
*** 1267,1273 ****
        break;
  
        /* Etags options */
-       case 'a': append_to_tagfile = TRUE;                     break;
        case 'D': constantypedefs = FALSE;                      break;
        case 'i': included_files[nincluded_files++] = optarg;   break;
  
--- 1277,1282 ----
***************
*** 1285,1290 ****
--- 1294,1300 ----
        /* NOTREACHED */
        }
  
+   /* No more options.  Store the rest of arguments. */
    for (; optind < argc; optind++)
      {
        argbuffer[current_arg].arg_type = at_filename;
***************
*** 1413,1419 ****
  
    if (!CTAGS || cxref_style)
      {
!       put_entries (nodehead); /* write the remainig tags (ETAGS) */
        free_tree (nodehead);
        nodehead = NULL;
        if (!CTAGS)
--- 1423,1429 ----
  
    if (!CTAGS || cxref_style)
      {
!       put_entries (nodehead); /* write the remaining tags (ETAGS) */
        free_tree (nodehead);
        nodehead = NULL;
        if (!CTAGS)
***************
*** 4075,4084 ****
             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 */
  
  /*
   * Read a file, but do no processing.  This is used to do regexp
--- 4085,4102 ----
             char_pointer = line_buffer.buffer,                         \
           TRUE);                                                       \
        )
! 
! #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
***************
*** 4956,4962 ****
  
  
  /*
!  * Postscript tag functions
   * Just look for lines where the first character is '/'
   * Also look at "defineps" for PSWrap
   * Ideas by:
--- 4974,4980 ----
  
  
  /*
!  * Postscript tags
   * Just look for lines where the first character is '/'
   * Also look at "defineps" for PSWrap
   * Ideas by:
***************
*** 4987,4992 ****
--- 5005,5047 ----
  
  
  /*
+  * 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 <address@hidden> (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);
+ }
+ 
+ 
+ /*
   * Scheme tag functions
   * look for (def... xyzzy
   *          (def... (xyzzy
***************
*** 4994,5000 ****
   *          (set! xyzzy
   * Original code by Ken Haase (1985?)
   */
- 
  static void
  Scheme_functions (inf)
       FILE *inf;
--- 5049,5054 ----
***************
*** 5213,5223 ****
  }
  
  
- /* 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.
--- 5267,5272 ----
***************
*** 5434,5440 ****
         || (s[pos] == '(' && (pos += 1))
         || (s[pos] == ':' && s[pos + 1] == '-' && (pos += 2)))
        && (last == NULL                /* save only the first clause */
!         || len != strlen (last)
          || !strneq (s, last, len)))
        {
          make_tag (s, len, TRUE, s, pos, lineno, linecharno);
--- 5483,5489 ----
         || (s[pos] == '(' && (pos += 1))
         || (s[pos] == ':' && s[pos + 1] == '-' && (pos += 2)))
        && (last == NULL                /* save only the first clause */
!         || len != (int)strlen (last)
          || !strneq (s, last, len)))
        {
          make_tag (s, len, TRUE, s, pos, lineno, linecharno);
***************
*** 6502,6508 ****
            : *s1 - *s2);
  }
  
! /* Skip spaces, return new pointer. */
  static char *
  skip_spaces (cp)
       char *cp;
--- 6551,6557 ----
            : *s1 - *s2);
  }
  
! /* Skip spaces (end of string is not space), return new pointer. */
  static char *
  skip_spaces (cp)
       char *cp;
***************
*** 6512,6518 ****
    return cp;
  }
  
! /* Skip non spaces, return new pointer. */
  static char *
  skip_non_spaces (cp)
       char *cp;
--- 6561,6567 ----
    return cp;
  }
  
! /* Skip non spaces, except end of string, return new pointer. */
  static char *
  skip_non_spaces (cp)
       char *cp;