tagmanager/pascal.c

   1 /*
   2 *   $Id$
   3 *
   4 *   Copyright (c) 2001-2002, Darren Hiebert
   5 *
   6 *   This source code is released for free distribution under the terms of the
   7 *   GNU General Public License.
   8 *
   9 *   This module contains functions for generating tags for the Pascal language,
  10 *   including some extensions for Object Pascal.
  11 */
  12
  13 /*
  14 *   INCLUDE FILES
  15 */
  16 #include "general.h"    /* must always come first */
  17
  18 #include <string.h>
  19
  20 #include "entry.h"
  21 #include "parse.h"
  22 #include "read.h"
  23 #include "main.h"
  24 #include "vstring.h"
  25
  26 /*
  27 *   DATA DEFINITIONS
  28 */
  29 typedef enum {
  30     K_FUNCTION, K_PROCEDURE
  31 } pascalKind;
  32
  33 static kindOption PascalKinds [] = {
  34     { TRUE, 'f', "function", "functions"},
  35     { TRUE, 'f', "function", "procedures"}
  36 };
  37
  38 /*
  39 *   FUNCTION DEFINITIONS
  40 */
  41
  42 static void createPascalTag (tagEntryInfo* const tag,
  43                              const vString* const name, const int kind,
  44                              const char *arglist, const char *vartype)
  45 {
  46     if (PascalKinds [kind].enabled  &&  name != NULL  &&  vStringLength (name) > 0)
  47     {
  48         initTagEntry (tag, vStringValue (name));
  49
  50         tag->kindName = PascalKinds [kind].name;
  51         tag->kind     = PascalKinds [kind].letter;
  52         tag->extensionFields.arglist = arglist;
  53         tag->extensionFields.varType = vartype;
  54     }
  55     else
  56         initTagEntry (tag, NULL);
  57 }
  58
  59 static void makePascalTag (const tagEntryInfo* const tag)
  60 {
  61     if (tag->name != NULL)
  62         makeTagEntry (tag);
  63 }
  64
  65 static const unsigned char* dbp;
  66
  67 #define starttoken(c) (isalpha ((int) c) || (int) c == '_')
  68 #define intoken(c)    (isalnum ((int) c) || (int) c == '_' || (int) c == '.')
  69 #define endtoken(c)   (! intoken (c)  &&  ! isdigit ((int) c))
  70
  71 static boolean tail (const char *cp)
  72 {
  73     boolean result = FALSE;
  74     register int len = 0;
  75
  76     while (*cp != '\0' && tolower ((int) *cp) == tolower ((int) dbp [len]))
  77         cp++, len++;
  78     if (*cp == '\0' && !intoken (dbp [len]))
  79     {
  80         dbp += len;
  81         result = TRUE;
  82     }
  83     return result;
  84 }
  85
  86 static void parseArglist(const char *buf, char **arglist, char **vartype)
  87 {
  88     char *c, *start, *end;
  89     int level;
  90
  91     if (NULL == buf || NULL == arglist)
  92         return;
  93
  94     c = strdup(buf);
  95     /* parse argument list which can be missing like in "function ginit:integer;" */
  96     if (NULL != (start = strchr(c, '(')))
  97     {
  98         for (level = 1, end = start + 1; level > 0; ++end)
  99         {
 100             if ('\0' == *end)
 101                 break;
 102             else if ('(' == *end)
 103                 ++ level;
 104             else if (')' == *end)
 105                 -- level;
 106         }
 107     }
 108     else /* if no argument list was found, continue looking for a return value */
 109     {
 110         start = "()";
 111         end = c;
 112     }
 113
 114     /* parse return type if requested by passing a non-NULL vartype argument */
 115     if (NULL != vartype)
 116     {
 117         char *var, *var_start;
 118
 119         *vartype = NULL;
 120
 121         if (NULL != (var = strchr(end, ':')))
 122         {
 123             var++; /* skip ':' */
 124             while (isspace((int) *var))
 125                 ++var;
 126
 127             if (starttoken(*var))
 128             {
 129                 var_start = var;
 130                 var++;
 131                 while (intoken(*var))
 132                     var++;
 133                 if (endtoken(*var))
 134                 {
 135                     *var = '\0';
 136                     *vartype = strdup(var_start);
 137                 }
 138             }
 139         }
 140     }
 141
 142     *end = '\0';
 143     *arglist = strdup(start);
 144
 145     eFree(c);
 146 }
 147
 148
 149 /* Algorithm adapted from from GNU etags.
 150  * Locates tags for procedures & functions.  Doesn't do any type- or
 151  * var-definitions.  It does look for the keyword "extern" or "forward"
 152  * immediately following the procedure statement; if found, the tag is
 153  * skipped.
 154  */
 155 static void findPascalTags (void)
 156 {
 157     vString *name = vStringNew ();
 158     tagEntryInfo tag;
 159     char *arglist = NULL;
 160     char *vartype = NULL;
 161     pascalKind kind = K_FUNCTION;
 162                                 /* each of these flags is TRUE iff: */
 163     boolean incomment = FALSE;  /* point is inside a comment */
 164     int comment_char = '\0';    /* type of current comment */
 165     boolean inquote = FALSE;    /* point is inside '..' string */
 166     boolean get_tagname = FALSE;/* point is after PROCEDURE/FUNCTION
 167                                     keyword, so next item = potential tag */
 168     boolean found_tag = FALSE;  /* point is after a potential tag */
 169     boolean inparms = FALSE;    /* point is within parameter-list */
 170     boolean verify_tag = FALSE; /* point has passed the parm-list, so the
 171                                    next token will determine whether this
 172                                    is a FORWARD/EXTERN to be ignored, or
 173                                    whether it is a real tag */
 174
 175     dbp = fileReadLine ();
 176     while (dbp != NULL)
 177     {
 178         int c = *dbp++;
 179
 180         if (c == '\0')          /* if end of line */
 181         {
 182             dbp = fileReadLine ();
 183             if (dbp == NULL  ||  *dbp == '\0')
 184                 continue;
 185             if (!((found_tag && verify_tag) || get_tagname))
 186                 c = *dbp++;             /* only if don't need *dbp pointing
 187                                     to the beginning of the name of
 188                                     the procedure or function */
 189         }
 190         if (incomment)
 191         {
 192             if (comment_char == '{' && c == '}')
 193                 incomment = FALSE;
 194             else if (comment_char == '(' && c == '*' && *dbp == ')')
 195             {
 196                 dbp++;
 197                 incomment = FALSE;
 198             }
 199             continue;
 200         }
 201         else if (inquote)
 202         {
 203             if (c == '\'')
 204                 inquote = FALSE;
 205             continue;
 206         }
 207         else switch (c)
 208         {
 209             case '\'':
 210                 inquote = TRUE; /* found first quote */
 211                 continue;
 212             case '{':           /* found open { comment */
 213                 incomment = TRUE;
 214                 comment_char = c;
 215                 continue;
 216             case '(':
 217                 if (*dbp == '*')        /* found open (* comment */
 218                 {
 219                     incomment = TRUE;
 220                     comment_char = c;
 221                     dbp++;
 222                 }
 223                 else if (found_tag)  /* found '(' after tag, i.e., parm-list */
 224                     inparms = TRUE;
 225                 continue;
 226             case ')':           /* end of parms list */
 227                 if (inparms)
 228                     inparms = FALSE;
 229                 continue;
 230             case ';':
 231                 if (found_tag && !inparms) /* end of proc or fn stmt */
 232                 {
 233                     verify_tag = TRUE;
 234                     break;
 235                 }
 236                 continue;
 237         }
 238         if (found_tag && verify_tag && *dbp != ' ')
 239         {
 240             /* check if this is an "extern" declaration */
 241             if (*dbp == '\0')
 242                 continue;
 243             if (tolower ((int) *dbp == 'e'))
 244             {
 245                 if (tail ("extern"))    /* superfluous, really! */
 246                 {
 247                     found_tag = FALSE;
 248                     verify_tag = FALSE;
 249                 }
 250             }
 251             else if (tolower ((int) *dbp) == 'f')
 252             {
 253                 if (tail ("forward"))   /*  check for forward reference */
 254                 {
 255                     found_tag = FALSE;
 256                     verify_tag = FALSE;
 257                 }
 258             }
 259             else if (tolower ((int) *dbp) == 't')
 260             {
 261                 if (tail ("type"))      /*  check for forward reference */
 262                 {
 263                     found_tag = FALSE;
 264                     verify_tag = FALSE;
 265                 }
 266             }
 267             if (found_tag && verify_tag) /* not external proc, so make tag */
 268             {
 269                 found_tag = FALSE;
 270                 verify_tag = FALSE;
 271                 makePascalTag (&tag);
 272                 continue;
 273             }
 274         }
 275         if (get_tagname)                /* grab name of proc or fn */
 276         {
 277             const unsigned char *cp;
 278
 279             if (*dbp == '\0')
 280                 continue;
 281
 282             /* grab block name */
 283             while (isspace ((int) *dbp))
 284                 ++dbp;
 285             for (cp = dbp  ;  *cp != '\0' && !endtoken (*cp)  ;  cp++)
 286                 continue;
 287             vStringNCopyS (name, (const char*) dbp,  cp - dbp);
 288             if (arglist != NULL)
 289                 eFree(arglist);
 290             if (kind == K_FUNCTION && vartype != NULL)
 291                 eFree(vartype);
 292             parseArglist((const char*) cp, &arglist, (kind == K_FUNCTION) ? &vartype : NULL);
 293             createPascalTag (&tag, name, kind, arglist, (kind == K_FUNCTION) ? vartype : NULL);
 294             dbp = cp;           /* set dbp to e-o-token */
 295             get_tagname = FALSE;
 296             found_tag = TRUE;
 297             /* and proceed to check for "extern" */
 298         }
 299         else if (!incomment && !inquote && !found_tag)
 300         {
 301             switch (tolower ((int) c))
 302             {
 303                 case 'c':
 304                     if (tail ("onstructor"))
 305                     {
 306                         get_tagname = TRUE;
 307                         kind = K_PROCEDURE;
 308                     }
 309                     break;
 310                 case 'd':
 311                     if (tail ("estructor"))
 312                     {
 313                         get_tagname = TRUE;
 314                         kind = K_PROCEDURE;
 315                     }
 316                     break;
 317                 case 'p':
 318                     if (tail ("rocedure"))
 319                     {
 320                         get_tagname = TRUE;
 321                         kind = K_PROCEDURE;
 322                     }
 323                     break;
 324                 case 'f':
 325                     if (tail ("unction"))
 326                     {
 327                         get_tagname = TRUE;
 328                         kind = K_FUNCTION;
 329                     }
 330                     break;
 331                 case 't':
 332                     if (tail ("ype"))
 333                     {
 334                         get_tagname = TRUE;
 335                         kind = K_FUNCTION;
 336                     }
 337                     break;
 338             }
 339         }  /* while not eof */
 340     }
 341     if (arglist != NULL)
 342         eFree(arglist);
 343     if (vartype != NULL)
 344         eFree(vartype);
 345     vStringDelete(name);
 346 }
 347
 348 extern parserDefinition* PascalParser (void)
 349 {
 350     static const char *const extensions [] = { "p", "pas", NULL };
 351     parserDefinition* def = parserNew ("Pascal");
 352     def->extensions = extensions;
 353     def->kinds      = PascalKinds;
 354     def->kindCount  = KIND_COUNT (PascalKinds);
 355     def->parser     = findPascalTags;
 356     return def;
 357 }
 358
 359 /* vi:set tabstop=8 shiftwidth=4: */