/**   $Id: pascal.c 536 2007-06-02 06:09:00Z elliotth $**   Copyright (c) 2001-2002, Darren Hiebert**   This source code is released for free distribution under the terms of the*   GNU General Public License.**   This module contains functions for generating tags for the Pascal language,*   including some extensions for Object Pascal.*//**   INCLUDE FILES*/#include "general.h"  /* must always come first */#include <string.h>#include "entry.h"#include "parse.h"#include "read.h"#include "vstring.h"/**   DATA DEFINITIONS*/typedef enum {	K_FUNCTION, K_PROCEDURE} pascalKind;static kindOption PascalKinds [] = {	{ TRUE, 'f', "function",  "functions"},	{ TRUE, 'p', "procedure", "procedures"}};/**   FUNCTION DEFINITIONS*/static void createPascalTag (		tagEntryInfo* const tag, const vString* const name, const int kind){	if (PascalKinds [kind].enabled  &&  name != NULL  &&  vStringLength (name) > 0)	{	    initTagEntry (tag, vStringValue (name));	    tag->kindName = PascalKinds [kind].name;	    tag->kind     = PascalKinds [kind].letter;	}	else	    initTagEntry (tag, NULL);}static void makePascalTag (const tagEntryInfo* const tag){	if (tag->name != NULL)		makeTagEntry (tag);}static const unsigned char* dbp;#define starttoken(c) (isalpha ((int) c) || (int) c == '_')#define intoken(c)    (isalnum ((int) c) || (int) c == '_' || (int) c == '.')#define endtoken(c)   (! intoken (c)  &&  ! isdigit ((int) c))static boolean tail (const char *cp){	boolean result = FALSE;	register int len = 0;	while (*cp != '\0' && tolower ((int) *cp) == tolower ((int) dbp [len]))		cp++, len++;	if (*cp == '\0' && !intoken (dbp [len]))	{		dbp += len;		result = TRUE;	}	return result;}/* 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 = fileReadLine ();	while (dbp != NULL)	{		int c = *dbp++;		if (c == '\0')  /* if end of line */		{			dbp = fileReadLine ();			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);}extern parserDefinition* PascalParser (void){	static const char *const extensions [] = { "p", "pas", NULL };	parserDefinition* def = parserNew ("Pascal");	def->extensions = extensions;	def->kinds      = PascalKinds;	def->kindCount  = KIND_COUNT (PascalKinds);	def->parser     = findPascalTags;	return def;}/* vi:set tabstop=4 shiftwidth=4: */