scheme.c

   1 /*
   2 *   $Id: scheme.c 443 2006-05-30 04:37:13Z darren $
   3 *
   4 *   Copyright (c) 2000-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 Scheme language
  10 *   files.
  11 */
  12
  13 /*
  14 *   INCLUDE FILES
  15 */
  16 #include "general.h"  /* must always come first */
  17
  18 #include <string.h>
  19
  20 #include "parse.h"
  21 #include "read.h"
  22 #include "vstring.h"
  23
  24 /*
  25 *   DATA DEFINITIONS
  26 */
  27 typedef enum {
  28         K_FUNCTION, K_SET
  29 } schemeKind;
  30
  31 static kindOption SchemeKinds [] = {
  32         { TRUE, 'f', "function", "functions" },
  33         { TRUE, 's', "set",      "sets" }
  34 };
  35
  36 /*
  37 *   FUNCTION DEFINITIONS
  38 */
  39
  40 /* Algorithm adapted from from GNU etags.
  41  * Scheme tag functions
  42  * look for (def... xyzzy
  43  * look for (def... (xyzzy
  44  * look for (def ... ((... (xyzzy ....
  45  * look for (set! xyzzy
  46  */
  47 static void readIdentifier (vString *const name, const unsigned char *cp)
  48 {
  49         const unsigned char *p;
  50         vStringClear (name);
  51         /* Go till you get to white space or a syntactic break */
  52         for (p = cp; *p != '\0' && *p != '(' && *p != ')' && !isspace (*p); p++)
  53                 vStringPut (name, (int) *p);
  54         vStringTerminate (name);
  55 }
  56
  57 static void findSchemeTags (void)
  58 {
  59         vString *name = vStringNew ();
  60         const unsigned char *line;
  61
  62         while ((line = fileReadLine ()) != NULL)
  63         {
  64                 const unsigned char *cp = line;
  65
  66                 if (cp [0] == '(' &&
  67                         (cp [1] == 'D' || cp [1] == 'd') &&
  68                         (cp [2] == 'E' || cp [2] == 'e') &&
  69                         (cp [3] == 'F' || cp [3] == 'f'))
  70                 {
  71                         while (!isspace (*cp))
  72                                 cp++;
  73                         /* Skip over open parens and white space */
  74                         while (*cp != '\0' && (isspace (*cp) || *cp == '('))
  75                                 cp++;
  76                         readIdentifier (name, cp);
  77                         makeSimpleTag (name, SchemeKinds, K_FUNCTION);
  78                 }
  79                 if (cp [0] == '(' &&
  80                         (cp [1] == 'S' || cp [1] == 's') &&
  81                         (cp [2] == 'E' || cp [2] == 'e') &&
  82                         (cp [3] == 'T' || cp [3] == 't') &&
  83                         (cp [4] == '!' || cp [4] == '!') &&
  84                         (isspace (cp [5])))
  85                 {
  86                         while (*cp != '\0'  &&  !isspace (*cp))
  87                                 cp++;
  88                         /* Skip over white space */
  89                         while (isspace (*cp))
  90                                 cp++;
  91                         readIdentifier (name, cp);
  92                         makeSimpleTag (name, SchemeKinds, K_SET);
  93                 }
  94         }
  95         vStringDelete (name);
  96 }
  97
  98 extern parserDefinition* SchemeParser (void)
  99 {
 100         static const char *const extensions [] = {
 101                 "SCM", "SM", "sch", "scheme", "scm", "sm", NULL
 102         };
 103         parserDefinition* def = parserNew ("Scheme");
 104         def->kinds      = SchemeKinds;
 105         def->kindCount  = KIND_COUNT (SchemeKinds);
 106         def->extensions = extensions;
 107         def->parser     = findSchemeTags;
 108         return def;
 109 }
 110
 111 /* vi:set tabstop=4 shiftwidth=4: */