From: pnr@innopoli.ajk.tele.fi (Pekka Nikander)
Newsgroups: comp.lang.tcl
Subject: Dynamic Regexp (was Re: On thanx, SQL, Lex/Yacc, and perl)
Date: 11 Apr 92 12:38:20 GMT
Distribution: all
Organization: Telecomm Finland

In article <1992Apr6.215853.10020@PacBell.COM> t4mhoff@srv.PacBell.COM (Todd Hoff) writes:

> Does anyone have a tcl interface for:
> 2. Building Lex/Yacc type programs.

Well, I am writing a module that allows one to turn textually
represented regular expressions into desterministic finete automata
(this works) and allows one to simultaneously search a match for
several patterns (this does not work properly).  

My primary problem is that I haven't figured out in what ways it would
be useful to combine several regular expressions.  There are clearly
several possiblities:
  a) lex style:  get the longest match in priority order
  b) a "dynamic" style: get the first match in priority order
  c) etc...
The secondary problem is that I would like to backtrack as little as
possible, but I haven't got time to search the compiler litterature
for good methods of avoiding backtracking....  The current
implementation does not backtrack at all in the case of a single
regexp, but when there are many I have problems....

BTW.  Below is an utterly simple ANSI terminal emulater written in TCL
and my regexp package (using tkText winget).....  It nearly works
(setting cursor to some arbitary position does not work).  If you are
interested, please let me know and I may send you an interim copy of
my C-code...

#
# Test code -- implements a very simple ANSI terminal emulator
#

#
# Echo is used for debugging
#

proc echo {args} {puts stdout "$args"}

# 
# optionHandler is called whenever the underlying Telnet protocol
# machine receives an Telnet option request.  
#

proc optionHandler {command option} {
   echo $command $option
   if {$command == "do"} {
       if {$option == "echo"} {return true}
       if {$option == "ttype"} {return true}
   }
   if {$command == "will"} {
       if {$option == "sga"} {return true}
       if {$option == "echo"} {return true}
   }
   return false
}

# 
# giveTermType is called be Telnet protocol machine to handle
# suboption requests.  The only suboption request we know
# is ttype, i.e. terminal type.  We try to emulate 
# a very little subset of the ansi type
#

proc giveTermType {option} {
  echo suboptionrequest $option
  if {$option == "ttype"} {return "ansi"}
  error "bad suboption request"
}

# 
# The doRead procedure is called by the tk select routine
# to process data that is available at the communication 
# socket.  It is activated via "handle" command which
# calls Tcp_FileHanderCmd.
#
# The command reads data from the communication socket
# via the Telnet protocol machine.  The Telnet protocl
# machine handles all the options during the reading
# and calls optionHandler (and giveTermType when
# a suboptionrequest is received).  The resulting
# string is the read data sans Telnet protocol.  This
# is handled to the expect pattern matcher, which in turn
# will call the appropriate routines so that we get
# an utterly simple terminal emulator.
# 

proc doRead {eventType fileHandle} {
  global expect
  global telnet
  $expect inputstring "[$telnet read]"
}

# 
# The next few term.* routines attempt to implement an utterly
# simple terminal emulator.  However, since the text widget
# does not contain a actual "position cursor here" routine,
# and my simplistic attempt does not work, full screen mode
# does not work.
#

proc term.backspace {regexp string} 	{ .text edit bc }
proc term.insert    {regexp string}	{ .text insert cursor "$string" }
proc term.newline   {regexp string}	{ .text edit eol;
					  .text insert cursor "\n" }
proc term.return    {regexp string}	{ .text edit bol }
proc term.up	    {regexp string}	{ .text edit pl }
proc term.nd	    {regexp string}	{ .text edit fc }
proc term.ce	    {regexp string}	{ .text edit kill }
proc term.ho	    {regexp string}	{ .text cursor 0 }

proc term.bell	    {regexp string}	{ puts stdout "$string" }
proc term.ignore    {regexp string}	{}

# The term cm does not work.  Inserting newlines is an 
# attemt to make it to work, but anyway, it does not

proc term.clear     {regexp string}	{
     .text delete 0 end
     .text insert end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
     .text cursor 0
}

# .text goto is an attempt to force the cursor to move
# to a specific position.  However, it does not seem to work.

proc term.cm	    {regexp string}	{
     scan "$string" "\033\[%d;%dH" row col
     echo cm $row $col
     .text goto $row $col
}

#
# The following expect object implements the actual ANSI terminal
# 

set expect [expect {
  "\033\\[;H\033\\[2J"	{term.clear}
  "\033\\[[0-9]*;[0-9]*H" {term.cm}
  "\033\\[C"		{term.nd}
  "\033\\[A"		{term.up}
  "\033\\[K"		{term.ce}
  "\033\\[H"		{term.ho}
  "\007"	   	{term.bell}
  "\008"		{term.backspace}
  "\012"		{term.newline}
  "\015"		{term.return}
  "..*"			{term.insert}
}]

#
#----------------------------------------------------------------
#

# Parameters

set host "ajk.tele.fi"

# Connect to the remote host

set file [connect $host telnet]

# Create a Telnet protocol machine to handle Telnet negotiation

set telnet [telnet $file -command echo \
			 -option optionHandler \
			 -command suboptrequest giveTermType]

# Arrange the doRead routine to be called whenever there is
# data available from the remote host

handle $file r doRead

# Create a new text widget and display it.  Put the keyboard
# focus into it so that the cursor will be shown.

text .text -height 24 -width 80 -cursorwidth 3 -cursorofftime 100
pack append . .text top
focus .text

# Bind all keyboard events to send the corresponding ASCII
# code to the Telnet connection

bind .text <Any-Key> {$telnet write "%A"}


--
Pekka Nikander