diff --git a/Tmain/list-fields-with-prefix.d/stdout-expected.txt b/Tmain/list-fields-with-prefix.d/stdout-expected.txt index 798fe68062..838c1d1be8 100644 --- a/Tmain/list-fields-with-prefix.d/stdout-expected.txt +++ b/Tmain/list-fields-with-prefix.d/stdout-expected.txt @@ -48,6 +48,7 @@ x UCTAGSxpath no NONE s-- no -- xpath for - UCTAGSoverline no ReStructuredText --b no -- whether using overline & underline for declaring section - UCTAGSsectionMarker no ReStructuredText s-- no -- character used for declaring section - UCTAGSmixin yes Ruby s-- no -- how the class or module is mixed in (mixin:HOW:MODULE) +- UCTAGSdefiner yes Scheme s-- no -- the name of the function or macro that defines the unknown/Y-kind object - UCTAGSparameter no SystemVerilog --b no -- parameter whose value can be overridden. - UCTAGStarget yes Thrift s-- no -- the target language specified at "namespace" - UCTAGSthrows yes Thrift s-- no -- throws list of function diff --git a/Tmain/list-fields.d/stdout-expected.txt b/Tmain/list-fields.d/stdout-expected.txt index 57b0503ab3..fb4587a956 100644 --- a/Tmain/list-fields.d/stdout-expected.txt +++ b/Tmain/list-fields.d/stdout-expected.txt @@ -66,6 +66,7 @@ z kind no NONE s-- no r- [tags output] prepend "kind:" to k/ (or K/) field outpu - overline no ReStructuredText --b no -- whether using overline & underline for declaring section - sectionMarker no ReStructuredText s-- no -- character used for declaring section - mixin yes Ruby s-- no -- how the class or module is mixed in (mixin:HOW:MODULE) +- definer yes Scheme s-- no -- the name of the function or macro that defines the unknown/Y-kind object - parameter no SystemVerilog --b no -- parameter whose value can be overridden. - target yes Thrift s-- no -- the target language specified at "namespace" - throws yes Thrift s-- no -- throws list of function diff --git a/Units/option-regex-attaching-role.r/extending-existing-parser.d/expected.tags b/Units/option-regex-attaching-role.r/extending-existing-parser.d/expected.tags index 826d229a40..a22b6d2f79 100644 --- a/Units/option-regex-attaching-role.r/extending-existing-parser.d/expected.tags +++ b/Units/option-regex-attaching-role.r/extending-existing-parser.d/expected.tags @@ -1,4 +1,4 @@ -foo input.scm /^(define-module foo$/;" function language:Scheme roles:def +foo input.scm /^(define-module foo$/;" unknown language:Scheme roles:def definer:DEFINE-MODULE foobar input.scm /^(define (foobar)$/;" function language:Scheme roles:def foo input.scm /^(define-module foo$/;" module language:myGauche roles:def bar input.scm /^ (use bar)$/;" module language:myGauche scope:module:foo roles:used diff --git a/docs/man-pages.rst b/docs/man-pages.rst index 21d4905db3..cb4d292998 100644 --- a/docs/man-pages.rst +++ b/docs/man-pages.rst @@ -21,6 +21,7 @@ Man pages ctags-lang-automake(7) ctags-lang-c(7) ctags-lang-c++(7) + ctags-lang-clojure(7) ctags-lang-cuda(7) ctags-lang-elm(7) ctags-lang-emacslisp(7) @@ -41,6 +42,7 @@ Man pages ctags-lang-python(7) ctags-lang-r(7) ctags-lang-rmarkdown(7) + ctags-lang-scheme(7) ctags-lang-scss(7) ctags-lang-sql(7) ctags-lang-systemtap(7) diff --git a/docs/man/ctags-lang-clojure.7.rst b/docs/man/ctags-lang-clojure.7.rst new file mode 100644 index 0000000000..88217fa8b6 --- /dev/null +++ b/docs/man/ctags-lang-clojure.7.rst @@ -0,0 +1,37 @@ +.. _ctags-lang-clojure(7): + +============================================================== +ctags-lang-clojure +============================================================== + +Random notes about tagging Clojure source code with Universal Ctags + +:Version: 6.1.0 +:Manual group: Universal Ctags +:Manual section: 7 + +SYNOPSIS +-------- +| **ctags** ... --languages=+Clojure ... +| **ctags** ... --language-force=Clojure ... +| **ctags** ... --map-Clojure=+.clj ... +| **ctags** ... --map-Clojure=+.cljs ... +| **ctags** ... --map-Clojure=+.cljc ... + +DESCRIPTION +----------- +This man page gathers random notes about tagging Clojure source code. + +VERSIONS +-------- + +Change since "0.0" +~~~~~~~~~~~~~~~~~~ + +* Add ``unknown`` kind. + +* Add ``definer`` field. + +SEE ALSO +-------- +:ref:`ctags(1) ` diff --git a/docs/man/ctags-lang-scheme.7.rst b/docs/man/ctags-lang-scheme.7.rst new file mode 100644 index 0000000000..091088b42a --- /dev/null +++ b/docs/man/ctags-lang-scheme.7.rst @@ -0,0 +1,41 @@ +.. _ctags-lang-scheme(7): + +============================================================== +ctags-lang-scheme +============================================================== + +Random notes about tagging Scheme source code with Universal Ctags + +:Version: 6.1.0 +:Manual group: Universal Ctags +:Manual section: 7 + +SYNOPSIS +-------- +| **ctags** ... --languages=+Scheme ... +| **ctags** ... --language-force=Scheme ... +| **ctags** ... --map-Scheme=+.SCM ... +| **ctags** ... --map-Scheme=+.SM ... +| **ctags** ... --map-Scheme=+.sch ... +| **ctags** ... --map-Scheme=+.scheme ... +| **ctags** ... --map-Scheme=+.scm ... +| **ctags** ... --map-Scheme=+.sm ... +| **ctags** ... --map-Scheme=+.rkt ... + +DESCRIPTION +----------- +This man page gathers random notes about tagging Scheme source code. + +VERSIONS +-------- + +Change since "0.0" +~~~~~~~~~~~~~~~~~~ + +* Add ``unknown`` kind. + +* Add ``definer`` field. + +SEE ALSO +-------- +:ref:`ctags(1) ` diff --git a/man/GNUmakefile.am b/man/GNUmakefile.am index d04b64dfbc..0587b0eb4f 100644 --- a/man/GNUmakefile.am +++ b/man/GNUmakefile.am @@ -32,6 +32,7 @@ GEN_IN_MAN_FILES = \ ctags-lang-automake.7 \ ctags-lang-c.7 \ ctags-lang-c++.7 \ + ctags-lang-clojure.7 \ ctags-lang-cuda.7 \ ctags-lang-elm.7 \ ctags-lang-emacslisp.7 \ @@ -52,6 +53,7 @@ GEN_IN_MAN_FILES = \ ctags-lang-python.7 \ ctags-lang-r.7 \ ctags-lang-rmarkdown.7 \ + ctags-lang-scheme.7 \ ctags-lang-scss.7 \ ctags-lang-sql.7 \ ctags-lang-systemtap.7 \ diff --git a/man/ctags-lang-clojure.7.rst.in b/man/ctags-lang-clojure.7.rst.in new file mode 100644 index 0000000000..bbf5a214f3 --- /dev/null +++ b/man/ctags-lang-clojure.7.rst.in @@ -0,0 +1,37 @@ +.. _ctags-lang-clojure(7): + +============================================================== +ctags-lang-clojure +============================================================== +--------------------------------------------------------------------- +Random notes about tagging Clojure source code with Universal Ctags +--------------------------------------------------------------------- +:Version: @VERSION@ +:Manual group: Universal Ctags +:Manual section: 7 + +SYNOPSIS +-------- +| **@CTAGS_NAME_EXECUTABLE@** ... --languages=+Clojure ... +| **@CTAGS_NAME_EXECUTABLE@** ... --language-force=Clojure ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Clojure=+.clj ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Clojure=+.cljs ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Clojure=+.cljc ... + +DESCRIPTION +----------- +This man page gathers random notes about tagging Clojure source code. + +VERSIONS +-------- + +Change since "0.0" +~~~~~~~~~~~~~~~~~~ + +* Add ``unknown`` kind. + +* Add ``definer`` field. + +SEE ALSO +-------- +ctags(1) diff --git a/man/ctags-lang-scheme.7.rst.in b/man/ctags-lang-scheme.7.rst.in new file mode 100644 index 0000000000..45c5098285 --- /dev/null +++ b/man/ctags-lang-scheme.7.rst.in @@ -0,0 +1,41 @@ +.. _ctags-lang-scheme(7): + +============================================================== +ctags-lang-scheme +============================================================== +--------------------------------------------------------------------- +Random notes about tagging Scheme source code with Universal Ctags +--------------------------------------------------------------------- +:Version: @VERSION@ +:Manual group: Universal Ctags +:Manual section: 7 + +SYNOPSIS +-------- +| **@CTAGS_NAME_EXECUTABLE@** ... --languages=+Scheme ... +| **@CTAGS_NAME_EXECUTABLE@** ... --language-force=Scheme ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.SCM ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.SM ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.sch ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.scheme ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.scm ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.sm ... +| **@CTAGS_NAME_EXECUTABLE@** ... --map-Scheme=+.rkt ... + +DESCRIPTION +----------- +This man page gathers random notes about tagging Scheme source code. + +VERSIONS +-------- + +Change since "0.0" +~~~~~~~~~~~~~~~~~~ + +* Add ``unknown`` kind. + +* Add ``definer`` field. + +SEE ALSO +-------- +ctags(1) diff --git a/parsers/clojure.c b/parsers/clojure.c index d404bb7524..5563d98df2 100644 --- a/parsers/clojure.c +++ b/parsers/clojure.c @@ -7,74 +7,88 @@ * This module contains code for generating tags for the Clojure language. */ -#include "general.h" -#include +/* +* INCLUDE FILES +*/ +#include "general.h" /* must always come first */ -#include "parse.h" -#include "read.h" -#include "routines.h" -#include "vstring.h" #include "entry.h" +#include "parse.h" + +#include "x-lisp.h" + +#include +#include +/* +* DATA DEFINITIONS +*/ typedef enum { + K_UNKNOWN, K_FUNCTION, K_NAMESPACE } clojureKind; +typedef enum { + F_DEFINER, +} clojureField; + +static fieldDefinition ClojureFields[] = { + { .name = "definer", + .description = "the name of the function or macro that defines the unknown/Y-kind object", + .enabled = true }, +}; + static kindDefinition ClojureKinds[] = { - {true, 'f', "function", "functions"}, - {true, 'n', "namespace", "namespaces"} + { true, 'Y', "unknown", "unknown type of definitions" }, + { true, 'f', "function", "functions" }, + { true, 'n', "namespace", "namespaces" }, }; -static int isNamespace (const char *strp) +/* +* FUNCTION DEFINITIONS +*/ +static bool clojure_is_def (struct lispDialect *dialect CTAGS_ATTR_UNUSED, const unsigned char *strp) { - return strncmp (++strp, "ns", 2) == 0 && isspace ((unsigned char) strp[2]); -} + if (strp [1] == 'n' && strp [2] == 's' && isspace (strp [3])) + return true; -static int isCoreNamespace (const char *strp) -{ - return strncmp (++strp, "clojure.core/ns", 15) == 0 && - isspace ((unsigned char) strp[15]); -} + if (strp [1] == 'd' && strp [2] == 'e' && strp [3] == 'f' && strp [4] == 'n' + && isspace (strp [5])) + return true; -static int isFunction (const char *strp) -{ - return (strncmp (++strp, "defn", 4) == 0 && - isspace ((unsigned char) strp[4])); + return false; } -static int isCoreFunction (const char *strp) +static int clojure_hint2kind (const vString *const hint, const char *namespace) { - return (strncmp (++strp, "clojure.core/defn", 17) == 0 && - isspace ((unsigned char) strp[17])); -} + int k = K_UNKNOWN; + int n = vStringLength (hint) - 4; + unsigned int offset = 1; -static int isQuote (const char *strp) -{ - return strncmp (++strp, "quote", 5) == 0 && - isspace ((unsigned char) strp[5]); -} + if (strcmp (namespace, "clojure.core/") == 0) + { + offset = 0; + n++; + } -static void functionName (vString * const name, const char *dbp) -{ - const char *p; + if (strncmp (vStringValue (hint) + offset, "ns", 2) == 0) + return K_NAMESPACE; - if (*dbp == '\'') - dbp++; - else if (*dbp == '(' && isQuote (dbp)) +#define EQN(X) strncmp(vStringValue (hint) + offset + 3, &X[3], n) == 0 + switch (n) { - dbp += 7; - while (isspace ((unsigned char) *dbp)) - dbp++; + case 1: + if (EQN("defn")) + k = K_FUNCTION; + break; } - - for (p = dbp; *p != '\0' && *p != '(' && !isspace ((unsigned char) *p) - && *p != ')'; p++) - vStringPut (name, *p); +#undef EQN + return k; } -const char* skipMetadata (const char *dbp) +const unsigned char* clojure_skip_metadata (const unsigned char *dbp) { while (1) { @@ -108,65 +122,40 @@ const char* skipMetadata (const char *dbp) return dbp; } -static int makeNamespaceTag (vString * const name, const char *dbp) +static int clojure_get_it (struct lispDialect *dialect, + vString *const name, const unsigned char *dbp, vString *kind_hint, + const char *namespace) { - dbp = skipMetadata (dbp); - functionName (name, dbp); - if (vStringLength (name) > 0 && ClojureKinds[K_NAMESPACE].enabled) - return makeSimpleTag (name, K_NAMESPACE); - else + dbp = clojure_skip_metadata (dbp); + int index = lispGetIt (dialect, name, dbp, kind_hint, namespace); + tagEntryInfo *e = getEntryInCorkQueue (index); + + if (!e) return CORK_NIL; -} -static void makeFunctionTag (vString * const name, const char *dbp, int scope_index) -{ - dbp = skipMetadata (dbp); - functionName (name, dbp); - if (vStringLength (name) > 0 && ClojureKinds[K_FUNCTION].enabled) - { - tagEntryInfo e; - initTagEntry (&e, vStringValue (name), K_FUNCTION); - e.extensionFields.scopeIndex = scope_index; - makeTagEntry (&e); - } -} + if (e->kindIndex == K_NAMESPACE) + dialect->scope = index; + else + e->extensionFields.scopeIndex = dialect->scope; -static void skipToSymbol (const char **p) -{ - while (**p != '\0' && !isspace ((unsigned char) **p)) - *p = *p + 1; - while (isspace ((unsigned char) **p)) - *p = *p + 1; + return index; } static void findClojureTags (void) { - vString *name = vStringNew (); - const char *p; - int scope_index = CORK_NIL; - - while ((p = (char *)readLineFromInputFile ()) != NULL) - { - vStringClear (name); - - while (isspace ((unsigned char) *p)) - p++; + struct lispDialect clojure_dialect = { + .definer2kind = clojure_hint2kind, + .case_insensitive = false, + .namespace_sep = '/', + .unknown_kind = K_UNKNOWN, + .definer_field = ClojureFields + F_DEFINER, + .skip_initial_spaces = true, + .is_def = clojure_is_def, + .get_it = clojure_get_it, + .scope = CORK_NIL, + }; - if (*p == '(') - { - if (isNamespace (p) || isCoreNamespace (p)) - { - skipToSymbol (&p); - scope_index = makeNamespaceTag (name, p); - } - else if (isFunction (p) || isCoreFunction (p)) - { - skipToSymbol (&p); - makeFunctionTag (name, p, scope_index); - } - } - } - vStringDelete (name); + findLispTagsCommon (&clojure_dialect); } extern parserDefinition *ClojureParser (void) @@ -185,5 +174,7 @@ extern parserDefinition *ClojureParser (void) def->aliases = aliases; def->parser = findClojureTags; def->useCork = CORK_QUEUE; + def->versionCurrent = 0; + def->versionAge = 1; return def; } diff --git a/parsers/lisp.c b/parsers/lisp.c index e3e2e79e96..baf8088139 100644 --- a/parsers/lisp.c +++ b/parsers/lisp.c @@ -18,13 +18,14 @@ #include "general.h" /* must always come first */ #include "entry.h" -#include "field.h" #include "parse.h" #include "read.h" #include "routines.h" #include "selectors.h" #include "vstring.h" +#include "x-lisp.h" + #include /* @@ -125,12 +126,6 @@ static kindDefinition EmacsLispKinds [] = { { true, 'T', "theme", "custom themes" }, }; -struct lispDialect { - int (* definer2kind) (const vString *const hint); - int unknown_kind; - fieldDefinition *definer_field; -}; - /* * FUNCTION DEFINITIONS */ @@ -139,9 +134,9 @@ struct lispDialect { * lisp tag functions * look for (def or (DEF, quote or QUOTE */ -static int L_isdef (const unsigned char *strp, bool case_insensitive) +bool lispIsDef (struct lispDialect *dialect, const unsigned char *strp) { - bool cis = case_insensitive; /* Renaming for making code short */ + bool cis = dialect->case_insensitive; /* Renaming for making code short */ bool is_def = ( (strp [1] == 'd' || (cis && strp [1] == 'D')) && (strp [2] == 'e' || (cis && strp [2] == 'E')) && (strp [3] == 'f' || (cis && strp [3] == 'F'))); @@ -191,7 +186,7 @@ static int L_issetf (const unsigned char *strp, bool case_insensitive) && isspace (*(++strp))); } -static int lisp_hint2kind (const vString *const hint) +static int lisp_hint2kind (const vString *const hint, const char *namespace CTAGS_ATTR_UNUSED) { int k = K_UNKNOWN; int n = vStringLength (hint) - 4; @@ -242,7 +237,7 @@ static int lisp_hint2kind (const vString *const hint) } /* TODO: implement this in hashtable. */ -static int elisp_hint2kind (const vString *const hint) +static int elisp_hint2kind (const vString *const hint, const char *namespace CTAGS_ATTR_UNUSED) { int k = eK_UNKNOWN; int n = vStringLength (hint) - 4; @@ -329,22 +324,22 @@ static int elisp_hint2kind (const vString *const hint) return k; } -static void L_getit (vString *const name, const unsigned char *dbp, - bool case_insensitive, - struct lispDialect *dialect, - vString *kind_hint) + int lispGetIt (struct lispDialect *dialect, + vString *const name, const unsigned char *dbp, vString *kind_hint, + const char *namespace) { + int index = CORK_NIL; const unsigned char *p; if (*dbp == '\'') /* Skip prefix quote */ dbp++; - else if (*dbp == '(' && L_isquote (dbp, case_insensitive)) /* Skip "(quote " */ + else if (*dbp == '(' && L_isquote (dbp, dialect->case_insensitive)) /* Skip "(quote " */ { dbp += 7; while (isspace (*dbp)) dbp++; } - else if (*dbp == '(' && L_issetf (dbp, case_insensitive)) /* Skip "(setf " */ + else if (*dbp == '(' && L_issetf (dbp, dialect->case_insensitive)) /* Skip "(setf " */ { dbp += 6; while (isspace (*dbp)) @@ -355,7 +350,7 @@ static void L_getit (vString *const name, const unsigned char *dbp, if (vStringLength (name) > 0) { - int kind = dialect->definer2kind(kind_hint); + int kind = dialect->definer2kind(kind_hint, namespace); const char *definer = NULL; if (kind == dialect->unknown_kind) @@ -367,69 +362,107 @@ static void L_getit (vString *const name, const unsigned char *dbp, if (kind != KIND_GHOST_INDEX) { - int index = makeSimpleTag (name, kind); + index = makeSimpleTag (name, kind); if (dialect->definer_field && dialect->definer_field->enabled && definer && index != CORK_NIL) attachParserFieldToCorkEntry (index, dialect->definer_field->ftype, definer); } } vStringClear (name); + + return index; } /* Algorithm adapted from from GNU etags. */ -static void findLispTagsCommon (bool case_insensitive, - bool has_namespace, - struct lispDialect *dialect) +void findLispTagsCommon (struct lispDialect *dialect) { vString *name = vStringNew (); vString *kind_hint = vStringNew (); - const unsigned char* p; - + const unsigned char* line; - while ((p = readLineFromInputFile ()) != NULL) + while ((line = readLineFromInputFile ()) != NULL) { + const unsigned char *p = line; + + if (dialect->skip_initial_spaces) + { + while (isspace ((unsigned char) *p)) + p++; + } + if (*p == '(') { - if (L_isdef (p, case_insensitive)) + if (dialect->is_def (dialect, p)) { vStringClear (kind_hint); while (*p != '\0' && !isspace (*p)) { vStringPut (kind_hint, - case_insensitive? toupper(*p): *p); + dialect->case_insensitive? toupper(*p): *p); p++; } - while (isspace (*p)) - p++; - L_getit (name, p, case_insensitive, dialect, kind_hint); + + + if (dialect->lambda_syntax_sugar) + { + /* Skip over open parens and white space: + (def ((foo + -----^^ + */ + do { + while (*p != '\0' && (isspace (*p) || *p == '(')) + p++; + if (*p == '\0') + p = line = readLineFromInputFile (); + else + break; + } while (line); + if (line == NULL) + break; + } + else + { + while (isspace (*p)) + p++; + } + dialect->get_it(dialect, name, p, kind_hint, ""); } - else if (has_namespace) + else if (dialect->namespace_sep != 0) { + vString *namespace = vStringNew(); do + { + if (*p != '(') + vStringPut (namespace, *p); p++; + } while (*p != '\0' && !isspace (*p) - && *p != ':' && *p != '(' && *p != ')'); - if (*p == ':') + && *p != dialect->namespace_sep && *p != '(' && *p != ')'); + if (*p == dialect->namespace_sep) { do + { + vStringPut (namespace, *p); p++; - while (*p == ':'); + } + while (*p == dialect->namespace_sep); - if (L_isdef (p - 1, case_insensitive)) + if (dialect->is_def (dialect, p - 1)) { vStringClear (kind_hint); while (*p != '\0' && !isspace (*p)) { vStringPut (kind_hint, - case_insensitive? toupper(*p): *p); + dialect->case_insensitive? toupper(*p): *p); p++; } while (isspace (*p)) p++; - L_getit (name, p, case_insensitive, dialect, kind_hint); + dialect->get_it(dialect, name, p, kind_hint, vStringValue (namespace)); } } + vStringDelete (namespace); } } } @@ -441,24 +474,39 @@ static void findLispTags (void) { struct lispDialect lisp_dialect = { .definer2kind = lisp_hint2kind, + .case_insensitive = true, + .namespace_sep = ':', .unknown_kind = K_UNKNOWN, .definer_field = LispFields + F_DEFINER, + .skip_initial_spaces = false, + .lambda_syntax_sugar = false, + .is_def = lispIsDef, + .get_it = lispGetIt, + .scope = CORK_NIL, }; - findLispTagsCommon (true, true, &lisp_dialect); + findLispTagsCommon (&lisp_dialect); } static void findEmacsLispTags (void) { struct lispDialect elisp_dialect = { .definer2kind = elisp_hint2kind, + .case_insensitive = false, + .namespace_sep = 0, .unknown_kind = eK_UNKNOWN, .definer_field = EmacsLispFields + eF_DEFINER, + .skip_initial_spaces = false, + .lambda_syntax_sugar = false, + .is_def = lispIsDef, + .get_it = lispGetIt, + .scope = CORK_NIL, }; - findLispTagsCommon (false, false, &elisp_dialect); + findLispTagsCommon (&elisp_dialect); } + extern parserDefinition* LispParser (void) { static const char *const extensions [] = { diff --git a/parsers/scheme.c b/parsers/scheme.c index c76de02c6d..f6178e52ba 100644 --- a/parsers/scheme.c +++ b/parsers/scheme.c @@ -13,21 +13,34 @@ */ #include "general.h" /* must always come first */ -#include - +#include "entry.h" #include "parse.h" -#include "read.h" -#include "routines.h" -#include "vstring.h" + +#include "x-lisp.h" + +#include +#include /* * DATA DEFINITIONS */ typedef enum { + K_UNKNOWN, K_FUNCTION, K_SET } schemeKind; +typedef enum { + F_DEFINER, +} schemeField; + +static fieldDefinition SchemeFields[] = { + { .name = "definer", + .description = "the name of the function or macro that defines the unknown/Y-kind object", + .enabled = true }, +}; + static kindDefinition SchemeKinds [] = { + { true, 'Y', "unknown", "unknown type of definitions" }, { true, 'f', "function", "functions" }, { true, 's', "set", "sets" } }; @@ -36,76 +49,60 @@ static kindDefinition SchemeKinds [] = { * FUNCTION DEFINITIONS */ -/* Algorithm adapted from from GNU etags. - * Scheme tag functions - * look for (def... xyzzy - * look for (def... (xyzzy - * look for (def ... ((... (xyzzy .... - * look for (set! xyzzy - */ -static void readIdentifier (vString *const name, const unsigned char *cp) +/* +* FUNCTION DEFINITIONS +*/ +static bool scheme_is_def (struct lispDialect *dialect, const unsigned char *strp) { - const unsigned char *p; - vStringClear (name); - /* Go till you get to white space or a syntactic break */ - for (p = cp; *p != '\0' && *p != '(' && *p != ')' && !isspace (*p); p++) - vStringPut (name, *p); + bool cis = dialect->case_insensitive; /* Renaming for making code short */ + + bool is_set = ( (strp [1] == 's' || (cis && strp [1] == 'S')) + && (strp [2] == 'e' || (cis && strp [2] == 'E')) + && (strp [3] == 't' || (cis && strp [3] == 'T')) + && (strp [4] == '!')); + if (is_set) + return true; + + return lispIsDef (dialect, strp); } -static void findSchemeTags (void) +static int scheme_hint2kind (const vString *const hint, const char *namespace CTAGS_ATTR_UNUSED) { - vString *name = vStringNew (); - const unsigned char *line; + int k = K_UNKNOWN; + int n = vStringLength (hint) - 4; - while ((line = readLineFromInputFile ()) != NULL) + if (strncmp (vStringValue (hint) + 1, "SET!", 4) == 0) + return K_SET; + + /* 4 means strlen("(def"). */ +#define EQN(X) strncmp(vStringValue (hint) + 4, &X[3], n) == 0 + switch (n) { - const unsigned char *cp = line; - - if (cp [0] == '(' && - (cp [1] == 'D' || cp [1] == 'd') && - (cp [2] == 'E' || cp [2] == 'e') && - (cp [3] == 'F' || cp [3] == 'f')) - { - while (*cp != '\0' && !isspace (*cp)) - cp++; - /* Skip over open parens and white space */ - do { - while (*cp != '\0' && (isspace (*cp) || *cp == '(')) - cp++; - if (*cp == '\0') - cp = line = readLineFromInputFile (); - else - break; - } while (line); - if (line == NULL) - break; - readIdentifier (name, cp); - makeSimpleTag (name, K_FUNCTION); - } - if (cp [0] == '(' && - (cp [1] == 'S' || cp [1] == 's') && - (cp [2] == 'E' || cp [2] == 'e') && - (cp [3] == 'T' || cp [3] == 't') && - (cp [4] == '!') && - (isspace (cp [5]) || cp[5] == '\0')) - { - cp += 5; - /* Skip over white space */ - do { - while (*cp != '\0' && isspace (*cp)) - cp++; - if (*cp == '\0') - cp = line = readLineFromInputFile (); - else - break; - } while (line); - if (line == NULL) - break; - readIdentifier (name, cp); - makeSimpleTag (name, K_SET); - } + case 3: + if (EQN("DEFINE")) + k = K_FUNCTION; + break; + } - vStringDelete (name); + return k; +} + +static void findSchemeTags (void) +{ + struct lispDialect scheme_dialect = { + .definer2kind = scheme_hint2kind, + .case_insensitive = true, + .namespace_sep = 0, + .unknown_kind = K_UNKNOWN, + .definer_field = SchemeFields + F_DEFINER, + .skip_initial_spaces = false, + .lambda_syntax_sugar = true, + .is_def = scheme_is_def, + .get_it = lispGetIt, + .scope = CORK_NIL, + }; + + findLispTagsCommon (&scheme_dialect); } extern parserDefinition* SchemeParser (void) @@ -119,8 +116,13 @@ extern parserDefinition* SchemeParser (void) parserDefinition* def = parserNew ("Scheme"); def->kindTable = SchemeKinds; def->kindCount = ARRAY_SIZE (SchemeKinds); + def->fieldTable = SchemeFields; + def->fieldCount = ARRAY_SIZE (SchemeFields); def->extensions = extensions; def->aliases = aliases; def->parser = findSchemeTags; + def->useCork = CORK_QUEUE; + def->versionCurrent = 0; + def->versionAge = 1; return def; } diff --git a/parsers/x-lisp.h b/parsers/x-lisp.h new file mode 100644 index 0000000000..cda227c42c --- /dev/null +++ b/parsers/x-lisp.h @@ -0,0 +1,39 @@ +/* + * Copyright (c) 2011, Colomban Wendling + * + * This source code is released for free distribution under the terms of the + * GNU General Public License version 2 or (at your option) any later version. + * + * List meata parser interface exported to the other lisp families + */ + +#ifndef CTAGS_LISP_H +#define CTAGS_LISP_H + +#include "general.h" + +#include "field.h" + +struct lispDialect { + int (* definer2kind) (const vString *const hint, const char *namespace); + bool case_insensitive; + unsigned char namespace_sep; + int unknown_kind; + fieldDefinition *definer_field; + bool skip_initial_spaces; + bool lambda_syntax_sugar; + bool (* is_def) (struct lispDialect *, const unsigned char *); + int (* get_it) (struct lispDialect *, + vString *const, const unsigned char *, vString *, + const char *); + int scope; +}; + +void findLispTagsCommon (struct lispDialect *dialect); + +int lispGetIt (struct lispDialect *dialect, + vString *const name, const unsigned char *dbp, vString *kind_hint, + const char *namespace); +bool lispIsDef (struct lispDialect *dialect, const unsigned char *strp); + +#endif /* CTAGS_LISP_H */ diff --git a/source.mak b/source.mak index ff373b0cee..7eb0b5734b 100644 --- a/source.mak +++ b/source.mak @@ -294,6 +294,7 @@ PARSER_HEADS = \ parsers/x-frontmatter.h \ parsers/x-iniconf.h \ parsers/x-jscript.h \ + parsers/x-lisp.h \ parsers/x-m4.h \ parsers/x-make.h \ parsers/x-markdown.h \ diff --git a/win32/ctags_vs2013.vcxproj b/win32/ctags_vs2013.vcxproj index 8e64187bce..f19c11c3b4 100644 --- a/win32/ctags_vs2013.vcxproj +++ b/win32/ctags_vs2013.vcxproj @@ -476,6 +476,7 @@ + diff --git a/win32/ctags_vs2013.vcxproj.filters b/win32/ctags_vs2013.vcxproj.filters index 6c8b25fa30..8b878b7ad3 100644 --- a/win32/ctags_vs2013.vcxproj.filters +++ b/win32/ctags_vs2013.vcxproj.filters @@ -947,6 +947,9 @@ Header Files + + Header Files + Header Files