From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,XPRIO autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,78f14d88da182825,start
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: g2news1.google.com!news2.google.com!proxad.net!wanadoo.fr!not-for-mail
From: "silversword31" <nomail@nomail.fr>
Newsgroups: comp.lang.ada
Subject: Ada parser for Exuberant Ctags program
Date: Thu, 5 Aug 2004 22:09:07 +0200
Organization: Wanadoo, l'internet avec France Telecom
Message-ID: <ceu4gr$g2g$1@news-reader5.wanadoo.fr>
NNTP-Posting-Host: atoulouse-152-1-4-53.w82-125.abo.wanadoo.fr
X-Trace: news-reader5.wanadoo.fr 1091736923 16464 82.125.2.53 (5 Aug 2004
 20:15:23 GMT)
X-Complaints-To: abuse@wanadoo.fr
NNTP-Posting-Date: 5 Aug 2004 20:15:23 GMT
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2800.1437
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1441
Xref: g2news1.google.com comp.lang.ada:2588
Date: 2004-08-05T20:15:23+00:00
List-Id: <comp.lang.ada>

I've wrote a parser for exuberant ctags 5.5.4. It capture procedures,
functions, type, subtype, package and package body.
It's not very complete but it's usefull :o)

Eric Fraxinous

Ps: I've used Pascal Parser for begining. Thank you Darren Hiebert for this
example :o)

---Code

/*
*
*
*   Copyright (c) 2004, Fraxinous Eric
*
*   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 Ada language
*/

/*
*   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,K_FUNCTION_P, K_PROCEDURE_P, K_PACKAGE,
K_PACKAGE_BODY, K_TYPE, K_SUBTYPE
} AdaKind;

static kindOption AdaKinds [] = {
    { TRUE, 'f', "function",  "functions"},
    { TRUE, 'f', "procedure", "procedures"},
    { TRUE, 'p', "function",  "functions def"},
    { TRUE, 'p', "procedure", "procedures def"},
    { TRUE, 'c', "package",   "package"},
    { TRUE, 'b', "package body",   "package body"},
    { TRUE, 't', "type",    "type"},
    { TRUE, 't', "subtype",    "subtype"}
};

/*
*   FUNCTION DEFINITIONS
*/

static void createAdaTag (tagEntryInfo* const tag,
        const vString* const name, const int kind)
{
    if (AdaKinds [kind].enabled  &&  name != NULL  &&  vStringLength (name)
> 0)
    {
        initTagEntry (tag, vStringValue (name));

        tag->kindName = AdaKinds [kind].name;
        tag->kind     = AdaKinds [kind].letter;
    }
    else
        initTagEntry (tag, NULL);
}

static void makeAdaTag (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 findAdaTags (void)
{
    vString *name = vStringNew ();
    tagEntryInfo tag;
    AdaKind 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 skip_line = FALSE; /* skip line ? */
    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'|| skip_line)  /* if end of line */
 {
    if (found_tag) /* end of proc or fn stmt */
           {
        verify_tag = TRUE;
     }
            incomment = FALSE;
            skip_line = FALSE;
     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 */
 }
 /* incomment test */
 if (tail("--"))
 {
     incomment = TRUE;
            skip_line = TRUE;
     continue;
 }
 else switch (c)
 {
     case '(':
  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;
      if( kind == K_PROCEDURE)
   kind=K_PROCEDURE_P;
      if( kind == K_FUNCTION)
   kind=K_FUNCTION_P;
                    skip_line = FALSE;
      break;
  }
  continue;
     default:
  if(tail("is"))
  {
     if (found_tag && !inparms) /* end of proc or fn stmt */
                   {
      verify_tag = TRUE;
      if( kind == K_PROCEDURE_P)
      {
   kind=K_PROCEDURE;
                createAdaTag (&tag, name, kind);
       }
      if( kind == K_FUNCTION_P)
      {
   kind=K_FUNCTION;
                createAdaTag (&tag, name, kind);
       }
                    skip_line = FALSE;
      break;
  }
  else
      verify_tag = FALSE;
  }
 }
 if (found_tag && verify_tag && *dbp != ' ')
 {
     /* check if this is an "extern" declaration */
     if (*dbp == '\0')
  continue;
     if (found_tag && verify_tag && !inparms) /* not external proc, so make
tag */
     {
  found_tag = FALSE;
  verify_tag = FALSE;
  makeAdaTag (&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);
     createAdaTag (&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 'p':
      if (tail ("rocedure"))
      {
   get_tagname = TRUE;
   kind = K_PROCEDURE_P;
      }
      if (tail ("ackage"))
      {
         if (tail (" body"))
         {
      get_tagname = TRUE;
      kind = K_PACKAGE_BODY;
         }
         else
         {
     get_tagname = TRUE;
     kind = K_PACKAGE;
         }
      }
      break;
  case 'f':
      if (tail ("unction"))
      {
   get_tagname = TRUE;
   kind = K_FUNCTION_P;
      }
      break;
  case 't':
      if (tail ("ype"))
      {
   get_tagname = TRUE;
   kind = K_TYPE;
      }
      break;
  case 's':
      if (tail ("ubtype"))
      {
   get_tagname = TRUE;
   kind = K_SUBTYPE;
      }
     }
 }    /* while not eof */
    }
}

extern parserDefinition* AdaParser (void)
{
    static const char *const extensions [] = { "adb", "ads", NULL };
    parserDefinition* def = parserNew ("Ada");
    def->extensions = extensions;
    def->kinds      = AdaKinds;
    def->kindCount  = KIND_COUNT (AdaKinds);
    def->parser     = findAdaTags;
    return def;
}

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