1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; and now
for something completely different
...
3 ;; UrForth
/C Forth Engine
!
4 ;; Copyright
(C
) 2023 Ketmar Dark
// Invisible Vector
6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7 ;; simple line
-oriented editor
8 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13 reset input line
(make it empty
)
16 edit line without redrawing the prompt
.
17 result is in LINORE
:ACCEPT
-RESULT
.
19 1 for enter
, -1 on esc
/^C
/^D
21 LINORE
:LINE
( -- addr count
)
30 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; it will be filled later
36 simple
-vocabulary osc
-actions
40 -1 constant result
-esc
41 1 constant result
-enter
43 ;; if set
, LINORE will
switch to raw mode on entering
44 ;; edit loop
, and
then switch back
.
45 true value tty
-set
/reset
47 ;; set this
to non
-zero in key handler
to exit edit loop
.
48 ;; can be checked after editing
.
51 ;; start x position
for line drawing
.
55 ;; when cursor is out of visible line part
, make at
56 ;; least this number of chars visible before
/after the cursor
.
57 ;; do not set
to zero or negative
.
58 10 value visible
-amount
60 ;; reset input buffer
(i
.e
. make it empty
).
61 ;; defined here
, because we need it in the code
.
65 ;; use this from key processors
to exit with this code
.
66 : finish
-it
! ( code
-- ) to accept
-result
;
68 ;; called
for normal keys
(non
-OSC
).
69 ;; drop `ch` and
return TRUE
if you handled it
.
70 ;; you can replace char code here
.
71 ;; negative `ch` means that this is
"ESC something" sequence
(not OSC
).
72 : key
-processor
( ch FALSE
-- ch FALSE
/ TRUE
) ... ;
74 ;; called
for OSC keys
. string is OSC without
"\e[".
75 ;; drop string and
return TRUE
if you handled it
.
76 ;; you can replace string here
.
77 : osc
-key
-processor
( addr count FALSE
-- addr count FALSE
/ TRUE
) ... ;
79 ;; called before redrawing the input line
.
80 ;; return TRUE
to prevent redraw
.
81 : on
-before
-draw
( FALSE
-- FALSE
/ TRUE
) ... ;
83 ;; called after redrawing the input line
.
84 : on
-after
-draw
( -- ) ... ;
86 ;; this is called after screen switching
87 : on
-start
-editing
( -- ) ... ;
89 ;; this is called before screen switching
90 : on
-end-editing
( -- ) ... ;
95 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
100 vocabulary linore
-internal
101 also
-defs
: linore
-internal
105 (user
-tib
-size
) 1- value buf
-size
110 ;; if set
, first input will erase the line
114 ;; OSC buffer
(without first
2 chars
)
115 32 constant keybuf
-size
117 create keybuf keybuf-size allot create;
120 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121 ;; working with cursor position
124 : norm
-cursor
-pos
( -- ) cur
-ofs buf
-len min
0 max
to cur
-ofs
;
126 : curvis
-at
-left
( -- )
127 cur
-ofs visible
-amount
- 0 max
to draw
-ofs
130 : curvis
-at
-right
( -- )
132 cur
-ofs draw
-width
- visible
-amount
+ 0 max
133 buf
-len visible
-amount
- 0 max
137 : make
-cursor
-visible
( -- )
140 cur
-ofs draw
-ofs
< if-of curvis
-at
-left endof
141 cur
-ofs draw
-ofs
- draw
-width
>= if-of curvis
-at
-right endof
146 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
147 ;; drawing the edit line
150 : .osc
-1 ( n cmd
-char
-- )
152 swap
<# #s #
> tty
:raw
-type
164 : higlight
-first
-input
( -- )
165 first
-input
if " \e[0;4m" else " \e[0m" endif
171 buf draw
-ofs
+ buf
-len draw
-ofs
- draw
-width min tty
:raw
-type
172 " \e[0m\e[K" tty
:raw
-type
176 start
-x cur
-ofs draw
-ofs
- + goto-x
181 to-start
-x draw
-line pos
-cursor
186 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
187 ;; line editing helper words
190 ;; -1 when out of bounds
192 cur
-ofs
0 buf
-len within
if buf cur
-ofs
+ c@
196 : (go-left
-right
) ( mdir cmp
-cfa
-- mdir
)
206 : (go-word
-left
-right
) ( mdir
-- )
208 dup
0< if -1-to cur
-ofs
endif
210 cur
-c@ bl
<= if ['] <= else ['] > endif
212 0< if +1-to cur
-ofs
endif
213 else 0< if +1-to cur
-ofs
endif
217 prev
-defs
;; in LINORE again
220 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
221 ;; line editing words
224 simple
-vocabulary linore
-edit
-api
226 also
-defs
: linore
-edit
-api
228 : reset
-first
-input
( -- ) false
to first
-input
;
230 : left
( -- ) reset
-first
-input
-1-to cur
-ofs
;
231 : right
( -- ) reset
-first
-input
+1-to cur
-ofs
;
232 : home
( -- ) reset
-first
-input
0-to cur
-ofs
;
233 : end ( -- ) reset
-first
-input buf
-len
to cur
-ofs
;
235 : word
-left
( -- ) reset
-first
-input
-1 (go-word
-left
-right
) ;
236 : word
-right
( -- ) reset
-first
-input
+1 (go-word
-left
-right
) ;
242 buf cur
-ofs
+ dup
1+ swap
243 buf
-len cur
-ofs
- move
251 cur
-ofs
if left delete
endif
255 first
-input
if linore
:reset reset
-first
-input
endif
258 buf
-len cur
-ofs
- move
264 prev
-defs
;; in LINORE
-INTERNAL again
267 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
272 create (ctrl-keys-handlers) 32 cells allot create;
273 ;; default is
"do nothing"
274 (ctrl
-keys
-handlers
) 32 cells erase
276 : set
-ctrl
-handler
( cfa code
-- )
277 dup
0 32 within
" invalid ctrl code" ?not
-error
278 cells
(ctrl
-keys
-handlers
) + !
281 :noname
( -- ) result
-^C linore
:finish
-it
! ; 3 set
-ctrl
-handler
;; ^C
282 :noname
( -- ) result
-^D linore
:finish
-it
! ; 4 set
-ctrl
-handler
;; ^D
284 :noname
( -- ) result
-esc linore
:finish
-it
! ; 27 set
-ctrl
-handler
;; ESC
286 :noname
( -- ) result
-enter linore
:finish
-it
! ;
287 dup
10 set
-ctrl
-handler
288 dup
13 set
-ctrl
-handler
291 ' linore-edit-api:backspace 8 set-ctrl-handler ;; ^H
292 ' linore
:reset
25 set
-ctrl
-handler
;; ^Y
295 ;; collect OSC
(without first
2 chars
)
296 : (collect
-osc
) ( -- )
299 drop tty
:raw
-readch dup bl
>
301 keybuf
-len keybuf
-size
= if break endif
302 dup keybuf keybuf
-len
+ c
! +1-to keybuf
-len
307 : (edit
-process
-osc
) ( -- )
309 keybuf keybuf
-len false linore
:osc
-key
-processor
311 vocid
: linore
:osc
-actions find
-word
-in
-voc
316 : (edit
-process
-other
) ( ch
-- )
317 false linore
:key
-processor ifnot
319 cells
(ctrl
-keys
-handlers
) + @ ?dup
if execute
endif
321 dup
127 = if drop linore
-edit
-api
:backspace
322 else dup bl
>= if linore
-edit
-api
:ins
-char
else drop
endif
328 : (edit
-process
-esc
) ( ch
-- )
329 drop
;; it is always
27
330 tty
:raw
-readch dup
[char
] [ = if ;; OSC start
331 drop
(edit
-process
-osc
)
332 else ;; esc
+something
; negate keycode
333 dup
27 <> if ( not esc
-esc
) negate
endif
338 prev
-defs
;; in LINORE again
342 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
343 ;; default OSC handlers
346 also
-defs
: osc
-actions
348 : D linore
-edit
-api
:left
;
349 : C linore
-edit
-api
:right
;
350 : 7~ linore
-edit
-api
:home
;
351 : 8~ linore
-edit
-api
:end ;
352 : 3~ linore
-edit
-api
:delete
;
353 : 1;5D linore
-edit
-api
:word
-left
;
354 : 1;5C linore
-edit
-api
:word
-right
;
356 prev
-defs
;; in LINORE again
359 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
367 :noname
( -- ) 0-to buf
-len
0-to draw
-ofs
0-to cur
-ofs
;
370 : line
( -- addr count
) buf buf
-len
;
372 : line
! ( addr count
-- )
373 buf
-size min dup
to buf
-len buf swap move
378 tty
-set
/reset
if tty
:set
-raw
" fuck!" ?not
-error
endif
379 0 to accept
-result true
to first
-input
382 false on
-before
-draw ifnot draw
endif on
-after
-draw
383 tty
:raw
-readch dup
0>=
385 dup
27 = if (edit
-process
-esc
)
386 else (edit
-process
-other
)
390 tty
-set
/reset
if tty
:set
-cooked drop
endif
395 previous previous prev-defs