ctags/parsers/lisp.c

   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, 'Y', "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, 'Y', "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  */
  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
 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
 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. */
 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
 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 (*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  */
 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 (*p))
 300                                 {
 301                                         vStringPut (kind_hint,
 302                                                                 case_insensitive? toupper(*p): *p);
 303                                         p++;
 304                                 }
 305                                 while (isspace (*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 (*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 (*p))
 325                                                 {
 326                                                         vStringPut (kind_hint,
 327                                                                                 case_insensitive? toupper(*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
 342 static void findLispTags (void)
 343 {
 344         findLispTagsCommon (true, true, lisp_hint2kind);
 345 }
 346
 347 static void findEmacsLispTags (void)
 348 {
 349         findLispTagsCommon (false, false, elisp_hint2kind);
 350 }
 351
 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
 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 }