Category: | Miscellaneous |
Author/Contact Info | Dmitri |
Description: | This patch adds several nice features to ctags' support of Perl. More are likely to come. Summary:
New feature support in perl parser:
- support for 'use constant ABC => "xyz";' construct (ABC tag is created); - support for label constructs: EXIT: will produce a tag for EXIT; - support for full (package name + name) tags for constants and subroutines: package ABC::XYZ; sub hello { # will create tags # 'ABC::XYZ::hello' # and 'hello', in case hello is # called in the first way. } Update: Now patch is provided instead of a link to it. Update 2: This node 444294 provides a newer patch against ctags 5.5.4. |
--- ctags-5.5.2/perl.c Mon Mar 31 23:55:27 2003 +++ ctags-5.5.2-mod/perl.c Wed Jan 14 16:08:41 2004 @@ -15,6 +15,7 @@ */ #include "general.h" /* must always come first */ +#include <ctype.h> #include <string.h> #include "read.h" @@ -25,14 +26,26 @@ */ typedef enum { K_SUBROUTINE, - K_PACKAGE + K_PACKAGE, + K_CONSTANT, + K_LABEL, } perlKind; static kindOption PerlKinds [] = { { TRUE, 's', "subroutine", "subroutines" }, - { TRUE, 'p', "package", "packages" } + { TRUE, 'p', "package", "packages" }, + { TRUE, 'c', "constant", "constants" }, + { TRUE, 'l', "label", "labels" }, }; +static struct { + char str[1024]; + int set; +} package = { "", 0 }; + +#define NOLABEL_STR "{(;=" +#define LABEL_STR ":" + /* * FUNCTION DEFINITIONS */ @@ -48,9 +61,12 @@ const unsigned char *line; perlKind kind; + package.set = 0; + while ((line = fileReadLine ()) != NULL) { - const unsigned char *cp = line; + const unsigned char *cp = line, *aux; + int sub = 0, use = 0, lbl = 0; /* This will save up strcmps +later */ if (skipPodDoc) { @@ -74,31 +90,77 @@ while (isspace (*cp)) cp++; - if (strncmp((const char*) cp, "sub", (size_t) 3) == 0 || + /* Try to find a label here */ + for (aux = cp; *aux && isalnum(*aux); ++aux) + ; + if (aux > cp) { + while (isspace(*aux)) + ++aux; + if (':' == *aux && (aux[1] ? ':' != aux[1] : 1)) + lbl = 1; + } + + if (lbl + || + (strncmp((const char*) cp, "sub", (size_t) 3) == 0 && (su +b = 1)) || + (strncmp((const char*) cp, "use", (size_t) 3) == 0 && (us +e = 1)) || strncmp((const char*) cp, "package", (size_t) 7) == 0) { - if (strncmp((const char*) cp, "sub", (size_t) 3) == 0) + if (sub) { cp += 3; kind = K_SUBROUTINE; + } else if (use) { + cp += 3; + if (!isspace(*cp)) + continue; + while (*cp && isspace(*cp)) + ++cp; + if (0 != strncmp((const char*) cp, "constant", (size_ +t) 8)) { + cp += 8; + continue; + } + cp += 8; + kind = K_CONSTANT; + } else if (lbl) { + kind = K_LABEL; } else { cp += 7; kind = K_PACKAGE; } - if (!isspace(*cp)) /* woops, not followed by a space * +/ + + /* This check is only performed if not a label */ + if (!(lbl || isspace(*cp))) /* woops, not followed by a s +pace */ continue; while (isspace (*cp)) cp++; while (! isspace ((int) *cp) && *cp != '\0' && - strchr ("{(;", (int) *cp) == NULL) + strchr ((lbl ? LABEL_STR : NOLABEL_STR), (int) *cp +) == NULL) { vStringPut (name, (int) *cp); cp++; } vStringTerminate (name); - if (vStringLength (name) > 0) + + if (vStringLength (name) > 0) { makeSimpleTag (name, PerlKinds, kind); + if (K_PACKAGE == kind && + vStringLength(name) < sizeof(package.str)) + { + strcpy(package.str, vStringValue(name)); + package.set = 1; + } else if ((K_SUBROUTINE == kind || K_CONSTANT == kin +d) + && package.set) + { + vString *fname = vStringNew(); + vStringCatS(fname, package.str); + vStringCatS(fname, "::"); + vStringCatS(fname, vStringValue(name)); + makeSimpleTag(fname, PerlKinds, kind); + vStringDelete(fname); + } + } + vStringClear (name); } } |
Back to
Code Catacombs