Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / SEDITOR.SEQ < prev next >

Wrap

Text File | 1988-01-11 | 54.1 KB | 1,401 lines

\ SEDITOR.SEQ Sequential EDitor Written by 1987 Tom Zimmer ?dark .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 FF Forth system, and may be used as needed to develop programs on that system. SED is provided in source form in the FF system to allow you the ability to change SEDs characteristics. The Forth system FF is also in the public domain, and as such you may do with FF 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 lastline \ last valid line in file. variable lmrgn 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 0 constant curline \ current line number 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 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 0 max 80 min type ; : gremit create c, does> c@ qemit ; hex c0 gremit |. c4 gremit -- b3 gremit | d9 gremit .| bf gremit '| da gremit |' decimal : ss qspaces ; : || ( --- ) 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 key? while key drop repeat ; hex \ 02 = Shift key, 08 = Alt key, 40 = Caps lock. \ : ?capslock ( --- f1 ) 0 417 c@l 40 and 0<> ; : ?shiftkey ( --- f1 ) 0 417 c@l 02 and 0<> ; decimal : eeol ( --- ) \ clear the screen line. #out @ 78 > ?exit blnks #out @ 79 min 79 over - swap #line @ vtype ; : 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 ; : set.newfile ( --- ) \ setup memory for a new file creeol ." New File Created " creeol pad 64 blank ?cs: pad 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 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 ; : clearit initstuff 0 dos-line c! ; : read.openfile ( --- ) \ read a file that is already open. shndl @ endfile 64000. 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 64000. D> \ > than 64k bytes? if creeol ." WARNING ! File too BIG, reading first 64k." beep newfl on " ORG" ">$ change.ext creeol creeol ." Old file renamed to --> " shndl+ count type creeol 2 seconds then read.openfile ; : ?diskfull ( --- f1 ) 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 + 0 128 um/mod swap if 1+ then 0 D< dup if creeol ." WARNING !!" creeol ." There is NO ROOM TO SAVE on disk !!" beep 1 seconds beep 1 seconds then ; : read.file ( --- ) \ read file in shndl -1 tend ! newfl off shndl @ handle>ext 1+ " BAK" caps-comp 0= " Can't edit files with ext .BAK" ?terror 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 temp.buf 10 26 fill ?cs: temp.buf tend @ tb: negate 10 cmovel \ text to buffer beginning. 0.0 shndl @ movepointer torig tend @ negate 2+ dup >r \ +2 Control Z's 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 \ ['] qemit is emit \ change emit getfile \ no, get one from windw ['] (emit) is emit \ restore emit 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 ." Press ENTER to pick an existing file, change drives, or set the path." creeol ." Type a NEW Filename to create and edit, or Press ESC to leave." creeol ." ->" 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 ." SED is released into the Public Domain." 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 begin ?diskfull while creeol ." Insert another disk, and press " ." 'Enter' to continue," creeol ." or 'Esc' to abort" 0 begin drop key dup 27 = over 13 = or until 27 = if terminate.edit then dark repeat write.file ; : linebuf: ( --- seg a1 ) \ a useful primitive ?cs: linebuf ; : lineptr ( --- a1 ) \ addr of current line curline >lineptr ; : lineinfo ( --- a1 n1 ) \ info on current line curline #linedata ; : showcur ( --- ) \ display cursor at proper loc screenchar 1+ dup 78 > if 39 mod 39 + 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 0 linebuf count 0 swap 1- 0 max ?do i over + c@ bl <> if nip i 1+ swap leave then -1 +loop drop linebuf c! ; : 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 2+ 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 2- tl:@ toff @ over - >r swap tl:@ r@ - tb: r@ cmovel r@ negate toff +! lineptr dup tl:@ r> - swap 2- 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 toff ! ; \ conditional lastline and firstline tests : ?lastline ( --- f1 ) curline lastline @ >= ; : ?firstline ( --- f1 ) curline 1 < ; : >lf ( a1 --- a2 ) \ find the next linefeed in file tsegb @ sseg ! \ seg search segment dup ch/l 10 scan 0= if drop rsplit @ 1- else over - then xrmrgn @ over max xrmrgn ! + ?cs: sseg ! ; : build.linelist ( --- ) tend @ maxlines 1- 0 do incr> curline >lf 1+ dup lineptr tl:! dup 0= ?leave loop drop ; : 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 ; : sltype ( n1 --- ) \ n1 is data line dup lastline @ = \ If last file line over prtlines qmod 0= over or \ or first page line ( --- n1 f1 f2 ) \ f1 is lastline, \ f2 is firstpage, or lastline if if 30 else 31 then qemit else drop \ throw away f1, it wasn't needed | then >norm tsegb @ vtseg ! \ set VTYPE source segment dup curline 1- = if >lineptr tl:@ toff @ over - else #linedata then 2- clipline 0 max type ?cs: vtseg ! \ restore VTYPE source segment eeol >norm || ; : <statfunc> ( --- ) \ 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 ( eeol ) >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@ qemit 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> ; : statfunc ( --- ) 0 statusline at |' 4 -s >attrib1 imode @ if >attrib4 ." INSERT " else >attrib1 ." OVERTYPE" then >norm <statfunc> ; ' 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 curline prtlines qmod 0= ?lastline or if ?lastline if 30 else 31 then qemit else | then linebuf 1+ linelen clipline 0 max 78 min type eeol >norm || ; : scrshow ( --- ) \ display screen full of file. cursor-off first.textline curline screenline first.textline - - 0 max dup last.textline 1+ first.textline - + swap do i curline = >norm if sdisp else 0 over at i lastline @ <= if i sltype else | eeol || then >norm then 1+ loop drop >norm cursor-on ; : <sdln> ( --- ) putline curline+ getline ; : <suln> ( --- ) \ 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 2+ tl: \ list. maxlines curline - 1- 2* cmovel> lastline incr ; : ?appendline ( --- ) ?lastline if lineptr 2+ dup tl:@ swap 2+ 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 <sdln> incr> screenline clipdown ; : <shom> ( --- ) \ home to beginning of file putline begin ?firstline 0= while curline- repeat first.textline =: screenline 0 =: screenchar lmrgn off getline ; : shom ( --- ) <shom> scrshow ; : suln ( --- ) \ sequential line down ?firstline if exit then <suln> decr> screenline screenline >r screenline first.textline - curline min 0 max first.textline + dup =: screenline r> <> if scrshow then ; : ?cursor ( --- ) imode @ if med-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 ; : <ldel> ( --- ) \ delete the current line. ?appendline line>ldel.buf lineptr dup 2+ tl:@ tend ! maxlines >lineptr over - >r tl: dup 2+ tl: 2swap r> cmovel lastline decr getline changed on lchng on ?showfull drop ; : ldel ( --- ) <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 " .file eeol >norm shom put r> to.line r> =: screenline r> =: screenchar scrshow changed off updated on then ?cursor emptykbd fdbuf off ; : squt ( f1 --- f2 ) \ discard changes and exit dark 0 2 at .elapse loadline off lastldline off updated @ 0= if restore.name then ." Edit Aborted on " .file eeol drop -1 edready off ; : <sesc> ( 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 " .file put else updated @ 0= if restore.name then ." No changes to save in " .file then eeol drop -1 changed off ; : sesc ( f1 --- f2 ) \ save changes and exit ?shiftkey if squt else <sesc> then ; defer <nlnx> ' noop is <nlnx> \ conditionally add a line : ?addline ( -- ) ?lastline if screenchar ch/l =: screenchar <nlnx> =: screenchar then ; : rchr ( --- ) \ right a character screenchar 1+ ch/l 1- min dup =: screenchar rmargin @ >= if 0 =: screenchar ?addline sdln scrshow then screenchar 39 - 39 /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 linelen =: screenchar scrshow ; : send ( --- ) \ goto end of file putline begin ?lastline 0= while curline+ repeat last.textline =: screenline getline sendl ; : ?leftshow ( --- ) \ reshow screen of screen scrolled screenchar 39 /mod 0<> swap 38 = 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 @ 200 > 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 ; : <<space> ( --- 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 ; : <text ( --- ) \ move to previous text in line. 0 dup screenchar ?do linebuf 1+ i + c@ dup bl <> 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 <text screenchar 0= if scrshow exit then <<space> 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 <sdln> linebuf linebuf.len blank split.buf count linebuf 1+ lmrgn @ + swap cmove split.buf c@ lmrgn @ + dup linebuf c! =: linelen ins.linelist lchng on <suln> ; : <nln> ( --- ) \ 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 ; ' <nln> is <nlnx> : nln ( --- ) \ next line function \ inserts line if in insert mode. <nln> sdln lmrgn @ dup =: screenchar linelen max =: linelen ch/l linebuf c! scrshow ; : 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! ; : <fdel> ( --- ) 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 <<space> 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 <nln> 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 <fdel> repeat ; : delbl's ( --- ) \ delete blanks rmargin @ screenchar ?do chrptr c@ bl <> ?leave <fdel> 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 ; : 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 pad 1+ dup 66 blank 64 expect pad span @ over c! filtering off ; : look.till ( --- f1 ) 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 i to.line 0= \ change false bool to true leave \ and leave else drop then key? ?leave i 31 and 0= if cursor-off 19 statusline at I 1+ 4 >attrib1 .l >norm then loop ?cs: sseg ! getline emptykbd ?cursor ; : look.back ( --- f1 ) 0 =: screenchar putline 0 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 31 and 0= if cursor-off 19 statusline at I 1+ 4 >attrib1 .l >norm then -1 +loop ?cs: sseg ! getline emptykbd ?cursor ; : <slooker> ( --- ) ?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 <slooker> 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 ; : 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 : <srepa> ( --- ) looked @ 0= repset @ 0= or if beep exit then imode dup @ >r on slook.buf c@ 0 ?do <fdel> lchng on changed on putline getline loop rep.buf count bounds ?do i c@ schr loop looked off r> imode ! scrshow ; : srepa ( --- ) <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 <srepa> then begin slooa looked @ while <srepa> repeat ; : wr->fl ( --- ) first.textline inputline ! " Write to Filename->" input$ dup c@ escflg @ 0= and if restore.name shndl @ $>handle shndl @ pathset " Can't read path" ?terror screenchar >r newfl on changed on screenline >r curline >r 0 statusline at ." *** Saving to File *** " eeol shom put begin curline r@ <> while curline+ repeat r> drop r> =: screenline r> =: screenchar getline changed off updated on else drop then scrshow ; : <joinln> ( --- ) screenchar >r sdln 0 =: screenchar bdel r> =: screenchar ; : joinln ( --- ) imode dup @ >r on <joinln> r> imode ! ; : itgl ( --- ) \ insert mode toggle imode @ 0= imode ! ?cursor ; : fdel ( --- ) \ forward delete screenchar linelen >= if bl schr <joinln> delbl's else csaveon <fdel> csaveoff then lchng on changed on putline getline ?showfull drop sdisplay ; : wdel ( --- ) screenchar linelen >= if bl schr <joinln> \ unwrap line chrptr c@ bl = if delbl's then else chrptr c@ bl <> if csaveon del<>bl's \ delete non blank <fdel> \ 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 ; : 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 <slooker> looked @ while fdel stab lchr xrmrgn @ linelen max xrmrgn ! repeat shom r> caps ! xrmrgn @ 2+ mxlln min 80 max rmargin ! ; : 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 ! ; : tabset ( --- ) screenchar tabsize ! ; : 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 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 pmenux 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 tabxp 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 ( --- ) \ verify shndl is in the hndls array shndl @ hndls >= shndl @ hndls maxnest + b/hcb - < and 0= \ is shndl within the hndls array? \ and not stacked up to last handle. abort" We are out of handles!" ; : 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 0 lastline @ 0 over min ?do i #linedata nip + dup loadline @ u>= if i 1+ to.line leave then loop drop else loadline @ 1- 0 max maxlines min to.line byte|line on \ reset to byte offset then ; : deferset ( --- ) \ save current defered 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 defered words old function. @> normbgstuff is bgstuff @> normkey is key @> normfilter is keyfilter ; : <reedit> ( --- ) \ reenter edit of file time-reset check.shndl savestate 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 ; : reedit ( --- ) deferset <reedit> deferreset ; : <sed> ( 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 <reedit> repeat deferreset ; : esed ( t1 --- ) \ entry point for sequential file editor. 0 loadline ! 1 scrline ! <sed> ; only forth definitions