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