Created
November 22, 2012 23:56
-
-
Save rhaberkorn/4133371 to your computer and use it in GitHub Desktop.
Abandoned (Video)TECO implementation on top of The Hessling Editor, written in Open Object Rexx
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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