--- /dev/null
+/* Tags file maker to go with GNUmacs
+ Copyright (C) 1984, 1987, 1988 Free Software Foundation, Inc. and Ken Arnold
+
+ NO WARRANTY
+
+ BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY
+NO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW. EXCEPT
+WHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
+RICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS"
+WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
+BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY
+AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE
+DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
+CORRECTION.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
+STALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
+WHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR
+OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR
+DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR
+A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS
+PROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
+
+ GENERAL PUBLIC LICENSE TO COPY
+
+ 1. You may copy and distribute verbatim copies of this source file
+as you receive it, in any medium, provided that you conspicuously
+and appropriately publish on each copy a valid copyright notice
+"Copyright (C) 1986 Free Software Foundation"; and include
+following the copyright notice a verbatim copy of the above disclaimer
+of warranty and of this License.
+
+ 2. You may modify your copy or copies of this source file or
+any portion of it, and copy and distribute such modifications under
+the terms of Paragraph 1 above, provided that you also do the following:
+
+ a) cause the modified files to carry prominent notices stating
+ that you changed the files and the date of any change; and
+
+ b) cause the whole of any work that you distribute or publish,
+ that in whole or in part contains or is a derivative of this
+ program or any part thereof, to be licensed at no charge to all
+ third parties on terms identical to those contained in this
+ License Agreement (except that you may choose to grant more extensive
+ warranty protection to some or all third parties, at your option).
+
+ c) You may charge a distribution fee for the physical act of
+ transferring a copy, and you may at your option offer warranty
+ protection in exchange for a fee.
+
+Mere aggregation of another unrelated program with this program (or its
+derivative) on a volume of a storage or distribution medium does not bring
+the other program under the scope of these terms.
+
+ 3. You may copy and distribute this program (or a portion or derivative
+of it, under Paragraph 2) in object code or executable form under the terms
+of Paragraphs 1 and 2 above provided that you also do one of the following:
+
+ a) accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ b) accompany it with a written offer, valid for at least three
+ years, to give any third party free (except for a nominal
+ shipping charge) a complete machine-readable copy of the
+ corresponding source code, to be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ c) accompany it with the information you received as to where the
+ corresponding source code may be obtained. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form alone.)
+
+For an executable file, complete source code means all the source code for
+all modules it contains; but, as a special exception, it need not include
+source code for modules which are standard libraries that accompany the
+operating system on which the executable file runs.
+
+ 4. You may not copy, sublicense, distribute or transfer this program
+except as expressly provided under this License Agreement. Any attempt
+otherwise to copy, sublicense, distribute or transfer this program is void and
+your rights to use the program under this License agreement shall be
+automatically terminated. However, parties who have received computer
+software programs from you with this License Agreement will not have
+their licenses terminated so long as such parties remain in full compliance.
+
+In other words, you are welcome to use, share and improve this program.
+You are forbidden to forbid anyone else to use, share and improve
+what you give them. Help stamp out software-hoarding! */
+
+#include <stdio.h>
+#include <ctype.h>
+
+/* Define the symbol ETAGS to make the program "etags",
+ which makes emacs-style tag tables by default.
+ Define CTAGS to make the program "ctags" compatible with the usual one.
+ Define neither one to get behavior that depends
+ on the name with which the program is invoked
+ (but we don't normally compile it that way). */
+
+/* On VMS, CTAGS is not useful, so always do ETAGS. */
+#ifdef VMS
+#ifndef ETAGS
+#define ETAGS
+#endif
+#endif
+
+/* Exit codes for success and failure. */
+
+#ifdef VMS
+#define GOOD (1)
+#define BAD (0)
+#else
+#define GOOD (0)
+#define BAD (1)
+#endif
+
+#define reg register
+#define logical char
+
+#ifndef TRUE
+#define TRUE (1)
+#endif
+
+#ifndef FALSE
+#define FALSE (0)
+#endif
+
+#define iswhite(arg) (_wht[arg]) /* T if char is white */
+#define begtoken(arg) (_btk[arg]) /* T if char can start token */
+#define intoken(arg) (_itk[arg]) /* T if char can be in token */
+#define endtoken(arg) (_etk[arg]) /* T if char ends tokens */
+#define isgood(arg) (_gd[arg]) /* T if char can be after ')' */
+
+#define max(I1,I2) (I1 > I2 ? I1 : I2)
+
+/* cause token checking for typedef, struct, union, enum to distinguish
+ keywords from identifier-prefixes (e.g. struct vs struct_tag). */
+#define istoken(s, tok, len) (!strncmp(s,tok,len) && endtoken(*((s)+(len))))
+
+struct nd_st { /* sorting structure */
+ char *name; /* function or type name */
+ char *file; /* file name */
+ logical f; /* use pattern or line no */
+ int lno; /* line number tag is on */
+ long cno; /* character number line starts on */
+ char *pat; /* search pattern */
+ logical been_warned; /* set if noticed dup */
+ struct nd_st *left,*right; /* left and right sons */
+};
+
+long ftell();
+typedef struct nd_st NODE;
+
+int number; /* tokens found so far on line starting with # (including #) */
+logical gotone, /* found a func already on line */
+ /* boolean "func" (see init) */
+ _wht[0177],_etk[0177],_itk[0177],_btk[0177],_gd[0177];
+
+ /* typedefs are recognized using a simple finite automata,
+ * tydef is its state variable.
+ */
+typedef enum {none, begin, tag_ok, middle, end } TYST;
+
+TYST tydef = none;
+
+char searchar = '/'; /* use /.../ searches */
+
+int lineno; /* line number of current line */
+long charno; /* current character number */
+long linecharno; /* character number of start of line */
+
+char *curfile, /* current input file name */
+ *outfile= 0, /* output file */
+ *white = " \f\t\n", /* white chars */
+ *endtk = " \t\n\"'#()[]{}=-+%*/&|^~!<>;,.:?",
+ /* token ending chars */
+ *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$",
+ /* token starting chars */
+ *intk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$0123456789",
+ /* valid in-token chars */
+ *notgd = ",;"; /* non-valid after-function chars */
+
+int file_num = 0; /* current file number */
+int aflag = 0; /* -a: append to tags */
+int tflag = 0; /* -t: create tags for typedefs */
+int uflag = 0; /* -u: update tags */
+int wflag = 0; /* -w: suppress warnings */
+int vflag = 0; /* -v: create vgrind style index output */
+int xflag = 0; /* -x: create cxref style output */
+int eflag = 0; /* -e: emacs style output */
+
+/* Name this program was invoked with. */
+char *progname;
+
+FILE *inf, /* ioptr for current input file */
+ *outf; /* ioptr for tags file */
+
+NODE *head; /* the head of the sorted binary tree */
+
+char *savestr();
+char *savenstr ();
+char *rindex();
+char *index();
+char *concat ();
+void initbuffer ();
+long readline ();
+
+/* A `struct linebuffer' is a structure which holds a line of text.
+ `readline' reads a line from a stream into a linebuffer
+ and works regardless of the length of the line. */
+
+struct linebuffer
+ {
+ long size;
+ char *buffer;
+ };
+
+struct linebuffer lb, lb1;
+\f
+#if 0 /* VMS now provides the `system' function. */
+#ifdef VMS
+
+#include <descrip.h>
+
+void
+system (buf)
+ char *buf;
+{
+ struct dsc$descriptor_s command =
+ {
+ strlen(buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf
+ };
+
+ LIB$SPAWN(&command);
+}
+#endif /* VMS */
+#endif /* 0 */
+\f
+main(ac,av)
+ int ac;
+ char *av[];
+{
+ char cmd[100];
+ int i;
+ int fflag = 0;
+ char *this_file;
+#ifdef VMS
+ char got_err;
+
+ extern char *gfnames();
+ extern char *massage_name();
+#endif
+
+ progname = av[0];
+
+#ifdef ETAGS
+ eflag = 1;
+#else
+#ifdef CTAGS
+ eflag = 0;
+#else
+ {
+ char *subname = rindex (progname, '/');
+ if (subname++ == NULL)
+ subname = progname;
+ eflag = ! strcmp(subname, "ctags");
+ }
+#endif
+#endif
+
+ while (ac > 1 && av[1][0] == '-')
+ {
+ for (i=1; av[1][i]; i++)
+ {
+ switch(av[1][i])
+ {
+#ifndef VMS /* These options are useful only with ctags,
+ and VMS can't input them, so just omit them. */
+ case 'B':
+ searchar='?';
+ eflag = 0;
+ break;
+ case 'F':
+ searchar='/';
+ eflag = 0;
+ break;
+#endif
+ case 'a':
+ aflag++;
+ break;
+ case 'e':
+ eflag++;
+ break;
+ case 'f':
+ if (fflag > 0)
+ {
+ fprintf(stderr,
+ "%s: -f flag may only be given once\n", progname);
+ goto usage;
+ }
+ fflag++, ac--; av++;
+ if (ac <= 1 || av[1][0] == '\0')
+ {
+ fprintf(stderr,
+ "%s: -f flag must be followed by a filename\n",
+ progname);
+ goto usage;
+ }
+ outfile = av[1];
+ goto end_loop;
+ case 't':
+ tflag++;
+ break;
+#ifndef VMS
+ case 'u':
+ uflag++;
+ eflag = 0;
+ break;
+#endif
+ case 'w':
+ wflag++;
+ break;
+ case 'v':
+ vflag++;
+ xflag++;
+ eflag = 0;
+ break;
+ case 'x':
+ xflag++;
+ eflag = 0;
+ break;
+ default:
+ goto usage;
+ }
+ }
+ end_loop: ;
+ ac--; av++;
+ }
+
+ if (ac <= 1)
+ {
+ usage:
+#ifdef VMS
+ fprintf (stderr, "Usage: %s [-aetwvx] [-f outfile] file ...\n", progname);
+#else
+ fprintf (stderr, "Usage: %s [-BFaetuwvx] [-f outfile] file ...\n", progname);
+#endif
+ exit(BAD);
+ }
+
+ if (outfile == 0)
+ {
+ outfile = eflag ? "TAGS" : "tags";
+ }
+
+ init(); /* set up boolean "functions" */
+
+ initbuffer (&lb);
+ initbuffer (&lb1);
+ /*
+ * loop through files finding functions
+ */
+ if (eflag)
+ {
+ outf = fopen (outfile, aflag ? "a" : "w");
+ if (!outf)
+ {
+ fprintf (stderr, "%s: ", progname);
+ perror (outfile);
+ exit (BAD);
+ }
+ }
+
+ file_num = 1;
+#ifdef VMS
+ for (ac--, av++;
+ (this_file = gfnames (&ac, &av, &got_err)) != NULL; file_num++)
+ {
+ if (got_err)
+ {
+ error("Can't find file %s\n", this_file);
+ ac--, av++;
+ }
+ else
+ {
+ this_file = massage_name (this_file);
+#else
+ for (; file_num < ac; file_num++)
+ {
+ this_file = av[file_num];
+ if (1)
+ {
+#endif
+ find_entries (this_file);
+ if (eflag)
+ {
+ fprintf (outf, "\f\n%s,%d\n",
+ this_file, total_size_of_entries (head));
+ put_entries (head);
+ free_tree (head);
+ head = NULL;
+ }
+ }
+ }
+
+ if (eflag)
+ {
+ fclose (outf);
+ exit (GOOD);
+ }
+
+ if (xflag)
+ {
+ put_entries(head);
+ exit(GOOD);
+ }
+ if (uflag)
+ {
+ for (i=1; i<ac; i++)
+ {
+ sprintf(cmd,
+ "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS",
+ outfile, av[i], outfile);
+ system(cmd);
+ }
+ aflag++;
+ }
+ outf = fopen(outfile, aflag ? "a" : "w");
+ if (outf == NULL)
+ {
+ fprintf (stderr, "%s: ", outfile);
+ perror(outfile);
+ exit(BAD);
+ }
+ put_entries(head);
+ fclose(outf);
+#ifndef VMS
+ if (uflag)
+ {
+ sprintf(cmd, "sort %s -o %s", outfile, outfile);
+ system(cmd);
+ }
+#endif
+ exit(GOOD);
+}
+
+/*
+ * This routine sets up the boolean psuedo-functions which work
+ * by seting boolean flags dependent upon the corresponding character
+ * Every char which is NOT in that string is not a white char. Therefore,
+ * all of the array "_wht" is set to FALSE, and then the elements
+ * subscripted by the chars in "white" are set to TRUE. Thus "_wht"
+ * of a char is TRUE if it is the string "white", else FALSE.
+ */
+init()
+{
+
+ reg char *sp;
+ reg int i;
+
+ for (i = 0; i < 0177; i++)
+ {
+ _wht[i] = _etk[i] = _itk[i] = _btk[i] = FALSE;
+ _gd[i] = TRUE;
+ }
+ for (sp = white; *sp; sp++)
+ _wht[*sp] = TRUE;
+ for (sp = endtk; *sp; sp++)
+ _etk[*sp] = TRUE;
+ for (sp = intk; *sp; sp++)
+ _itk[*sp] = TRUE;
+ for (sp = begtk; *sp; sp++)
+ _btk[*sp] = TRUE;
+ for (sp = notgd; *sp; sp++)
+ _gd[*sp] = FALSE;
+ _wht[0] = _wht['\n'];
+ _etk[0] = _etk['\n'];
+ _btk[0] = _btk['\n'];
+ _itk[0] = _itk['\n'];
+ _gd[0] = _gd['\n'];
+}
+
+/*
+ * This routine opens the specified file and calls the function
+ * which finds the function and type definitions.
+ */
+find_entries (file)
+ char *file;
+{
+ char *cp;
+
+ if ((inf=fopen(file,"r")) == NULL)
+ {
+ fprintf (stderr, "%s: ", progname);
+ perror(file);
+ return;
+ }
+ curfile = savestr(file);
+ cp = rindex(file, '.');
+ /* .tex, .aux or .bbl implies LaTeX source code */
+ if (cp && (!strcmp (cp + 1, "tex") || !strcmp (cp + 1, "aux")
+ || !strcmp (cp + 1, "bbl")))
+ {
+ TEX_funcs(inf);
+ fclose(inf);
+ return;
+ }
+ /* .l or .el or .lisp (or .cl or .clisp or ...) implies lisp source code */
+ if (cp && (!strcmp (cp + 1, "l") ||
+ !strcmp (cp + 1, "el") ||
+ !strcmp (cp + 1, "lsp") ||
+ !strcmp (cp + 1, "lisp") ||
+ !strcmp (cp + 1, "cl") ||
+ !strcmp (cp + 1, "clisp")))
+ {
+ L_funcs(inf);
+ fclose(inf);
+ return;
+ }
+ /* .scm or .sm or .scheme implies scheme source code */
+ if (cp && (!strcmp (cp + 1, "sm")
+ || !strcmp (cp + 1, "scm")
+ || !strcmp (cp + 1, "scheme")
+ || !strcmp (cp + 1, "t")
+ || !strcmp (cp + 1, "sch")
+ || !strcmp (cp + 1, "SM")
+ || !strcmp (cp + 1, "SCM")
+ /* The `SCM' or `scm' prefix with a version number */
+ || (cp[-1] == 'm' && cp[-2] == 'c' && cp[-3] == 's')
+ || (cp[-1] == 'M' && cp[-2] == 'C' && cp[-3] == 'S')))
+ {
+ Scheme_funcs(inf);
+ fclose(inf);
+ return;
+ }
+ /* .M implies Mcode source code */
+ if (cp && !strcmp (cp + 1, "M"))
+ {
+ Mcode_funcs(inf);
+ fclose(inf);
+ return;
+ }
+
+ /* if not a .c or .h or .y file, try fortran */
+ if (cp && (cp[1] != 'c' && cp[1] != 'h' && cp[1] != 'y')
+ && cp[2] == '\0')
+ {
+ if (PF_funcs(inf) != 0)
+ {
+ fclose(inf);
+ return;
+ }
+ rewind(inf); /* no fortran tags found, try C */
+ }
+ C_entries();
+ fclose(inf);
+}
+\f
+/* Record a tag on the current line.
+ name is the tag name,
+ f is nonzero to use a pattern, zero to use line number instead. */
+
+pfnote (name, f, linestart, linelen, lno, cno)
+ char *name;
+ logical f; /* f == TRUE when function */
+ char *linestart;
+ int linelen;
+ int lno;
+ long cno;
+{
+ register char *fp;
+ register NODE *np;
+ char *altname;
+ char tem[51];
+
+ if ((np = (NODE *) malloc (sizeof (NODE))) == NULL)
+ {
+ fprintf(stderr, "%s: too many entries to sort\n", progname);
+ put_entries(head);
+ free_tree(head);
+ head = NULL;
+ np = (NODE *) xmalloc(sizeof (NODE));
+ }
+ /* Change name "main" to M<thisfilename>. */
+ if (!eflag && !xflag && !strcmp(name, "main"))
+ {
+ fp = rindex(curfile, '/');
+ if (fp == 0)
+ fp = curfile;
+ else
+ fp++;
+ altname = concat ("M", fp, "");
+ fp = rindex(altname, '.');
+ if (fp && fp[2] == 0)
+ *fp = 0;
+ name = altname;
+ }
+ np->name = savestr(name);
+ np->file = curfile;
+ np->f = f;
+ np->lno = lno;
+ np->cno = cno;
+ np->left = np->right = 0;
+ if (eflag)
+ {
+ linestart[linelen] = 0;
+ }
+ else if (xflag == 0)
+ {
+ sprintf (tem, strlen (linestart) < 50 ? "%s$" : "%.50s", linestart);
+ linestart = tem;
+ }
+ np->pat = savestr (linestart);
+ if (head == NULL)
+ head = np;
+ else
+ add_node(np, head);
+}
+
+free_tree(node)
+ NODE *node;
+{
+ while (node)
+ {
+ free_tree(node->right);
+ free(node);
+ node = node->left;
+ }
+}
+
+add_node(node, cur_node)
+ NODE *node,*cur_node;
+{
+ register int dif;
+
+ dif = strcmp(node->name, cur_node->name);
+
+ /* If this tag name matches an existing one, then
+ unless -e was given, do not add the node, but maybe print a warning */
+ if (!eflag && !dif)
+ {
+ if (node->file == cur_node->file)
+ {
+ if (!wflag)
+ {
+ fprintf(stderr,"%s: Duplicate entry in file %s, line %d: %s\n",
+ progname, node->file,lineno,node->name);
+ fprintf(stderr,"Second entry ignored\n");
+ }
+ return;
+ }
+ if (!cur_node->been_warned)
+ if (!wflag)
+ fprintf(stderr,"%s: Duplicate entry in files %s and %s: %s (Warning only)\n",
+ progname, node->file, cur_node->file, node->name);
+ cur_node->been_warned = TRUE;
+ return;
+ }
+
+ /* Actually add the node */
+ if (dif < 0)
+ {
+ if (cur_node->left != NULL)
+ add_node(node,cur_node->left);
+ else
+ cur_node->left = node;
+ return;
+ }
+ if (cur_node->right != NULL)
+ add_node(node,cur_node->right);
+ else
+ cur_node->right = node;
+}
+\f
+put_entries(node)
+ reg NODE *node;
+{
+ reg char *sp;
+
+ if (node == NULL)
+ return;
+
+ /* Output subentries that precede this one */
+ put_entries (node->left);
+
+ /* Output this entry */
+
+ if (eflag)
+ {
+ fprintf (outf, "%s%c%d,%d\n",
+ node->pat, 0177, node->lno, node->cno);
+ }
+ else if (!xflag)
+ {
+ fprintf (outf, "%s\t%s\t",
+ node->name, node->file);
+
+ if (node->f)
+ { /* a function */
+ putc (searchar, outf);
+ putc ('^', outf);
+
+ for (sp = node->pat; *sp; sp++)
+ {
+ if (*sp == '\\' || *sp == searchar)
+ putc ('\\', outf);
+ putc (*sp, outf);
+ }
+ putc (searchar, outf);
+ }
+ else
+ { /* a typedef; text pattern inadequate */
+ fprintf (outf, "%d", node->lno);
+ }
+ putc ('\n', outf);
+ }
+ else if (vflag)
+ fprintf (stdout, "%s %s %d\n",
+ node->name, node->file, (node->lno+63)/64);
+ else
+ fprintf (stdout, "%-16s%4d %-16s %s\n",
+ node->name, node->lno, node->file, node->pat);
+
+ /* Output subentries that follow this one */
+ put_entries (node->right);
+}
+
+/* Return total number of characters that put_entries will output for
+ the nodes in the subtree of the specified node.
+ Works only if eflag is set, but called only in that case. */
+
+total_size_of_entries(node)
+ reg NODE *node;
+{
+ reg int total = 0;
+ reg long num;
+
+ if (node == NULL)
+ return 0;
+
+ /* Count subentries that precede this one */
+ total = total_size_of_entries (node->left);
+
+ /* Count subentries that follow this one */
+ total += total_size_of_entries (node->right);
+
+ /* Count this entry */
+
+ total += strlen (node->pat) + 3;
+
+ num = node->lno;
+ while (num)
+ {
+ total++;
+ num /= 10;
+ }
+
+ num = node->cno;
+ if (!num) total++;
+ while (num)
+ {
+ total++;
+ num /= 10;
+ }
+ return total;
+}
+\f
+/*
+ * This routine finds functions and typedefs in C syntax and adds them
+ * to the list.
+ */
+#ifdef VMS
+long vmslinecharno;
+#define VMS_SET_LINECHARNO (vmslinecharno = ftell(inf))
+#else
+#define VMS_SET_LINECHARNO
+#endif
+
+#define CNL_SAVE_NUMBER \
+{ \
+ VMS_SET_LINECHARNO; \
+ linecharno = charno; lineno++; \
+ charno += 1 + readline (&lb, inf); \
+ lp = lb.buffer; \
+}
+
+#define CNL \
+{ \
+ CNL_SAVE_NUMBER; \
+ number = 0; \
+}
+
+C_entries ()
+{
+ register int c;
+ register char *token, *tp, *lp;
+ logical incomm, inquote, inchar, midtoken;
+ int level;
+ char tok[BUFSIZ];
+
+ lineno = 0;
+ charno = 0;
+ lp = lb.buffer;
+ *lp = 0;
+
+ number = 0;
+ gotone = midtoken = inquote = inchar = incomm = FALSE;
+ level = 0;
+
+ while (!feof (inf))
+ {
+ c = *lp++;
+ if (c == 0)
+ {
+ CNL;
+ gotone = FALSE;
+ }
+ if (c == '\\')
+ {
+ c = *lp++;
+ if (c == 0)
+ CNL_SAVE_NUMBER;
+ c = ' ';
+ }
+ else if (incomm)
+ {
+ if (c == '*')
+ {
+ while ((c = *lp++) == '*')
+ continue;
+ if (c == 0)
+ CNL;
+ if (c == '/')
+ incomm = FALSE;
+ }
+ }
+ else if (inquote)
+ {
+ /*
+ * Too dumb to know about \" not being magic, but
+ * they usually occur in pairs anyway.
+ */
+ if (c == '"')
+ inquote = FALSE;
+ continue;
+ }
+ else if (inchar)
+ {
+ if (c == '\'')
+ inchar = FALSE;
+ continue;
+ }
+ else switch (c)
+ {
+ case '"':
+ inquote = TRUE;
+ continue;
+ case '\'':
+ inchar = TRUE;
+ continue;
+ case '/':
+ if (*lp == '*')
+ {
+ lp++;
+ incomm = TRUE;
+ }
+ continue;
+ case '#':
+ if (lp == lb.buffer + 1)
+ number = 1;
+ continue;
+ case '{':
+ if (tydef == tag_ok)
+ {
+ tydef=middle;
+ }
+ level++;
+ continue;
+ case '}':
+ if (lp == lb.buffer + 1)
+ level = 0; /* reset */
+ else
+ level--;
+ if (!level && tydef==middle)
+ {
+ tydef=end;
+ }
+ continue;
+ }
+ if (!level && !inquote && !incomm && gotone == FALSE)
+ {
+ if (midtoken)
+ {
+ if (endtoken(c))
+ {
+ int f;
+ char *buf = lb.buffer;
+ int endpos = lp - lb.buffer;
+ char *lp1 = lp;
+ int line = lineno;
+ long linestart = linecharno;
+#ifdef VMS
+ long vmslinestart = vmslinecharno;
+#endif
+ int tem = consider_token (&lp1, token, &f, level);
+ lp = lp1;
+ if (tem)
+ {
+ if (linestart != linecharno)
+ {
+#ifdef VMS
+ getline (vmslinestart);
+#else
+ getline (linestart);
+#endif
+ strncpy (tok, token + (lb1.buffer - buf),
+ tp-token+1);
+ tok[tp-token+1] = 0;
+ pfnote(tok, f, lb1.buffer, endpos, line, linestart);
+ }
+ else
+ {
+ strncpy (tok, token, tp-token+1);
+ tok[tp-token+1] = 0;
+ pfnote(tok, f, lb.buffer, endpos, line, linestart);
+ }
+ gotone = f; /* function */
+ }
+ midtoken = FALSE;
+ token = lp - 1;
+ }
+ else if (intoken(c))
+ tp++;
+ }
+ else if (begtoken(c))
+ {
+ token = tp = lp - 1;
+ midtoken = TRUE;
+ }
+ }
+ if (c == ';' && tydef==end) /* clean with typedefs */
+ tydef=none;
+ }
+}
+
+/*
+ * This routine checks to see if the current token is
+ * at the start of a function, or corresponds to a typedef
+ * It updates the input line * so that the '(' will be
+ * in it when it returns.
+ */
+consider_token (lpp, token, f, level)
+ char **lpp, *token;
+ int *f, level;
+{
+ reg char *lp = *lpp;
+ reg char c;
+ static logical next_token_is_func;
+ logical firsttok; /* T if have seen first token in ()'s */
+ int bad, win;
+
+ *f = 1; /* a function */
+ c = lp[-1];
+ bad = FALSE;
+ if (!number)
+ { /* space is not allowed in macro defs */
+ while (iswhite(c))
+ {
+ c = *lp++;
+ if (c == 0)
+ {
+ if (feof (inf))
+ break;
+ CNL;
+ }
+ }
+ }
+ else
+ {
+ /* the following tries to make it so that a #define a b(c) */
+ /* doesn't count as a define of b. */
+
+ number++;
+ if (number >= 4 || (number==2 && strncmp (token, "define", 6)==0))
+ {
+ /* Force the next symbol to be recognised, even if it is #define a b(c)! */
+ if(number == 2) next_token_is_func = 1;
+ else
+ gotone = TRUE;
+ badone:
+ bad = TRUE;
+ goto ret;
+ }
+ }
+ /* check for the typedef cases */
+ if (tflag && istoken(token, "typedef", 7))
+ {
+ tydef=begin;
+ goto badone;
+ }
+ if (tydef==begin && (istoken(token, "struct", 6) ||
+ istoken(token, "union", 5) || istoken(token, "enum", 4)))
+ {
+ tydef=tag_ok;
+ goto badone;
+ }
+ if (tydef==tag_ok)
+ {
+ tydef=middle;
+ goto badone;
+ }
+ if (tydef==begin) /* e.g. typedef ->int<- */
+ {
+ tydef=end;
+ goto badone;
+ }
+ if (tydef==middle && level == 0) /* e.g. typedef struct tag ->struct_t<- */
+ {
+ tydef=end;
+ }
+ if (tydef==end)
+ {
+ *f = 0;
+ win = 1;
+ goto ret;
+ }
+ /* Detect GNUmacs's function-defining macros. */
+ if (!number && !strncmp (token, "DEF", 3))
+
+ {
+ next_token_is_func = 1;
+ goto badone;
+ }
+ if (next_token_is_func)
+ {
+ next_token_is_func = 0;
+ win = 1;
+ goto ret;
+ }
+ if (c != '(')
+ goto badone;
+ firsttok = FALSE;
+ while ((c = *lp++) != ')')
+ {
+ if (c == 0)
+ {
+ if (feof (inf))
+ break;
+ CNL;
+ }
+ /*
+ * This line used to confuse ctags:
+ * int (*oldhup)();
+ * This fixes it. A nonwhite char before the first
+ * token, other than a / (in case of a comment in there)
+ * makes this not a declaration.
+ */
+ if (begtoken(c) || c=='/') firsttok++;
+ else if (!iswhite(c) && !firsttok) goto badone;
+ }
+ while (iswhite (c = *lp++))
+ {
+ if (c == 0)
+ {
+ if (feof (inf))
+ break;
+ CNL;
+ }
+ }
+ win = isgood (c);
+ret:
+ *lpp = lp - 1;
+ return !bad && win;
+}
+
+getline (atchar)
+ long atchar;
+{
+ long saveftell = ftell (inf);
+
+ fseek (inf, atchar, 0);
+ readline (&lb1, inf);
+ fseek (inf, saveftell, 0);
+}
+\f
+/* Fortran parsing */
+
+char *dbp;
+int pfcnt;
+
+PF_funcs(fi)
+ FILE *fi;
+{
+ lineno = 0;
+ charno = 0;
+ pfcnt = 0;
+
+ while (!feof (fi))
+ {
+ lineno++;
+ linecharno = charno;
+ charno += readline (&lb, fi) + 1;
+ dbp = lb.buffer;
+ if (*dbp == '%') dbp++ ; /* Ratfor escape to fortran */
+ while (isspace(*dbp))
+ dbp++;
+ if (*dbp == 0)
+ continue;
+ switch (*dbp |' ')
+ {
+ case 'i':
+ if (tail("integer"))
+ takeprec();
+ break;
+ case 'r':
+ if (tail("real"))
+ takeprec();
+ break;
+ case 'l':
+ if (tail("logical"))
+ takeprec();
+ break;
+ case 'c':
+ if (tail("complex") || tail("character"))
+ takeprec();
+ break;
+ case 'd':
+ if (tail("double"))
+ {
+ while (isspace(*dbp))
+ dbp++;
+ if (*dbp == 0)
+ continue;
+ if (tail("precision"))
+ break;
+ continue;
+ }
+ break;
+ }
+ while (isspace(*dbp))
+ dbp++;
+ if (*dbp == 0)
+ continue;
+ switch (*dbp|' ')
+ {
+ case 'f':
+ if (tail("function"))
+ getit();
+ continue;
+ case 's':
+ if (tail("subroutine"))
+ getit();
+ continue;
+ case 'p':
+ if (tail("program"))
+ {
+ getit();
+ continue;
+ }
+ if (tail("procedure"))
+ getit();
+ continue;
+ }
+ }
+ return (pfcnt);
+}
+
+tail(cp)
+ char *cp;
+{
+ register int len = 0;
+
+ while (*cp && (*cp&~' ') == ((*(dbp+len))&~' '))
+ cp++, len++;
+ if (*cp == 0)
+ {
+ dbp += len;
+ return (1);
+ }
+ return (0);
+}
+
+takeprec()
+{
+ while (isspace(*dbp))
+ dbp++;
+ if (*dbp != '*')
+ return;
+ dbp++;
+ while (isspace(*dbp))
+ dbp++;
+ if (!isdigit(*dbp))
+ {
+ --dbp; /* force failure */
+ return;
+ }
+ do
+ dbp++;
+ while (isdigit(*dbp));
+}
+
+getit()
+{
+ register char *cp;
+ char c;
+ char nambuf[BUFSIZ];
+
+ while (isspace(*dbp))
+ dbp++;
+ if (*dbp == 0 || !isalpha(*dbp))
+ return;
+ for (cp = dbp+1; *cp && (isalpha(*cp) || isdigit(*cp)); cp++)
+ continue;
+ c = cp[0];
+ cp[0] = 0;
+ strcpy(nambuf, dbp);
+ cp[0] = c;
+ pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+ pfcnt++;
+}
+\f
+/*
+ * lisp tag functions
+ * just look for (def or (DEF
+ */
+
+L_funcs (fi)
+ FILE *fi;
+{
+ lineno = 0;
+ charno = 0;
+ pfcnt = 0;
+
+ while (!feof (fi))
+ {
+ lineno++;
+ linecharno = charno;
+ charno += readline (&lb, fi) + 1;
+ dbp = lb.buffer;
+ if (dbp[0] == '(' &&
+ (dbp[1] == 'D' || dbp[1] == 'd') &&
+ (dbp[2] == 'E' || dbp[2] == 'e') &&
+ (dbp[3] == 'F' || dbp[3] == 'f'))
+ {
+ while (!isspace(*dbp)) dbp++;
+ while (isspace(*dbp)) dbp++;
+ L_getit();
+ }
+ }
+}
+
+L_getit()
+{
+ register char *cp;
+ char c;
+ char nambuf[BUFSIZ];
+
+ if (*dbp == 0) return;
+ for (cp = dbp+1; *cp && *cp != '(' && *cp != ' '; cp++)
+ continue;
+ c = cp[0];
+ cp[0] = 0;
+ strcpy(nambuf, dbp);
+ cp[0] = c;
+ pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+ pfcnt++;
+}
+\f
+/*
+ * Scheme tag functions
+ * look for (def... xyzzy
+ * look for (def... (xyzzy
+ * look for (def ... ((...(xyzzy ....
+ * look for (set! xyzzy
+ */
+
+static get_scheme ();
+Scheme_funcs (fi)
+ FILE *fi;
+{
+ lineno = 0;
+ charno = 0;
+ pfcnt = 0;
+
+ while (!feof (fi))
+ {
+ lineno++;
+ linecharno = charno;
+ charno += readline (&lb, fi) + 1;
+ dbp = lb.buffer;
+ if (dbp[0] == '(' &&
+ (dbp[1] == 'D' || dbp[1] == 'd') &&
+ (dbp[2] == 'E' || dbp[2] == 'e') &&
+ (dbp[3] == 'F' || dbp[3] == 'f'))
+ {
+ while (!isspace(*dbp)) dbp++;
+ /* Skip over open parens and white space */
+ while (*dbp && (isspace(*dbp) || *dbp == '(')) dbp++;
+ get_scheme ();
+ }
+ if (dbp[0] == '(' &&
+ (dbp[1] == 'S' || dbp[1] == 's') &&
+ (dbp[2] == 'E' || dbp[2] == 'e') &&
+ (dbp[3] == 'T' || dbp[3] == 't') &&
+ (dbp[4] == '!' || dbp[4] == '!') &&
+ (isspace(dbp[5])))
+ {
+ while (!isspace(*dbp)) dbp++;
+ /* Skip over white space */
+ while (isspace(*dbp)) dbp++;
+ get_scheme ();
+ }
+ }
+}
+
+static
+get_scheme()
+{
+ register char *cp;
+ char c;
+ char nambuf[BUFSIZ];
+
+ if (*dbp == 0) return;
+ /* Go till you get to white space or a syntactic break */
+ for (cp = dbp+1; *cp && *cp != '(' && *cp != ')' && !isspace(*cp); cp++)
+ continue;
+ /* Null terminate the string there. */
+ c = cp[0];
+ cp[0] = 0;
+ /* Copy the string */
+ strcpy(nambuf, dbp);
+ /* Unterminate the string */
+ cp[0] = c;
+ /* Announce the change */
+ pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+ pfcnt++;
+}
+static get_mcode ();
+Mcode_funcs (fi)
+ FILE *fi;
+{
+ lineno = 0;
+ charno = 0;
+ pfcnt = 0;
+
+ while (!feof (fi))
+ {
+ lineno++;
+ linecharno = charno;
+ charno += readline (&lb, fi) + 1;
+ dbp = lb.buffer;
+
+ while (*dbp != 0)
+ {
+ /* Skip over white space */
+ while (isspace(*dbp)) dbp++;
+ get_mcode();
+ }
+ }
+}
+
+static
+get_mcode()
+{
+ register char *cp;
+ char c;
+ char nambuf[BUFSIZ];
+
+ if (*dbp == 0) return;
+ /* Go till you get to white space or a syntactic break */
+ for (cp = dbp; *cp && *cp != ':' && *cp != ';' && !isspace(*cp); cp++)
+ continue;
+
+ if(*cp == ':')
+ {
+ /* Null terminate the string there. */
+ c = cp[0];
+ cp[0] = 0;
+ /* Copy the string */
+ strcpy(nambuf, dbp);
+ /* Unterminate the string */
+ cp[0] = c;
+ /* Announce the change */
+ pfnote(nambuf, TRUE, lb.buffer, strlen(lb.buffer), lineno, linecharno);
+ pfcnt++;
+ *dbp = 0;
+ }
+ if (*cp == ';')
+ *dbp = 0;
+ else
+ dbp = cp;
+}
+\f
+/* Find tags in TeX and LaTeX input files. */
+
+/* TEX_toktab is a table of TeX control sequences that define tags.
+ Each TEX_tabent records one such control sequence. */
+
+struct TEX_tabent
+{
+ char *name;
+ int len;
+};
+
+struct TEX_tabent *TEX_toktab = NULL; /* Table with tag tokens */
+
+/* Default set of control sequences to put into TEX_toktab.
+ The value of environment var TEXTAGS is prepended to this. */
+
+static char *TEX_defenv =
+ ":chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem:typeout";
+
+struct TEX_tabent *TEX_decode_env ();
+
+static char TEX_esc = '\\';
+static char TEX_opgrp = '{';
+static char TEX_clgrp = '}';
+
+/*
+ * TeX/LaTeX scanning loop.
+ */
+
+TEX_funcs (fi)
+ FILE *fi;
+{
+ char *lasthit;
+
+ lineno = 0;
+ charno = 0;
+ pfcnt = 0;
+
+ /* Select either \ or ! as escape character. */
+ TEX_mode (fi);
+
+ /* Initialize token table once from environment. */
+ if (!TEX_toktab)
+ TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv);
+
+ while (!feof (fi))
+ {
+ lineno++;
+ linecharno = charno;
+ charno += readline (&lb, fi) + 1;
+ dbp = lb.buffer;
+ lasthit = dbp;
+
+ while (!feof (fi))
+ { /* Scan each line in file */
+ lineno++;
+ linecharno = charno;
+ charno += readline (&lb, fi) + 1;
+ dbp = lb.buffer;
+ lasthit = dbp;
+ while (dbp = index (dbp, TEX_esc)) /* Look at each escape in line */
+ {
+ register int i;
+
+ if (! *(++dbp))
+ break;
+ linecharno += dbp - lasthit;
+ lasthit = dbp;
+ i = TEX_Token (lasthit);
+ if (0 <= i)
+ {
+ TEX_getit (lasthit, TEX_toktab[i].len);
+ break; /* We only save a line once */
+ }
+ }
+ }
+ }
+}
+
+#define TEX_LESC '\\'
+#define TEX_SESC '!'
+
+/* Figure out whether TeX's escapechar is '\\' or '!' and set grouping */
+/* chars accordingly. */
+
+TEX_mode (f)
+ FILE *f;
+{
+ int c;
+
+ while ((c = getc (f)) != EOF)
+ if (c == TEX_LESC || c == TEX_SESC)
+ break;
+
+ if (c == TEX_LESC)
+ {
+ TEX_esc = TEX_LESC;
+ TEX_opgrp = '{';
+ TEX_clgrp = '}';
+ }
+ else
+ {
+ TEX_esc = TEX_SESC;
+ TEX_opgrp = '<';
+ TEX_clgrp = '>';
+ }
+ rewind (f);
+}
+
+/* Read environment and prepend it to the default string. */
+/* Build token table. */
+
+struct TEX_tabent *
+TEX_decode_env (evarname, defenv)
+ char *evarname;
+ char *defenv;
+{
+ register char *env, *p;
+ extern char *savenstr (), *index ();
+
+ struct TEX_tabent *tab;
+ int size, i;
+
+ /* Append deafult string to environment. */
+ env = (char *) getenv (evarname);
+ if (!env)
+ env = defenv;
+ else
+ env = concat (env, defenv, "");
+
+ /* Allocate a token table */
+ for (size = 1, p=env; p;)
+ if ((p = index (p, ':')) && *(++p))
+ size++;
+ tab = (struct TEX_tabent *) xmalloc (size * sizeof (struct TEX_tabent));
+
+ /* Unpack environment string into token table. Be careful about */
+ /* zero-length strings (leading ':', "::" and trailing ':') */
+ for (i = 0; *env;)
+ {
+ p = index (env, ':');
+ if (!p) /* End of environment string. */
+ p = env + strlen (env);
+ if (p - env > 0)
+ { /* Only non-zero strings. */
+ tab[i].name = savenstr (env, p - env);
+ tab[i].len = strlen (tab[i].name);
+ i++;
+ }
+ if (*p)
+ env = p + 1;
+ else
+ {
+ tab[i].name = NULL; /* Mark end of table. */
+ tab[i].len = 0;
+ break;
+ }
+ }
+ return tab;
+}
+
+/* Record a tag defined by a TeX command of length LEN and starting at NAME.
+ The name being defined actually starts at (NAME + LEN + 1).
+ But we seem to include the TeX command in the tag name. */
+
+TEX_getit (name, len)
+ char *name;
+ int len;
+{
+ char *p = name + len;
+ char nambuf[BUFSIZ];
+
+ if (*name == 0) return;
+
+ /* Let tag name extend to next group close (or end of line) */
+ while (*p && *p != TEX_clgrp)
+ p++;
+ strncpy (nambuf, name, p - name);
+ nambuf[p - name] = 0;
+
+ pfnote (nambuf, TRUE, lb.buffer, strlen (lb.buffer), lineno, linecharno);
+ pfcnt++;
+}
+
+/* If the text at CP matches one of the tag-defining TeX command names,
+ return the index of that command in TEX_toktab.
+ Otherwise return -1. */
+
+/* Keep the capital `T' in `Token' for dumb truncating compilers
+ (this distinguishes it from `TEX_toktab' */
+TEX_Token (cp)
+ char *cp;
+{
+ int i;
+
+ for (i = 0; TEX_toktab[i].len > 0; i++)
+ if (strncmp (TEX_toktab[i].name, cp, TEX_toktab[i].len) == 0)
+ return i;
+ return -1;
+}
+\f
+/* Initialize a linebuffer for use */
+
+void
+initbuffer (linebuffer)
+ struct linebuffer *linebuffer;
+{
+ linebuffer->size = 200;
+ linebuffer->buffer = (char *) xmalloc (200);
+}
+
+/* Read a line of text from `stream' into `linebuffer'.
+ Return the length of the line. */
+
+long
+readline (linebuffer, stream)
+ struct linebuffer *linebuffer;
+ register FILE *stream;
+{
+ char *buffer = linebuffer->buffer;
+ register char *p = linebuffer->buffer;
+ register char *pend = p + linebuffer->size;
+
+ while (1)
+ {
+ int c = getc (stream);
+ if (p == pend)
+ {
+ linebuffer->size *= 2;
+ buffer = (char *) xrealloc (buffer, linebuffer->size);
+ p += buffer - linebuffer->buffer;
+ pend = buffer + linebuffer->size;
+ linebuffer->buffer = buffer;
+ }
+ if (c < 0 || c == '\n')
+ {
+ *p = 0;
+ break;
+ }
+ *p++ = c;
+ }
+
+ return p - buffer;
+}
+\f
+char *
+savestr(cp)
+ char *cp;
+{
+ return savenstr (cp, strlen (cp));
+}
+
+char *
+savenstr(cp, len)
+ char *cp;
+ int len;
+{
+ register char *dp;
+
+ dp = (char *) xmalloc (len + 1);
+ strncpy (dp, cp, len);
+ dp[len] = '\0';
+ return dp;
+}
+
+/*
+ * Return the ptr in sp at which the character c last
+ * appears; NULL if not found
+ *
+ * Identical to v7 rindex, included for portability.
+ */
+
+char *
+rindex(sp, c)
+ register char *sp, c;
+{
+ register char *r;
+
+ r = NULL;
+ do
+ {
+ if (*sp == c)
+ r = sp;
+ } while (*sp++);
+ return(r);
+}
+
+/*
+ * Return the ptr in sp at which the character c first
+ * appears; NULL if not found
+ *
+ * Identical to v7 index, included for portability.
+ */
+
+char *
+index(sp, c)
+ register char *sp, c;
+{
+ do
+ {
+ if (*sp == c)
+ return (sp);
+ } while (*sp++);
+ return (NULL);
+}
+
+/* Print error message and exit. */
+
+fatal (s1, s2)
+ char *s1, *s2;
+{
+ error (s1, s2);
+ exit (BAD);
+}
+
+/* Print error message. `s1' is printf control string, `s2' is arg for it. */
+
+error (s1, s2)
+ char *s1, *s2;
+{
+ fprintf (stderr, "%s: ", progname);
+ fprintf (stderr, s1, s2);
+ fprintf (stderr, "\n");
+}
+
+/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */
+
+char *
+concat (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
+ char *result = (char *) xmalloc (len1 + len2 + len3 + 1);
+
+ strcpy (result, s1);
+ strcpy (result + len1, s2);
+ strcpy (result + len1 + len2, s3);
+ *(result + len1 + len2 + len3) = 0;
+
+ return result;
+}
+
+/* Like malloc but get fatal error if memory is exhausted. */
+
+int
+xmalloc (size)
+ int size;
+{
+ int result = malloc (size);
+ if (!result)
+ fatal ("virtual memory exhausted", 0);
+ return result;
+}
+
+int
+xrealloc (ptr, size)
+ char *ptr;
+ int size;
+{
+ int result = realloc (ptr, size);
+ if (!result)
+ fatal ("virtual memory exhausted");
+ return result;
+}
projects / ghc-hetmet.git / blobdiff