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
createPascalTag(tagEntryInfo * const tag,const vString * const name,const int kind)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
makePascalTag(const tagEntryInfo * const tag)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
tail(const char * cp)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 */
findPascalTags(void)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
PascalParser(void)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: */
268