|
|
1.1 ! root 1: run_ctrlsk = proc (e: env, c: char) signals (errmsg(string), stop(env, string)) ! 2: ! 3: help_msg1 = "@,?w: move to end of # previous word\n" || ! 4: "A,?x: move backward # pages\n" || ! 5: "B,?r: move forward # pages\n" || ! 6: "C,?v: move right # words\n" || ! 7: "D,?t: move left # word\n" || ! 8: "H: enter alternate keypad mode\n" || ! 9: "J: pattern search # times for default\n" || ! 10: "L,?q: delete backward to end of # previous word\n" || ! 11: "M,?s: delete forward to start of # next word\n" || ! 12: "N,?y: move to start of # next word\n" ! 13: ! 14: norm_msg = "P: delete forward # words\n" || ! 15: "Q: delete backward # words\n" ! 16: ! 17: swap_msg = "P: delete backward # words\n" || ! 18: "Q: delete forward # words\n" ! 19: ! 20: help_msg2 = "R: forward string search # times for default\n" || ! 21: "S,?p: backward string search # times for default\n" || ! 22: "T: set case mode for searches\n" || ! 23: "U: scroll window up # lines\n" || ! 24: "V: scroll window down # lines\n" || ! 25: "W: reposition window at cursor\n" || ! 26: "?n: exit to EXEC\n" || ! 27: "?u: exit alternate keypad mode\n" || ! 28: "?M: garbage collect address space\n" || ! 29: "&c: scroll window to button position\n" || ! 30: "&C: set cursor to button position\n" || ! 31: "&t: (#<1: normal, #=1: underline, #>1: invert) between cursor and mouse\n" || ! 32: "&T: set mark to button position\n" || ! 33: "&w: move to button window cursor\n" || ! 34: "&W: move to button window\n" || ! 35: "&Y: insert cut buffer |#| times (#<0: before cursor)\n" || ! 36: "&z: store saved text in cut buffer\n" || ! 37: "&Z: store deleted text in cut buffer\n" || ! 38: "esc: redefine escape sequence" ! 39: ! 40: prompt1 = "Escape: " ! 41: prompt2 = "Escape: ?" ! 42: prompt3 = "Escape: [" ! 43: prompt4 = "Escape: O" ! 44: ! 45: own any_defs: bool := false ! 46: own redefs: string ! 47: own qredefs: string ! 48: own swapped: bool := false ! 49: if c = ctrlat ! 50: then prompt = "Set red & blue function keys" ! 51: legal = "RS" ! 52: help = "R: reset to normal mode\n" || ! 53: "S: swap meanings" ! 54: i: int, opt: char := get_option (e, prompt, legal, help, false) ! 55: swapped := opt = 'S' ! 56: return ! 57: end resignal errmsg ! 58: b: buf := e.buffer ! 59: arg: int := e.this_arg ! 60: line, pos: int := buf$get_cursor(b) ! 61: dotop: bool := false ! 62: prompt: string := prompt1 ! 63: qmark: bool := false ! 64: xmark: bool := false ! 65: while true do ! 66: if ~dotop ! 67: then dotop := ~_pending_wait() end ! 68: if dotop ! 69: then top_display(e, prompt) ! 70: env$display(e) ! 71: end ! 72: c := _getc() ! 73: if xmark cand c >= 'a' cand c <= 'z' ! 74: then qmark := true end ! 75: if dotop ! 76: then top_display(e, string$append(prompt, c)) end ! 77: if any_defs cand ((~qmark cand string$indexc(c, redefs) > 0) cor ! 78: (qmark cand string$indexc(c, qredefs) > 0)) ! 79: then s: string ! 80: if qmark ! 81: then s := "esc-?" ! 82: else s := "esc-" ! 83: end ! 84: s := env$fetch_str(e, string$append(s, c), "") ! 85: env$forget_char(e) ! 86: for i: int in int$from_to_by(arg, 1, -1) do ! 87: _push_macro_chars(s) ! 88: end ! 89: return ! 90: end ! 91: if (~qmark cand (c = 'A' cor c = 'B')) cor ! 92: (qmark cand (c = 'x' cor c = 'r')) ! 93: then % move up/down arg pages ! 94: if c = 'A' cor c = 'x' then arg := - arg end ! 95: env$move_window(e, arg) ! 96: elseif (~qmark cand (c = 'C' cor c = 'D')) cor ! 97: (qmark cand (c = 'v' cor c = 't')) ! 98: then % move right/left # words ! 99: if c = 'D' cor c = 't' then arg := - arg end ! 100: line, pos := scan_word(b, line, pos, arg, ! 101: false, e.word_chars) ! 102: buf$set_cursor(b, line, pos) ! 103: elseif (~qmark cand (c = '@' cor c = 'N')) cor ! 104: (qmark cand (c = 'w' cor c = 'y')) ! 105: then % move right/left # start/end words ! 106: if c = '@' cor c = 'w' then arg := - arg end ! 107: line, pos := scan_word(b, line, pos, arg, ! 108: true, e.word_chars) ! 109: buf$set_cursor(b, line, pos) ! 110: elseif ~qmark cand c = 'H' ! 111: then % enter alternate keypad mode ! 112: if _set_keypad_mode(true) ! 113: then top_display(e, "Entering Alternate Keypad Mode.") ! 114: env$store_num(e, "keypad", 1) ! 115: end ! 116: elseif ~qmark cand c = 'J' ! 117: then % pattern search # times ! 118: obj: string := env$fetch_str(e, "psearch", "") ! 119: case: bool := env$fetch_num(e, "ignore_case", 0) = 0 ! 120: confirm: bool := env$fetch_num(e, "pconfirm", 0) ~= 0 ! 121: immed: bool := false ! 122: if arg < 0 ! 123: then immed := true ! 124: arg := -arg ! 125: end ! 126: for arg in int$from_to_by(arg, 1, -1) do ! 127: if ~pattern$search(e, obj, case, immed, confirm) ! 128: then signal errmsg("Not found!") end ! 129: end ! 130: elseif (~qmark cand (c = 'L' cor c = 'M')) cor ! 131: (qmark cand (c = 'q' cor c = 's')) ! 132: then % delete left/right # end/start words ! 133: if c = 'L' cor c = 'q' then arg := -arg end ! 134: line, pos := scan_word(b, line, pos, arg, ! 135: true, e.word_chars) ! 136: env$delete1(e, line, pos) ! 137: elseif ~qmark cand (c = 'P' cor c = 'Q') ! 138: then % delete left/right # words ! 139: if (c = 'P' cand swapped) cor (c = 'Q' cand ~swapped) ! 140: then arg := -arg end ! 141: line, pos := scan_word(b, line, pos, arg, ! 142: false, e.word_chars) ! 143: env$delete1(e, line, pos) ! 144: elseif (~qmark cand (c = 'R' cor c = 'S')) cor (qmark cand c = 'p') ! 145: then % search left/right # times ! 146: if c ~= 'R' then arg := - arg end ! 147: if ~string_search(e.buffer, ! 148: env$fetch_str(e, "search", ""), ! 149: arg, ! 150: env$fetch_num(e, "ignore_case", 0) = 0) ! 151: then signal errmsg("Not found!") end ! 152: elseif ~qmark cand c = 'T' ! 153: then % set case mode ! 154: arg := 0 ! 155: if mconfirm(e, "Ignore upper/lower case in searches", true) ! 156: then arg := 1 end ! 157: env$store_num(e, "ignore_case", arg) ! 158: elseif ~qmark cand (c = 'U' cor c = 'V') ! 159: then % scroll up/down ! 160: if c = 'U' then arg := -arg end ! 161: pos := env$choose_window(e) + arg ! 162: if line < pos ! 163: then if arg = -1 cor arg = 1 then _bell() end ! 164: pos := line ! 165: elseif line >= pos + e.size ! 166: then if arg = -1 cor arg = 1 then _bell() end ! 167: pos := line - e.size + 1 ! 168: end ! 169: e.window_top := pos ! 170: elseif ~qmark cand c = 'W' ! 171: then % reposition at cursor ! 172: env$new_window(e) ! 173: elseif qmark cand (c = 'M' cor c = 'n') ! 174: then % enter EXEC or GC ! 175: e.this_arg := 1 ! 176: if c = 'M' then e.this_arg := 4 end ! 177: run_ctrlat(e, ctrlat) ! 178: elseif qmark cand c = 'u' ! 179: then % exit alternate keypad mode ! 180: if _set_keypad_mode(false) ! 181: then top_display(e, "Leaving Alternate Keypad Mode.") ! 182: env$store_num(e, "keypad", 0) ! 183: end ! 184: elseif c = '?' ! 185: then % read next char or print help ! 186: if ~qmark cand ~xmark ! 187: then qmark := true ! 188: prompt := prompt2 ! 189: continue ! 190: end ! 191: help: string := norm_msg ! 192: if swapped then help := swap_msg end ! 193: type_string(e, help_msg1 || help || help_msg2, ! 194: "---- Help for escape sequences") ! 195: dotop := true ! 196: xmark := false ! 197: qmark := false ! 198: prompt := prompt1 ! 199: continue ! 200: elseif c = '[' cand ~xmark cand ~qmark ! 201: then xmark := true ! 202: prompt := prompt3 ! 203: continue ! 204: elseif c = 'O' cand ~xmark cand ~qmark ! 205: then xmark := true ! 206: prompt := prompt4 ! 207: continue ! 208: elseif c = esc cand ~qmark cand ~xmark ! 209: then % redefine escape sequence ! 210: prompt := "Define escape: " ! 211: while true do ! 212: if ~_in_macro() ! 213: then top_display(e, prompt) ! 214: env$display(e) ! 215: end ! 216: c := _getc() ! 217: prompt := string$append(prompt, c) ! 218: if qmark cor xmark ! 219: then break ! 220: elseif c = '?' ! 221: then qmark := true ! 222: elseif c = '[' cor c = 'O' ! 223: then xmark := true ! 224: else break end ! 225: end ! 226: if ~_in_macro() then top_display(e, prompt) end ! 227: if env$is_argenv(e) ! 228: then signal errmsg("Can't redefine now!") end ! 229: if xmark cand c >= 'a' cand c <= 'z' ! 230: then qmark := true end ! 231: if (~qmark cand c = esc) cor (qmark cand c = '?') ! 232: then signal errmsg("Can't redefine this sequence!") end ! 233: if ~any_defs ! 234: then redefs := "" ! 235: qredefs := "" ! 236: end ! 237: name, defs: string ! 238: if qmark ! 239: then name := string$append("esc-?", c) ! 240: defs := qredefs ! 241: else name := string$append("esc-", c) ! 242: defs := redefs ! 243: end ! 244: s: string := get_string_arg(e, "Define as", ! 245: env$fetch_str(e, name, "")) ! 246: env$store_str(e, name, s) ! 247: arg := string$indexc(c, defs) ! 248: if string$empty(s) ! 249: then if arg > 0 ! 250: then defs := string$substr(defs, 1, arg - 1) || ! 251: string$rest(defs, arg + 1) ! 252: any_defs := ~string$empty(redefs) cor ! 253: ~string$empty(qredefs) ! 254: end ! 255: elseif arg = 0 ! 256: then defs := string$append(defs, c) ! 257: any_defs := true ! 258: end ! 259: if qmark ! 260: then qredefs := defs ! 261: else redefs := defs ! 262: end ! 263: elseif (c = '\303' cor c = '\324') cand ~qmark cand ~xmark ! 264: then hpos, vpos: int := input$bpos() ! 265: lines, chars: int := _get_screen_size() ! 266: if vpos <= e.top_line cor vpos > e.last_line cor ! 267: hpos < 0 cor hpos >= chars ! 268: then signal errmsg("Position lies outside window") end ! 269: vpos := vpos - e.top_line + e.window_top - 1 ! 270: s: string := b[vpos] ! 271: i: int := int$max(hpos + 2, string$size(s) + 1) ! 272: while _calc_hpos(s, i) > hpos do ! 273: i := i - 1 ! 274: end ! 275: if c = '\303' ! 276: then buf$set_cursor(b, vpos, i) ! 277: else buf$set_mark(b, vpos, i) ! 278: end ! 279: elseif (c = '\327' cor c = '\343' cor c = '\367') cand ! 280: ~qmark cand ~xmark ! 281: then hpos, vpos: int := input$bpos() ! 282: lines, chars: int := _get_screen_size() ! 283: for ee: env in winset$displayed() do ! 284: if vpos <= ee.top_line cor vpos > ee.last_line cor ! 285: hpos < 0 cor hpos >= chars cor ! 286: (env$is_argenv(e) cand e ~= ee) ! 287: then continue end ! 288: if c = '\343' ! 289: then if e ~= ee ! 290: then break end ! 291: e.window_top := line + e.top_line + 1 - vpos ! 292: return ! 293: end ! 294: if c = '\327' ! 295: then env$choose_cursor(ee) end ! 296: signal stop(ee, "") ! 297: end ! 298: signal errmsg("Position lies outside window") ! 299: elseif c = '\331' cand ~qmark cand ~xmark ! 300: then s: string := x_fetch_cut(0) ! 301: if string$empty(s) then return end ! 302: for i: int in int$from_to_by(int$abs(arg), 1, -1) do ! 303: if ~env$insert1(e, s) then ! 304: signal errmsg("Can't insert text here!") ! 305: end ! 306: end ! 307: if arg > 0 then buf$set_cursor(b, line, pos) end ! 308: elseif (c = '\332' cor c = '\372') cand ~qmark cand ~xmark ! 309: then cut: buf ! 310: if c = '\332' ! 311: then cut := e.killed ! 312: else cut := e.saved ! 313: end ! 314: buf$set_cursor(cut, 1, 1) ! 315: x_store_cut(0, buf$b2s(cut, buf$size(cut), max_int)) ! 316: buf$set_cursor(cut, 1, 1) ! 317: elseif c = '\364' cand ~qmark cand ~xmark ! 318: then input$set_highlight(arg > 0) ! 319: screen$set_highlight(arg > 0, arg > 1) ! 320: elseif ((c >= '\301' cand c <= '\330') cor ! 321: (c >= '\341' cand c <= '\370')) cand ! 322: ~qmark cand ~xmark ! 323: then return ! 324: elseif c = ctrlg ! 325: then % quit ! 326: signal errmsg(quit_msg) ! 327: else signal errmsg("Illegal escape char: '" || c2s(c) || "'") ! 328: end resignal errmsg ! 329: return ! 330: end ! 331: end run_ctrlsk
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.