-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathed.scr
executable file
·1 lines (1 loc) · 17 KB
/
ed.scr
1
ED.SCR Pygmy Line Editor Frank Sergeant frank@pygmy.utoh.org http://pygmy.utoh.org copyright 2005-2007 Frank C. Sergeant - frank@pygmy.utoh.org BSD/MIT/X-style license, see file license20040130.txt. http://pygmy.utoh.org Similar to the one described on p. 63 ff. of _Starting Forth_ 2nd Ed. ( Load screen for line editor) 8001 8016 THRU ( PLACE INDEX utility extensions ) : PLACE ( a # buf -) 2DUP C! 1+ SWAP CMOVE ; : INDEX ( start end -) OVER - 1+ FOR ( u) ?SCROLL CR DUP 4 .R SPACE DUP BLOCK 64 TYPE 1+ NEXT DROP ; ( Editor buffers FBUF IBUF K LINE-TAIL BLOCK-TAIL CURSOR! ) VARIABLE CURSOR CREATE FBUF 65 ALLOT ( find buffer -- bigger than needed? ) CREATE IBUF 65 ALLOT ( insert buffer, count by 64 chars) : K ( -) FBUF PAD 65 CMOVE IBUF FBUF 65 CMOVE PAD IBUF 65 CMOVE ; : LINE-TAIL ( - a #) CURSOR @ 64 OVER 64 UMOD - SCR @ BLOCK +UNDER ; : BLOCK-TAIL ( - a #) CURSOR @ 1024 OVER - SCR @ BLOCK +UNDER ; : CURSOR! ( u -) 0 1023 CLAMP CURSOR ! ; : CURSOR+! ( u -) CURSOR @ + CURSOR! ; ( .BAR .LINE# (LINE MK .L list screen with line numbers ) : .BAR ( -) '| EMIT ; : .LINE# ( n -) CR 2 .R .BAR ; : (LINE ( n -) DUP .LINE# ( n) 64 * SCR @ BLOCK + 64 ( a #) TYPE .BAR ; VARIABLE MK ( marker ) '| MK ! : .L ( -) ( show a single line with a cursor marker below) CURSOR @ 64 U/MOD ( offset line) (LINE ( offset) ( ie show the line) CR 3 + SPACES MK @ EMIT ( ie show the cursor position) ; ( (LIST LIST L +LIST N B A T ) : (LIST ( -) CR ." scr " SCR @ DUP U. SPACE >UNIT# .FILE 0 16 FOR DUP (LINE 1+ NEXT DROP ; : LIST ( n -) CURSOR OFF DUP DUP >UNIT# RANGE UBETWEEN IF ( n) SCR ! (LIST EXIT THEN ( n) ." no block " ( n) U. ; : L ( -) (LIST ; : +LIST ( n -) SCR @ DUP +UNDER ( new old) >UNIT# RANGE WRAP ( n') LIST ; : N ( -) 1 +LIST ; : B ( -) -1 +LIST ; : A ( -) SCR @ 1000 OVER >UNIT# ODD? IF NEGATE THEN + LIST ; : T ( line# -) 64 * CURSOR! .L ; ( SRCH ) : SRCH ( - found) FBUF C@ 0= IF -1 ( nothing to find but we found it) EXIT THEN BLOCK-TAIL ( a #) FBUF C@ 1- - ( a #) BEGIN DUP WHILE ( a #) OVER FBUF COUNT COMP 0= IF ( a #) ( yes, a match) DROP SCR @ BLOCK - FBUF C@ + CURSOR! ( new cursor position is just past the found string) -1 EXIT THEN 1 +UNDER 1- REPEAT ( a #) 2DROP 0 ( ie not found) ; ( GET-SEARCH-STRING (F F ) : GET-SEARCH-STRING ( -) ( string) 0 WORD COUNT ( a #) ?DUP IF ( a #) FBUF PLACE EXIT THEN DROP ; : (F ( -) ( string) GET-SEARCH-STRING ( ) SRCH 0= ABORT" not found" ; : F ( -) (F .L ; EXIT : (F ( -) SRCH 0= ABORT" not found" .L ; : F ( -) ( string) 0 WORD COUNT ( a #) ?DUP IF ( a #) FBUF PLACE (F EXIT THEN DROP (F ; ( SPREAD INSERT (I I ) : SPREAD ( a # size -) OVER MIN PUSH 2DUP ( a # a # -- size) OVER ( a # a # a) R@ + ( a # a # dest) SWAP R@ - ( a # a dest #') CMOVE> ( a #) DROP POP 32 FILL UPDATE ; : INSERT ( a # -) ( new new#) LINE-TAIL ROT ( new tail t# new#) OVER MIN PUSH ( new tail t# -- new#) R@ SPREAD ( new -- new#) SCR @ BLOCK CURSOR @ + R@ CMOVE POP ( new#) CURSOR+! ( ) UPDATE ; : (I ( -) ( string) 0 WORD COUNT ( a #) DUP IF ( a #) 2DUP IBUF PLACE THEN 2DROP ( ) IBUF COUNT INSERT .L ; : I ( -) (I ; ( DELETE E D R) : DELETE ( del# -) LINE-TAIL ( del# tail t#) ROT OVER MIN ( tail t# del#) ( move from=tail+del# to=tail len=t#-del# ) ( then fill tail+t#-del# for a len of del# with spaces) PUSH ( tail t# -- del#) OVER R@ + ( tail t# from) ROT ( t# from tail) ROT ( from tail t#) ( from to #) R@ - CMOVE ( -- del#) LINE-TAIL ( tail t#) + R@ - ( a) POP 32 FILL UPDATE ; : E ( -) FBUF C@ ( #) DUP NEGATE CURSOR+! ( ie backup) ( #) DELETE .L ; : D ( -) ( string) F E ; : R ( -) E (I ; ( BOL EOL P ) : BOL ( -) CURSOR @ 64 U/ 64 * CURSOR! ; : EOL ( -) BOL 64 CURSOR+! ; : P ( -) ( string) 0 WORD COUNT ( a #) DUP IF ( a #) 2DUP IBUF PLACE THEN 2DROP PAD 64 32 FILL ( prepare a blank line) IBUF COUNT PAD SWAP CMOVE ( now PAD holds our new line) BOL ( temporarily move cursor to start of line) ( CURSOR @ 64 U/ 64 * ) ( DUP CURSOR ! ) CURSOR @ ( temporarily move cursor to start of line) PAD 64 INSERT ( move the line to the block) ( start-of-same-line) CURSOR! .L ; ( U C X ) : U ( -) ( string) EOL BLOCK-TAIL DUP 64 U< ABORT" end of block" ( a #) 64 SPREAD P ; : C ( -) BOL LINE-TAIL IBUF PLACE ( ) ; : X ( -) C CURSOR @ LINE-TAIL DROP ( cur to) EOL BLOCK-TAIL ( cur to from #) PUSH SWAP POP CMOVE ( cur) 15 64 * CURSOR! LINE-TAIL 32 FILL ( cur) CURSOR! UPDATE .L ; ( S search across blocks) : S ( -) ( string) GET-SEARCH-STRING CURSOR @ ( save it in case string is not found) SCR @ DUP DUP >UNIT# RANGE NIP ( ie lastBlk#) PUSH BEGIN ( origCur origBlk blk#) SRCH IF 2DROP POP 2DROP L .L EXIT ( ) THEN DUP R@ U< WHILE ( origCur origBlk blk) 1+ DUP SCR ! CURSOR OFF REPEAT POP DROP ." not found" ( origCur origBlk blk#) DROP SCR ! CURSOR! ; ( BRING bring a range of lines into the current block) : BRING ( sourceBlock first last -) OVER - 1+ ( ie lines) 64 * ( ie size) PUSH ( srcBlk first) 64 * ( ie offset) SWAP BLOCK + ( from) BLOCK-TAIL POP OVER ( from tail t# size t#) 0 SWAP ( from tail t# size 0 t#) CLAMP ( from tail t# 'size) DUP PUSH ( from tail t# size -- size) SPREAD ( from -- size) BLOCK-TAIL DROP ( from to) POP CMOVE L .L ; ( TILL ) : TILL ( -) ( string) CURSOR @ ( origCur) (F CURSOR @ ( origCur newCur) OVER CURSOR! ( restore cursor regardless) SWAP - ( actualDistance) DUP LINE-TAIL NIP ( actual actual allowedDistance) U> NOT IF ( actual#) LINE-TAIL DROP OVER IBUF PLACE ( actual#) DELETE ELSE DROP ." not found" THEN .L ; ( Possible enhancements ) EXIT Pushing and Popping individual lines Easy way to insert blank blocks, see HOLES in old editor SPLIT would delete from the cursor to the end of line then trim that string and put it in the insert buffer then insert it at the beginning of the next line (or maybe do U). JOIN would delete from cursor to end of current line and then pull as much from following line into current line as will fit. Define the common 1-letter commands also as lower case. ( HOLES insert one or more blank blocks after current block) ( this uses MORE [ # handle] ) : HOLES ( u -) 0 50 CLAMP ( u) DUP PUSH ( u -- u) ( first, extend file by u blocks and reopen) SCR @ >UNIT# DUP PUSH HANDLE @ MORE R@ ?OPEN ( -- unit# u) 1 SCR +! ( we insert *following* current block) ( next, copy original remaining blocks forward) SCR @ DUP ( from to-u) POP RANGE NIP SCR @ - 1+ ( ie count+u) ( from to-u count+u -- u) R@ +UNDER R@ - ( from to count) COPIES ( -- u) ( then, blank out the new blocks ) SCR @ POP FOR ( blk) DUP CLEAR 1+ NEXT DROP ( ) ( finally, restore current block) -1 SCR +! ;