Skip to content

Instantly share code, notes, and snippets.

@rhaberkorn

rhaberkorn/theco.rex

Created November 22, 2012 23:56
Show Gist options
  • Save rhaberkorn/4133371 to your computer and use it in GitHub Desktop.
Save rhaberkorn/4133371 to your computer and use it in GitHub Desktop.
Download ZIP
Abandoned (Video)TECO implementation on top of The Hessling Editor, written in Open Object Rexx
Raw
theco.rex
#!/usr/local/bin/nthe -p
if .environment~theco.initialized \= .nil then return
/*
* Initialize classic Rexx function packages
*/
call ReLoadFuncs
/*
* THE profile code: THECO initialization
*/
keys = .Array~of(-
"A", "B", "C", "D", "E", "F", "G", "H", "I", "J",-
"K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",-
"U", "V", "W", "X", "Y", "Z", "S-A", "S-B", "S-C", "S-D",-
"S-E", "S-F", "S-G", "S-H", "S-I", "S-J", "S-K", "S-L", "S-M", "S-N",-
"S-O", "S-P", "S-Q", "S-R", "S-S", "S-T", "S-U", "S-V", "S-W", "S-X",-
"S-Y", "S-Z", "0", "1", "2", "3", "4", "5", "6", "7",-
"8", "9", "`", "-", "=", "[", "]", "\", ";", "'",-
",", ".", "/", ")", "!", "@", "#", "$", "%",-
"^", "&", "*", "(", "~", "_", "+", "{", "}", "|",-
":", '"', "<", ">", "?", "SPACE", "ESC", "F0", "F1", "F2", "F3",-
"F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12", "S-F1",-
"S-F2", "S-F3", "S-F4", "S-F5", "S-F6", "S-F7", "S-F8", "S-F9", "S-F10", "S-F11",-
"S-F12", "C-F1", "C-F2", "C-F3", "C-F4", "C-F5", "C-F6", "C-F7", "C-F8", "C-F9",-
"C-F10", "C-F11", "C-F12", "A-F1", "A-F2", "A-F3", "A-F4", "A-F5", "A-F6", "A-F7",-
"A-F8", "A-F9", "A-F10", "A-F11", "A-F12", "F13", "F14", "F15", "F16", "F17",-
"F18", "F19", "F20", "S-F13", "S-F14", "S-F15", "S-F16", "S-F17", "S-F18", "S-F19",-
"NUM0", "NUM1", "NUM2", "NUM3", "NUM4", "CENTER", "NUM6", "NUM7", "NUM8", "NUM9",-
"CURU", "CURD", "CURL", "CURR", "ENTER", "ENTER", "TAB", "HOME", "PGUP",-
"PGDN", "END", "INS", "DEL", "PLUS", "MINUS", "SLASH", "STAR", "NUMENTER", "NUMSTOP",-
"S-HOME", "S-END", "S-CURL", "S-CURR",-
"C-TAB", "C-HOME", "C-PGUP", "C-PGDN", "C-CURU", "C-CURD",-
"C-CURL", "C-CURR", "C-END",-
"S-TAB", "S-INS", "SELECT", "PRINT", "S-PRINT", "FIND", "S-FIND", "SUSPEND", "S-SUSPEND",-
"CLEAR", "OPTIONS", "S-OPTIONS", "BREAK", "CANCEL", "S-CANCEL", "HELP", "S-HELP", "S-TAB",-
"S-INS", "EXIT", "CURD",-
"CURU", "CURL", "CURR", "BACKSPACE", "HOME", "PF1", "PF2", "PF3", "PF4", "NUMENTER",-
"MINUS", "NUMSTOP", "COMMA", "STAR", "PLUS", "SLASH", "S-TAB", "FIND", "INS", "REMOVE",-
"DEL", "SELECT", "PGUP", "PGDN", "TAB", "ENTER", "TAB", "RETURN", "CSI", "BREAK",-
"DL", "IL", "DC", "INS", "EIC", "CLEAR", "EOS", "EOL", "SF", "SR",-
"PGDN", "PGUP", "S-TAB", "C-TAB", "CATAB", "ENTER", "S-RESET", "RESET", "PRINT", "LL",-
"A1", "A3", "B2", "C1", "C3", "S-TAB", "BEG", "CANCEL", "CLOSE", "COMMAND",-
"COPY", "CREATE", "END", "EXIT", "FIND", "HELP", "MARK", "MESSAGE", "MOVE", "NEXT",-
"OPEN", "OPTIONS", "PREVIOUS", "REDO", "REFERENCE", "REFRESH", "REPLACE", "RESTART", "RESUME", "SAVE",-
"S-BEG", "S-CANCEL", "S-COMMAND", "S-COPY", "S-CREATE", "S-DC", "S-DL", "SELECT", "S-END", "S-EOL",-
"S-EXIT", "S-FIND", "S-HELP", "S-HOME", "S-INS", "S-CURL", "S-MESSAGE", "S-MOVE", "S-NEXT", "S-OPTIONS",-
"S-PREVIOUS", "S-PRINT", "S-REDO", "S-REPLACE", "S-CURR", "S-RSUME", "S-SAVE", "S-SUSPEND", "S-UNDO", "SUSPEND",-
"UNDO", "C-CURL", "C-CURR", "C-CURU", "C-CURD", "C-HOME", "C-END", "C-PGUP", "C-PGDN", "C-A",-
"C-B", "C-C", "C-D", "C-E", "C-F", "C-G", "C-H", "C-I", "C-J", "C-K",-
"C-L", "C-M", "C-N", "C-O", "C-P", "C-Q", "C-R", "C-S", "C-T", "C-U",-
"C-V", "C-W", "C-X", "C-Y", "C-Z",-
)
'set msgmode off'
do key over keys
'define' key 'rexx call theco_keypress' stringify(key)';',
'::requires "theco"'
end
'set msgmode on'
'set cmdline off'
'set insertmode on'
/*
* configurable by THECO macro
*/
'color filearea white black'
'color pr green black'
'color cpr black green'
'color arrow green black'
'color st black white'
'color to bold green black'
'color cto bold black green'
'color divider black white'
'color idline black white'
'color scale green black'
'color cur reverse'
'ecolor b yellow black'
'ecolor s white black'
'ecolor f bright cyan on black'
'ecolor i magenta on black'
'ecolor c bright blue on black'
'ecolor d bright green on black'
'ecolor a blue on black'
'ecolor x magenta on black'
'ecolor 5 red on black'
'ecolor 2 bright blue on black'
'ecolor 6 bright green on black'
'ecolor y bright green on black'
'ecolor w bright red on black'
'set beep on'
'set insertmode on'
/*'reprofile on'*/
/* NOTE: currently broken on THE v3.3 RC1? */
'set tabkey tab character'
/*
* NOTE: control chars broken on THE v3.3 RC1
* NOTE: setting excape char yields error
* WORKAROUND: reset attribs after escaping the escape char
* WORKAROUND: disable messages for setting escape char
*/
'nomsg set ctlchar \ escape'
'set ctlchar N protect normal'
'set ctlchar R protect reverse'
.environment~theco.cmdline = ""
.environment~theco.undo = .UndoStackDummy~new
.environment~theco.quit_requested = .false
.environment~theco.escape = '1B'x
.environment~theco.modifiers.at = .false
.environment~theco.modifiers.colon = .false
'set reserved -1' echo_cmdline(.environment~theco.cmdline)
/*
* Parser state machine
*/
s = .Table~new
s["start"] = .StateStart~new
s["start"][""] = "start"
s["start"][" "] = "start"
s["start"]['0D'x] = "start"
s["start"]['0A'x] = "start"
s["start"]["!"] = "label"
s["start"]["^"] = "ctlcmd"
s["start"]["F"] = "fcmd"
s["start"]['"'] = "condcmd"
s["start"]["O"] = "cmd_goto"
s["start"]["Q"] = "qcmd"
s["start"]["U"] = "ucmd"
s["start"]["%"] = "inccmd"
s["start"]["M"] = "mcmd"
s["start"]["E"] = "ecmd"
s["start"]["I"] = "cmd_insert"
s["start"]["S"] = "cmd_search"
s["label"] = .StateLabel~new
s["label"][""] = "label"
s["ctlcmd"] = .StateCtlCmd~new
s["ctlcmd"][""] = "ctlcmd"
s["ctlcmd"]["U"] = "ctlucmd"
s["ctlucmd"] = .StateCtlUCmd~new
s["ctlucmd"][""] = "ctlucmd"
s["cmd_ctlu"] = .StateCmdCtlU~new
s["fcmd"] = .StateFCmd~new
s["fcmd"][""] = "fcmd"
s["condcmd"] = .StateCondCmd~new
s["condcmd"][""] = "condcmd"
s["cmd_goto"] = .StateCmdGoto~new
s["qcmd"] = .StateQCmd~new
s["qcmd"][""] = "qcmd"
s["ucmd"] = .StateUCmd~new
s["ucmd"][""] = "ucmd"
s["inccmd"] = .StateIncCmd~new
s["inccmd"][""] = "inccmd"
s["mcmd"] = .StateMCmd~new
s["mcmd"][""] = "mcmd"
s["ecmd"] = .StateECmd~new
s["ecmd"][""] = "ecmd"
s["ecmd"]["B"] = "cmd_file"
s["ecmd"]["Q"] = "eqcmd"
s["cmd_file"] = .StateCmdFile~new
s["eqcmd"] = .StateEQCmd~new
s["eqcmd"][""] = "eqcmd"
s["cmd_insert"] = .StateCmdInsert~new
s["cmd_search"] = .StateCmdSearch~new
.environment~theco.states = s
.environment~theco.state = s["start"]
/*
* Operator precedence table
* "=" is not a real operator and excluded from comparisons
*/
operators = .Array~of("^*","*","/","^/","+","-","&","#","(","<")
.ArithmeticStack~precedence = .Table~new
do i = 1 to operators~items
.ArithmeticStack~precedence[operators[i]] = i
end
.ArithmeticStack~precedence[.nil] = i
.ArithmeticStack~operators = .Operators~new
.environment~theco.stack = .ArithmeticStack~new
.environment~theco.reg_arg = .nil
/*
* Strings (for storing string arguments)
*/
.environment~theco.strings.1 = ""
.environment~theco.strings.2 = ""
/*
* Q-Registers
*/
.environment~theco.registers = .Table~new
do c = "A"~c2d to "Z"~c2d
.environment~theco.registers[c~d2c] = .QRegister~new(c~d2c)
end
do c = 0 to 9
.environment~theco.registers[c] = .QRegister~new(c)
end
/* search string & status (examined by ";" command) */
.environment~theco.registers["_"] = .QRegister~new("_")
.environment~theco.registers["_"]~integer = 0 /* failure */
/*
* THECO labels mapped to program counters
*/
.environment~theco.goto_table = .Table~new
.environment~theco.pc = 0
.environment~theco.exec = .true
.environment~theco.skip_else = .false
.environment~theco.skip_label = .nil
.environment~theco.nest_level = 0
'locate 1'
/*
* Execute TECO.INI
*/
input = .Stream~new("teco.ini")
input~open("read")
if \execute(input~charIn(1, input~chars)) then do
say "Error executing teco.ini"
return
end
input~close
.environment~theco.pc = 0
.environment~theco.undo = .UndoStack~new
.environment~theco.initialized = .true
/*
* Main entry point, called on key press
*/
::routine theco_keypress public
use arg key_the
/*
* Translate THE key to TECO ASCII char
*/
select
when lastkey.2() \== "" then
key_char = lastkey.2()~d2c
when key_the == "BACKSPACE" then
key_char = '08'x
when key_the == "DC" then
/* FIXME: preliminary escape surrogate */
key_char = '1B'x
otherwise
'emsg WARNING: Unresolved key' key_the 'ignored'
return
end
cmdline = sor(.environment~theco.cmdline, "")
/*
* Process immediate editing commands
*/
insert = ""
select
when key_the == "BACKSPACE" then do
.environment~theco.undo~pop(cmdline~length)
cmdline = cmdline~left(max(cmdline~length - 1, 0))
.environment~theco.pc = cmdline~length
end
when key_the == "C-T" | key_char == '09'x,-
.environment~theco.state~name == "cmd_file" then do
filename = .environment~theco.strings.1
insert = filename_complete(filename, .environment~theco.escape)
end
when key_the == "C-T" then do
start = last_match(cmdline, '0D 0A 09'x "<>,;@") + 1
insert = filename_complete(cmdline~substr(start))
end
otherwise
insert = key_char
end
old_cmdline = .environment~theco.cmdline
.environment~theco.cmdline = cmdline
/*
* Parse/execute characters
*/
do insert_index = 1 to insert~length
cmdline ||= insert~subchar(insert_index)
.environment~theco.cmdline = cmdline
if \execute(cmdline) then do
.environment~theco.cmdline = old_cmdline
leave insert_index
end
end
/*
* Echo command line
*/
'set reserved -1' echo_cmdline(sor(.environment~theco.cmdline, ""))
/*
* Parse/execute
*/
::routine execute
use arg code
do while .environment~theco.pc < code~length
.environment~theco.pc += 1
c = code~subchar(.environment~theco.pc)
if \.State~input(c) then do
.environment~theco.pc -= 1 /* FIXME */
'emsg Syntax error "'c'"'
return .false
end
end
return .true
/*
* Return cmdline in as a reserved line string (for echoing)
*/
::routine echo_cmdline
use arg cmdline
/* FIXME : could use CHANGESTR() */
line = ""
do i = 1 to cmdline~length
c = cmdline~subchar(i)
select
when c == "\" then
line ||= "\\N"
when c == '1B'x then
line ||= "$"
when c == '0D'x then
line ||= "<CR>"
when c == '0A'x then
line ||= "<LF>"
when c == '09'x then
line ||= "<TAB>"
when c~c2d < 32 then
line ||= "^"ctlecho(c)
otherwise
line ||= c
end
end
half_line = (lscreen.2() - 2) % 2
line = line~right(min(line~length,-
half_line + line~length // half_line))
return "*"line"\R "
/*
* Complete filename/path (used for autocompletions)
*/
::routine filename_complete
use arg filename, completed=" "
/*
* Do not complete match specs
*/
if is_matchspec(filename) then return ""
/*
* Get all files/directorie beginning with `filename`
*/
if SysFileTree(filename"*", "matching.") \= 0 then return ""
if matching.0 = 0 then return ""
complete_chars = filespec("name", filename)~length
/*
* Complete the entire filename if possible
*/
matching.1 = get_real_filename(matching.1)
if matching.0 = 1 then do
if matching.1~right(1) \== get_path_sep() then
matching.1 ||= completed
return matching.1~substr(complete_chars + 1)
end
/*
* Find the longest common prefix of all matching files/directories
* and complete it
*/
longest_prefix = matching.1~length
longest_file = matching.1~length
do i = 2 to matching.0
matching.i = get_real_filename(matching.i)
longest_prefix = min(longest_prefix,-
matching.i~compare(matching.1) - 1)
longest_file = max(longest_file, matching.i~length)
end
if longest_prefix > complete_chars then
return matching.1~left(longest_prefix),
~substr(complete_chars + 1)
/*
* If no completion is possible, display all matching files
*/
if SysStemSort("matching.") \= 0 then return ""
screen_width = lscreen.2()
col_length = min(longest_file + 3, screen_width)
old_msglines = msgline.3()
'set msgline on = * ='
line = ""
do i = 1 to matching.0
if line~length + col_length > screen_width then do
'msg' line
line = ""
end
line ||= matching.i~left(col_length)
end
'msg' line
'set msgline on =' old_msglines '='
return ""
::class UndoToken
::attribute pos
::attribute code
::method INIT
use arg self~pos, self~code
::method run
interpret self~code
::class UndoStack subclass Queue
::method push
use arg code
token = .UndoToken~new(.environment~theco.cmdline~length, code)
self~push:super(token)
::method push_cmd
use arg cmd
self~push(stringify(cmd))
::method pop
use arg pos
do while self~peek \= .nil, self~peek~pos = pos
self~pull~run
end
/*
* Undo stack dummy implementation - use when rubout is not required
*/
::class UndoStackDummy
::method push
::method push_cmd
::method pop
/*
* Class implementing THECO operators, dy default forwarded to the String class
* (by default THECO operator equals Rexx operator)
*/
::class Operators
::method "/"
return arg(1) % arg(2)
::method "&"
return arg(1)~d2c~bitAnd(arg(2)~d2c)~c2d
::method "#"
return arg(1)~d2c~bitOr(arg(2)~d2c)~c2d
::method "^*"
return arg(1) ** arg(2)
::method "^/"
return arg(1) // arg(2)
::method UNKNOWN
use arg name, arguments
return arguments[1]~send(name, arguments[2])
::class ArithmeticStack
::attribute precedence class
::attribute operators class
/* special value "" is pushed by "," and means: no argument (yet) */
::attribute nums
::attribute ops
::attribute num_sign
::attribute radix
::method INIT
self~nums = .Queue~new
self~ops = .Queue~new
self~num_sign = 1
self~radix = 10
::method set_radix
use arg radix
.environment~theco.undo~~push(-
".environment~theco.stack~radix =" self~radix-
)
self~radix = radix
::method push_num
do while self~nums~peek = ""
self~pop_num
end
self~push_op("=")
.environment~theco.undo~~push(-
".environment~theco.stack~nums~pull"-
)
forward message "push" to (self~nums)
::method pop_num
use arg index=1
n = self~~pop_op~nums~remove(index)
if n \= .nil then
.environment~theco.undo~~push(-
".environment~theco.stack~nums~insert('"n"',"-
isor(index - 1, ".nil")")"-
)
return n
::method pop_num_calc
use arg index=1, imply=(self~num_sign)
n = ""
if self~~eval~args > 0 then
n = self~pop_num(index)
if n == "" then
n = imply
if self~num_sign < 0 then do
.environment~theco.undo~~push(-
".environment~theco.stack~num_sign = -1"-
)
self~num_sign = 1
end
return n
::method add_digit
use arg digit
n = ""
if self~args > 0 then
n = self~pop_num
self~push_num(sor(n, 0)*self~radix + self~num_sign*digit)
::method push_op
.environment~theco.undo~~push(-
".environment~theco.stack~ops~pull"-
)
forward message "push" to (self~ops)
::method push_op_calc
use arg op
/* calculate if op has lower precedence than op on stack */
if .ArithmeticStack~precedence[self~ops[self~first_op]] <=,
.ArithmeticStack~precedence[op] then self~calc
self~push_op(op)
::method pop_op
use arg index=1
o = self~ops~remove(index)
if o \= .nil then
.environment~theco.undo~~push(-
".environment~theco.stack~ops~insert('"o"',"-
isor(index - 1, ".nil")")"-
)
return o
::method calc
vright = self~pop_num
op = self~pop_op
vleft = self~pop_num
self~push_num(-
.ArithmeticStack~operators~send(op, vleft, vright)-
)
::method eval
use arg pop_brace=.false
if self~nums~items < 2 then return
do label calc forever
n = self~first_op
op = self~ops[n]
select
when op = .nil | op == "<" then leave calc
when op == "(" then do
if pop_brace then self~pop_op(n)
leave calc
end
otherwise self~calc
end
end calc
::method args
do n = 0 while self~ops[n+1] = "="; end
return n
::method first_op
do n = 1 to self~ops~items while self~ops[n] = "="; end
return n
::method discard_args
do self~~eval~args
self~pop_num_calc
end
::class QRegister
::attribute name
::attribute integer
::attribute fileid
::method INIT
use arg self~name
self~integer = 0
/*
* FIXME: create as pseudo-files if possible
*/
prev_file = efileid.1()
'nomsg edit' SysTempFileName("THECO.???")
'add' /* no we are automatically in line 1 */
self~fileid = efileid.1()
'edit' prev_file
::method edit
.environment~theco.undo~~push_cmd('edit' efileid.1())
'edit' self~fileid
::method "string"
old_fileid = efileid.1()
'edit' self~fileid
buffer = get_buffer()
'edit' old_fileid
return buffer~toString("l", get_eol())
::method "string="
use arg val
old_fileid = efileid.1()
'edit' self~fileid
.environment~theco.undo~~push_cmd('edit' old_fileid),
~~push_cmd('clocate :'column.1()),
~~push_cmd('locate :'line.1())
buffer = get_buffer()
do i = 1 to buffer~items
if i > 1 then
.environment~theco.undo~~push_cmd('split cursor')
.environment~theco.undo~~push_cmd('cinsert' buffer[i])
end
.environment~theco.undo~~push_cmd('add'),
~~push_cmd('delete *'),
~~push_cmd('locate :1'),
~~push_cmd('edit' self~fileid)
'locate :1'
'delete *'
do line over tokenize(val, '0D 0A'x)
'add'
'cinsert' line
end
'locate :1'
'edit' old_fileid
::class State
::attribute name
::attribute transitions
::method INIT
use arg self~name
self~transitions = .Table~new
::method "[]="
forward to (self~transitions)
::method eval_colon class
if \.environment~theco.modifiers.colon then return .false
.environment~theco.modifiers.colon = .false
.environment~theco.undo~~push(-
".environment~theco.modifiers.colon = true"-
)
return .true
::method input class
use arg key
state = .environment~theco.state
do forever
next_state = state~get_next_state(key)
/* syntax error */
if next_state == "" then return .false
if next_state == state~name then leave
state = .environment~theco.states[next_state]
key = ""
end
if next_state \== .environment~theco.state~name then do
.environment~theco.undo~~push(-
".environment~theco.state ="-
".environment~theco.states['"||-
.environment~theco.state~name"']"-
)
.environment~theco.state = state
end
return .true
::method get_next_state
use arg key
next_state = self~transitions[key~upper]
if next_state = .nil then
next_state = self~custom(key)
return next_state
::method custom abstract
/*
* Super-class for states accepting string arguments
* Opaquely cares about alternative-escape characters,
* string building commands and accumulation into a string
*/
::class StateExpectString subclass State
::attribute state class
::attribute mode class
::attribute toctl class
::method INIT
.StateExpectString~state = "start"
.StateExpectString~mode = ""
.StateExpectString~toctl = .false
forward class (super)
::method save_machine class
.environment~theco.undo~~push(-
".StateExpectString~state =" stringify(self~state)-
)~~push(-
".StateExpectString~mode =" stringify(self~mode)-
)~~push(".StateExpectString~toctl =" self~toctl)
::method machine class
use arg input
select
when self~mode == "upper" then
input = input~upper
when self~mode == "lower" then
input = input~lower
otherwise
end
if self~toctl then do
input = input~upper~bitAnd('3F'x)
self~toctl = .false
end
select
when self~state == "escaped" then do
self~state = "start"
return input
end
when input == "^" then
self~toctl = .true
when self~state == "start" then do
if input~c2d >= 32 then return input
echo = ctlecho(input)
select
when echo == "Q" |,
echo == "R" then self~state = "escaped"
when echo == "V" then self~state = "lower"
when echo == "W" then self~state = "upper"
when echo == "E" then self~state = "ctle"
otherwise
return input
end
end
when self~state == "lower" then do
self~state = "start"
select
when input~c2d < 32, ctlecho(input) == "V" then
self~mode = "lower"
otherwise
return input~lower
end
end
when self~state == "upper" then do
self~state = "start"
select
when input~c2d < 32, ctlecho(input) == "W" then
self~mode = "upper"
otherwise
return input~upper
end
end
when self~state == "ctle" then do
input = input~upper
select
when input == "Q" then self~state = "ctleq"
when input == "U" then self~state = "ctleu"
otherwise
return .nil
end
end
when self~state == "ctleq" then do
reg = .environment~theco.registers[input~upper]
if reg = .nil then return .nil
self~state = "start"
return reg~string
end
when self~state == "ctleu" then do
reg = .environment~theco.registers[input~upper]
if reg = .nil then return .nil
self~state = "start"
return reg~integer~d2c
end
otherwise
return .nil
end
return ""
::method custom
use arg key
if key == "" then do
if .environment~theco.exec then self~initial
return self~name
end
/*
* String termination handling
*/
if .environment~theco.modifiers.at then do
.environment~theco.undo~~push(-
".environment~theco.modifiers.at = .true"-
)~~push(".environment~theco.escape = '1B'x")
.environment~theco.modifiers.at = .false
.environment~theco.escape = key~upper
return self~name
end
if key~upper == .environment~theco.escape then do
.environment~theco.undo~~push(-
".environment~theco.escape ="-
"'".environment~theco.escape~c2x"'x"-
)~~push(-
".environment~theco.strings.1 ="-
stringify(.environment~theco.strings.1)-
)
.environment~theco.escape = '1B'x
str = .environment~theco.strings.1
.environment~theco.strings.1 = ""
.StateExpectString~~save_machine~state = "start"
.StateExpectString~mode = ""
.StateExpectString~toctl = .false
return self~done(str)
end
/*
* String building characters
*/
insert = .StateExpectString~~save_machine~machine(key)
if insert = .nil then return ""
if insert == "" then return self~name
/*
* String accumulation
*/
.environment~theco.undo~~push(-
".environment~theco.strings.1 ="-
stringify(.environment~theco.strings.1)-
)
.environment~theco.strings.1 ||= insert
if .environment~theco.exec then
self~process(.environment~theco.strings.1,-
insert~length)
return self~name
::method initial abstract
::method process abstract
::method done abstract
/*
* Super class for states accepting Q-Register specifications
*/
::class StateExpectQReg subclass State
::method INIT
forward class (super)
::method save
use arg reg
.environment~theco.undo~~push(-
".environment~theco.registers['"reg~name"']~integer ="-
reg~integer-
)
::method custom
use arg key
reg = .environment~theco.registers[key~upper]
if reg = .nil then return ""
return self~got_register(reg)
::method got_register abstract
::class StateStart subclass State
::method INIT
forward array ("start") class (super)
::method move
use arg n
.environment~theco.undo~~push_cmd('clocate :'column.1()),
~~push_cmd('locate :'line.1())
/* FIXME: do this in less commands */
if n > 0 then
do n
'cursor cua right'
end
else
do -n
'cursor cua left'
end
::method move_lines
use arg n
.environment~theco.undo~~push_cmd('clocate :'column.1()),
~~push_cmd('locate' (-n))
'locate' n
'clocate :1'
::method custom
use arg key
key = key~upper
select
/*
* <CTRL/x> commands implemented in `ctlcmd` state
*/
when key~c2d < 32 then do
return .environment~theco.states["ctlcmd"],
~get_next_state(ctlecho(key))
end
/*
* arithmetics
*/
when key~matchchar(1, "0123456789") then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~add_digit(key)
end
when key~matchchar(1, "/*+&#") then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~push_op_calc(key)
end
when key == "-" then do
if \.environment~theco.exec then return self~name
if .environment~theco.stack~args = 0 |,
.environment~theco.stack~nums~peek == "" then do
.environment~theco.undo~~push(-
".environment~theco.stack~num_sign ="-
.environment~theco.stack~num_sign-
)
.environment~theco.stack~num_sign *= -1
end
else
.environment~theco.stack~push_op_calc("-")
end
when key == "(" then do
if \.environment~theco.exec then return self~name
if .environment~theco.stack~num_sign < 0 then
.environment~theco.stack,
~~push_num(-1)~push_op_calc("*")
.environment~theco.stack~push_op("(")
end
when key == ")" then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~eval(.true)
end
when key == "," then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~~eval~push_num("")
end
when key == "." then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~~eval~push_num(get_dot())
end
when key == "Z" then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~~eval~push_num(get_size())
end
when key == "H" then do
if \.environment~theco.exec then return self~name
.environment~theco.stack~~eval,
~~push_num(0)~push_num(get_size())
end
/*
* control structures (loops)
*/
when key == "<" then do
if \.environment~theco.exec then do
.environment~theco.nest_level += 1
.environment~theco.undo~~push(-
".environment~theco.nest_level -= 1"-
)
return self~name
end
if .environment~theco.stack~~eval~args = 0 then
/* infinite loop */
.environment~theco.stack~push_num(-1)
if .environment~theco.stack~nums~peek = 0 then do
.environment~theco.stack~pop_num
/* skip up to end of loop (parse without exec) */
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)
end
else
.environment~theco.stack,
~~push_num(.environment~theco.pc),
~~push_op("<")
end
when key == ">" then do
if \.environment~theco.exec then do
if .environment~theco.nest_level = 0 then do
.environment~theco.exec = .true
.environment~theco.undo~~push(-
".environment~theco.exec ="-
".false"-
)
end
else do
.environment~theco.nest_level -= 1
.environment~theco.undo~~push(-
".environment~theco.nest_level"-
"+= 1"-
)
end
return self~name
end
.environment~theco.stack~~discard_args~pop_op /* "<" */
loop_pc = .environment~theco.stack~pop_num
loop_cnt = .environment~theco.stack~pop_num
if loop_cnt \= 1 then do
/* repeat loop */
if loop_cnt > 0 then loop_cnt -= 1
.environment~theco.pc = loop_pc
.environment~theco.stack,
~~push_num(loop_cnt),
~~push_num(loop_pc),
~~push_op("<")
end
end
when key == ";" then do
if \.environment~theco.exec then return self~name
search = .environment~theco.registers["_"]~integer
v = .environment~theco.stack~pop_num_calc(1, search)
if .State~eval_colon then v = complement(v)
if v >= 0 then do
.environment~theco.stack,
~~discard_args,
~~pop_op~~pop_num~~pop_num
/* skip up to end of loop (parse without exec) */
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)
end
end
/*
* control structures (conditionals)
*/
when key == "|" then do
if \.environment~theco.exec then do
if \.environment~theco.skip_else &,
.environment~theco.nest_level = 0 then do
.environment~theco.exec = .true
.environment~theco.undo~~push(-
".environment~theco.exec ="-
".false"-
)
end
return self~name
end
/*
* skip up to end of conditional; skip ELSE-part
* (parse without exec)
*/
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)
end
when key == "'" then do
if \.environment~theco.exec then do
if .environment~theco.nest_level = 0 then do
.environment~theco.undo~~push(-
".environment~theco.exec ="-
".false"-
)~~push(-
".environment~theco.skip_else ="-
.environment~theco.skip_else-
)
.environment~theco.exec = .true
.environment~theco.skip_else = .false
end
else do
.environment~theco.nest_level -= 1
.environment~theco.undo~~push(-
".environment~theco.nest_level"-
"+= 1"-
)
end
return self~name
end
end
/*
* modifiers
*/
when key == "@" then do
if \.environment~theco.exec then return self~name
.environment~theco.undo~~push(-
".environment~theco.modidifiers.at ="-
.environment~theco.modidifiers.at-
)
.environment~theco.modifiers.at = .true
end
when key == ":" then do
if \.environment~theco.exec then return self~name
.environment~theco.undo~~push(-
".environment~theco.modidifiers.colon ="-
.environment~theco.modidifiers.colon-
)
.environment~theco.modifiers.colon = .true
end
/*
* commands
*/
when key == "J" then do
if \.environment~theco.exec then return self~name
.environment~theco.undo~~push_cmd('clocate :'column.1()),
~~push_cmd('locate :'line.1())
call set_dot .environment~theco.stack~pop_num_calc(1, 0)
end
when key == "C" then do
if \.environment~theco.exec then return self~name
self~move(.environment~theco.stack~pop_num_calc)
end
when key == "R" then do
if \.environment~theco.exec then return self~name
self~move(-.environment~theco.stack~pop_num_calc)
end
when key == "L" then do
if \.environment~theco.exec then return self~name
self~move_lines(.environment~theco.stack~pop_num_calc)
end
when key == "B" then do
if \.environment~theco.exec then return self~name
self~move_lines(-.environment~theco.stack~pop_num_calc)
end
when key == "=" then do
if \.environment~theco.exec then return self~name
'msg' .environment~theco.stack~pop_num_calc
end
when key == "D" then do
if \.environment~theco.exec then return self~name
v1 = .environment~theco.stack~pop_num_calc
if .environment~theco.stack~args = 0 then do
/* relative character range */
if v1 > 0 then do
from = get_dot()
to = from + v1
end
else do
to = get_dot()
from = to + v1
end
end
else do
/* absolute character range */
from = .environment~theco.stack~pop_num_calc
to = v1
end
eol_len = get_eol()~length
call set_dot from
dot = from
col = column.1()
do forever
line = curline.3()
size = min(to - dot, line~length - col + 1)
line = line~substr(col, size)
if line~length > 0 then do
/* THE bug: Undo insert does not work properly! */
.environment~theco.undo,
~~push_cmd('cinsert' line)
'cdelete' line~length
end
dot += line~length
if dot >= to then leave
dot += eol_len
'join cursor'
.environment~theco.undo,
~~push_cmd('split cursor')
end
end
otherwise
return ""
end
return self~name
::class StateLabel subclass State
::method INIT
forward array ("label") class (super)
::method custom
use arg key
select
when key == "!" then do
label = .environment~theco.strings.1
escaped = stringify(label)
.environment~theco.undo~~push(-
".environment~theco.goto_table["escaped"] ="-
sor(.environment~theco.goto_table[label], ".nil")-
)~~push(".environment~theco.strings.1 =" escaped)
.environment~theco.goto_table[label] =,
.environment~theco.pc
.environment~theco.strings.1 = ""
if .environment~theco.skip_label == label then do
.environment~theco.skip_label = .nil
.environment~theco.exec = .true
.environment~theco.undo~~push(-
".environment~theco.skip_label ="-
stringify(label)-
)~~push(".environment~theco.exec = .false")
end
return "start"
end
otherwise
.environment~theco.undo~~push(-
".environment~theco.strings.1 ="-
stringify(.environment~theco.strings.1)-
)
.environment~theco.strings.1 ||= key
return self~name
end
::class StateCtlCmd subclass State
::method INIT
forward array ("ctlcmd") class (super)
::method custom
use arg key
key = key~upper
select
when key == "O" then do
if \.environment~theco.exec then return "start"
.environment~theco.stack~set_radix(8)
end
when key == "D" then do
if \.environment~theco.exec then return "start"
.environment~theco.stack~set_radix(10)
end
when key == "R" then do
if \.environment~theco.exec then return "start"
if .environment~theco.stack~~eval~args = 0 then
.environment~theco.stack~push_num(-
.environment~theco.stack~radix-
)
else
.environment~theco.stack~set_radix(-
.environment~theco.stack~pop_num_calc-
)
end
/*
* Alternatives: ^i, ^I, <CTRL/I>, <TAB>
*/
when key == "I" then do
if \.environment~theco.exec then return "cmd_insert"
.environment~theco.stack~~eval~push_num(9)
return "cmd_insert"
end
/*
* Alternatives: ^[, <CTRL/[> (cannot be typed), <ESC>
*/
when key == "[" then do
if \.environment~theco.exec then return "start"
.environment~theco.stack~discard_args
/*
* Does not allow the caret-escape form;
* must be typed with two consequtive <ESC>
*/
if .environment~theco.cmdline~right(2) == '1B 1B'x then do
if .environment~theco.quit_requested then
do nbfile.1()
'qquit'
end
.environment~theco.cmdline = ""
.environment~theco.undo~empty
end
end
/*
* Additional numeric operations
*/
when key == "_" then do
if \.environment~theco.exec then return "start"
v = .environment~theco.stack~pop_num_calc
.environment~theco.stack~push_num(complement(v))
end
when key~matchchar(1, "*/") then do
if \.environment~theco.exec then return "start"
.environment~theco.stack~push_op_calc("^"key)
end
otherwise
return ""
end
return "start"
::class StateCtlUCmd subclass StateExpectQReg
::method INIT
forward array ("ctlucmd") class (super)
::method got_register
use arg reg
if \.environment~theco.exec then return "cmd_ctlu"
.environment~theco.reg_arg = reg
return "cmd_ctlu"
::class StateCmdCtlU subclass StateExpectString
::method INIT
forward array ("cmd_ctlu") class (super)
::method initial
/* nothing to be done */
::method process
/* nothing to be done */
::method done
use arg str
if \.environment~theco.exec then return "start"
.environment~theco.reg_arg~string = str
return "start"
::class StateFCmd subclass State
::method INIT
forward array ("fcmd") class (super)
::method custom
use arg key
select
/*
* loop flow control
*/
when key == "<" then do
if \.environment~theco.exec then return "start"
/* FIXME: what if in brackets? */
/* FIXME: what if not in loop -> set PC to 1 */
.environment~theco.stack~~discard_args~pop_op /* "<" */
/* repeat loop */
/* FIXME: peeking the program counter would be sufficient */
.environment~theco.pc = .environment~theco.stack~pop_num
.environment~theco.stack,
~~push_num(.environment~theco.pc),
~~push_op("<")
end
when key == ">" then do
if \.environment~theco.exec then return "start"
/* FIXME: what if in brackets? */
.environment~theco.stack~~discard_args~pop_op /* "<" */
loop_pc = .environment~theco.stack~pop_num
loop_cnt = .environment~theco.stack~pop_num
if loop_cnt > 1 then do
/* repeat loop */
.environment~theco.pc = loop_pc
.environment~theco.stack,
~~push_num(loop_cnt-1),
~~push_num(loop_pc),
~~push_op("<")
end
else do
/* skip up to end of loop (parse without exec) */
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)
end
end
/*
* conditional flow control
*/
when key == "'" then do
if \.environment~theco.exec then return "start"
/*
* skip to end of conditional (parse without exec)
*/
.environment~theco.exec = .false
.environment~theco.skip_else = .true
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)~~push(".environment~theco.skip_else = .false")
end
when key == "|" then do
if \.environment~theco.exec then return "start"
/*
* skip to ELSE-part or end of conditional
* (parse without exec)
*/
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)
end
otherwise
return ""
end
return "start"
::class ConditionalTests
::method "A"
return self~"V"(arg(1)) | self~"W"(arg(1))
::method "C"
/* FIXME */
return self~"R"(arg(1))
::method "D"
return arg(1) >= "0"~c2d & arg(1) <= "9"~c2d
::method "E"
return arg(1) = 0
::method "F"
forward message "E"
::method "G"
return arg(1) > 0
::method "L"
return arg(1) < 0
::method "N"
return arg(1) \= 0
::method "R"
return self~"A"(arg(1)) | self~"D"(arg(1))
::method "S"
forward message "L"
::method "T"
forward message "L"
::method "U"
forward message "E"
::method "V"
return arg(1) >= "a"~c2d & arg(1) <= "z"~c2d
::method "W"
return arg(1) >= "A"~c2d & arg(1) <= "Z"~c2d
::method "<"
forward message "L"
::method ">"
forward message "G"
::method "="
forward message "E"
::class StateCondCmd subclass State
::attribute tests
::method INIT
self~tests = .ConditionalTests~new
forward array ("condcmd") class (super)
::method custom
use arg key
if \self~tests~hasMethod(key) then return ""
if \.environment~theco.exec then do
.environment~theco.nest_level += 1
.environment~theco.undo~~push(-
".environment~theco.nest_level -= 1"-
)
return "start"
end
v = .environment~theco.stack~pop_num_calc
if \self~tests~send(key, v) then do
/*
* skip to ELSE-part or end of conditional
* (parse without exec)
*/
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.exec = .true"-
)
end
return "start"
::class StateCmdGoto subclass StateExpectString
::method INIT
forward array ("cmd_goto") class (super)
::method initial
/* nothing to be done */
::method process
/* nothing to be done */
::method done
use arg str
if \.environment~theco.exec then return "start"
labels = tokenize(str, ",")
label = labels[.environment~theco.stack~pop_num_calc]
if label \= .nil, label \== "" then do
pc = .environment~theco.goto_table[label]
if pc \= .nil then
.environment~theco.pc = pc
else do
.environment~theco.skip_label = label
/* skip till label is defined */
.environment~theco.exec = .false
.environment~theco.undo~~push(-
".environment~theco.skip_label = .nil"-
)~~push(".environment~theco.exec = .true")
end
end
return "start"
::class StateQCmd subclass StateExpectQReg
::method INIT
forward array ("qcmd") class (super)
::method got_register
use arg reg
if \.environment~theco.exec then return "start"
.environment~theco.stack~~eval~push_num(reg~integer)
return "start"
::class StateUCmd subclass StateExpectQReg
::method INIT
forward array ("ucmd") class (super)
::method got_register
use arg reg
if \.environment~theco.exec then return "start"
self~save(reg)
reg~integer = .environment~theco.stack~pop_num_calc
return "start"
::class StateIncCmd subclass StateExpectQReg
::method INIT
forward array ("inccmd") class (super)
::method got_register
use arg reg
if \.environment~theco.exec then return "start"
self~save(reg)
reg~integer += .environment~theco.stack~pop_num_calc
.environment~theco.stack~push_num(reg~integer)
return "start"
::class StateMCmd subclass StateExpectQReg
::method INIT
forward array ("mcmd") class (super)
::method got_register
use arg reg
if \.environment~theco.exec then return "start"
pc = .environment~theco.pc
.environment~theco.pc = 0
.environment~theco.state = .environment~theco.states["start"]
if \execute(reg~string) then return ""
.environment~theco.pc = pc
return "start"
::class StateECmd subclass State
::method INIT
forward array ("ecmd") class (super)
::method custom
use arg key
key = key~upper
select
when key == "X" then do
if \.environment~theco.exec then return "start"
.environment~theco.quit_requested = .true
return "start"
end
otherwise
return ""
end
::class StateCmdFile subclass StateExpectString
::method INIT
forward array ("cmd_file") class (super)
::method do_edit
use arg filename
file_cnt = nbfile.1()
old_file = efileid.1()
'edit' filename
if nbfile.1() > file_cnt then
/* file is new in ring */
.environment~theco.undo~~push_cmd('qquit')
else
.environment~theco.undo~~push_cmd('edit' old_file)
select
when size.1() = 0 then 'add'
when tof() then 'locate 1'
otherwise
end
::method initial
/* nothing to be done */
::method process
/* nothing to be done */
::method done
use arg filename
if \.environment~theco.exec then return "start"
/* FIXME: match-spec error */
if SysFileTree(filename, "matching.", "FO") \= 0 then
return ""
if matching.0 = 0 then
/* no match-spec or non-existing file */
self~do_edit(filename)
else
do i = 1 to matching.0
self~do_edit(matching.i)
end
return "start"
/*
* TODO: expect filename to read into Q-register
*/
::class StateEQCmd subclass StateExpectQReg
::method INIT
forward array ("eqcmd") class (super)
::method got_register
use arg reg
if \.environment~theco.exec then return "start"
reg~edit()
return "start"
::class StateCmdInsert subclass StateExpectString
::method INIT
forward array ("cmd_insert") class (super)
::method do_insert
use arg key
if key == "" then return
select
when key == '0D'x | key == '0A'x then do
'split cursor'
'next'
'clocate :1'
.environment~theco.undo,
~~push_cmd('join cursor'),
~~push_cmd('sos endchar'),
~~push_cmd('up')
end
when key == '09'x, tabkey.2() == "TAB" then do
/* NOTE: sos tabf in insertmode currently broken on THE v3.3 RC1!? */
.environment~theco.undo,
~~push_cmd('clocate :'column.1()),
~~push_cmd('sos tabb')
'sos tabf'
end
otherwise
'cinsert' key
'clocate 1'
.environment~theco.undo~~push_cmd('sos cuadelback')
end
::method initial
/*
* NOTE: cannot support VideoTECO's <n>I because
* beginning and end of strings must be determined
* syntactically
*/
do i = .environment~theco.stack~~eval~args to 1 by -1
char = .environment~theco.stack~pop_num_calc(i)
self~do_insert(char~d2c)
end
::method process
use arg str, new_chars
do i = new_chars-1 to 0 by -1
self~do_insert(str~subchar(str~length - i))
end
::method done
/* nothing to be done when done */
return "start"
::class StateCmdSearch subclass StateExpectString
::attribute initial_dot
::attribute from
::attribute to
::attribute count
::method INIT
forward array ("cmd_search") class (super)
::method initial
self~initial_dot = get_dot()
v = .environment~theco.stack~pop_num_calc
if .environment~theco.stack~args > 0 then do
self~from = .environment~theco.stack~pop_num_calc
self~to = v
self~count = 1
end
else do
self~from = self~initial_dot
self~to = get_size()
self~count = v
end
::method process
use arg str
cre = ReComp(pattern2regexp(str), "x")
if cre~left(1) then do
.environment~theco.undo~~push(-
".environment~theco.registers['_']~integer ="-
.environment~theco.registers["_"]~integer-
)
.environment~theco.registers["_"]~integer = 0 /* failure */
call ReFree cre
return
end
buffer = get_buffer(self~from, self~to)~toString("l", get_eol())
offset = 1
do self~count,
while ReExec(cre, buffer~substr(offset), "matches.", "p")
offset += matches.!match~word(1) - 1 /* offset */
offset += matches.!match~word(2) /* length */
end
call ReFree cre
.environment~theco.undo~~push_cmd('clocate :'column.1()),
~~push_cmd('locate :'line.1())
.environment~theco.undo~~push(-
".environment~theco.registers['_']~integer ="-
.environment~theco.registers["_"]~integer-
)
if matches.!match~word(2) = 0 then do
call set_dot self~initial_dot
.environment~theco.registers["_"]~integer = 0 /* failure */
end
else do
call set_dot self~from+offset-1
.environment~theco.registers["_"]~integer = -1 /* success */
end
::method done
use arg str
if \.environment~theco.exec then return "start"
search_reg = .environment~theco.registers["_"]
if str == "" then
self~process(search_reg~string)
else
search_reg~string = str
return "start"
/*
* auxilliary stuff
*/
::routine sor
use arg obj, val
select
when obj = .nil then return val
when obj == "" then return val
otherwise
return obj
end
::routine isor
use arg obj, val
if obj = 0 then return val
return obj
/*
* Ones complement (binary NOT), may be used to negate TECO boolean values
* (x < 0 and x >= 0)
*/
::routine complement
return -arg(1) - 1
::routine last_match
use arg str, chars
do i = str~length to 1 by -1
if str~matchchar(i, chars) then return i
end
return 0
::routine tokenize
use arg str, delims
tokens = .Array~new
start = 1
do i = 1 to str~length
if str~matchchar(i, delims) then do
tokens~append(str~substr(start, i - start))
start = i + 1
end
end
tokens~append(str~substr(start, i - start))
return tokens
::routine stringify
return "'"arg(1)~changeStr("'", "''")"'"
::routine ctlecho
return arg(1)~bitOr('40'x)
::routine is_matchspec
use arg spec
/* FIXME: glob rules - different on Windows!? */
do i = 1 to spec~length
if spec~matchchar(i, "?*[") then return .true
end
return .false
::routine get_path_sep
os = version.3()
if os == "OS2" | os == "WIN32" then return "\"
return "/"
::routine get_real_filename
use arg file
name = filespec("name", file~word(5))
if file~word(4)~caselessPos("D") \= 0 then
return name || get_path_sep()
return name
::routine get_eol
eol = eolout.1()
select
when eol == "LF" then return '0A'x
when eol == "CR" then return '0D'x
when eol == "CRLF" then return '0D 0A'x
end
::routine get_dot
old_line = line.1()
eol_len = get_eol()~length
dot = 0
do l = 1 to old_line-1
'up'
/* FIXME: for some reason length.1() always returns 19 */
dot += curline.3()~length + eol_len
end
'locate :'old_line
return dot + column.1() - 1
::routine get_size
line = line.1()
column = column.1()
'locate :'size.1()
'sos endchar'
size = get_dot()
'locate :'line
'clocate :'column
return size
::routine set_dot
use arg dot
eol_len = get_eol()~length
'locate :1'
'clocate :1'
do forever
/* FIXME: for some reason length.1() always returns 19 */
line_length = curline.3()~length + eol_len
if dot < line_length then leave
dot -= line_length
'next'
end
'clocate' dot
::routine get_buffer
use arg from=0, to=(get_size())
eol_len = get_eol()~length
old_line = line.1()
old_column = column.1()
call set_dot from
dot = from
/*
* THE bug workaround: sometimes necessary to fixup curline.3()
*/
'next'
'up'
buffer = .Array~new
do forever
col = column.1()
line = curline.3()
line = line~substr(col, min(to - dot, line~length - col + 1))
buffer~append(line)
dot += line~length
if dot >= to then leave
dot += eol_len
'next'
'clocate :1'
end
'locate :'old_line
'clocate :'old_column
return buffer
::routine regexp_escape
use arg char
if char~matchchar(1, ".[](){}^$*+?|\") then return "\"char
return char
::routine pattern2regexp
use arg pattern
re = ""
state = "start"
do i = 1 to pattern~length
c = pattern~subchar(i)
select
when state == "start" then do
if c~c2d >= 32 then do
re ||= regexp_escape(c)
iterate i
end
echo = ctlecho(c)
select
when echo == "X" then re ||= "."
when echo == "S" then re ||= "[^[:alnum:]]"
when echo == "N" then state = "not"
when echo == "E" then state = "ctle"
otherwise
/* control characters never have to be escaped */
re ||= c
end
end
when state == "not" then do
if c~matchchar(1, "[]-\") then c = "\"c
re ||= "[^"c"]"
state = "start"
end
when state == "ctle" then do
c = c~upper
select
when c == "A" then re ||= "[[:alpha:]]"
when c == "B" then re ||= "[^[:alnum:]]"
when c == "C" then re ||= "[[:alnum:].$]"
when c == "D" then re ||= "[[:digit:]]"
/* when c == "G" then */
when c == "L" then re ||= "[\r\n\v\f]"
/* when c == "M" then */
when c == "R" then re ||= "[[:alnum:]]"
when c == "S" then re ||= "[[:blank:]]+"
when c == "V" then re ||= "[[:lower:]]"
when c == "W" then re ||= "[[:upper:]]"
when c == "X" then re ||= "."
/* when ^E<nnn> */
when c == "[" then re ||= "("
otherwise
return ""
end
state = "start"
end
end
end
return re
/*
* External routines (classic Rexx function packages)
*/
::routine ReLoadFuncs external "REGISTERED rexxre reloadfuncs"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment