Added support for classes and methods to TCL and fixed bug #615928.

git-svn-id: svn://svn.code.sf.net/p/ctags/code/trunk@213 c5d04d22-be80-434c-894e-aa346cc9e8e8

NEWS

@@ -1,10 +1,12 @@
 Current Version: @@VERSION@@
 
-ctags-5.3.2 (Thu Sep 26 2002)
+ctags-5.3.2 (Sat Sep 28 2002)
 * Improved ability for tagsOpen() in readtags library to report failure to
   open tag file, adding new fields to tagFileInfo structure.
 * Added '$' a valid character for C identifier [VMS].
+* Added class and method support to TCL parser [TCL].
 * Fixed problem terminating Perl POD block [Perl, Bug #612019].
+* Fixed problem with leading spaces before instruction [TCL, Bug #615928].
 
 ctags-5.3.1 (Thu Sep 12 2002)
 * Renamed tagsSetSorted() to tagsSetSortType() and "sorted" member of

Test/simple.tcl

@@ -0,0 +1,10 @@
+# proc comment
+proc simple1
+
+class tcl_class
+
+itcl::class itcl_class
+
+public method method1
+protected method method2
+private method method3

tcl.c

@@ -24,17 +24,40 @@
 *   DATA DEFINITIONS
 */
 typedef enum {
-    K_PROCEDURE
+    K_PROCEDURE, K_CLASS, K_METHOD
 } tclKind;
 
 static kindOption TclKinds [] = {
-    { TRUE, 'p', "procedure", "procedures" }
+    { TRUE, 'p', "procedure", "procedures" },
+    { TRUE, 'c', "class",  "classes" },
+    { TRUE, 'f', "method", "methods" }
 };
 
 /*
 *   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;
+    }
+    vStringTerminate (name);
+    makeSimpleTag (name, TclKinds, kind);
+    return cp;
+}
+
+static boolean match (const unsigned char *line, const char *word)
+{
+    return (boolean) (strncmp ((const char*) line, word, strlen (word)) == 0);
+}
+
 static void findTclTags (void)
 {
     vString *name = vStringNew ();
@@ -42,24 +65,38 @@ static void findTclTags (void)
 
     while ((line = fileReadLine ()) != NULL)
     {
-	int i;
+	const unsigned char *cp;
 
+	while (isspace (line [0])) 
+	    ++line;
+	
 	if (line [0] == '\0'  ||  line [0] == '#')
 	    continue;
 
-	if (strncmp ((const char*) line, "proc", (size_t) 4) == 0)
+	/* 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"))
 	{
-	    const unsigned char *cp = line + 4;
-	    while (isspace ((int) *cp))
-		++cp;
-	    while ((int) *cp != '\0'  &&  ! isspace ((int) *cp))
+	    if (match (cp, "method"))
 	    {
-		vStringPut (name, (int) *cp);
-		++cp;
+		cp += 6;
+		while (isspace ((int) *cp))
+		    ++cp;
+		cp = makeTclTag (cp, name, K_METHOD);
 	    }
-	    vStringTerminate (name);
-	    makeSimpleTag (name, TclKinds, K_PROCEDURE);
-	    vStringClear (name);
 	}
     }
     vStringDelete (name);
@@ -67,7 +104,7 @@ static void findTclTags (void)
 
 extern parserDefinition* TclParser (void)
 {
-    static const char *const extensions [] = { "tcl", "tk", "wish", NULL };
+    static const char *const extensions [] = { "tcl", "tk", "wish", "itcl", NULL };
     parserDefinition* def = parserNew ("Tcl");
     def->kinds      = TclKinds;
     def->kindCount  = KIND_COUNT (TclKinds);