|
|
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.