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 */
readIdentifier(vString * const name,const unsigned char * cp)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
findSchemeTags(void)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
SchemeParser(void)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: */
112