[geany/geany] ef316b: Use the upstream TCL parser

Jiří Techet git-noreply at geany.org
Thu May 12 22:45:36 UTC 2022


Branch:      refs/heads/master
Author:      Jiří Techet <techet at gmail.com>
Committer:   Jiří Techet <techet at gmail.com>
Date:        Tue, 12 Apr 2022 17:44:01 UTC
Commit:      ef316b41573dd88c390efb586ace4a2110a07809
             https://github.com/geany/geany/commit/ef316b41573dd88c390efb586ace4a2110a07809

Log Message:
-----------
Use the upstream TCL parser

The TCL parser is split into three parts:

tcl - for parsing pure tcl code
tcloo - for parsing tcloo OO extension of tcl
itcl - for parsing itcl OO extension of tcl

TCLOO and ITCL parsers run the TCL parser as a subparser but it isn't
possible to combine all three parsers at the same time. Since TCLOO
is the "modern" (but 10 years old) OO extension, it seems to be a better
choice for Geany (if needed, a new filetype could be introduced for
ITCL).

Since it's run as a subparser, we need to introduce also a subparser
tag type mapping for TCL (types are mapped to the same values here
because they don't conflict with the TCLOO types).

Also, the new parser reports full scope information so take care of that.
In addition, scope by the TCL parser is prefixed by :: which we need
to strip because the TM doesn't expect scope in this format.

Update the unit test based on several uctags unit tests to cover the
tags we generate with this parser.


Modified Paths:
--------------
    ctags/Makefile.am
    ctags/parsers/geany_tcl.c
    ctags/parsers/tcl.c
    ctags/parsers/tcl.h
    ctags/parsers/tcloo.c
    meson.build
    src/filetypes.c
    src/tagmanager/tm_parser.c
    src/tagmanager/tm_parser.h
    src/tagmanager/tm_parsers.h
    tests/ctags/simple.tcl
    tests/ctags/simple.tcl.tags

Modified: ctags/Makefile.am
4 lines changed, 3 insertions(+), 1 deletions(-)
===================================================================
@@ -89,7 +89,9 @@ parsers = \
 	parsers/rust.c \
 	parsers/sh.c \
 	parsers/sql.c \
-	parsers/geany_tcl.c \
+	parsers/tcl.c \
+	parsers/tcl.h \
+	parsers/tcloo.c \
 	parsers/geany_tex.c \
 	parsers/txt2tags.c \
 	parsers/verilog.c \


Modified: ctags/parsers/geany_tcl.c
145 lines changed, 0 insertions(+), 145 deletions(-)
===================================================================
@@ -1,145 +0,0 @@
-/*
-*   Copyright (c) 2000-2003, Darren Hiebert
-*
-*   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.
-*
-*   This module contains functions for generating tags for TCL scripts.
-*/
-
-/*
-*   INCLUDE FILES
-*/
-#include "general.h"  /* must always come first */
-
-#include <string.h>
-
-#include "parse.h"
-#include "read.h"
-#include "routines.h"
-#include "vstring.h"
-
-/*
-*   DATA DEFINITIONS
-*/
-typedef enum {
-	K_CLASS, K_METHOD, K_PROCEDURE, K_MODULE
-} tclKind;
-
-static kindDefinition TclKinds [] = {
-	{ true, 'c', "class",     "classes" },
-	{ true, 'm', "method",    "methods" },
-	{ true, 'p', "procedure", "procedures" },
-	{ true, 'n', "module",    "modules" }
-};
-
-/*
-*   FUNCTION DEFINITIONS
-*/
-
-static const unsigned char *makeTclTag (
-		const unsigned char *cp,
-		vString *const name,
-		const tclKind kind)
-{
-	vStringClear (name);
-	while ((int) *cp != '\0'  &&  ! isspace ((int) *cp))
-	{
-		vStringPut (name, (int) *cp);
-		++cp;
-	}
-	makeSimpleTag (name, kind);
-	return cp;
-}
-
-static bool match (const unsigned char *line, const char *word)
-{
-	size_t len = strlen (word);
-	bool matched = (strncmp ((const char*) line, word, len) == 0);
-
-	if (matched)
-	{
-		/* check that the word is followed by a space to avoid detecting something
-		 * like "proc_new ..." */
-		matched = isspace (*(line + len));
-	}
-	return matched;
-}
-
-static void findTclTags (void)
-{
-	vString *name = vStringNew ();
-	const unsigned char *line;
-
-	while ((line = readLineFromInputFile ()) != NULL)
-	{
-		const unsigned char *cp;
-
-		while (isspace (line [0])) 
-			++line;
-		
-		if (line [0] == '\0'  ||  line [0] == '#')
-			continue;
-
-		/* read first word */
-		for (cp = line ; *cp != '\0'  &&  ! isspace ((int) *cp) ; ++cp)
-			;
-		if (! isspace ((int) *cp))
-			continue;
-		while (isspace ((int) *cp))
-			++cp;
-		/* Now `line' points at first word and `cp' points at next word */
-
-		if (match (line, "proc"))
-			cp = makeTclTag (cp, name, K_PROCEDURE);
-		else if (match (line, "class") || match (line, "itcl::class"))
-			cp = makeTclTag (cp, name, K_CLASS);
-		else if (match (line, "public") ||
-				match (line, "protected") ||
-				match (line, "private"))
-		{
-			if (match (cp, "method"))
-			{
-				cp += 6;
-				while (isspace ((int) *cp))
-					++cp;
-				cp = makeTclTag (cp, name, K_METHOD);
-			}
-		}
-		else if (match (line, "method"))
-		{
-			cp = makeTclTag (cp, name, K_METHOD);
-		}
-		else if (match (line, "oo::class") ) {
-			if (match (cp, "create"))
-			{
-				cp += 6;
-				while (isspace ((int) *cp))
-					++cp;
-				cp = makeTclTag (cp, name, K_CLASS);
-			}
-		}
-		else if (match (line, "namespace") ) {
-			if (match (cp, "eval"))
-			{
-				cp += 4;
-				while (isspace ((int) *cp))
-					++cp;
-				cp = makeTclTag (cp, name, K_MODULE);
-			}
-		}
-
-	}
-	vStringDelete (name);
-}
-
-extern parserDefinition* TclParser (void)
-{
-	static const char *const extensions [] = { "tcl", "tk", "wish", "itcl", NULL };
-	parserDefinition* def = parserNew ("Tcl");
-	def->kindTable  = TclKinds;
-	def->kindCount  = ARRAY_SIZE (TclKinds);
-	def->extensions = extensions;
-	def->parser     = findTclTags;
-	return def;
-}


Modified: ctags/parsers/tcl.c
716 lines changed, 716 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,716 @@
+/*
+*   Copyright (c) 2000-2003, Darren Hiebert
+*   Copyright (c) 2017, Masatake YAMATO
+*   Copyright (c) 2017, Red Hat, Inc.
+*
+*   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.
+*
+*   This module contains functions for generating tags for TCL scripts.
+*/
+
+/*
+*   INCLUDE FILES
+*/
+#include "general.h"  /* must always come first */
+#include "tokeninfo.h"
+#include "parse.h"
+#include "read.h"
+#include "vstring.h"
+#include "keyword.h"
+#include "entry.h"
+#include "routines.h"
+#include "ptrarray.h"
+#include "tcl.h"
+
+#include <string.h>
+
+
+
+/*
+*   DATA DEFINITIONS
+*/
+typedef enum {
+	K_PROCEDURE, K_NAMESPACE, K_PARAMETER,
+} tclKind;
+
+static scopeSeparator TclParameterSeparators [] = {
+	{ K_PROCEDURE        , "{" },
+};
+
+static kindDefinition TclKinds [] = {
+	{ true, 'p', "procedure", "procedures", },
+	{ true, 'n', "namespace", "namespaces", },
+	{ false, 'z', "parameter", "procedure parameters",
+	  ATTACH_SEPARATORS(TclParameterSeparators)},
+};
+
+enum {
+	KEYWORD_PROC,
+	KEYWORD_NAMESPACE,
+	KEYWORD_EVAL,
+	KEYWORD_PACKAGE,
+};
+
+typedef int keywordId; /* to allow KEYWORD_NONE */
+
+
+static const keywordTable TclKeywordTable[] = {
+	/* keyword			keyword ID */
+	{ "proc",			KEYWORD_PROC		},
+	{ "namespace",		KEYWORD_NAMESPACE	},
+	{ "eval",			KEYWORD_EVAL		},
+	{ "package",        KEYWORD_PACKAGE     },
+};
+
+typedef struct sCollector collector;
+struct sCollector {
+	void (* proc) (const tokenInfo *const, collector *);
+	vString *str;
+	int depth;
+	int scopeIndex;
+	int nth;
+};
+
+/*
+*   FUNCTION DEFINITIONS
+*/
+
+static bool tokenIsEOL (const tokenInfo *const token);
+
+static void initToken (tokenInfo *token, void *data);
+static void readToken (tokenInfo *const token, void *data);
+static void clearToken (tokenInfo *token);
+static void copyToken (tokenInfo *dest, tokenInfo *src, void *data CTAGS_ATTR_UNUSED);
+
+struct sTclParserState {
+	enum TclTokenType lastTokenType;
+};
+
+typedef struct sTclToken {
+	tokenInfo base;
+	int scopeIndex;
+	struct sTclParserState *pstate;
+} tclToken;
+
+#define TCL(TOKEN) ((tclToken *)TOKEN)
+#define TCL_PSTATE(TOKEN) (TCL(TOKEN)->pstate)
+
+static struct tokenTypePair typePairs [] = {
+	{ '{', '}' },
+	{ '[', ']' },
+};
+
+
+static struct tokenInfoClass tclTokenInfoClass = {
+	.nPreAlloc = 4,
+	.typeForUndefined = TOKEN_TCL_UNDEFINED,
+	.keywordNone      = KEYWORD_NONE,
+	.typeForKeyword   = TOKEN_TCL_KEYWORD,
+	.typeForEOF       = TOKEN_TCL_EOF,
+	.extraSpace       = sizeof (tclToken) - sizeof (tokenInfo),
+	.pairs            = typePairs,
+	.pairCount        = ARRAY_SIZE (typePairs),
+	.init             = initToken,
+	.read             = readToken,
+	.clear            = clearToken,
+	.copy             = copyToken,
+};
+
+extern tokenInfo *newTclToken (void *pstate)
+{
+	return newTokenFull (&tclTokenInfoClass, pstate);
+}
+
+static void clearToken (tokenInfo *token)
+{
+	TCL (token)->scopeIndex = CORK_NIL;
+	TCL (token)->pstate = NULL;
+}
+
+static void copyToken (tokenInfo *dest, tokenInfo *src, void *data CTAGS_ATTR_UNUSED)
+{
+	TCL (dest)->scopeIndex =
+		TCL (src)->scopeIndex;
+	TCL (dest)->pstate =
+		TCL (src)->pstate;
+}
+
+static void readString (vString *string)
+{
+	int c;
+	bool escaped = false;
+
+	while (1)
+	{
+		c = getcFromInputFile ();
+		switch (c)
+		{
+		case EOF:
+			return;
+		case '\\':
+			if (escaped)
+			{
+				vStringPut (string, c);
+				escaped = false;
+			}
+			else
+				escaped = true;
+			break;
+		case '"':
+			vStringPut (string, c);
+			if (escaped)
+				escaped = false;
+			else
+				return;
+			break;
+		default:
+			escaped = false;
+			vStringPut (string, c);
+			break;
+		}
+	}
+}
+
+static void readIdentifier (vString *string)
+{
+	while (1)
+	{
+		int c = getcFromInputFile ();
+		if (isgraph (c) && (!strchr ("{}[]", c)))
+			vStringPut (string, c);
+		else
+		{
+			ungetcToInputFile (c);
+			break;
+		}
+	}
+}
+
+static keywordId resolveKeyword (vString *string)
+{
+	char *s = vStringValue (string);
+	static langType lang = LANG_AUTO;
+
+	if (lang == LANG_AUTO)
+		lang = getInputLanguage ();
+
+	return lookupKeyword (s, lang);
+}
+
+static void initToken (tokenInfo *token, void *data)
+{
+	TCL (token)->pstate = data;
+}
+
+static void readToken0 (tokenInfo *const token, struct sTclParserState *pstate)
+{
+	int c = EOF;
+	bool escaped;
+	bool bol = (pstate->lastTokenType == TOKEN_TCL_EOL
+				|| pstate->lastTokenType == ';'
+				|| pstate->lastTokenType == TOKEN_TCL_UNDEFINED);
+	token->type		= TOKEN_TCL_UNDEFINED;
+	token->keyword	= KEYWORD_NONE;
+	vStringClear (token->string);
+
+ getNextChar:
+	escaped = false;
+
+	do {
+		c = getcFromInputFile ();
+	} while (c == ' ' || c== '\t' || c == '\f');
+
+	if (c == '\\')
+	{
+		bol = false;
+		int c0 = getcFromInputFile ();
+		switch (c0)
+		{
+		case '\n':
+		case '\r':
+			goto getNextChar;
+		default:
+			escaped = true;
+			c = c0;
+			break;
+		}
+	}
+
+	token->lineNumber   = getInputLineNumber ();
+	token->filePosition = getInputFilePosition ();
+
+	switch (c)
+	{
+	case EOF:
+		token->type = TOKEN_TCL_EOF;
+		break;
+	case '\n':
+	case '\r':
+		token->type = TOKEN_TCL_EOL;
+		break;
+	case '#':
+		if (!escaped)
+		{
+			if (bol)
+			{
+				do
+					c = getcFromInputFile ();
+				while (c != EOF && c != '\r' && c != '\n');
+			}
+			goto getNextChar;
+		}
+	case '"':
+		if (!escaped)
+		{
+			token->type = TOKEN_TCL_STRING;
+			tokenPutc (token, c);
+			readString (token->string);
+			break;
+		}
+	case ';':
+	case '{':
+	case '}':
+	case '[':
+	case ']':
+		if (!escaped)
+		{
+			tokenPutc (token, c);
+			token->type = c;
+			break;
+		}
+	case '$':
+		if (!escaped)
+		{
+			tokenPutc (token, c);
+			token->type = TOKEN_TCL_VARIABLE;
+
+			int c0 = getcFromInputFile ();
+			if (c0 == EOF)
+				break;
+
+			if (c0 == '{')
+			{
+				tokenPutc (token, c0);
+				while ((c0 = getcFromInputFile ()) != EOF)
+				{
+					tokenPutc (token, c0);
+					if (c0 == '}')
+						break;
+				}
+			}
+			else if (isalnum (c0))
+			{
+				tokenPutc (token, c0);
+				readIdentifier (token->string);
+			}
+			else
+				ungetcToInputFile (c0);
+			break;
+		}
+	default:
+			tokenPutc (token, c);
+			readIdentifier (token->string);
+
+			token->keyword = resolveKeyword (token->string);
+			if (token->keyword == KEYWORD_NONE)
+				token->type = TOKEN_TCL_IDENTIFIER;
+			else
+				token->type = TOKEN_TCL_KEYWORD;
+			break;
+	}
+}
+
+static void readToken (tokenInfo *const token, void *data)
+{
+	struct sTclParserState *pstate = TCL_PSTATE(token);
+
+	readToken0 (token, pstate);
+
+	pstate->lastTokenType = token->type;
+
+	if (data)
+	{
+		collector *col = data;
+		col->proc (token, col);
+	}
+}
+
+static bool tokenIsEOL (const tokenInfo *const token)
+{
+	if (token->type == ';'
+		|| tokenIsType (token, TCL_EOL)
+		|| tokenIsEOF (token))
+		return true;
+	return false;
+}
+
+static void skipToEndOfCmdline (tokenInfo *const token)
+{
+	while (!tokenIsEOL (token))
+	{
+		if ((token->type == '{')
+			|| (token->type == '['))
+			tokenSkipOverPair(token);
+		tokenRead (token);
+	}
+}
+
+extern void skipToEndOfTclCmdline (tokenInfo *const token)
+{
+	skipToEndOfCmdline (token);
+}
+
+static bool isAbsoluteIdentifier(tokenInfo *const token)
+{
+	return !strncmp (tokenString (token), "::", 2);
+}
+
+static const char* getLastComponentInIdentifier(tokenInfo *const token)
+{
+	const char* s = tokenString (token);
+	char *last = strrstr(s, "::");
+
+	if (last)
+		return last + 2;
+	else
+		return NULL;
+}
+
+
+static void notifyNamespaceImport (tokenInfo *const token)
+{
+	subparser *sub;
+
+	foreachSubparser (sub, false)
+	{
+		tclSubparser *tclsub = (tclSubparser *)sub;
+
+		if (tclsub->namespaceImportNotify)
+		{
+			enterSubparser(sub);
+			tclsub->namespaceImportNotify (tclsub, tokenString (token),
+										   TCL_PSTATE(token));
+			leaveSubparser();
+		}
+	}
+}
+
+static int notifyCommand (tokenInfo *const token, int parent)
+{
+	subparser *sub;
+	int r = CORK_NIL;
+
+	foreachSubparser (sub, false)
+	{
+		tclSubparser *tclsub = (tclSubparser *)sub;
+
+		if (tclsub->commandNotify)
+		{
+			enterSubparser(sub);
+			r = tclsub->commandNotify (tclsub, tokenString (token), parent,
+									   TCL_PSTATE(token));
+			leaveSubparser();
+			if (r != CORK_NIL)
+				break;
+		}
+	}
+	return r;
+}
+
+static void collectSignature (const tokenInfo *const token, collector * col)
+{
+	if (tokenIsEOL (token))
+		return;
+
+	if (tokenIsType (token, TCL_IDENTIFIER) &&
+		(col->depth == 1
+		 || (col->depth == 2 && tokenIsType (token, TCL_IDENTIFIER)
+			 && vStringLast (col->str) == '{')))
+	{
+		tagEntryInfo e;
+		initTagEntry (&e, tokenString (token), K_PARAMETER);
+		e.extensionFields.scopeIndex = col->scopeIndex;
+		e.extensionFields.nth = col->nth++;
+		makeTagEntry (&e);
+	}
+	else if (tokenIsTypeVal (token, '{'))
+		col->depth++;
+	else if (tokenIsTypeVal (token, '}'))
+		col->depth--;
+
+	if ((vStringLength (col->str) > 0
+		 && vStringLast (col->str) != '{'
+		 && vStringLast (col->str) != '['
+		 && vStringLast (col->str) != '(')
+		&& (!tokenIsTypeVal (token, '}'))
+		&& (!tokenIsTypeVal (token, ']'))
+		&& (!tokenIsTypeVal (token, ')')))
+		vStringPut (col->str, ' ');
+	vStringCat (col->str, token->string);
+}
+
+static void parseProc (tokenInfo *const token,
+					   int parent)
+{
+	int index = CORK_NIL;
+	int index_fq = CORK_NIL;
+
+	tokenRead (token);
+
+	if (tokenIsType(token, TCL_IDENTIFIER))
+	{
+		const char *last = getLastComponentInIdentifier (token);
+		if (last)
+		{
+			tagEntryInfo e;
+
+			initTagEntry (&e, last, K_PROCEDURE);
+			e.lineNumber = token->lineNumber;
+			e.filePosition = token->filePosition;
+
+			int len  = (last - tokenString (token));
+			vString *ns = vStringNew();
+			tagEntryInfo *e_parent = getEntryInCorkQueue (parent);
+			if (isAbsoluteIdentifier (token))
+			{
+				if (len > 2)
+					vStringNCopy (ns, token->string, len - 2);
+			}
+			else if (e_parent)
+			{
+				const char * sep = scopeSeparatorFor (getInputLanguage(),
+													  K_PROCEDURE,
+													  e_parent->kindIndex);
+				vStringCatS(ns, e_parent->name);
+				vStringCatS(ns, sep);
+				vStringNCopy(ns, token->string, len - 2);
+			}
+			else
+				vStringNCopy (ns, token->string, len - 2);
+
+			if (vStringLength(ns) > 0)
+			{
+				e.extensionFields.scopeKindIndex = K_NAMESPACE;
+				e.extensionFields.scopeName = vStringValue (ns);
+			}
+
+			e.skipAutoFQEmission = 1;
+			index = makeTagEntry (&e);
+
+			if (isXtagEnabled(XTAG_QUALIFIED_TAGS))
+			{
+				const char * sep = scopeSeparatorFor (getInputLanguage(),
+													  K_PROCEDURE,
+													  vStringIsEmpty (ns)
+													  ? KIND_GHOST_INDEX
+													  : K_NAMESPACE);
+
+				vStringCatS (ns, sep);
+				vStringCatS (ns, last);
+
+				index_fq = makeSimpleTag (ns, K_PROCEDURE);
+				tagEntryInfo *e_fq = getEntryInCorkQueue (index_fq);
+				if (e_fq)
+					markTagExtraBit (e_fq, XTAG_QUALIFIED_TAGS);
+			}
+			vStringDelete (ns);
+		}
+		else
+		{
+			tagEntryInfo *ep;
+			index = makeSimpleTag (token->string, K_PROCEDURE);
+			ep = getEntryInCorkQueue (index);
+			if (ep)
+				ep->extensionFields.scopeIndex = parent;
+		}
+	}
+
+	vString *signature = NULL;
+	if (!tokenIsEOL (token))
+	{
+		tokenRead (token);
+		if (tokenIsType (token, TCL_IDENTIFIER))
+		{
+			tagEntryInfo e;
+			initTagEntry (&e, tokenString (token), K_PARAMETER);
+			e.extensionFields.scopeIndex = index;
+			makeTagEntry (&e);
+			signature = vStringNewCopy (token->string);
+		}
+		else if (token->type == '{')
+		{
+			signature = vStringNewInit ("{");
+			collector col = {
+				.proc = collectSignature,
+				.str = signature,
+				.depth = 1,
+				.scopeIndex = index,
+				.nth = 0,
+			};
+			tokenSkipOverPairFull (token, &col);
+		}
+
+		skipToEndOfCmdline(token);
+	}
+
+	tagEntryInfo *e = getEntryInCorkQueue (index);
+	if (e)
+	{
+		e->extensionFields.endLine = token->lineNumber;
+
+		if (signature)
+		{
+			e->extensionFields.signature = vStringDeleteUnwrap (signature);
+			signature = NULL;
+		}
+
+		tagEntryInfo *e_fq = getEntryInCorkQueue (index_fq);
+		if (e_fq)
+		{
+			const char *sig = e->extensionFields.signature;
+			e_fq->extensionFields.endLine = token->lineNumber;
+			if (sig)
+				e_fq->extensionFields.signature = eStrdup (sig);
+		}
+	}
+	vStringDelete (signature);	/* NULL is acceptable */
+}
+
+static void parseNamespace (tokenInfo *const token,
+							int parent)
+{
+	tokenRead (token);
+	if (tokenIsEOF(token))
+		return;
+
+	if (tokenIsType (token, TCL_IDENTIFIER) &&
+		(strcmp(tokenString(token), "import") == 0))
+	{
+		while (1)
+		{
+			tokenRead (token);
+
+			if (!tokenIsType (token, TCL_IDENTIFIER))
+				break;
+
+			if (tokenString(token)[0] == '-')
+				continue;
+
+			notifyNamespaceImport (token);
+		}
+		skipToEndOfCmdline(token);
+		return;
+	}
+	else if (!tokenIsKeyword (token, EVAL))
+		return;
+
+	tokenRead (token);
+	if (!tokenIsType (token, TCL_IDENTIFIER))
+	{
+		skipToEndOfCmdline(token);
+		return;
+	}
+
+	int index = makeSimpleTag (token->string, K_NAMESPACE);
+	tagEntryInfo *e = getEntryInCorkQueue (index);
+	if (e && parent != CORK_NIL && !isAbsoluteIdentifier(token))
+		e->extensionFields.scopeIndex = parent;
+
+	tokenRead (token);
+	if (token->type != '{')
+	{
+		skipToEndOfCmdline(token);
+		return;
+	}
+
+	do {
+		tokenRead (token);
+		if (tokenIsKeyword (token, NAMESPACE))
+			parseNamespace (token, index);
+		else if (tokenIsKeyword (token, PROC))
+			parseProc (token, index);
+		else if (tokenIsType (token, TCL_IDENTIFIER))
+		{
+			notifyCommand (token, index);
+			skipToEndOfCmdline(token); /* ??? */
+		}
+		else if (token->type == '}')
+		{
+			if (e)
+				e->extensionFields.endLine = token->lineNumber;
+			break;
+		}
+		else
+			skipToEndOfCmdline(token);
+	} while (!tokenIsEOF(token));
+}
+
+static void parsePackage (tokenInfo *const token)
+{
+	tokenRead (token);
+	if (tokenIsType (token, TCL_IDENTIFIER)
+		&& (strcmp (tokenString (token), "require") == 0))
+	{
+	next:
+		tokenRead (token);
+		if (tokenIsType (token, TCL_IDENTIFIER)
+			&& (vStringLength (token->string) > 0))
+		{
+			if (tokenString(token)[0] == '-')
+				goto next;
+		}
+	}
+	skipToEndOfCmdline(token);
+}
+
+
+static void findTclTags (void)
+{
+	struct sTclParserState pstate = {
+		.lastTokenType = TOKEN_TCL_UNDEFINED,
+	};
+	tokenInfo *const token = newTclToken (&pstate);
+
+	do {
+		tokenRead (token);
+		if (tokenIsKeyword (token, NAMESPACE))
+			parseNamespace (token, CORK_NIL);
+		else if (tokenIsKeyword (token, PROC))
+			parseProc (token, CORK_NIL);
+		else if (tokenIsKeyword (token, PACKAGE))
+			parsePackage (token);
+		else if (tokenIsType (token, TCL_IDENTIFIER))
+		{
+			notifyCommand (token, CORK_NIL);
+			skipToEndOfCmdline(token); /* ??? */
+		}
+		else
+			skipToEndOfCmdline(token);
+	} while (!tokenIsEOF(token));
+
+	tokenDelete (token);
+	flashTokenBacklog (&tclTokenInfoClass);
+}
+
+extern parserDefinition* TclParser (void)
+{
+	static const char *const extensions [] = { "tcl", "tk", "wish", "exp", NULL };
+	static const char *const aliases [] = {"expect", "tclsh", NULL };
+
+	parserDefinition* def = parserNew ("Tcl");
+	def->kindTable      = TclKinds;
+	def->kindCount  = ARRAY_SIZE (TclKinds);
+	def->extensions = extensions;
+	def->aliases = aliases;
+	def->keywordTable = TclKeywordTable;
+	def->keywordCount = ARRAY_SIZE (TclKeywordTable);
+
+	def->parser     = findTclTags;
+	def->useCork    = CORK_QUEUE;
+	def->requestAutomaticFQTag = true;
+	def->defaultScopeSeparator = "::";
+	def->defaultRootScopeSeparator = "::";
+
+	return def;
+}


Modified: ctags/parsers/tcl.h
51 lines changed, 51 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,51 @@
+/*
+*   Copyright (c) 2017, Masatake YAMATO
+*
+*   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.
+*/
+
+#ifndef CTAGS_PARSER_TCL_H
+#define CTAGS_PARSER_TCL_H
+
+/*
+*   INCLUDE FILES
+*/
+#include "general.h"  /* must always come first */
+
+#include "subparser.h"
+#include "tokeninfo.h"
+
+typedef struct sTclSubparser tclSubparser;
+
+enum TclTokenType {
+	/* 0..255 are the byte's value */
+	TOKEN_TCL_EOF = 256,
+	TOKEN_TCL_UNDEFINED,
+	TOKEN_TCL_KEYWORD,
+	TOKEN_TCL_IDENTIFIER,
+	TOKEN_TCL_VARIABLE,
+	TOKEN_TCL_EOL,
+	TOKEN_TCL_STRING,
+};
+
+struct sTclSubparser {
+	subparser subparser;
+
+	/* `pstate' is needed to call newTclToken(). */
+	void (* namespaceImportNotify) (tclSubparser *s, char *namespace,
+									void *pstate);
+	/* Return CORK_NIL if the command line is NOT consumed.
+	   If a positive integer is returned, end: field may
+	   be attached by tcl base parser.
+	   Return CORK_NIL - 1 if the command line is consumed
+	   but not tag is made. */
+	int (* commandNotify) (tclSubparser *s, char *command,
+						   int parentIndex,
+						   void *pstate);
+};
+
+extern tokenInfo *newTclToken (void *pstate);
+extern void skipToEndOfTclCmdline (tokenInfo *const token);
+
+#endif	/* CTAGS_PARSER_TCL_H */


Modified: ctags/parsers/tcloo.c
201 lines changed, 201 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,201 @@
+/*
+*   Copyright (c) 2017, Masatake YAMATO
+*
+*   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.
+*
+*/
+
+#include "general.h"  /* must always come first */
+#include "tcl.h"
+#include "param.h"
+#include "parse.h"
+#include "entry.h"
+#include "tokeninfo.h"
+
+#include <string.h>
+
+
+struct tclooSubparser {
+	tclSubparser tcl;
+	bool foundTclOONamespaceImported;
+};
+
+static scopeSeparator TclOOGenericSeparators [] = {
+	{ KIND_WILDCARD_INDEX, "::" },
+};
+
+enum TclOOKind {
+	K_CLASS,
+	K_METHOD,
+};
+
+static kindDefinition TclOOKinds[] = {
+	{ true, 'c', "class", "classes" },
+	{ true, 'm', "method", "methods",
+	  ATTACH_SEPARATORS(TclOOGenericSeparators) },
+};
+
+static bool tclooForceUse;
+
+static void parseMethod (tokenInfo *token, int owner)
+{
+	tokenRead (token);
+	if (tokenIsType (token, TCL_IDENTIFIER))
+	{
+		tagEntryInfo e;
+
+		initTagEntry(&e, tokenString (token), K_METHOD);
+		e.extensionFields.scopeIndex = owner;
+		makeTagEntry (&e);
+	}
+	skipToEndOfTclCmdline (token);
+}
+
+static void parseSuperclass (tokenInfo *token, int this_class)
+{
+	tokenRead (token);
+	if (tokenIsType (token, TCL_IDENTIFIER))
+	{
+		tagEntryInfo *e = getEntryInCorkQueue(this_class);
+
+		if (e)
+		{
+			if (e->extensionFields.inheritance)
+			{   /* superclass is used twice in a class. */
+				eFree ((void *)e->extensionFields.inheritance);
+			}
+			e->extensionFields.inheritance = eStrdup(tokenString(token));
+		}
+	}
+	skipToEndOfTclCmdline (token);
+}
+
+static int parseClass (tclSubparser *s CTAGS_ATTR_UNUSED, int parentIndex,
+					   void *pstate)
+{
+	tokenInfo *token = newTclToken (pstate);
+	int r = CORK_NIL;
+
+	tokenRead (token);
+	if (tokenIsType (token, TCL_IDENTIFIER)
+		&& (strcmp(tokenString(token), "create") == 0))
+	{
+		tokenRead (token);
+		if (tokenIsType (token, TCL_IDENTIFIER))
+		{
+			tagEntryInfo e;
+
+			initTagEntry(&e, tokenString (token), K_CLASS);
+			e.extensionFields.scopeIndex = parentIndex;
+			r = makeTagEntry (&e);
+		}
+
+		if (tokenSkipToType (token, '{'))
+		{
+			do {
+				tokenRead (token);
+				if (tokenIsType (token, TCL_IDENTIFIER)
+					|| tokenIsType (token, TCL_KEYWORD))
+				{
+					if (strcmp(tokenString(token), "method") == 0)
+						parseMethod(token, r);
+					else if (strcmp(tokenString(token), "superclass") == 0)
+						parseSuperclass(token, r);
+					else
+						skipToEndOfTclCmdline (token);
+				}
+				else if (token->type == '}')
+					break;
+			} while (!tokenIsEOF(token));
+		}
+	}
+
+	skipToEndOfTclCmdline (token);
+	tokenDelete(token);
+	return r;
+}
+
+static int commandNotify (tclSubparser *s, char *command,
+						  int parentIndex, void *pstate)
+{
+	struct tclooSubparser *tcloo = (struct tclooSubparser *)s;
+	int r = CORK_NIL;
+
+	if ((tcloo->foundTclOONamespaceImported
+		 && (strcmp (command, "class") == 0))
+		|| (strcmp (command, "oo::class") == 0))
+		r = parseClass (s, parentIndex, pstate);
+
+	return r;
+}
+
+static void namespaceImportNotify (tclSubparser *s, char *namespace,
+								   void *pstate CTAGS_ATTR_UNUSED)
+{
+	struct tclooSubparser *tcloo = (struct tclooSubparser *)s;
+
+	if (strcmp(namespace, "oo::*") == 0
+		|| strcmp(namespace, "oo::class") == 0)
+		tcloo->foundTclOONamespaceImported = true;
+}
+
+static void inputStart (subparser *s)
+{
+	struct tclooSubparser *tcloo = (struct tclooSubparser *)s;
+
+	tcloo->foundTclOONamespaceImported = tclooForceUse;
+}
+
+static struct tclooSubparser tclooSubparser = {
+	.tcl = {
+		.subparser = {
+			.direction = SUBPARSER_BI_DIRECTION,
+			.inputStart = inputStart,
+		},
+		.commandNotify = commandNotify,
+		.namespaceImportNotify = namespaceImportNotify,
+	},
+};
+
+static void findTclOOTags(void)
+{
+	scheduleRunningBaseparser (RUN_DEFAULT_SUBPARSERS);
+}
+
+static void tclooForceUseParamHandler (const langType language CTAGS_ATTR_UNUSED,
+									  const char *name, const char *arg)
+{
+	tclooForceUse = paramParserBool (arg, tclooForceUse, name, "parameter");
+}
+
+static parameterHandlerTable TclOOParameterHandlerTable [] = {
+	{ .name = "forceUse",
+	  .desc = "enable the parser even when `oo' namespace is not specified in the input (true or [false])" ,
+	  .handleParameter = tclooForceUseParamHandler,
+	},
+};
+
+extern parserDefinition* TclOOParser (void)
+{
+	parserDefinition* const def = parserNew("TclOO");
+
+	static parserDependency dependencies [] = {
+		[0] = { DEPTYPE_SUBPARSER, "Tcl", &tclooSubparser },
+	};
+
+	def->dependencies = dependencies;
+	def->dependencyCount = ARRAY_SIZE (dependencies);
+
+	def->kindTable = TclOOKinds;
+	def->kindCount = ARRAY_SIZE(TclOOKinds);
+
+	def->parser = findTclOOTags;
+	def->useCork = CORK_QUEUE;
+	def->requestAutomaticFQTag = true;
+
+	def->parameterHandlerTable = TclOOParameterHandlerTable;
+	def->parameterHandlerCount = ARRAY_SIZE(TclOOParameterHandlerTable);
+
+	return def;
+}


Modified: meson.build
4 lines changed, 3 insertions(+), 1 deletions(-)
===================================================================
@@ -638,7 +638,6 @@ ctags = static_library('ctags',
 	'ctags/parsers/geany_lcpp.h',
 	'ctags/parsers/geany_markdown.c',
 	'ctags/parsers/geany_matlab.c',
-	'ctags/parsers/geany_tcl.c',
 	'ctags/parsers/geany_tex.c',
 	'ctags/parsers/geany_vhdl.c',
 	'ctags/parsers/go.c',
@@ -668,6 +667,9 @@ ctags = static_library('ctags',
 	'ctags/parsers/rust.c',
 	'ctags/parsers/sh.c',
 	'ctags/parsers/sql.c',
+	'ctags/parsers/tcl.c',
+	'ctags/parsers/tcl.h',
+	'ctags/parsers/tcloo.c',
 	'ctags/parsers/txt2tags.c',
 	'ctags/parsers/verilog.c',
 	c_args: geany_cflags + [ '-DG_LOG_DOMAIN="CTags"',


Modified: src/filetypes.c
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -144,7 +144,7 @@ static void init_builtin_filetypes(void)
 	FT_INIT( JS,         JAVASCRIPT,   "Javascript",       NULL,                      SOURCE_FILE, SCRIPT   );
 	FT_INIT( PYTHON,     PYTHON,       "Python",           NULL,                      SOURCE_FILE, SCRIPT   );
 	FT_INIT( RUBY,       RUBY,         "Ruby",             NULL,                      SOURCE_FILE, SCRIPT   );
-	FT_INIT( TCL,        TCL,          "Tcl",              NULL,                      SOURCE_FILE, SCRIPT   );
+	FT_INIT( TCL,        TCLOO,        "Tcl",              NULL,                      SOURCE_FILE, SCRIPT   );
 	FT_INIT( LUA,        LUA,          "Lua",              NULL,                      SOURCE_FILE, SCRIPT   );
 	FT_INIT( GDSCRIPT,   GDSCRIPT,     "GDScript",         NULL,                      SOURCE_FILE, SCRIPT   );
 	FT_INIT( HASKELL,    HASKELL,      "Haskell",          NULL,                      SOURCE_FILE, COMPILED );


Modified: src/tagmanager/tm_parser.c
31 lines changed, 28 insertions(+), 3 deletions(-)
===================================================================
@@ -372,10 +372,9 @@ static TMParserMapGroup group_RUBY[] = {
 };
 
 static TMParserMapEntry map_TCL[] = {
-	{'c', tm_tag_class_t},      // class
-	{'m', tm_tag_member_t},     // method
 	{'p', tm_tag_function_t},   // procedure
-	{'n', tm_tag_namespace_t},  // module
+	{'n', tm_tag_namespace_t},  // namespace
+	{'z', tm_tag_undef_t},      // parameter
 };
 static TMParserMapGroup group_TCL[] = {
 	{_("Namespaces"), TM_ICON_NAMESPACE, tm_tag_namespace_t},
@@ -384,6 +383,19 @@ static TMParserMapGroup group_TCL[] = {
 	{_("Procedures"), TM_ICON_OTHER, tm_tag_function_t},
 };
 
+static TMParserMapEntry map_TCLOO[] = {
+	{'c', tm_tag_class_t},   // class
+	{'m', tm_tag_member_t},  // method
+};
+#define group_TCLOO group_TCL
+
+static TMSubparserMapEntry subparser_TCLOO_TCL_map[] = {
+	{tm_tag_namespace_t, tm_tag_namespace_t},
+	{tm_tag_class_t, tm_tag_class_t},
+	{tm_tag_member_t, tm_tag_member_t},
+	{tm_tag_function_t, tm_tag_function_t},
+};
+
 static TMParserMapEntry map_SH[] = {
 	{'a', tm_tag_undef_t},     // alias
 	{'f', tm_tag_function_t},  // function
@@ -1008,6 +1020,7 @@ static TMParserMap parser_map[] = {
 	MAP_ENTRY(POWERSHELL),
 	MAP_ENTRY(JULIA),
 	MAP_ENTRY(CPREPROCESSOR),
+	MAP_ENTRY(TCLOO),
 };
 /* make sure the parser map is consistent and complete */
 G_STATIC_ASSERT(G_N_ELEMENTS(parser_map) == TM_PARSER_COUNT);
@@ -1110,6 +1123,7 @@ static void add_subparser(TMParserType lang, TMParserType sublang, TMSubparserMa
 static void init_subparser_map(void)
 {
 	SUBPARSER_MAP_ENTRY(HTML, JAVASCRIPT, subparser_HTML_javascript_map);
+	SUBPARSER_MAP_ENTRY(TCLOO, TCL, subparser_TCLOO_TCL_map);
 }
 
 
@@ -1302,6 +1316,13 @@ gchar *tm_parser_update_scope(TMParserType lang, gchar *scope)
 			/* PHP parser uses two different scope separators but this would
 			 * complicate things in Geany so make sure there's just one type */
 			return replace_string_if_present(scope, "\\", "::");
+		case TM_PARSER_TCL:
+		case TM_PARSER_TCLOO:
+			/* The TCL(OO) parser returns scope prefixed with :: which we don't
+			 * want. */
+			if (g_str_has_prefix(scope, "::"))
+				return g_strdup(scope + 2);
+			break;
 	}
 	return scope;
 }
@@ -1432,6 +1453,8 @@ const gchar *tm_parser_scope_separator(TMParserType lang)
 		case TM_PARSER_PHP:
 		case TM_PARSER_POWERSHELL:
 		case TM_PARSER_RUST:
+		case TM_PARSER_TCL:
+		case TM_PARSER_TCLOO:
 		case TM_PARSER_ZEPHIR:
 			return "::";
 
@@ -1492,6 +1515,8 @@ gboolean tm_parser_has_full_scope(TMParserType lang)
 		case TM_PARSER_RUBY:
 		case TM_PARSER_RUST:
 		case TM_PARSER_SQL:
+		case TM_PARSER_TCL:
+		case TM_PARSER_TCLOO:
 		case TM_PARSER_TXT2TAGS:
 		case TM_PARSER_VALA:
 		case TM_PARSER_VERILOG:


Modified: src/tagmanager/tm_parser.h
1 lines changed, 1 insertions(+), 0 deletions(-)
===================================================================
@@ -112,6 +112,7 @@ enum
 	TM_PARSER_JULIA,
 	TM_PARSER_BIBTEX,
 	TM_PARSER_CPREPROCESSOR,
+	TM_PARSER_TCLOO,
 	TM_PARSER_COUNT
 };
 


Modified: src/tagmanager/tm_parsers.h
3 lines changed, 2 insertions(+), 1 deletions(-)
===================================================================
@@ -67,6 +67,7 @@
 	PowerShellParser, \
 	JuliaParser, \
 	BibtexParser, \
-	CPreProParser
+	CPreProParser, \
+	TclOOParser
 
 #endif


Modified: tests/ctags/simple.tcl
59 lines changed, 52 insertions(+), 7 deletions(-)
===================================================================
@@ -1,10 +1,55 @@
-# proc comment
-proc simple1
+oo::class create X {
+    superclass Y;
 
-class tcl_class
+    method add v {
+    }; method doSomething {v} {
+    }
+}
 
-itcl::class itcl_class
+class create ShouldNotBeCaptured {
+}
 
-public method method1
-protected method method2
-private method method3
+proc simple1 {} {
+}
+
+namespace eval A::B {
+}
+
+namespace eval A {
+    proc pr1 {s} {
+	puts $s
+    }
+    pr1 "a"
+    proc B::pr2 {s} {
+	puts "$s"
+    }
+    namespace eval C {
+	proc pr3 {s} {
+	    puts $s
+	}
+    }
+    proc ::pr4 {s} {
+	puts "$s"
+    }
+
+}
+
+proc ::pr5 {s} {
+    puts "$s"
+}
+
+proc pr6 {s} {
+    puts "$s"
+}
+
+A::pr1 "b"
+
+A::B::pr2 "c"
+
+A::C::pr3 "d"
+
+pr4 "e"
+
+pr5 "f"
+
+pr6 "g"


Modified: tests/ctags/simple.tcl.tags
19 lines changed, 13 insertions(+), 6 deletions(-)
===================================================================
@@ -1,7 +1,14 @@
 # format=tagmanager
-itcl_class�1�0
-method1�64�0
-method2�64�0
-method3�64�0
-simple1�16�0
-tcl_class�1�0
+A�256�0
+A::B�256�0
+C�256�A�0
+X�1�0
+add�64�X�0
+doSomething�64�X�0
+pr1�16�{s}�A�0
+pr2�16�{s}�B�0
+pr3�16�{s}�A::C�0
+pr4�16�{s}�0
+pr5�16�{s}�0
+pr6�16�{s}�0
+simple1�16�{}�0



--------------
This E-Mail was brought to you by github_commit_mail.py (Source: https://github.com/geany/infrastructure).


More information about the Commits mailing list