\ editor <list> l ll lll -text load screen 910515jb ) decimal : --editor-- ; warning @ 0 warning ! : <list> dup scr ! 13 emit eeol colm 13 emit 3 .r 16 0 do cr i 4 .r space i scr @ .line pause ?terminal if leave then loop space quit ; : l scr @ <list> ; : ll 1 scr +! l ; : lll -1 scr +! l ; : -text ( addr count addr --- flag ) swap ?dup if over + swap do dup c@ i c@ - if 0= leave else 1+ then loop else drop 0= then ; 2 18 thru \ load rest of editor file \ match : match ( cursor addr-4, bytes left-3, string addr-2 ) ( string count-1, --- flag-2, cursor offset-1 ) >r >r 2dup r> r> 2swap over + swap ( caddr-6, bleft-5, $addr-4, $len-3, caddr+bleft-2, caddr-1 ) do 2dup i -text if >r 2drop r> - i swap - 0 swap 0 0 leave ( cadr, bleft, $addr, $len or 0, offset, 0, 0 ) then loop 2drop ( caddr-2, bleft-1 or 0-2, offset-1 ) swap 0= swap ; \ line wipe hex : line ( relative to scr, leave address of line ) dup fff0 and abort" not on current editing screen" scr @ <line> drop ; : wipe scr @ clear ; \ editor #locate hex vocabulary editor immediate editor definitions : #locate ( --- cursor offset-2, line-1 ) r# @ c/l /mod ; \ #lead #lag -move buf-move : #lead ( --- cursor addr-2, offset to cursor-1 ) #locate line swap ; : #lag ( --- cursor addr-2, count after cursor-1 ) #lead dup >r + c/l r> - ; : -move ( move from addr-2, to line-1 --- ) line c/l cmove update ; : buf-move ( move text to buffer-1, if any --- ) here c@ if pad swap c/l 1+ cmove else drop then ; ( >line# find-buf insert-buf mvp-forth) : >line# ( convert current cursor position to line# ) #locate swap drop ; : find-buf ( buffer used for all searches ) pad 50 + ; : insert-buf ( buffer used for all insertions ) find-buf 50 + ; ( hold- <kill> <spread> x mvp-forth) : <hold> ( move line-1 from block to insert buffer ) line insert-buf 1+ c/l dup insert-buf c! cmove ; : <kill> ( erase line-1 with blanks ) line c/l blank update ; : <spread> ( spread, making line# blank ) >line# dup 0e do i line i 1+ -move -1 +loop <kill> ; : x ( delete line# from block, put in insert buffer) >line# dup <hold> 0f dup rot do i 1+ line i -move loop <kill> ; ( display-cursor t l mvp-forth) : display-cursor ( --- ) cr space #lead type 5e emit #lag type #locate 2 .r space drop ; : t ( type line#-1 ) c/l * r# ! display-cursor ; : l ( list current screen ) scr @ list display-cursor ; ( <top> seek-error mvp-forth) : <top> ( reset cursor to top of block ) 0 r# ! ; : seek-error ( output error msg if no match ) <top> find-buf here c/l 1+ cmove here count type ." none" quit ; ( <r> p mvp-forth) : <r> ( replace current line with insert buffer ) >line# insert-buf 1+ swap -move ; : p ( following text in insert buffer and line ) 5e text insert-buf buf-move <r> ; ( 1line mvp-forth) : 1line ( scan current line for match with find buffer ) ( update cursor, return boolean ) #lag find-buf count match r# +! ; ( <seek> <delete> mvp-forth) : <seek> ( find buffer match over full screen, else error ) begin 3ff r# @ < if seek-error then 1line until ; : <delete> ( backwards at cursor by count-1 ) >r #lag + r@ - ( save blank fill location ) #lag r@ negate r# +! ( back at cursor ) #lead + swap cmove r> blank update ; ( fill from end of text ) ( <f> f <e> e mvp-forth) : <f> ( find occurance of following text ) 5e text find-buf buf-move <seek> ; : f ( find and display following text ) <f> display-cursor ; : <e> ( erase backwards from cursor ) find-buf c@ <delete> ; : e ( erase and display line ) <e> display-cursor ; ( d till mvp-forth) : d ( find, delete, and display following text ) <f> e ; : till ( delete from cursor to text end ) #lead + 5e text find-buf buf-move 1line 0= if seek-error then #lead + swap - <delete> display-cursor ; ( counter bump mvp-forth) variable counter 0 counter ! : bump ( the line number and handle paging ) 1 counter +! counter @ 38 > if 0 counter ! cr cr 0c emit then ; ( s mvp-forth) : s ( from current to screen-1 for string ) 0c emit 5e text 0 counter ! find-buf buf-move scr @ dup >r do i scr ! <top> begin 1line if display-cursor scr ? bump then 3fe r# @ < ?terminal if 1 else 0 then or until pause ?terminal if key drop leave then loop r> scr ! ; ( i u mvp-forth) : i ( insert text within line ) 5e text ( load insert buffer with text ) insert-buf buf-move ( if any ) insert-buf count #lag rot over min >r r@ r# +! ( bump cursor ) r@ - >r ( characters to save ) dup here r@ cmove ( from old cursor to here ) here #lead + r> cmove ( here to cursor location ) r> cmove update ( pad to old cursor ) display-cursor ; ( look at new line ) : u ( insert following text under current line ) c/l r# +! <spread> p ; ( r m mvp-forth) : r ( replace found text with insert buffer ) <e> i ; : m ( screen line --- ) ( move from current line on current screen ) scr @ >r ( to screen-2, under line-1 ) r# @ >r ( save original screen and cursor location ) >line# <hold> ( move current line to insert buffer ) swap scr ! ( set new screen # ) 1+ c/l * r# ! ( text is stored under requested line ) <spread> <r> ( store insert buffer in new screen ) r> c/l + r# ! ( set original cursor to next line ) r> scr ! ; ( restore original screen ) decimal forth definitions ( value on stack ) warning !
