#!/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 ||= "" when c == '0A'x then line ||= "" when c == '09'x then line ||= "" 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 /* * 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, , */ 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: ^[, (cannot be typed), */ 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 */ 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 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 */ 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"