/*****************************************************************************

 * Parser for Tcl subset

 *

 * Copyright (C) 2010      by Rene Zaumseil

 * based on the work of Dimitri van Heesch.

 *

 * Permission to use, copy, modify, and distribute this software and its

 * documentation under the terms of the GNU General Public License is hereby 

 * granted. No representations are made about the suitability of this software 

 * for any purpose. It is provided "as is" without express or implied warranty.

 * See the GNU General Public License for more details.

 *

 * Documents produced by Doxygen are derivative works derived from the

 * input used in their production; they are not affected by this license.

 *

 */ 

%option never-interactive

%option case-insensitive

%option prefix="tclscannerYY"

%{

#include <stdio.h> 

#include <stdlib.h>

#include <assert.h>

#include <ctype.h>

#include <qstring.h>

#include <qstringlist.h>

#include <qlist.h>

#include <qmap.h>

#include <qarray.h>

#include <qstack.h>

#include <qregexp.h>

#include <qfile.h>

#include <qdict.h>

#include "entry.h"

#include "message.h"

#include "config.h"

#include "doxygen.h"

#include "util.h"

#include "defargs.h"

#include "language.h"

#include "commentscan.h" 

#include "pre.h"

#include "tclscanner.h"

#include "outputlist.h"

#include "membername.h"

#include "searchindex.h"

#include "commentcnv.h"

#include "bufstr.h"

#include "portable.h"

#include "arguments.h"

#include "namespacedef.h"

#include "filedef.h"

#define YY_NO_INPUT 1

#define YY_NO_UNISTD_H 1

#define MAX_INCLUDE_DEPTH 10

//! Application error.

#define tcl_err \

  printf("Error %d %s() at line %d! ",__LINE__,tcl.file_name.data(),yylineno); \

  yy_push_state(ERROR); \

  yyless(0); \

  printf

//! Application warning.

#define tcl_war \

  printf("Warning %d %s() at line %d: ",__LINE__,tcl.file_name.data(),yylineno); \

  printf

//! Application message.

#define tcl_inf \

  if (0) printf("--- %.4d %d@%d: ",__LINE__,yylineno,yy_start_stack_ptr) && printf

//! Debug message.

#define D\

  if (0) printf("--- %.4d %d@%d: %s\n",__LINE__,yylineno,yy_start_stack_ptr,yytext);

// BEGIN of copy from tclUtil.c

// - Tcl_Interp removed

// - changes are marked with RZ

// #define's to adapt the code:

#define CONST           const

#define UCHAR           (unsigned char)

#define TCL_ERROR       1

#define TCL_OK          0

#define ckalloc         malloc

#define ckfree          free

#define TclCopyAndCollapse(size,src,dest) memcpy(dest,src,size); *(dest+size)=0

int TclFindElement(

      CONST char *list,         /* Points to the first byte of a string

                                 * containing a Tcl list with zero or more

                                 * elements (possibly in braces). */

      int listLength,           /* Number of bytes in the list's string. */

      CONST char **elementPtr,  /* Where to put address of first significant

                                 * character in first element of list. */

      CONST char **nextPtr,     /* Fill in with location of character just

                                 * after all white space following end of

                                 * argument (next arg or end of list). */

      int *sizePtr,             /* If non-zero, fill in with size of

                                 * element. */

      int *bracePtr)            /* If non-zero, fill in with non-zero/zero to

                                 * indicate that arg was/wasn't in braces. */

{

  CONST char *p = list;

  CONST char *elemStart;        /* Points to first byte of first element. */

  CONST char *limit;            /* Points just after list's last byte. */

  int openBraces = 0;           /* Brace nesting level during parse. */

  int inQuotes = 0;

  int size = 0;         /* lint. */

  //RZ    int numChars;

  /*

   * Skim off leading white space and check for an opening brace or quote.

   * We treat embedded NULLs in the list as bytes belonging to a list

   * element.

   */

  limit = (list + listLength);

  while ((p < limit) && (isspace(UCHAR(*p)))) 

  { /* INTL: ISO space. */

    p++;

  }

  if (p == limit) 

  {             /* no element found */

    elemStart = limit;

    goto done;

  }

  if (*p == '{')   /* } to keep vi happy */

  {

    openBraces = 1;

    p++;

  } 

  else if (*p == '"') 

  {

    inQuotes = 1;

    p++;

  }

  elemStart = p;

  if (bracePtr != 0) 

  {

    *bracePtr = openBraces;

  }

  /*

   * Find element's end (a space, close brace, or the end of the string).

   */

  while (p < limit) 

  {

    switch (*p) 

    {

      /*

       * Open brace: don't treat specially unless the element is in

       * braces. In this case, keep a nesting count.

       */

      case '{':

        if (openBraces != 0) 

        {

          openBraces++;

        }

        break;

        /*

         * Close brace: if element is in braces, keep nesting count and

         * quit when the last close brace is seen.

         */

      case '}':

        if (openBraces > 1) 

        {

          openBraces--;

        } 

        else if (openBraces == 1) 

        {

          size = (int)(p - elemStart);

          p++;

          if ((p >= limit) || isspace(UCHAR(*p))) 

          {     /* INTL: ISO space. */

            goto done;

          }

          /*

           * Garbage after the closing brace; return an error.

           */

          return TCL_ERROR;

        }

        break;

        /*

         * Backslash: skip over everything up to the end of the backslash

         * sequence.

         */

      case '\\':

        //RZ        Tcl_UtfBackslash(p, &numChars, NULL);

        //RZ        p += (numChars - 1);

        p++; //RZ

        break;

        /*

         * Space: ignore if element is in braces or quotes; otherwise

         * terminate element.

         */

      case ' ':

      case '\f':

      case '\n':

      case '\r':

      case '\t':

      case '\v':

        if ((openBraces == 0) && !inQuotes) 

        {

          size = (int)(p - elemStart);

          goto done;

        }

        break;

        /*

         * Double-quote: if element is in quotes then terminate it.

         */

      case '"':

        if (inQuotes) 

        {

          size = (int)(p - elemStart);

          p++;

          if ((p >= limit) || isspace(UCHAR(*p))) 

          {     /* INTL: ISO space */

            goto done;

          }

          /*

           * Garbage after the closing quote; return an error.

           */

          return TCL_ERROR;

        }

        break;

    }

    p++;

  }

  /*

   * End of list: terminate element.

   */

  if (p == limit) 

  {

    if (openBraces != 0) 

    {

      return TCL_ERROR;

    } 

    else if (inQuotes) 

    {

      return TCL_ERROR;

    }

    size = (int)(p - elemStart);

  }

done:

  while ((p < limit) && (isspace(UCHAR(*p)))) 

  { /* INTL: ISO space. */

    p++;

  }

  *elementPtr = elemStart;

  *nextPtr = p;

  if (sizePtr != 0) 

  {

    *sizePtr = size;

  }

  return TCL_OK;

}

int Tcl_SplitList(

    CONST char *list,           /* Pointer to string with list structure. */

    int *argcPtr,               /* Pointer to location to fill in with the

                                 * number of elements in the list. */

    CONST char ***argvPtr)      /* Pointer to place to store pointer to array

                                 * of pointers to list elements. */

{

  CONST char **argv, *l, *element;

  char *p;

  int length, size, i, result, elSize, brace;

  /*

   * Figure out how much space to allocate. There must be enough space for

   * both the array of pointers and also for a copy of the list. To estimate

   * the number of pointers needed, count the number of space characters in

   * the list.

   */

  for (size = 2, l = list; *l != 0; l++) 

  {

    if (isspace(UCHAR(*l))) 

    {                   /* INTL: ISO space. */

      size++;

      /*

       * Consecutive space can only count as a single list delimiter.

       */

      while (1) 

      {

        char next = *(l + 1);

        if (next == '\0') 

        {

          break;

        }

        ++l;

        if (isspace(UCHAR(next))) 

        {               /* INTL: ISO space. */

          continue;

        }

        break;

      }

    }

  }

  length = (int)(l - list);

  argv = (CONST char **) ckalloc((unsigned)

      ((size * sizeof(char *)) + length + 1));

  for (i = 0, p = ((char *) argv) + size*sizeof(char *);

      *list != 0;  i++) 

  {

    CONST char *prevList = list;

    result = TclFindElement(list, length, &element, &list,

        &elSize, &brace);

    length -= (int)(list - prevList);

    if (result != TCL_OK) 

    {

      ckfree((char *) argv);

      return result;

    }

    if (*element == 0) 

    {

      break;

    }

    if (i >= size) 

    {

      ckfree((char *) argv);

      return TCL_ERROR;

    }

    argv[i] = p;

    if (brace) 

    {

      memcpy(p, element, (size_t) elSize);

      p += elSize;

      *p = 0;

      p++;

    } 

    else 

    {

      TclCopyAndCollapse(elSize, element, p);

      p += elSize+1;

    }

  }

  argv[i] = NULL;

  *argvPtr = argv;

  *argcPtr = i;

  return TCL_OK;

}

// END of tclUtil.c

void tcl_split_list(QString &str, QStringList &list)

{

  int argc;

  const char **argv;

  list.clear();

  if (str.left(1)=="{" && str.right(1)=="}")

  {

    str=str.mid(1,str.length()-2);

  }

  else if (str.left(1)=="\"" && str.right(1)=="\"")

  {

    str=str.mid(1,str.length()-2);

  }

  if (Tcl_SplitList(str.ascii(),&argc,&argv) != TCL_OK)

  {

    list.append(str);

  }

  else

  {

    for (int i = 0; i < argc; i++)

    {

      list.append(argv[i]);

    }

    ckfree((char *) argv);

  }

}

//! Structure containing information about current scan context.

typedef struct

{

  char type[2]; // type of scan context: "\"" "{" "[" "?" " "

  int line0; // start line of scan context

  int line1; // end line of scan context

  YY_BUFFER_STATE buffer_state; // value of scan context

  QCString ns; // current namespace

  Entry *entry_fn; // if set contains the current proc/method/constructor/destructor

  Entry *entry_cl; // if set contain the current class

  Entry *entry_scan; // current scan entry

  Protection protection; // current protections state

  QStringList after; // option/value list (options: NULL comment keyword script)

} tcl_scan;

//* Structure containing all internal global variables.

static struct

{

  CodeOutputInterface * code; // if set then we are codifying the file

  int code_line; // current line of code

  int code_linenumbers; // if true create line numbers in code

  const char *code_font; // used font to codify

  bool config_autobrief; // value of configuration option

  QMap<QString,QString> config_subst; // map of configuration option values

  QCString input_string; // file contents

  int input_position; // position in file

  QCString file_name; // name of used file

  ParserInterface *this_parser; // myself

  int command; // true if command was found

  int comment; // set true if comment was scanned

  int brace_level; // bookkeeping of braces

  int bracket_level; // bookkeeping of brackets

  int bracket_quote; // bookkeeping of quotes (toggles)

  char word_is; // type of current word: "\"" "{" "[" "?" " "

  int line_comment; // line number of comment

  int line_commentline; // line number of comment after command

  int line_command; // line number of command

  int line_body0; // start line of body

  int line_body1; // end line of body

  QCString string_command; // contain current command

  QCString string_commentline; // contain current comment after command

  QCString string_commentcodify; // current comment string used in codifying

  QCString string_comment; // contain current comment

  QCString string_last; // contain last read word or part of word

  QCString string; // temporary string value

  Entry*                entry_main; // top level entry

  Entry*                entry_file; // entry of current file

  Entry*                entry_current; // currently used entry

  Entry*                entry_inside; // contain entry of current scan context

  QStringList list_commandwords; // list of command words

  QList<tcl_scan> scan; // stack of scan contexts

  QAsciiDict<Entry> ns; // all read namespace entries

  QAsciiDict<Entry> cl; // all read class entries

  QAsciiDict<Entry> fn; // all read function entries

  QList<Entry> entry; // list of all created entries, will be deleted after codifying

  Protection protection; // current protections state

  MemberDef *memberdef; // contain current MemberDef when codifying

  bool collectXRefs;

} tcl;

// scanner functions

static int yyread(char *buf,int max_size);

static tcl_scan *tcl_scan_start(char type, QString content, QCString ns, Entry *entry_cls, Entry *entry_fn);

static void tcl_scan_end();

static void tcl_comment(int what,const char *text);

static void tcl_word(int what,const char *text);

static void tcl_command(int what,const char *text);

// helper functions

//! Create new entry.

// @return new initialised entry

Entry* tcl_entry_new()

{

  Entry *myEntry = new Entry;

  myEntry->section    = Entry::EMPTY_SEC;

  myEntry->name       = "";

//  myEntry->type       = "";

  myEntry->brief      = "";

//  myEntry->doc        = "";

  myEntry->protection = Public;

//  myEntry->mtype      = Method;

//  myEntry->virt       = Normal;

//  myEntry->stat       = FALSE;

  myEntry->fileName   = tcl.file_name;

  myEntry->lang       = SrcLangExt_Tcl;

  initGroupInfo(myEntry);

  // collect entries

  if (!tcl.code)

  {

    tcl.entry.insert(0,myEntry);

  }

  return myEntry;

}

//! Set protection level.

void tcl_protection(Entry *entry) 

{

  if (entry->protection!=Public&&entry->protection!=Protected&&entry->protection!=Private)

  {

    entry->protection = tcl.protection;

  }

  if (entry->protection!=Protected&&entry->protection!=Private)

  {

    entry->protection = Public;

  }

}

//! Check name.

// @return 'ns' and 'name' of given current 'ns0' and 'name0'

static void tcl_name(const QCString &ns0, const QCString &name0, QCString &ns, QCString &name)

{

  QCString myNm;

  int myStart;

  if (qstrncmp(name0.data(),"::",2)==0)

  {

    myNm = name0.mid(2);

  }

  else if (ns0.length() && ns0 != " ")

  {

    myNm = ns0 + "::" + name0;

  }

  else

  {

    myNm = name0;

  }

  myStart = myNm.findRev("::");

  if (myStart == -1)

  {

    ns = "";

    name = myNm;

  }

  else

  {

    ns = myNm.mid(0,myStart);

    name = myNm.mid(myStart+2);

  }

}

//! Check name. Strip namespace qualifiers from name0 if inside inlined code segment.

// @return 'ns' and 'name' of given current 'ns0' and 'name0'

static void tcl_name_SnippetAware(const QCString &ns0, const QCString &name0, QCString &ns, QCString &name)

{

  // If we are inside an inlined code snippet then ns0

  // already contains the complete namespace path.

  // Any namespace qualifiers in name0 are redundant.

  int i = name0.findRev("::");

  if (i>=0 && tcl.memberdef)

  {

    tcl_name(ns0, name0.mid(i+2), ns, name);

  }

  else

  {

    tcl_name(ns0, name0, ns, name);

  }

}

// Check and return namespace entry.

// @return namespace entry

Entry* tcl_entry_namespace(const QCString ns)

{

  Entry *myEntry;

  if (ns.length())

  {

    myEntry = tcl.ns.find(ns);

  }

  else

  {

    myEntry = tcl.ns.find("::");

  }

  if (myEntry == NULL)

  {

    myEntry = tcl_entry_new();

    myEntry->section    = Entry::NAMESPACE_SEC;

    myEntry->name       = ns;

    tcl.entry_main->addSubEntry(myEntry);

    tcl.ns.insert(ns,myEntry);

  }

  return myEntry;

}

// Check and return class entry.

// @return class entry

Entry* tcl_entry_class(const QCString cl)

{

  Entry *myEntry;

  if (!cl.length()) return(NULL);

  myEntry = tcl.cl.find(cl);

  if (myEntry == NULL)

  {

    myEntry = tcl_entry_new();

    myEntry->section    = Entry::CLASS_SEC;

    myEntry->name       = cl;

    tcl.entry_main->addSubEntry(myEntry);

    tcl.cl.insert(cl,myEntry);

  }

  return myEntry;

}

//! Check for keywords.

// @return 1 if keyword and 0 otherwise

static int tcl_keyword(QCString str)

{

  static QStringList myList;

  static int myInit=1;

  if (myInit)

  {

    // tcl keywords

    myList <<"append"<<"apply"<<"array"<<"auto_execok"<<"auto_import"<<"auto_load"<<"auto_mkindex"<<"auto_qualify"<<"auto_reset";

    myList <<"binary";

    myList <<"catch"<<"cd"<<"close"<<"clock"<<"concat";

    myList <<"eof"<<"eval"<<"exec"<<"exit"<<"expr";

    myList <<"fblocked"<<"fconfigure"<<"file"<<"fileevent"<<"flush"<<"for"<<"foreach"<<"format";

    myList <<"gets"<<"global";

    myList <<"http";

    myList <<"if"<<"incr"<<"info"<<"interp";

    myList <<"join";

    myList <<"lappend"<<"lassign"<<"lindex"<<"linsert"<<"llength"<<"load"<<"lrange"<<"lrepeat"<<"lreplace"<<"lreverse"<<"lset";

    myList <<"namespace";

    myList <<"package"<<"parray"<<"pid"<<"pkg_mkIndex"<<"proc"<<"puts"<<"pwd";

    myList <<"registry"<<"rename"<<"return";

    myList <<"scan"<<"set"<<"split"<<"string"<<"switch";

    myList <<"tclLog"<<"tcl_endOfWord"<<"tcl_findLibrary"<<"tcl_startOfNextWord"<<"tcl_startOfPreviousWord"<<"tcl_wordBreakAfter"<<"tcl_wordBreakBefore"<<"tell"<<"time";

    myList <<"unknown"<<"upvar";

    myList <<"variable"<<"vwait";

// tk keywords

    myList <<"bell"<<"bind"<<"bindtags";

    myList <<"clipboard"<<"console"<<"consoleinterp";

    myList <<"destroy";

    myList <<"event";

    myList <<"focus";

    myList <<"grid";

    myList <<"lower";

    myList <<"option";

    myList <<"pack"<<"place";

    myList <<"raise";

    myList <<"send";

    myList <<"tkerror"<<"tkwait"<<"tk_bisque"<<"tk_focusNext"<<"tk_focusPrev"<<"tk_focusFollowsMouse"<<"tk_popup"<<"tk_setPalette"<<"tk_textCut"<<"tk_TextCopy"<<"tk_textPaste"<<"chooseColor"<<"tk_chooseColor"<<"tk_chooseDirectory"<<"tk_dialog"<<"tk_getOpenFile"<<"tkDialog"<<"tk_getSaveFile"<<"tk_messageBox";

    myList <<"winfo"<<"wm";

    myList <<"button"<<"canvas"<<"checkbutton"<<"entry"<<"frame"<<"image"<<"label"<<"labelframe"<<"listbox"<<"menu"<<"menubutton"<<"message"<<"panedwindow"<<"radiobutton"<<"scale"<<"scrollbar"<<"spinbox"<<"toplevel";

    myList.sort();

    myInit=0;

  }

  str=str.stripWhiteSpace();

  if (str.left(2)=="::") {str=str.mid(2);}

  if (myList.findIndex(str) != -1) return(1);

  return 0;

}

//! End codifying with special font class.

static void tcl_font_end()

{

  if (!tcl.code) return;

  if (tcl.code_font)

  {

    tcl.code->endFontClass();

    tcl.code_font=NULL;

  }

}

//! Codify 'str' with special font class 's'.

static void tcl_codify(const char *s,const char *str)

{

  if (!tcl.code || !str) return;

  if (s && qstrcmp(s,"NULL")!=0)

  {

    tcl_font_end();

    tcl.code->startFontClass(s);

    tcl.code_font=s;

  }

  char *tmp = (char *) malloc(strlen(str)+1);

  strcpy(tmp, str);

  char *p=tmp,*sp=p;

  char c;

  bool done=FALSE;

  while (!done)

  {

    sp=p;

    while ((c=*p++) && c!='\n') {}

    if (c=='\n')

    {

      tcl.code_line++;

      *(p-1)='\0'; // Dimitri: is this really needed?

                   // wtschueller: As far as I can see: yes.

                   // Deletes that \n that would produce ugly source listings otherwise.

                   // However, there may exist more sophisticated solutions.

      tcl.code->codify(sp);

      if (tcl.code_font)

      {

        tcl.code->endFontClass();

      }

      tcl.code->endCodeLine();

      tcl.code->startCodeLine(tcl.code_linenumbers);

      if (tcl.code_linenumbers)

      {

        tcl.code->writeLineNumber(0,0,0,tcl.code_line);

      }

      if (tcl.code_font)

      {

        tcl.code->startFontClass(tcl.code_font);

      }

    }

    else

    {

      tcl.code->codify(sp);

      done=TRUE;

    }

  }

  free(tmp);

  tcl_font_end();

}

#if 0

//! Codify 'str' with special font class 's'.

static void tcl_codify(const char *s,const char *str)

{

  if (tcl.code==NULL) return;

  char *tmp= (char *) malloc(strlen(str)+1);

  strcpy(tmp, str);

  tcl_codify(s,tmp);

  free(tmp);

}

//! Codify 'str' with special font class 's'.

static void tcl_codify(const char *s,const QString &str)

{

  if (tcl.code==NULL) return;

  tcl_codify(s,str.utf8());

}

//! Codify 'str' with special font class 's'.

static void tcl_codify(const char *s,const QCString &str)

{

  if (!tcl.code) return;

  tcl_codify(s,str.data());

}

#endif

static void tcl_codify_cmd(const char *s,int i)

{

  tcl_codify(s,(*tcl.list_commandwords.at(i)).utf8());

}

//! codify a string token

//

// codifies string according to type.

// Starts a new scan context if needed (*myScan==0 and type == "script").

// Returns NULL or the created scan context.

//

static tcl_scan *tcl_codify_token(tcl_scan *myScan, const QCString type, const QCString string)

{

    if (myScan != NULL)

    {

      if (type != NULL)

      {

        myScan->after << type << string;

      }

      else

      {

        myScan->after << "NULL" << string;

      }

    }

    else

    {

      if (qstrcmp(type, "script") == 0)

      {

        myScan = tcl.scan.at(0);

        myScan = tcl_scan_start('?', string,

                myScan->ns, myScan->entry_cl, myScan->entry_fn);

      }

      else

      {

        tcl_codify((const char*)type, string);

      }

    }

    return myScan;

}

//-----------------------------------------------------------------------------

#undef  YY_INPUT

#define YY_INPUT(buf,result,max_size) result=yyread(buf,max_size);

//-----------------------------------------------------------------------------

%}

