/* Algorithm adapted from from GNU etags.
* Locates tags for procedures & functions. Doesn't do any type- or
* var-definitions. It does look for the keyword "extern" or "forward"
* immediately following the procedure statement; if found, the tag is
* skipped.
*/
static void findPascalTags (void)
{
vString *name = vStringNew ();
tagEntryInfo tag;
pascalKind kind = K_FUNCTION;
/* each of these flags is TRUE iff: */
boolean incomment = FALSE; /* point is inside a comment */
int comment_char = '\0'; /* type of current comment */
boolean inquote = FALSE; /* point is inside '..' string */
boolean get_tagname = FALSE;/* point is after PROCEDURE/FUNCTION
keyword, so next item = potential tag */
boolean found_tag = FALSE; /* point is after a potential tag */
boolean inparms = FALSE; /* point is within parameter-list */
boolean verify_tag = FALSE;
/* point has passed the parm-list, so the next token will determine
* whether this is a FORWARD/EXTERN to be ignored, or whether it is a
* real tag
*/
dbp = readLineFromInputFile ();
while (dbp != NULL)
{
int c = *dbp++;
if (c == '\0') /* if end of line */
{
dbp = readLineFromInputFile ();
if (dbp == NULL || *dbp == '\0')
continue;
if (!((found_tag && verify_tag) || get_tagname))
c = *dbp++;
/* only if don't need *dbp pointing to the beginning of
* the name of the procedure or function
*/
}
if (incomment)
{
if (comment_char == '{' && c == '}')
incomment = FALSE;
else if (comment_char == '(' && c == '*' && *dbp == ')')
{
dbp++;
incomment = FALSE;
}
continue;
}
else if (inquote)
{
if (c == '\'')
inquote = FALSE;
continue;
}
else switch (c)
{
case '\'':
inquote = TRUE; /* found first quote */
continue;
case '{': /* found open { comment */
incomment = TRUE;
comment_char = c;
continue;
case '(':
if (*dbp == '*') /* found open (* comment */
{
incomment = TRUE;
comment_char = c;
dbp++;
}
else if (found_tag) /* found '(' after tag, i.e., parm-list */
inparms = TRUE;
continue;
case ')': /* end of parms list */
if (inparms)
inparms = FALSE;
continue;
case ';':
if (found_tag && !inparms) /* end of proc or fn stmt */
{
verify_tag = TRUE;
break;
}
continue;
}
if (found_tag && verify_tag && *dbp != ' ')
{
/* check if this is an "extern" declaration */
if (*dbp == '\0')
continue;
if (tolower ((int) *dbp == 'e'))
{
if (tail ("extern")) /* superfluous, really! */
{
found_tag = FALSE;
verify_tag = FALSE;
}
}
else if (tolower ((int) *dbp) == 'f')
{
if (tail ("forward")) /* check for forward reference */
{
found_tag = FALSE;
verify_tag = FALSE;
}
}
if (found_tag && verify_tag) /* not external proc, so make tag */
{
found_tag = FALSE;
verify_tag = FALSE;
makePascalTag (&tag);
continue;
}
}
if (get_tagname) /* grab name of proc or fn */
{
const unsigned char *cp;
if (*dbp == '\0')
continue;
/* grab block name */
while (isspace ((int) *dbp))
++dbp;
for (cp = dbp ; *cp != '\0' && !endtoken (*cp) ; cp++)
continue;
vStringNCopyS (name, (const char*) dbp, cp - dbp);
createPascalTag (&tag, name, kind);
dbp = cp; /* set dbp to e-o-token */
get_tagname = FALSE;
found_tag = TRUE;
/* and proceed to check for "extern" */
}
else if (!incomment && !inquote && !found_tag)
{
switch (tolower ((int) c))
{
case 'c':
if (tail ("onstructor"))
{
get_tagname = TRUE;
kind = K_PROCEDURE;
}
break;
case 'd':
if (tail ("estructor"))
{
get_tagname = TRUE;
kind = K_PROCEDURE;
}
break;
case 'p':
if (tail ("rocedure"))
{
get_tagname = TRUE;
kind = K_PROCEDURE;
}
break;
case 'f':
if (tail ("unction"))
{
get_tagname = TRUE;
kind = K_FUNCTION;
}
break;
}
} /* while not eof */
}
vStringDelete (name);
}
static void parseArglist(const char *buf, char **arglist, char **vartype)
{
char *c, *start, *end;
int level;
if (NULL == buf || NULL == arglist)
return;
c = strdup(buf);
/* parse argument list which can be missing like in "function ginit:integer;" */
if (NULL != (start = strchr(c, '(')))
{
for (level = 1, end = start + 1; level > 0; ++end)
{
if ('\0' == *end)
break;
else if ('(' == *end)
++ level;
else if (')' == *end)
-- level;
}
}
else /* if no argument list was found, continue looking for a return value */
{
start = "()";
end = c;
}
/* parse return type if requested by passing a non-NULL vartype argument */
if (NULL != vartype)
{
char *var, *var_start;
*vartype = NULL;
if (NULL != (var = strchr(end, ':')))
{
var++; /* skip ':' */
while (isspace((int) *var))
++var;
if (starttoken(*var))
{
var_start = var;
var++;
while (intoken(*var))
var++;
if (endtoken(*var))
{
*var = '\0';
*vartype = strdup(var_start);
}
}
}
}
*end = '\0';
*arglist = strdup(start);
eFree(c);
}
