pascal.c

   1 /*
   2 *   $Id: pascal.c 536 2007-06-02 06:09:00Z elliotth $
   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 "vstring.h"
  24
  25 /*
  26 *   DATA DEFINITIONS
  27 */
  28 typedef enum {
  29         K_FUNCTION, K_PROCEDURE
  30 } pascalKind;
  31
  32 static kindOption PascalKinds [] = {
  33         { TRUE, 'f', "function",  "functions"},
  34         { TRUE, 'p', "procedure", "procedures"}
  35 };
  36
  37 /*
  38 *   FUNCTION DEFINITIONS
  39 */
  40
  41 static void createPascalTag (
  42                 tagEntryInfo* const tag, const vString* const name, const int kind)
  43 {
  44         if (PascalKinds [kind].enabled  &&  name != NULL  &&  vStringLength (name) > 0)
  45         {
  46             initTagEntry (tag, vStringValue (name));
  47             tag->kindName = PascalKinds [kind].name;
  48             tag->kind     = PascalKinds [kind].letter;
  49         }
  50         else
  51             initTagEntry (tag, NULL);
  52 }
  53
  54 static void makePascalTag (const tagEntryInfo* const tag)
  55 {
  56         if (tag->name != NULL)
  57                 makeTagEntry (tag);
  58 }
  59
  60 static const unsigned char* dbp;
  61
  62 #define starttoken(c) (isalpha ((int) c) || (int) c == '_')
  63 #define intoken(c)    (isalnum ((int) c) || (int) c == '_' || (int) c == '.')
  64 #define endtoken(c)   (! intoken (c)  &&  ! isdigit ((int) c))
  65
  66 static boolean tail (const char *cp)
  67 {
  68         boolean result = FALSE;
  69         register int len = 0;
  70
  71         while (*cp != '\0' && tolower ((int) *cp) == tolower ((int) dbp [len]))
  72                 cp++, len++;
  73         if (*cp == '\0' && !intoken (dbp [len]))
  74         {
  75                 dbp += len;
  76                 result = TRUE;
  77         }
  78         return result;
  79 }
  80
  81 /* Algorithm adapted from from GNU etags.
  82  * Locates tags for procedures & functions.  Doesn't do any type- or
  83  * var-definitions.  It does look for the keyword "extern" or "forward"
  84  * immediately following the procedure statement; if found, the tag is
  85  * skipped.
  86  */
  87 static void findPascalTags (void)
  88 {
  89         vString *name = vStringNew ();
  90         tagEntryInfo tag;
  91         pascalKind kind = K_FUNCTION;
  92                 /* each of these flags is TRUE iff: */
  93         boolean incomment = FALSE;  /* point is inside a comment */
  94         int comment_char = '\0';    /* type of current comment */
  95         boolean inquote = FALSE;    /* point is inside '..' string */
  96         boolean get_tagname = FALSE;/* point is after PROCEDURE/FUNCTION
  97                 keyword, so next item = potential tag */
  98         boolean found_tag = FALSE;  /* point is after a potential tag */
  99         boolean inparms = FALSE;    /* point is within parameter-list */
 100         boolean verify_tag = FALSE;
 101                 /* point has passed the parm-list, so the next token will determine
 102                  * whether this is a FORWARD/EXTERN to be ignored, or whether it is a
 103                  * real tag
 104                  */
 105
 106         dbp = fileReadLine ();
 107         while (dbp != NULL)
 108         {
 109                 int c = *dbp++;
 110
 111                 if (c == '\0')  /* if end of line */
 112                 {
 113                         dbp = fileReadLine ();
 114                         if (dbp == NULL  ||  *dbp == '\0')
 115                                 continue;
 116                         if (!((found_tag && verify_tag) || get_tagname))
 117                                 c = *dbp++;
 118                                         /* only if don't need *dbp pointing to the beginning of
 119                                          * the name of the procedure or function
 120                                          */
 121                 }
 122                 if (incomment)
 123                 {
 124                         if (comment_char == '{' && c == '}')
 125                                 incomment = FALSE;
 126                         else if (comment_char == '(' && c == '*' && *dbp == ')')
 127                         {
 128                                 dbp++;
 129                                 incomment = FALSE;
 130                         }
 131                         continue;
 132                 }
 133                 else if (inquote)
 134                 {
 135                         if (c == '\'')
 136                                 inquote = FALSE;
 137                         continue;
 138                 }
 139                 else switch (c)
 140                 {
 141                         case '\'':
 142                                 inquote = TRUE;  /* found first quote */
 143                                 continue;
 144                         case '{':  /* found open { comment */
 145                                 incomment = TRUE;
 146                                 comment_char = c;
 147                                 continue;
 148                         case '(':
 149                                 if (*dbp == '*')  /* found open (* comment */
 150                                 {
 151                                         incomment = TRUE;
 152                                         comment_char = c;
 153                                         dbp++;
 154                                 }
 155                                 else if (found_tag)  /* found '(' after tag, i.e., parm-list */
 156                                         inparms = TRUE;
 157                                 continue;
 158                         case ')':  /* end of parms list */
 159                                 if (inparms)
 160                                         inparms = FALSE;
 161                                 continue;
 162                         case ';':
 163                                 if (found_tag && !inparms)  /* end of proc or fn stmt */
 164                                 {
 165                                         verify_tag = TRUE;
 166                                         break;
 167                                 }
 168                                 continue;
 169                 }
 170                 if (found_tag && verify_tag && *dbp != ' ')
 171                 {
 172                         /* check if this is an "extern" declaration */
 173                         if (*dbp == '\0')
 174                                 continue;
 175                         if (tolower ((int) *dbp == 'e'))
 176                         {
 177                                 if (tail ("extern"))  /* superfluous, really! */
 178                                 {
 179                                         found_tag = FALSE;
 180                                         verify_tag = FALSE;
 181                                 }
 182                         }
 183                         else if (tolower ((int) *dbp) == 'f')
 184                         {
 185                                 if (tail ("forward"))  /*  check for forward reference */
 186                                 {
 187                                         found_tag = FALSE;
 188                                         verify_tag = FALSE;
 189                                 }
 190                         }
 191                         if (found_tag && verify_tag)  /* not external proc, so make tag */
 192                         {
 193                                 found_tag = FALSE;
 194                                 verify_tag = FALSE;
 195                                 makePascalTag (&tag);
 196                                 continue;
 197                         }
 198                 }
 199                 if (get_tagname)  /* grab name of proc or fn */
 200                 {
 201                         const unsigned char *cp;
 202
 203                         if (*dbp == '\0')
 204                                 continue;
 205
 206                         /* grab block name */
 207                         while (isspace ((int) *dbp))
 208                                 ++dbp;
 209                         for (cp = dbp  ;  *cp != '\0' && !endtoken (*cp)  ;  cp++)
 210                                 continue;
 211                         vStringNCopyS (name, (const char*) dbp,  cp - dbp);
 212                         createPascalTag (&tag, name, kind);
 213                         dbp = cp;  /* set dbp to e-o-token */
 214                         get_tagname = FALSE;
 215                         found_tag = TRUE;
 216                         /* and proceed to check for "extern" */
 217                 }
 218                 else if (!incomment && !inquote && !found_tag)
 219                 {
 220                         switch (tolower ((int) c))
 221                         {
 222                                 case 'c':
 223                                         if (tail ("onstructor"))
 224                                         {
 225                                                 get_tagname = TRUE;
 226                                                 kind = K_PROCEDURE;
 227                                         }
 228                                         break;
 229                                 case 'd':
 230                                         if (tail ("estructor"))
 231                                         {
 232                                                 get_tagname = TRUE;
 233                                                 kind = K_PROCEDURE;
 234                                         }
 235                                         break;
 236                                 case 'p':
 237                                         if (tail ("rocedure"))
 238                                         {
 239                                                 get_tagname = TRUE;
 240                                                 kind = K_PROCEDURE;
 241                                         }
 242                                         break;
 243                                 case 'f':
 244                                         if (tail ("unction"))
 245                                         {
 246                                                 get_tagname = TRUE;
 247                                                 kind = K_FUNCTION;
 248                                         }
 249                                         break;
 250                         }
 251                 }  /* while not eof */
 252         }
 253         vStringDelete (name);
 254 }
 255
 256 extern parserDefinition* PascalParser (void)
 257 {
 258         static const char *const extensions [] = { "p", "pas", NULL };
 259         parserDefinition* def = parserNew ("Pascal");
 260         def->extensions = extensions;
 261         def->kinds      = PascalKinds;
 262         def->kindCount  = KIND_COUNT (PascalKinds);
 263         def->parser     = findPascalTags;
 264         return def;
 265 }
 266
 267 /* vi:set tabstop=4 shiftwidth=4: */