ws              ([ \t]|\\\n)

%option yylineno

%option noyywrap

%option stack

%x ERROR

%x TOP

%x COMMAND

%x WORD

%x COMMENT

%x COMMENT_NL

%x COMMENT_CODE

%x COMMENT_VERB

%x COMMENTLINE

%x COMMENTLINE_NL

%%

<ERROR>. {

D

  yyterminate();

}

<<EOF>> {

D

  if (tcl.scan.count()<1)

  {// error

D

    tcl_err("Tcl parser stack empty! Parser error in file '%s'.\n",tcl.file_name.data());

    yyterminate();

  }

  else if (tcl.scan.count()==1)

  {// exit, check on input?

D

    yyterminate();

  }

  else

  {// continue

D

    tcl_command(-1,"");

    tcl_scan_end();

  }

}

<TOP>"#" {

D

  yyless(0);

  tcl.line_comment=yylineno;

  tcl_comment(0,"");

}

<TOP>({ws}|[\;\n])+ {

D

  tcl_codify(NULL,yytext);

}

<TOP>. {

D

  yyless(0);

  tcl.line_command=yylineno;

  tcl_command(0,"");

}

<COMMENT>[ \t]* {

D

  tcl_codify("comment",yytext);

}

<COMMENT>"###".*\n {

D

  tcl_codify("comment",yytext);

  tcl_comment(2,yytext+1);

}

<COMMENT>"##".*\\\n {

D

  tcl_codify("comment",yytext);

  QCString t=yytext;

  t = t.mid(2,t.length()-3);

  t.append("\n");

  tcl_comment(1,t.data());

  yy_push_state(COMMENT_NL);

}

<COMMENT>"##".*\n {

D

  tcl_codify("comment",yytext);

  tcl_comment(1,yytext+2);

}

<COMMENT>"#"[@\\]"code"\n[ \t]*[^#] {

D

  QCString t=yytext;

  tcl_codify("comment",t.left(7));

  tcl_comment(2,"\n@code\n");

  yyless(7);

  yy_push_state(COMMENT_CODE);

}

<COMMENT>"#"[@\\]"verbatim"\n[ \t]*[^#] {

D

  QCString t=yytext;

  tcl_codify("comment",t.left(11));

  tcl_comment(2,"\n@verbatim\n");

  yyless(11);

  yy_push_state(COMMENT_VERB);

}