\ SEDITOR.SEQ Sequential EDitor Written by 1987 Tom Zimmer comment: Hello - SED the Sequential EDitor was written by Tom Zimmer. SED is released into the Public Domain. It is included as an imbedded portion of the F-PC Forth system, and may be used as needed to develop programs on that system. SED is provided in source form in the F-PC system to allow you the ability to change SEDs characteristics. The Forth system F-PC is also in the public domain, and as such you may do with F-PC and SED as you wish. Tom Zimmer comment; only forth also hidden also editor also definitions 1 constant real.firstline real.firstline constant first.textline 24 constant lines/screen 0 constant statusline 1 constant helpline 250 constant ch/l 187 constant helpkey \ default value is F1 key lines/screen 1- constant last.textline 0 constant torig \ origin of text in text segment 2573 constant crlfval \ value of line terminator CRLF. 8224 constant blbl \ value of two blanks. 255 constant linebuf.len 12 constant formfeed 55 constant prtlines \ print lines per page variable imode \ insert mode flag variable lmrgn variable etabsize 8 etabsize ! \ default to 8 char increment variable memleft variable newfl \ was new file created? variable changed \ edit changed flag variable markline \ mark/get line # variable markchar \ mark/get character offset variable updated \ have we updated to disk yet? variable lookflg \ did we find anything last time? \ variable xrmrgn variable wrapped variable wraplen variable wraploc variable escflg \ are we escaping during filename entry variable filtering \ are we looking for ESC and Alt-F10? variable lchng \ line changed flag variable ldel.cnt \ count of line deletes variable emptyline variable lastldline \ last line we were editing. create nfil 13 c, 10 c, 13 c, 10 c, 13 c, 10 c, \ empty file create blnks 128 allot blnks 128 blank 0 constant screenline \ current screen line variable origcur : cursave ( --- ) get-cursor origcur ! ; : currest ( --- ) origcur @ set-cursor ; defer showstat defer exit.edit ' quit is exit.edit \ default to just quit defer doacharx defer normkey ' bl is normkey defer normfilter ' noop is normfilter defer normbgstuff ' noop is normbgstuff defer ins-cursor ' big-cursor is ins-cursor variable vstaton variable statcnt create slook.buf 36 allot \ search buffer slook.buf 36 blank 1 slook.buf c! create linebuf linebuf.len allot linebuf linebuf.len blank create temp.buf linebuf.len allot temp.buf linebuf.len blank create split.buf linebuf.len allot split.buf linebuf.len blank create wrap.buf linebuf.len allot wrap.buf linebuf.len blank create temp2.buf linebuf.len allot temp2.buf linebuf.len blank create fdbuf 36 allot fdbuf 36 erase variable csaveflg \ are we saving characters 0 constant ldel.buf 0 constant linelen create --'s.buf 80 allot --'s.buf 80 hex c4 decimal fill : -s ( n1 --- ) --'s.buf swap video-type ; : gremit create c, does> 1 video-type ; hex c0 gremit |. c4 gremit -- ( b3 gremit | ) d9 gremit .| bf gremit '| da gremit |' decimal : ss spaces ; \ : || ( --- ) 79 #line @ at | ; : .l ( n1 n2 --- ) \ Print left justified in fld >r (u.) dup >r type r> r> swap - 0 max ?dup if blnks swap type then ; : emptykbd ( --- ) \ empty any keyboard typeahead begin 0 1050 @L 0 1052 @L - abs 2 > \ keyboard depth > 1 key while bioskey drop repeat ; hex \ 02 = Shift key, 08 = Alt key, 40 = Caps lock. \ : ?capslock ( --- f1 ) 0 417 c@l 40 and 0<> ; : ?ctrlkey ( --- f1 ) 0 417 c@l 04 and 0<> ; : ?shiftkey ( --- f1 ) 0 417 c@l 02 and 0<> ; decimal create end-spcs 80 allot end-spcs 80 177 fill : eeol ( --- ) \ clear the screen line. spcs 80 #out @ - video-type ; : end-eeol ( --- ) \ clear the screen line. end-spcs 80 #out @ - video-type ; : creeol ( --- ) \ erase next line. cr eeol 0 #line @ at ; : erase.bottom ( --- ) 0 #line @ 24 over - 1 max 0 do creeol loop at ; : terminate.edit ( --- ) shndl+ clr-hcb creeol creeol ." Leaving now...." creeol erase.bottom exit.edit ; : ?terror ( f1 a1 n1 --- ) \ handle errors rot if creeol type terminate.edit else 2drop then ; : ?<>bak ( --- ) \ verify current file is not a .BAK shndl @ handle>ext 1+ " BAK" caps-comp 0= " Can't edit files with ext .BAK" ?terror ; : set.newfile ( --- ) \ setup memory for a new file creeol ." New File Created " creeol currentsize off temp2.buf 64 blank ?cs: temp2.buf torig tb: 64 cmovel 4 toff ! ?cs: nfil torig tb: 4 cmovel 5 tenths ; : ?softerror ( bool a1 n1 --- ) rot if beep 0 statusline at >attrib4 type eeol >norm cursor-off 2 seconds showstat else 2drop then ; : change.ext ( a1 --- ) \ rename file in tfcb to have renaming @ if shndl @ shndl+ b/hcb cmove shndl+ $>ext shndl+ hdelete drop \ delete old backup shndl @ shndl+ hrename dup 3 = over 5 = or swap 17 = or \ no path found, access denied, no path found newfl @ 0= and " Rename error" ?terror else drop then ; : clearit initstuff 0 dos-line c! ; : read.openfile ( --- ) \ read a file that is already open. ?<>bak shndl @ endfile 2dup 128 um/mod nip 1+ currentsize ! 65000. dmin drop dup toff ! >r creeol ." Reading... " shndl @ >attrib1 count type >norm creeol 0.0 shndl @ movepointer torig r> shndl @ tsegb @ exhread drop ; : read.oldfile ( --- ) \ get existing file newfl off shndl @ endfile 65000. D> " Sorry, File is TOO BIG, use another editor." ?terror read.openfile ; : warn-prompt ( --- ) >revblnk ." NO ROOM TO SAVE " >norm ." changes made to this file !!" beep 3 tenths creeol creeol tab ." You might try using Alt-W to write to another drive." creeol creeol tab tab ." PRESS A KEY to acknowledge " beep emptykbd key? if key drop then key drop ; : ?diskfull ( --- f1 ) renaming @ 0= if false exit then shndl @ >nam 1+ c@ ascii : = if shndl @ >nam c@ bl or 96 - else 0 then getdiskfree * 0 128 um/mod nip *D ( toff @ tend @ negate + ) 64000. 128 um/mod swap if 1+ then 0 D< dup if creeol tab tab tab >revblnk ." WARNING !!" >norm creeol creeol ." You have LESS than 64000 bytes free on disk" beep 3 tenths creeol ." There may be " warn-prompt then ; : ?enoughdisk ( --- f1 ) \ true if there is enough disk space to save shndl @ >nam 1+ c@ ascii : = if shndl @ >nam c@ bl or 96 - else 0 then getdiskfree * 0 128 um/mod nip *D renaming @ 0= if currentsize @ 0 d+ then toff @ tend @ negate + 0 128 um/mod swap if 1+ then 0 D< dup if dark cr cr creeol tab tab tab >revblnk ." WARNING !! " >norm creeol beep 3 tenths creeol tab ." There is " warn-prompt then 0= ; : read.file ( --- ) \ read file in shndl ?<>bak -1 tend ! newfl off shndl @ hopen \ opens the file. if newfl on set.newfile else read.oldfile 5 tenths shndl @ hclose " Close Error" ?terror ?diskfull drop then ; : ?change.bak ( --- ) newfl @ 0= if " BAK" ">$ change.ext then ; : write.file ( --- ) \ write file in shndl \ WRITE.FILE assumes we are on FIRST line. shndl @ hcreate dup " Error Making File" ?softerror ?exit tend @ tb: torig tb: tend @ negate cmovel \ text to buffer beginning. 0.0 shndl @ movepointer torig tend @ negate \ -- text_length dup 4 - tb: @l 2573 <> \ append CRLF if not already if 2573 over tb: !L 2+ \ there. 2573 over tb: !L 2+ then dup >r r@ 0 128 um/mod nip 1+ currentsize ! shndl @ tsegb @ exhwrite r> <> dup " Error while writing, probably out of space." ?softerror ?exit shndl @ hclose " Error Closing File" ?softerror torig tb: tend @ tb: dup negate cmovel> ; \ text back to buffer end. : skeyfilter ( n1 --- n2 ) normfilter filtering @ 0= ?exit ( escape key ) dup 27 = if drop 13 escflg on exit then ( Alt-F10 key) dup 241 = if drop 13 escflg on then ; \ ' skeyfilter is keyfilter : getafile ( --- f1 ) >in @ span @ 1- > \ entered filename? if @> key up @ + @ >r ['] normkey is key getfile \ no, get one from windw r> is key if file>tib \ good, then to TIB else span off #tib off >in off then then >in @ span @ 1- > 0= \ if tib has name if bl word shndl @ $>handle true \ moveit then done loadline off \ reset to first line else false \ else no good then ; : get.filename ( --- f1 ) begin 0 3 at escflg off filtering on creeol ." Enter a " >rev ." NEW " >norm ." Filename to create and edit." creeol creeol creeol creeol ." Press " >rev ." Enter " >norm ." alone to display a list of existing files." creeol creeol ." " >rev ." ESC = QUIT " >norm 0 6 at ." ->" query filtering off escflg @ if creeol creeol ." Written by Tom Zimmer" creeol 11 ss ." 292 Falcato Drive" creeol 11 ss ." Milpitas, California" creeol 22 ss ." Zip 95035 hm (408) 263-8859" creeol 35 ss ." wk (408) 432-4643" creeol shndl @ hopen drop \ try to leave the file open \ but don't get upset if it won't \ open. creeol false true else getafile ?dup then erase.bottom creeol until ; : set.file ( t1 --- f1 ) \ setup file name in shndl bl word c@ if here shndl @ $>handle true else get.filename then ; : get ( t1 --- f1 ) \ get a file, return true if ok set.file dup if read.file shndl @ pathset " Can't read path" ?terror then ; : put ( --- ) \ save a file write.file ; : linebuf: ( --- seg a1 ) \ a useful primitive ?cs: linebuf ; : lineinfo ( --- a1 n1 ) \ info on current line curline #linedata ; : showcur ( --- ) \ display cursor at proper loc screenchar dup 79 > if 40 mod 40 + then screenline at ; : #lineinfo ( n1 --- seg a1 n2 ) dup curline 1- = if tb: >lineptr tl:@ toff @ over - else tb: #linedata then ; : stripbl's ( --- ) \ strip off trailing blanks linebuf count -trailing linebuf c! drop ; : restore.name ( --- ) \ restore backup file extension shndl @ handle>ext 1+ temp.buf 1+ 3 cmove 3 temp.buf c! " BAK" ">$ shndl @ $>ext shndl @ hopen 0= if shndl @ hclose drop temp.buf change.ext then temp.buf shndl @ $>ext ; : getline ( --- ) \ get current line to linebuf. linebuf linebuf.len blank lineinfo >r tb: linebuf: 1+ r@ ch/l 2+ min cmovel ( --- ) r@ 2- =: linelen r> linebuf + 1- dup @ crlfval = if blbl swap ! else drop 2 +!> linelen then linebuf linelen + dup c@ 9 = if bl over c! decr> linelen then drop ch/l linebuf c! lchng off ; : putline ( --- ) lchng @ 0= ?exit \ only save if changed stripbl's \ restore linebuf to file linebuf count + crlfval swap ! linebuf c@ 2+ linebuf c! linebuf: count >r tsegb @ lineptr dup tl+ tl:@ linebuf c@ - dup rot tl:! dup tend ! r> cmovel ; : curline+ ( --- ) \ move down one line in text curline lastline @ = ?exit lineinfo >r tb: toff @ tb: r@ cmovel toff @ lineptr tl:! r> toff +! incr> curline lineptr tl:@ tend ! ; : curline- ( --- ) \ move up one line in text curline 0= ?exit tsegb @ lineptr dup tl- tl:@ toff @ over - >r swap tl:@ r@ - tb: r@ cmovel r@ negate toff +! lineptr dup tl:@ r> - swap tl- tl:! decr> curline lineptr tl:@ tend ! ; variable rsplit : ?lf's ( --- ) \ check for file has lf's 0 ch/l 2+ torig mxlln rsplit ! do i tb: @l crlfval = if drop -1 leave then loop ( --- f1 ) \ true if has line feed 0= if creeol ." Splitting lines longer than " 64 . 64 rsplit ! creeol ." Changing EXT to .TMP" creeol " TMP" ">$ shndl @ $>ext newfl on beep 2 seconds changed on \ make it save ! then ; : stripCtl-Z's ( --- ) toff @ dup dup 128 - swap 1- ?do i tb: c@l control Z <> if drop i 1+ leave then -1 +loop dup toff ! 1- tb: c@l 10 - \ if file doesn't end if crlfval toff @ tb: !l \ with CRLF then 2 toff +! \ add them then ; \ conditional lastline and firstline tests : ?lastline ( --- f1 ) curline lastline @ >= ; : ?firstline ( --- f1 ) curline 1 < ; : >lf ( a1 --- a2 ) \ find the next linefeed in file dup ch/l 10 scan 0= if drop rsplit @ 1- + else nip ( over - ) then ( xrmrgn @ over max xrmrgn ! + ) ; : build.linelist ( --- ) tsegb @ sseg ! \ seg search segment tend @ maxlines 1- 0 do incr> curline >lf 1+ dup lineptr tl:! dup 0= ?leave loop drop ?cs: sseg ! ; \ Restore the search segment : sinit ( --- ) \ initialize file, and linelist table changed off ?lf's stripCtl-Z's imode on -1 markline ! torig tb: toff @ tb: dup negate swap cmovel> toff @ negate tend ! toff off updated off lookflg off 0 =: curline lmrgn off first.textline =: screenline 0 =: screenchar \ xrmrgn off tend @ lineptr tl:! build.linelist curline 1- lastline ! 0 =: curline getline ; : pagechar ( --- ) 79 #out ! >rev 31 femit ; code ?page-char ( n1 --- ) pop ax sub dx, dx mov bx, # prtlines div bx cmp dx, # 0 0= if mov ax, # ' pagechar jmp ax then next end-code : sltype ( n1 --- ) \ n1 is data line >norm @> tsegb !> TYPESEG \ set VTYPE source segment on> nosetcur dup curline 1- = if >lineptr tl:@ @> toff over - else #linedata then 2- clipline video-type ?cs: !> TYPESEG \ restore VTYPE source segment eeol off> nosetcur ; : ( --- ) \ show file status to user >attrib1 ." Row=" curline 1+ 5 .l ." Column=" screenchar 4 .l ." Page#=" curline prtlines / 1+ 4 .l ." Lines=" lastline @ 1+ 5 .l ." Characters=" tend @ negate toff @ + 5 .l >norm 79 #out @ 79 min - 0 max -s '| 0 last.textline 1+ at |. shndl @ count dup 16 + 79 swap - 2 /mod swap >r >r r@ 1- >norm -s >attrib1 ." Current file = " over + swap ?do i c@ femit loop ." " >norm r> r> + ( 1+ ) 1- 0 max -s .| 2 last.textline 1+ at >attrib4 ." HELP=F1 " >norm ; : fullfunc ( --- ) \ status for when file is full > 64k 0 statusline at |' 4 -s >attrib1 >boldblnk ." MEM FULL" >norm ; : statfunc ( --- ) 0 statusline at |' 4 -s >attrib1 imode @ if >attrib4 ." INSERT " else >attrib1 ." OVERTYPE" then >norm ; ' statfunc is showstat lines/screen 1- constant lsl \ last screen line : ?full ( --- f1 ) \ is memory full? tend @ negate toff @ + 0 64000. d> ; : ?showfull ( --- ) \ set status func for memory ?full dup \ condition if ['] fullfunc is showstat else ['] statfunc is showstat then ; : ?maxlines ( --- f1 ) lastline @ 4 + maxlines > ; : sdisp ( --- ) 0 screenline at on> nosetcur linebuf 1+ linelen clipline video-type eeol curline ?page-char off> nosetcur >norm ; : scrshow ( --- ) \ display screen full of file. cursor-off first.textline curline screenline first.textline - - 0 max dup [ last.textline 1+ first.textline - ] literal + swap do i curline = >norm if sdisp else dup !> #line #out off i lastline @ <= if i sltype else end-eeol then i ?page-char then 1+ loop drop >norm cursor-on ; : ( --- ) putline curline+ getline ; : ( --- ) \ sequential line down putline curline- getline ; : sdisplay ( --- ) \ display current screen line. cursor-off sdisp cursor-on ; : ins.linelist ( --- ) \ add new entry to line pointer lineptr tl: dup tl+ tl: \ list. maxlines curline - 1- 2* cmovel> lastline incr ; : ?appendline ( --- ) ?lastline if lineptr tl+ dup tl:@ swap tl+ tl:! lastline incr then ; : clipdown ( --- ) screenline >r last.textline lastline @ curline - 0 max - screenline max last.textline min curline first.textline + min dup =: screenline r> <> if scrshow then ; : sdln ( --- ) \ sequential line down ?lastline ?exit incr> screenline clipdown ; : ( --- ) \ home to beginning of file putline begin ?firstline 0= while curline- repeat first.textline =: screenline 0 =: screenchar lmrgn off getline ; : shom ( --- ) scrshow ; : suln ( --- ) \ sequential line up ?firstline if exit then decr> screenline screenline >r screenline first.textline - curline min 0 max first.textline + dup =: screenline r> <> if scrshow then ; : ?cursor ( --- ) imode @ if ins-cursor else norm-cursor then ; : line>ldel.buf ( --- ) dseg @ if dseg @ ldel.buf 2dup mxlln + ldel.cnt @ maxdline 1- min mxlln * cmovel> ldel.cnt dup @ 1+ maxdline 1- min swap ! linelen linebuf c! ?cs: linebuf dseg @ ldel.buf linelen 1+ mxlln min cmovel then ; : ldel>linebuf ( --- ) dseg @ if dseg @ ldel.buf 2dup c@l ?cs: linebuf rot 1+ cmovel linebuf c@ =: linelen dseg @ ldel.buf 2dup mxlln + 2swap ldel.cnt @ maxdline min dup 1- ldel.cnt ! mxlln * cmovel then ; : #deletelines ( n1 --- ) 0 max ?dup 0= ?exit dup >r tl* tl:@ tend ! lineptr tl: dup r@ tl* + tl: 2swap maxlines >lineptr lineptr r@ tl* + - cmovel r> negate lastline +! getline changed on lchng on ; : linedelete ( --- ) lineptr dup tl+ tl:@ tend ! maxlines >lineptr over - >r tl: dup tl+ tl: 2swap r> cmovel lastline decr getline changed on lchng on ; : ( --- ) \ delete the current line. ?appendline line>ldel.buf linedelete ?showfull drop ; : ldel ( --- ) scrshow ; : to.line ( n1 --- ) begin curline over < ?lastline 0= and while curline+ repeat drop getline ; : backto.line ( n1 --- ) begin curline over > while curline- repeat drop getline ; : .elapse ( --- ) ." Edit time " time-elapsed b>t ttime 2@ <.time> ; : updt ( --- ) \ save changes if any to disk. changed @ 0= if 0 statusline at >attrib2 " No Changes to save" type eeol >norm showcur 5 tenths else screenchar >r screenline >r curline >r 0 statusline at >attrib2 ." Saving Changes to " .SHNDL eeol >norm shom ?enoughdisk if put changed off updated on else showstat then r> to.line r> =: screenline r> =: screenchar then scrshow ?cursor emptykbd fdbuf off ; : squt ( f1 --- f2 ) \ discard changes and exit dark 0 2 at .elapse loadline off lastldline off updated @ 0= renaming @ 0<> and if restore.name then ." Edit Aborted on " .SHNDL eeol drop -1 edready off ; : ( f1 --- f2 ) \ save changes and exit curline 0= if loadline off else curline 1- #lineinfo + nip loadline ! curline lastldline ! then shom dark 0 2 at .elapse changed @ if ." Saving Changes to " .SHNDL ?enoughdisk if put eeol drop -1 changed off else scrshow showstat then else updated @ 0= renaming @ 0<> and if restore.name then ." No changes to save in " .SHNDL drop -1 changed off then ; : sesc ( f1 --- f2 ) \ save changes and exit ?ctrlkey ?shiftkey and \ holding down Control & Shift renaming @ 0<> and \ and RENAMING is not 0 if restore.name \ then restore backup file renaming off \ and overwrite it with memory. else ?shiftkey \ Holding down SHIFT if squt \ then quit, and dont save else \ else go ahead and save then then ; defer ' noop is \ conditionally add a line : ?addline ( -- ) ?lastline if screenchar ch/l =: screenchar =: screenchar then ; : rchr ( --- ) \ right a character screenchar 1+ ch/l 1- min dup =: screenchar rmargin @ >= if 0 =: screenchar ?addline sdln scrshow then screenchar 40 - 40 /mod 0<> swap 0= and if scrshow then ; : chrptr ( --- a1 ) \ cur character line pointer screenchar linebuf 1+ + ; \ goto beginning of curent line : shoml ( --- ) 0 =: screenchar lmrgn off scrshow ; : sendl ( --- ) \ goto end of current line stripbl's linebuf c@ =: linelen ch/l linebuf c! linelen =: screenchar scrshow ; : send ( --- ) \ goto end of file putline begin ?lastline 0= while curline+ repeat last.textline curline 1+ min =: screenline getline sendl ; : ?leftshow ( --- ) \ reshow screen of screen scrolled screenchar 40 /mod 0<> swap 39 = and if scrshow then ; : lchr ( --- ) \ left a character -1 +!> screenchar screenchar 0< if 0 =: screenchar suln sendl scrshow then ?leftshow ; : ?showstatus ( --- ) normbgstuff vstaton @ 0= if exit then statcnt @ 40 > if statcnt off vstaton off #out @ #line @ showstat at ?cursor then statcnt incr ; \ ' ?showstatus is bgstuff : statkey ( --- c1 ) normkey statcnt off ; \ ' statkey is key : pdn ( --- ) \ go down a page in file ?lastline if exit then putline getline last.textline 1+ first.textline - 2- 0 max 0 ?do putline curline+ getline ?lastline if last.textline =: screenline leave then loop clipdown scrshow emptykbd ; : pup ( --- ) \ go up a page in file ?firstline if exit then putline getline last.textline 1+ first.textline - 2- 0 max 0 ?do putline curline- getline ?firstline if first.textline =: screenline leave then loop screenline first.textline curline + min =: screenline scrshow emptykbd ; : >space ( --- ) \ move to next space in line linelen dup screenchar over min ?do linebuf 1+ i + c@ dup bl = swap 127 > or if drop i leave then loop =: screenchar ; : space> ( --- ) \ move to non blank in line linelen dup screenchar over min ?do linebuf 1+ i + c@ dup bl <> swap 127 > 0= and if drop i leave then loop linelen min =: screenchar ; : < ( --- f1 ) \ t1 = true if found space 0 dup screenchar ?do linebuf 1+ i + c@ dup bl = swap 127 > or if drop i leave then -1 +loop dup =: screenchar ; : swap 127 > 0= and if drop i leave then -1 +loop =: screenchar ; : rwrd ( --- ) screenchar linelen rmargin @ min = ?lastline 0= and if 0 =: screenchar sdln scrshow exit then >space screenchar linelen >= if scrshow exit then space> scrshow ; : lwrd ( --- ) \ go back to previous word. screenchar 0= ?firstline 0= and if suln linelen =: screenchar scrshow exit then screenchar 1- 0 max =: screenchar if incr> screenchar then rmargin @ screenchar min =: screenchar scrshow ; : splitline ( --- ) linebuf screenchar + 1+ dup split.buf 1+ linelen screenchar - 1+ 0 max dup >r cmove r> split.buf c! ch/l screenchar - blank screenchar =: linelen ?appendline lchng on linebuf linebuf.len blank split.buf count linebuf 1+ lmrgn @ + swap cmove split.buf c@ lmrgn @ + dup linebuf c! =: linelen ins.linelist lchng on ; : ( --- ) \ inserts line if in insert mode. ?showfull ?maxlines or if beep exit then imode @ if SplitLine else ?lastline if stripbl's linebuf c@ =: screenchar SplitLine then then changed on ; ' is : nln ( --- ) \ next line function \ inserts line if in insert mode. sdln lmrgn @ dup =: screenchar linelen max =: linelen ch/l linebuf c! scrshow ; : nodisp-nln ( --- ) \ next line function \ inserts line if in insert mode. 0 =: screenchar ch/l linebuf c! ; : csaveon csaveflg on ; : csaveoff csaveflg off ; : csave ( c1 --- ) csaveflg @ 0= if drop exit then \ leave if not saving chars. fdbuf c@ 32 > if fdbuf count >r dup 1+ swap r> cmove fdbuf c@ 1- 0 max fdbuf c! then fdbuf count + c! fdbuf c@ 1+ fdbuf c! ; : ( --- ) screenchar dup linebuf + 1+ dup c@ csave dup 1+ swap rot ch/l 1+ swap - cmove changed on lchng on ?showfull drop decr> linelen ; : split.lineend ( --- ) wrap.buf linebuf.len blank rmargin @ 1- =: screenchar < drop screenchar 1+ lmrgn @ 1+ max ( was 2+ *** ) dup >r =: screenchar linebuf screenchar linelen over - 0 max >r + 1+ dup wrap.buf 1+ r@ cmove r@ wrap.buf c! r> blank lchng on putline getline wrapped @ 0= if wrap.buf c@ wraplen ! wrapped on r@ wraploc ! then r>drop ; : prepend.split ( --- ) linebuf 1+ rmargin @ bl skip 0= wrap.buf c@ rmargin @ > or if drop linebuf 1+ lmrgn @ + 0 =: screenchar 0 =: screenchar else wrap.buf c@ 1+ >r linebuf 1+ dup r@ + linelen 1+ r@ + ch/l min r@ - cmove> linebuf 1+ r> blank then ch/l linebuf c! dup linebuf 1+ - rmargin @ 2 - min lmrgn ! ( was 6 - *** ) >r wrap.buf count r@ swap cmove wrap.buf c@ 1+ +!> linelen wrap.buf c@ r> linebuf 1+ - + =: screenchar lchng on putline getline ; defer showst ' showstat is showst : ?lmargin ( --- ) screenchar 0= if lmrgn @ =: screenchar then ; : ?right ( --- ) wrapped @ if screenchar wraploc @ < if rchr ?lmargin else screenchar wraploc @ - lmrgn @ + 1+ =: screenchar sdln then scrshow else rchr ?lmargin then ; : del<>bl's ( --- ) \ delete non blanks begin chrptr c@ bl <> while repeat ; : delbl's ( --- ) \ delete blanks rmargin @ screenchar ?do chrptr c@ bl <> ?leave loop ; : AppendLine ( --- ) \ append this line to previous. ?firstline if beep exit then imode @ if stripbl's split.buf linebuf.len blank linebuf split.buf over c@ dup >r 1+ cmove curline 1- #lineinfo nip nip r> + ch/l 1- > if beep getline 0 =: screenchar else ?lastline 0= if ldel then suln stripbl's split.buf count linebuf count 1+ dup >r + swap cmove lchng on split.buf c@ r@ + ch/l 10 - min dup 10 + linebuf c! =: linelen r> rmargin @ 1- min =: screenchar putline screenchar linelen 1- min =: screenchar then else suln stripbl's linebuf c@ =: screenchar then getline sdisplay ; : bdel ( --- ) \ back delete screenchar 0= if AppendLine scrshow else imode @ if screenchar dup linebuf + 1+ dup 1- rot ch/l 1+ swap - cmove decr> screenchar linelen 1- screenchar max linelen min =: linelen else decr> screenchar bl chrptr c! lchng on putline getline then sdisplay screenchar lmrgn @ min lmrgn ! then lchng on changed on ?showfull drop ?leftshow ; : nodisp-schr ( c1 --- ) \ insert sequential char in line. ?showfull ?exit screenchar linelen max =: linelen screenchar linebuf 1+ + dup 1+ linelen screenchar - 0 max cmove> incr> linelen dup screenchar linebuf 1+ + c! bl <> if linelen screenchar 1+ max =: linelen then changed on lchng on screenchar 1+ ch/l 1- min =: screenchar ; : schr ( c1 --- ) \ insert sequential char in line. ?showfull ?exit screenchar linelen max =: linelen imode @ if screenchar linebuf 1+ + dup 1+ linelen screenchar - 0 max cmove> incr> linelen then dup screenchar linebuf 1+ + c! bl <> if linelen screenchar 1+ max =: linelen then sdisplay changed on lchng on ( ?wrap ) ?right ; : wudel ( --- ) imode dup @ >r on fdbuf count bounds ?do fdbuf 1+ c@ >r \ get char fdbuf 2+ fdbuf 1+ \ source destination fdbuf c@ 1- 0 max cmove \ clip char out fdbuf c@ 1- 0 max fdbuf c! \ reduce count r> ?dup 0= ?leave \ leave if null schr \ insert it loop r> imode ! ; : #linelook ( n1 --- f1 ) \ look through line n1 >r slook.buf count r> #lineinfo rot drop screenchar - 0 max swap screenchar + swap search swap over if +!> screenchar else drop then ; variable inputline variable looked : input$ ( a1 n1 -- a2 ) escflg off filtering on 1 inputline @ at >attrib1 type #out @ eeol >norm inputline @ at temp2.buf 1+ dup 66 blank 64 expect temp2.buf span @ over c! filtering off ; : look.till ( --- f1 ) \ time-reset 0 =: screenchar putline tsegb @ sseg ! 0 \ Leave false bool in case we don't find it. lastline @ 1+ curline 1+ over min ?do slook.buf count i #linedata search if =: screenchar \ 60 24 at <.elapsed> 5 tenths i to.line 0= \ change false bool to true leave \ and leave else drop then key? ?leave i 63 and 0= if cursor-off 19 statusline at I 1+ 4 >attrib1 .l >norm then loop ?cs: sseg ! getline emptykbd \ 60 24 at <.elapsed> 5 tenths ?cursor ; : look.back ( --- f1 ) 0 =: screenchar putline tsegb @ sseg ! 0 \ Leave false bool in case we don't find it. 0 curline 1- 0 max ?do i #linelook if i backto.line 0= \ change false bool to true leave \ and leave then key? ?leave i 63 and 0= if cursor-off 19 statusline at I 1+ 4 >attrib1 .l >norm then -1 +loop ?cs: sseg ! getline emptykbd ?cursor ; : ( --- ) ?lastline if exit then looked off slook.buf c@ 0= if rwrd exit \ just step to next word then putline getline tsegb @ sseg ! curline >r r@ #linelook 0= ?cs: sseg ! if look.till dup lookflg ! 0= if beep r@ backto.line else looked on then else looked on then r>drop screenline 10 < if screenline 1+ curline first.textline + min =: screenline then ; : slooker ( --- ) ?lastline if exit then caps @ >r ?shiftkey if caps off else caps on then r> caps ! ; : slookbk ( --- ) caps @ >r looked off caps on curline >r look.back dup lookflg ! 0= if beep r@ to.line else looked on then r>drop r> caps ! ; : sloob ( --- ) \ search again backwards slookbk scrshow clipdown ; : slooa ( --- ) \ search again forward incr> screenchar slooker scrshow sdisplay ; : sloon ( --- ) first.textline inputline ! " Text to look for ->" input$ escflg @ if drop scrshow exit then dup c@ if slook.buf over c@ 1+ 30 min cmove slook.buf dup c@ 30 min swap c! else drop then 1 first.textline at >attrib1 ." Looking for .... ->" #out @ eeol first.textline at slook.buf count type >norm slooa ; create rep.buf 128 allot rep.buf 128 erase variable repset : ( --- ) looked @ 0= repset @ 0= or if beep exit then imode dup @ >r on slook.buf c@ 0 ?do lchng on changed on putline getline loop rep.buf count bounds ?do i c@ schr loop looked off r> imode ! scrshow ; : srepa ( --- ) slooa ; : srepn ( --- ) repset off looked @ 0= if beep exit then first.textline inputline ! " Replace with ->" input$ escflg @ if drop scrshow exit then dup c@ if rep.buf over c@ 1+ 30 min cmove rep.buf dup c@ 30 min swap c! else drop then repset on srepa ; : repall ( --- ) looked @ if then begin slooa looked @ while repeat ; : already_exists? ( --- f1 ) \ does filename in SHNDL+ exist? shndl+ hopen 0= \ if so, then prompt for overwrite. if shndl+ hclose drop 0 statusline 2dup at eeol at >rev space shndl+ count type space ." ALREADY EXISTS, overwrite it? Y/N [N]-> " space key dup emit space bl or ascii y <> dup if ." Aborting..." 5 tenths >norm scrshow then >norm else false then ; : wr->fl ( --- ) first.textline inputline ! " Write file in memory to Drive:\Path\Filename ->" input$ dup c@ escflg @ 0= and if restore.name dup shndl+ $>handle shndl+ pathset drop already_exists? \ overwrite existing? if drop exit \ if not then exit then shndl @ $>handle shndl @ pathset drop screenchar >r newfl on changed on screenline >r curline >r shom 0 statusline 2dup at eeol at ." Saving to File..." ?enoughdisk if put changed off updated on ." .DONE " 5 tenths else showstat then begin curline r@ <> while curline+ repeat r>drop r> =: screenline r> =: screenchar getline else drop then scrshow ; : ( --- ) screenchar >r sdln 0 =: screenchar bdel r> =: screenchar ; : joinln ( --- ) imode dup @ >r on r> imode ! ; : itgl ( --- ) \ insert mode toggle imode @ 0= imode ! ?cursor ; : fdel ( --- ) \ forward delete screenchar linelen >= if bl schr delbl's else csaveon csaveoff then lchng on changed on putline getline ?showfull drop sdisplay ; : wdel ( --- ) screenchar linelen >= if bl schr \ unwrap line chrptr c@ bl = if delbl's then else chrptr c@ bl <> if csaveon del<>bl's \ delete non blank \ delete one blank 0 csave \ Append null delimiter csaveoff delbl's \ and delete blanks else csaveoff delbl's then \ for possible undelete then lchng on changed on putline getline ?showfull drop sdisplay ( scrshow ) ; : smrk ( --- ) \ mark line for get curline markline ! screenchar markchar ! 0 statusline at ." --- Mark is Set ---" eeol 5 tenths ; : sbtab ( --- ) \ tab left on screen lchr screenchar tabsize @ mod 0 ?do lchr loop ; : dnln ( --- ) sdln sdisplay emptykbd ; : upln ( --- ) suln sdisplay emptykbd ; : tscrn ( --- ) begin ?firstline 0= screenline first.textline <> and while upln repeat ; : bscrn ( --- ) begin ?lastline 0= screenline last.textline < and while dnln repeat ; : scldn ( --- ) screenline last.textline <> if decr> screenline sdln scrshow else sdln then emptykbd ; : sclup ( --- ) screenline first.textline <> if incr> screenline suln scrshow else suln then emptykbd ; : stab ( --- ) \ tab right on screen tabsize @ screenchar tabsize @ mod - imode @ if 0 ?do bl schr ?full screenchar lmrgn @ = or ?leave loop changed on else +!> screenchar then screenchar rmargin @ 1- >= if 0 =: screenchar sdln then linebuf 1+ screenchar bl skip nip 0= if screenchar rmargin @ 6 - min lmrgn ! then scrshow ; : e.## ( N1 --- ) \ Print two low digits of n1. 0 <# # # #> bounds ?do i c@ schr ?full ?leave loop ; : e./ ( --- ) ascii / schr ; : e.: ( --- ) ascii : schr ; : paste_datetime ( --- ) base @ >r decimal imode dup @ >r on bl schr getdate 0 256 um/mod e.## e./ e.## e./ 1900 - e.## bl schr gettime drop 0 256 um/mod e.## e.: e.## bl schr r> imode ! r> base ! ; : tabxp ( --- ) \ tab expansion word 9 slook.buf 1+ c! 1 slook.buf c! \ xrmrgn off mxlln rmargin ! caps @ >r caps off shom begin incr> screenchar looked @ while fdel stab lchr \ xrmrgn @ linelen max xrmrgn ! repeat shom r> caps ! ( xrmrgn @ 2+ mxlln min 80 max rmargin ! ) ; : l>lcase ( --- ) \ convert the current line to lower case linebuf 1+ linelen bounds ?do i c@ ascii A ascii Z between if i c@ bl or i c! then loop lchng on changed on putline getline ; : l>ucase ( --- ) \ convert the current line to lower case linebuf 1+ linelen bounds ?do i c@ ascii a ascii z between if i c@ 95 and i c! then loop lchng on changed on putline getline ; : Alt-O ( --- ) \ Alt-O options 0 statusline at >rev ." Alt-O (X-exp TABS, L-lowcase, U-UPCASE, P-Paste_Date/Time) press a key" eeol >norm >rev sdisplay >norm cursor-off key bl or >r ascii x r@ = if tabxp then ascii p r@ = if paste_datetime then ascii l r@ = if l>lcase then ascii u r> = if l>ucase then sdisplay showstat cursor-on ; : lundel ( --- ) \ undo line deletes ldel.cnt @ 0= if beep exit then imode dup @ >r on 0 =: screenchar nln suln ldel>linebuf changed on lchng on putline getline r> imode ! scrshow ; : sgetl ( --- ) markline @ lastline @ 2- > if beep exit then markline @ -1 = ?showfull or ?maxlines or if beep exit then imode @ >r imode on changed on 0 =: screenchar nln suln r> imode ! markline @ curline >= if markline incr then linebuf linebuf.len blank markline @ #lineinfo 2- >r ?cs: linebuf 1+ r> ch/l 2+ min cmovel ch/l linebuf c! lchng on putline getline sdln markline incr scrshow ; : spltln ( --- ) imode dup @ >r on screenchar >r nln suln r> =: screenchar r> imode ! scrshow ; : showscreen ( --- ) showstat scrshow ?cursor ; \ allow entry of any keyboard character : ^cc ( --- ) 0 0 at >attrib2 ." Enter a key to insert" eeol >norm showcur key schr ; : lmset ( --- ) screenchar lmrgn ! 0 0 at >attrib2 ." Left Margin set to column " screenchar . eeol >norm 3 tenths showcur ; : tabset ( --- ) screenchar 1 max dup tabsize ! etabsize ! 0 0 2dup at >attrib2 eeol at ." Tabs set column increment " screenchar 1 max . >norm 3 tenths showcur ; : notavail ( --- ) 0 statusline at cursor-off >attrib2 ." You MUST Load the expanded function set for that operation." eeol >norm beep 2 seconds cursor-on ; defer shelp ' notavail is shelp defer exportx ' notavail is exportx defer excutx ' notavail is excutx defer importx ' notavail is importx defer pmenux ' notavail is pmenux defer kerr ' beep is kerr \ control key functiontable : s^tbl ( n1 --- ) exec: \ @ A B C D E F G kerr lwrd kerr pdn rchr upln rwrd fdel \ H I J K L M N O bdel stab kerr kerr lmset nln spltln kerr \ P Q R S T U V W kerr kerr pup lchr wdel updt itgl sclup \ X Y Z ESC F1 dnln ldel scldn sesc kerr kerr shoml shelp ; \ function key table : sfuntbl ( n1 --- ) exec: \ A-9 A-0 A - A = CPGUP 133 134 135 kerr kerr kerr kerr kerr kerr kerr kerr \ 136 137 138 139 140 141 142 BACKSPACE kerr kerr kerr kerr kerr kerr kerr sbtab \ A-Q A-W A-E A-R A-T A-Y A-U A-I kerr wr->fl kerr kerr tabset lundel wudel kerr \ A-O A-P 154 155 156 157 A-A A-S Alt-O pmenux kerr kerr kerr kerr kerr kerr \ A-D A-F A-G A-H A-J A-K A-L 167 kerr kerr kerr kerr kerr kerr lmset kerr \ 168 169 170 171 A-Z A-X A-C A-V kerr kerr kerr kerr kerr excutx exportx importx \ A-B A-N A-M 179 180 181 182 183 kerr joinln kerr kerr kerr kerr kerr kerr \ 184 185 186 F1 F2 F3 F4 F5 kerr kerr kerr shelp tscrn smrk bscrn sgetl \ F6 F7 F8 F9 F10 197 198 199 sloon kerr srepn kerr ^cc kerr kerr kerr \ 200 201 202 203 204 205 206 END kerr kerr kerr kerr kerr kerr kerr sendl \ 208 209 210 211 SF1 SF2 SF3 SF4 kerr kerr kerr kerr kerr kerr kerr kerr \ SF5 SF6 SF7 SF8 SF9 SF10 CF1 CF2 kerr sloob kerr repall kerr kerr kerr kerr \ CF3 CF4 CF5 CF6 CF7 CF8 CF9 CF10 kerr kerr kerr kerr kerr kerr kerr kerr \ AF1 AF2 AF3 AF4 AF5 AF6 AF7 AF8 kerr kerr kerr kerr kerr slooa kerr srepa \ AF9 AF10 242 CLEFT CRIGHT CEND CPGDN CHOME kerr squt kerr lwrd rwrd send kerr shom \ A-1 A-2 A-3 A-4 A-5 A-6 A-7 A-8 kerr kerr kerr kerr kerr kerr kerr kerr ; : ?controls ( c1 --- c1 ) \ handle control characters dup 32 < if 0 swap s^tbl then ; : ?functions ( c1 --- c2 ) \ handle function characters dup 127 > \ they have values >127 if 128 - 0 swap sfuntbl then ; : ?del ( c1 --- ) \ char is delete key dup 127 = if drop fdel 0 then ; : ?schr ( c1 --- ) \ insert character if not a func dup 0> if schr 0 then ; : doachar ( c1 --- f1 ) ?controls ?functions ?del ?schr ; ' doachar is doacharx variable scrline : check.shndl ( --- f1 ) \ verify shndl is in the hndls array \ returns f1, true if we are out of handles shndl @ hndls u>= shndl @ hndls maxnest + b/hcb - u< and 0= dup \ is shndl within the hndls array? \ and not stacked up to last handle. if cr ." Sorry, too many files open !" then ; : find.line ( --- ) \ Assumes we are starting on first line. loadline @ 1000 u> if ." One moment..." then byte|line @ \ Are we going to a byte offset or a line#? if loadline @ 0 u> if 0 lastline @ 0 over min ?do i #linedata nip + dup loadline @ u>= if i 1+ to.line leave then loop drop else 0 to.line then else loadline @ 1- 0 max maxlines min to.line byte|line on \ reset to byte offset then ; : deferset ( --- ) \ save current deferred words, and reset them @> keyfilter is normfilter ['] skeyfilter is keyfilter @> key up @ + @ is normkey ['] statkey is key @> bgstuff is normbgstuff ['] ?showstatus is bgstuff ; : deferreset ( --- ) \ restore the deferred words old function. @> normbgstuff is bgstuff @> normkey is key @> normfilter is keyfilter ; : ( --- ) \ reenter edit of file restore_vectors ?diskfull drop time-reset savestate updated off etabsize @ tabsize ! 2 lmargin ! 132 rmargin ! edready @ 0= abort" No file to re-edit." dark ?showfull drop ?change.bak find.line scrline @ curline 1+ min =: screenline showscreen begin vstaton on showcur key doachar until restorestate set_vectors ; : reedit ( --- ) check.shndl 0= if deferset deferreset then ; : ( t1 --- ) deferset dark begin close 0 1 at 28 ss >attrib1 ." Tom's Sequential Editor" >norm cr 0 3 at get ( --- f1 ) while sinit ['] statfunc is showstat edready on repeat deferreset ; : esed ( t1 --- ) \ entry point for sequential file editor. check.shndl 0= if 0 loadline ! 1 scrline ! then ; only forth definitions