/*
*   $Id: lisp.c,v 1.2 2002/02/17 06:04:32 darren Exp $
*
*   Copyright (c) 2000-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 LISP files.
*/

/*
*   INCLUDE FILES
*/
#include "general.h"	/* must always come first */

#include "parse.h"
#include "read.h"
#include "vstring.h"

/*
*   DATA DEFINITIONS
*/
typedef enum {
    K_FUNCTION
} lispKind;

static kindOption LispKinds [] = {
    { TRUE, 'f', "function", "functions" }
};

/*
*   FUNCTION DEFINITIONS
*/

/*
 * lisp tag functions
 *  look for (def or (DEF, quote or QUOTE
 */
static int L_isdef (const unsigned char *strp)
{
    return ( (strp [1] == 'd' || strp [1] == 'D')
	  && (strp [2] == 'e' || strp [2] == 'E')
	  && (strp [3] == 'f' || strp [3] == 'F'));
}

static int L_isquote (const unsigned char *strp)
{
    return ( (*(++strp) == 'q' || *strp == 'Q')
	  && (*(++strp) == 'u' || *strp == 'U')
	  && (*(++strp) == 'o' || *strp == 'O')
	  && (*(++strp) == 't' || *strp == 'T')
	  && (*(++strp) == 'e' || *strp == 'E')
	  && isspace (*(++strp)));
}

static void L_getit (vString *const name, const unsigned char *dbp)
{
    const unsigned char *p;

    if (*dbp == '\'')		/* Skip prefix quote */
	dbp++;
    else if (*dbp == '(' && L_isquote (dbp)) /* Skip "(quote " */
    {
	dbp += 7;
	while (isspace (*dbp))
	dbp++;
    }
    for (p=dbp ; *p!='\0' && *p!='(' && !isspace ((int) *p) && *p!=')' ; p++)
	vStringPut (name, *p);
    vStringTerminate (name);

    if (vStringLength (name) > 0)
	makeSimpleTag (name, LispKinds, K_FUNCTION);
    vStringClear (name);
}

/* Algorithm adapted from from GNU etags.
 */
static void findLispTags (void)
{
    vString *name = vStringNew ();
    const unsigned char* p;


    while ((p = fileReadLine ()) != NULL)
    {
	if (*p == '(')
	{
	    if (L_isdef (p))
	    {
		while (*p != '\0' && !isspace ((int) *p))
		    p++;
		while (isspace ((int) *p))
		    p++;
		L_getit (name, p);
	    }
	    else
	    {
		/* Check for (foo::defmumble name-defined ... */
		do
		    p++;
		while (*p != '\0' && !isspace ((int) *p)
			&& *p != ':' && *p != '(' && *p != ')');
		if (*p == ':')
		{
		    do
			p++;
		    while (*p == ':');

		    if (L_isdef (p - 1))
		    {
			while (*p != '\0' && !isspace ((int) *p))
			    p++;
			while (isspace (*p))
			    p++;
			L_getit (name, p);
		    }
		}
	    }
	}
    }
    vStringDelete (name);
}

extern parserDefinition* LispParser (void)
{
    static const char *const extensions [] = {
	"cl", "clisp", "el", "l", "lisp", "lsp", "ml", NULL
    };
    parserDefinition* def = parserNew ("Lisp");
    def->kinds      = LispKinds;
    def->kindCount  = KIND_COUNT (LispKinds);
    def->extensions = extensions;
    def->parser     = findLispTags;
    return def;
}

/* vi:set tabstop=8 shiftwidth=4: */
