diff options
Diffstat (limited to 'theco.rex')
| -rw-r--r-- | theco.rex | 2178 |
1 files changed, 2178 insertions, 0 deletions
diff --git a/theco.rex b/theco.rex new file mode 100644 index 0000000..984a799 --- /dev/null +++ b/theco.rex @@ -0,0 +1,2178 @@ +#!/usr/local/bin/nthe -p +/* + * Abandoned (Video)TECO implementation on top of The Hessling Editor, written in Open Object Rexx + */ + +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" |