1 /*
2 * Copyright (c) 2000-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 LISP files.
8 */
9
10 /*
11 * INCLUDE FILES
12 */
13 #include "general.h" /* must always come first */
14
15 #include "parse.h"
16 #include "read.h"
17 #include "routines.h"
18 #include "selectors.h"
19 #include "vstring.h"
20
21 #include <string.h>
22
23 /*
24 * DATA DEFINITIONS
25 */
26 typedef enum {
27 K_UNKNOWN,
28 K_FUNCTION,
29 K_VARIABLE,
30 K_MACRO,
31 K_CONST,
32 } lispKind;
33
34 static kindDefinition LispKinds [] = {
35 { true, 'u', "unknown", "unknown type of definitions" },
36 { true, 'f', "function", "functions" },
37 { true, 'v', "variable", "variables" },
38 { true, 'm', "macro", "macros" },
39 { true, 'c', "const", "constants" },
40 };
41
42 typedef enum {
43 eK_UNKNOWN,
44 eK_FUNCTION,
45 eK_VARIABLE,
46 eK_CONST,
47 eK_MACRO,
48 eK_ALIAS,
49 eK_VARALIAS,
50 eK_SUBST,
51 eK_INLINE,
52 eK_ERROR,
53 eK_MINOR_MODE,
54 eK_DERIVED_MODE,
55 /* custom.el */
56 eK_CUSTOM,
57 eK_GROUP,
58 eK_FACE,
59 eK_THEME,
60 } emacsLispKind;
61
62 /* Following macro/builtin doesn't define a name appeared
63 * at car. So this parser doesn't handle it well.
64 * -----------------------------------------------------
65 * defadvice (=> cadadr)
66 * defconst-mode-local (=> cadr)
67 * defvar-mode-local (=> cadr)
68 */
69 static kindDefinition EmacsLispKinds [] = {
70 { true, 'u', "unknown", "unknown type of definitions" },
71 { true, 'f', "function", "functions" },
72 { true, 'v', "variable", "variables" },
73 { true, 'c', "const", "constants" },
74 { true, 'm', "macro", "macros" },
75 { true, 'a', "alias", "aliases for functions" },
76 { true, 'V', "varalias", "aliases for variables" },
77 { true, 's', "subst", "inline function" },
78 { true, 'i', "inline", "inline function" },
79 { true, 'e', "error", "errors" },
80 { true, 'M', "minorMode", "minor modes" },
81 { true, 'D', "derivedMode", "derived major mode" },
82 /* custom.el */
83 { true, 'C', "custom", "customizable variables" },
84 { true, 'G', "group", "customization groups" },
85 { true, 'H', "face", "customizable faces" }, /* 'F' is reserved by ctags */
86 { true, 'T', "theme", "custom themes" },
87 };
88
89 /*
90 * FUNCTION DEFINITIONS
91 */
92
93 /*
94 * lisp tag functions
95 * look for (def or (DEF, quote or QUOTE
96 */
L_isdef(const unsigned char * strp,bool case_insensitive)97 static int L_isdef (const unsigned char *strp, bool case_insensitive)
98 {
99 bool cis = case_insensitive; /* Renaming for making code short */
100
101 return ( (strp [1] == 'd' || (cis && strp [1] == 'D'))
102 && (strp [2] == 'e' || (cis && strp [2] == 'E'))
103 && (strp [3] == 'f' || (cis && strp [3] == 'F')));
104 }
105
L_isquote(const unsigned char * strp,bool case_insensitive)106 static int L_isquote (const unsigned char *strp, bool case_insensitive)
107 {
108 bool cis = case_insensitive; /* Renaming for making code short */
109
110 return ( (*(++strp) == 'q' || (cis && *strp == 'Q'))
111 && (*(++strp) == 'u' || (cis && *strp == 'U'))
112 && (*(++strp) == 'o' || (cis && *strp == 'O'))
113 && (*(++strp) == 't' || (cis && *strp == 'T'))
114 && (*(++strp) == 'e' || (cis && *strp == 'E'))
115 && isspace (*(++strp)));
116 }
117
lisp_hint2kind(const vString * const hint)118 static int lisp_hint2kind (const vString *const hint)
119 {
120 int k = K_UNKNOWN;
121 int n;
122
123 /* 4 means strlen("(def"). */
124 #define EQN(X) strncmp(vStringValue (hint) + 4, &X[3], n) == 0
125 switch (vStringLength (hint) - 4)
126 {
127 case 2:
128 n = 2;
129 if (EQN("DEFUN"))
130 k = K_FUNCTION;
131 break;
132 case 3:
133 n = 3;
134 if (EQN("DEFVAR"))
135 k = K_VARIABLE;
136 break;
137 case 5:
138 n = 5;
139 if (EQN("DEFMACRO"))
140 k = K_MACRO;
141 break;
142 case 8:
143 n = 8;
144 if (EQN("DEFCONSTANT"))
145 k = K_CONST;
146 break;
147 }
148 #undef EQN
149 return k;
150 }
151
152 /* TODO: implement this in hashtable. */
elisp_hint2kind(const vString * const hint)153 static int elisp_hint2kind (const vString *const hint)
154 {
155 int k = eK_UNKNOWN;
156 int n;
157
158 /* 4 means strlen("(def"). */
159 #define EQN(X) strncmp(vStringValue (hint) + 4, &X[3], n) == 0
160 switch (vStringLength (hint) - 4)
161 {
162 case 2:
163 n = 2;
164 if (EQN("defun"))
165 k = eK_FUNCTION;
166 break;
167 case 3:
168 n = 3;
169 if (EQN("defvar"))
170 k = eK_VARIABLE;
171 else if (EQN("defun*"))
172 k = eK_FUNCTION;
173 break;
174 case 4:
175 n = 4;
176 if (EQN("defface"))
177 k = eK_FACE;
178 case 5:
179 n = 5;
180 if (EQN("defconst"))
181 k = eK_CONST;
182 else if (EQN("defmacro"))
183 k = eK_MACRO;
184 else if (EQN("defalias"))
185 k = eK_ALIAS;
186 else if (EQN("defsubst"))
187 k = eK_SUBST;
188 else if (EQN("defgroup"))
189 k = eK_GROUP;
190 else if (EQN("deftheme"))
191 k = eK_THEME;
192 break;
193 case 6:
194 n = 6;
195 if (EQN("defcustom"))
196 k = eK_CUSTOM;
197 else if (EQN("defsubst*"))
198 k = eK_SUBST;
199 else if (EQN("defmacro*"))
200 k = eK_MACRO;
201 break;
202 case 7:
203 n = 7;
204 if (EQN("define-key"))
205 k = KIND_GHOST_INDEX;
206 break;
207 case 9:
208 n = 9;
209 if (EQN("defvar-local"))
210 k = eK_VARIABLE;
211 else if (EQN("define-error"))
212 k = eK_ERROR;
213 break;
214 case 8:
215 n = 8;
216 if (EQN("defvaralias"))
217 k = eK_VARALIAS;
218 break;
219 case 10:
220 n = 10;
221 if (EQN("define-inline"))
222 k = eK_INLINE;
223 break;
224 case 14:
225 n = 14;
226 if (EQN("define-minor-mode"))
227 k = eK_MINOR_MODE;
228 break;
229 case 16:
230 n = 16;
231 if (EQN("define-derived-mode"))
232 k = eK_DERIVED_MODE;
233 break;
234 case 21:
235 n = 21;
236 if (EQN("define-global-minor-mode"))
237 k = eK_MINOR_MODE;
238 break;
239 case 25:
240 n = 25;
241 if (EQN("define-globalized-minor-mode"))
242 k = eK_MINOR_MODE;
243 break;
244 case 27:
245 n = 27;
246 if (EQN("define-obsolete-function-alias"))
247 k = eK_ALIAS;
248 break;
249 }
250 #undef EQN
251 return k;
252 }
253
L_getit(vString * const name,const unsigned char * dbp,bool case_insensitive,int (* hint2kind)(const vString *),const vString * const kind_hint)254 static void L_getit (vString *const name, const unsigned char *dbp,
255 bool case_insensitive,
256 int (*hint2kind) (const vString *),
257 const vString *const kind_hint)
258 {
259 const unsigned char *p;
260
261 if (*dbp == '\'') /* Skip prefix quote */
262 dbp++;
263 else if (*dbp == '(' && L_isquote (dbp, case_insensitive)) /* Skip "(quote " */
264 {
265 dbp += 7;
266 while (isspace (*dbp))
267 dbp++;
268 }
269 for (p=dbp ; *p!='\0' && *p!='(' && !isspace ((int) *p) && *p!=')' ; p++)
270 vStringPut (name, *p);
271
272 if (vStringLength (name) > 0)
273 {
274 int kind = hint2kind (kind_hint);
275 if (kind != KIND_GHOST_INDEX)
276 makeSimpleTag (name, kind);
277 }
278 vStringClear (name);
279 }
280
281 /* Algorithm adapted from from GNU etags.
282 */
findLispTagsCommon(bool case_insensitive,bool has_namespace,int (* hint2kind)(const vString *))283 static void findLispTagsCommon (bool case_insensitive,
284 bool has_namespace,
285 int (*hint2kind) (const vString *))
286 {
287 vString *name = vStringNew ();
288 vString *kind_hint = vStringNew ();
289 const unsigned char* p;
290
291
292 while ((p = readLineFromInputFile ()) != NULL)
293 {
294 if (*p == '(')
295 {
296 if (L_isdef (p, case_insensitive))
297 {
298 vStringClear (kind_hint);
299 while (*p != '\0' && !isspace ((int) *p))
300 {
301 vStringPut (kind_hint,
302 case_insensitive? toupper((int)*p): *p);
303 p++;
304 }
305 while (isspace ((int) *p))
306 p++;
307 L_getit (name, p, case_insensitive, hint2kind, kind_hint);
308 }
309 else if (has_namespace)
310 {
311 do
312 p++;
313 while (*p != '\0' && !isspace ((int) *p)
314 && *p != ':' && *p != '(' && *p != ')');
315 if (*p == ':')
316 {
317 do
318 p++;
319 while (*p == ':');
320
321 if (L_isdef (p - 1, case_insensitive))
322 {
323 vStringClear (kind_hint);
324 while (*p != '\0' && !isspace ((int) *p))
325 {
326 vStringPut (kind_hint,
327 case_insensitive? toupper((int)*p): *p);
328 p++;
329 }
330 while (isspace (*p))
331 p++;
332 L_getit (name, p, case_insensitive, hint2kind, kind_hint);
333 }
334 }
335 }
336 }
337 }
338 vStringDelete (name);
339 vStringDelete (kind_hint);
340 }
341
findLispTags(void)342 static void findLispTags (void)
343 {
344 findLispTagsCommon (true, true, lisp_hint2kind);
345 }
346
findEmacsLispTags(void)347 static void findEmacsLispTags (void)
348 {
349 findLispTagsCommon (false, false, elisp_hint2kind);
350 }
351
LispParser(void)352 extern parserDefinition* LispParser (void)
353 {
354 static const char *const extensions [] = {
355 "cl", "clisp", "l", "lisp", "lsp", NULL
356 };
357 static const char *const aliases [] = {
358 "clisp", NULL
359 };
360
361 static selectLanguage selectors[] = { selectLispOrLEXByLEXMarker, NULL };
362
363 parserDefinition* def = parserNew ("Lisp");
364 def->kindTable = LispKinds;
365 def->kindCount = ARRAY_SIZE (LispKinds);
366 def->extensions = extensions;
367 def->aliases = aliases;
368 def->parser = findLispTags;
369 def->selectLanguage = selectors;
370 return def;
371 }
372
EmacsLispParser(void)373 extern parserDefinition* EmacsLispParser (void)
374 {
375 static const char *const extensions [] = {
376 "el", NULL
377 };
378 static const char *const aliases [] = {
379 "emacs-lisp", NULL
380 };
381
382 parserDefinition* def = parserNew ("EmacsLisp");
383 def->kindTable = EmacsLispKinds;
384 def->kindCount = ARRAY_SIZE (EmacsLispKinds);
385 def->extensions = extensions;
386 def->aliases = aliases;
387 def->parser = findEmacsLispTags;
388 return def;
389 }
390