tagmanager/ctags/pascal.c

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