home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / seditor.seq < prev    next >
Text File  |  1991-04-10  |  77KB  |  1,964 lines
  1. \ SEDITOR.SEQ   Sequential EDitor          Written by 1987 Tom Zimmer
  2.  
  3. comment:
  4.  
  5. Hello -
  6.  
  7.         SED the Sequential EDitor was written by Tom Zimmer.
  8.  
  9.         SED is released into the Public Domain. It is included as an
  10.         imbedded portion of the F-PC Forth system, and may be used as
  11.         needed to develop programs on that system. SED is provided in
  12.         source form in the F-PC system to allow you the ability to change
  13.         SEDs characteristics. The Forth system F-PC is also in the public
  14.         domain, and as such you may do with F-PC and SED as you wish.
  15.  
  16.                                         Tom Zimmer
  17.  
  18. comment;
  19.  
  20. decimal         \ always use default to decimal
  21.  
  22. editor definitions
  23.  
  24. : statusline first.textline 1- ;
  25.  
  26.   ' first.textline alias helpline
  27.             250 constant ch/l
  28.                187 value helpkey        \ default value is F1 key
  29.  
  30.                  0 value torig          \ origin of text in text segment
  31.            2573 constant crlfval        \ value of line terminator CRLF.
  32.            8224 constant blbl           \ value of two blanks.
  33.             255 constant linebuf.len
  34.              12 constant formfeed
  35.  
  36. 55 value prtlines                       \ print lines per page
  37.  0 value keychar                        \ key just pressed
  38.  0 value changed                        \ edit changed flag
  39.  0 value ?eddone                        \ is the edit done?
  40.  0 value imode                          \ insert mode flag
  41.  0 value lmrgn
  42.  0 value lchng                          \ line changed flag
  43.  0 value marking                        \ marked lines shown in reverse?
  44.  0 value markdone
  45.  0 value markfst
  46.  0 value markstrt                       \ mark/get line #
  47.  0 value markend
  48.  0 value markchar                       \ mark/get character offset
  49.  0 value etabsize       8 =: etabsize   \ default to 8 char increment
  50.  0 value ermargin     132 =: ermargin   \ default to 132 char right margin
  51.  0 value updated                        \ have we updated to disk yet?
  52.  0 value ldel.cnt                       \ count of line deletes
  53.  0 value leavesave
  54.  0 value leavenow                       \ leave editor now, don't unnest
  55.  0 value ?leaveprompt    \ do we prompt if the last file is being closed?
  56.  0 value pop-extra
  57.  0 value %read-from
  58.  0 value ?exp_tabs
  59.  
  60. headerless
  61.  
  62. 0 value ?border
  63. 0 value lookflg         \ did we find anything last time?
  64. 0 value wrapped
  65. 0 value wraplen
  66. 0 value wraploc
  67. 0 value filtering       \ are we looking for ESC and Alt-F10?
  68.  
  69. create nfil  2 c, 13 c, 10 c,   \ A counted empty file string
  70.  
  71. headers
  72.  
  73. 0 value linelen
  74.  
  75. create slook.buf   32 allot     \ search buffer
  76.        slook.buf   32 blank 1 slook.buf c!
  77.  
  78. 248 value hyperdest     \ hypertext character, marks a link destination
  79. 249 value hyperchar     \ hypertext character, marks a source link
  80.  
  81. defer showstat
  82. defer sbutton   ' beep is sbutton       \ screen editor button handler
  83.  
  84. headerless
  85.  
  86. defer exit.edit         ' quit          is exit.edit  \ default to just quit
  87. defer normkey           ' bl            is normkey
  88. defer normfilter        ' noop          is normfilter
  89. defer normbgstuff       ' noop          is normbgstuff
  90. defer normbutton        ' noop          is normbutton
  91. defer ins-cursor        ' big-cursor    is ins-cursor
  92. defer reset_defered     \ set later to DEFERRESET
  93.  
  94. 0 value vstaton
  95. 0 value statcnt
  96.  
  97. headers
  98.  
  99. \ : ?capslock     ( --- f1 ) 0 $417 c@l $40 and 0<> ;
  100. : ?altkey       ( --- f1 ) 0 $417 c@l $08 and 0<> ;
  101. : ?ctrlkey      ( --- f1 ) 0 $417 c@l $04 and 0<> ;
  102. : ?shiftkey     ( --- f1 ) 0 $417 c@l $03 and 0<> ;     \ 05/25/90 tjz
  103.  
  104. create  linebuf ( linebuf.len ) 300 allot
  105.         linebuf ( linebuf.len ) 300 blank
  106.  
  107. headerless
  108.  
  109. create split.buf linebuf.len allot split.buf linebuf.len blank
  110. create  wrap.buf linebuf.len allot  wrap.buf linebuf.len blank
  111. create fdbuf     66          allot fdbuf     66          erase
  112.  
  113. 0 value csaveflg        \ are we saving characters
  114.  
  115. 0 value ldel.buf
  116.  
  117. create --'s.buf 132 allot
  118.  
  119. : -s    ( n1 --- )
  120.         --'s.buf 132 ?browse if $cd else $c4 then fill
  121.         --'s.buf swap type ;
  122.  
  123. : gremit create c, does> 1 type ;
  124.  
  125. $c0 gremit |.   $c4 gremit --   $b3 gremit |    $d9 gremit .|
  126. $bf gremit '|   $da gremit |'
  127.  
  128. $c8 gremit ||.  $cd gremit ==   $ba gremit ||   $bc gremit .||
  129. $bb gremit '||  $c9 gremit ||'
  130.  
  131. : .g|           ( --- )         \ display a virtical bar character
  132.                 ?browse
  133.                 if      ||
  134.                 else    |
  135.                 then    ;
  136.  
  137. : .g'|          ( --- )
  138.                 ?browse
  139.                 if      '||
  140.                 else    '|
  141.                 then    ;
  142.  
  143. : .g|.          ( --- )
  144.                 ?browse
  145.                 if      ||.
  146.                 else    |.
  147.                 then    ;
  148.  
  149. : .g.|          ( --- )
  150.                 ?browse
  151.                 if      .||
  152.                 else    .|
  153.                 then    ;
  154.  
  155. : .g|'          ( --- )
  156.                 ?browse
  157.                 if      ||'
  158.                 else    |'
  159.                 then    ;
  160.  
  161. : .l            ( n1 n2 --- )   \ Print left justified in fld
  162.                 >r (u.) dup>r type r> r> swap - spaces ;
  163.  
  164. headers
  165.  
  166. : emptykbd  ( --- )     \ empty any keyboard typeahead
  167.             ?DOSIO
  168.             if    begin       key?
  169.                   while       (key) drop
  170.                   repeat
  171.             else  begin       0 $41A @L
  172.                               0 $41C @L - abs 2 >     \ keyboard depth > 1 key
  173.                   while       bioskey drop
  174.                   repeat
  175.             then  ;
  176.  
  177.                 \ $02 = Shift key, $08 = Alt key, $40 = Caps lock.
  178.  
  179. : modified      ( --- )         \ mark line and text as having been modified.
  180.                 on> lchng on> changed ;
  181.  
  182. create  end-spcs 80 allot
  183.         end-spcs 80 177 fill    \ 177 is a nice gray character.
  184.  
  185. : edeeol        ( --- )         \ clear the screen line.
  186.                 window.right @> #out - spaces ;
  187.  
  188. : end-eeol      ( --- )         \ clear the screen line to gray
  189.                 ?DOSIO
  190.                 if      @> #out @> #line at
  191.                 then    window.right @> #out -
  192.                 0max    dup 80 <
  193.                 if      end-spcs swap type
  194.                 else    80 /mod 0
  195.                         ?do     end-spcs   80 type
  196.                         loop    end-spcs swap type
  197.                 then    ;
  198.  
  199. : creeol        ( --- )         \ erase next line.
  200.                 cr edeeol first.textcol @> #line at ;
  201.  
  202. : erase.bottom  ( --- )
  203.                 first.textcol @> #line rows 1- over - 1 max 0
  204.                 do creeol loop at ;
  205.  
  206. headerless
  207.  
  208. : terminate.edit        ( --- )
  209.                 creeol creeol ." Leaving now...." creeol
  210.                 erase.bottom exit.edit ;
  211.  
  212. : ?<>bak        ( --- )                 \ verify current file is not a .BAK
  213.                 ed1hndl handle>ext 1+ " BAK" caps-comp 0=
  214.                 if      off> renaming
  215.                 then
  216.                 ed1hndl handle>ext 1+ " $$$" caps-comp 0=
  217.                 if      off> renaming
  218.                 then    ;
  219.  
  220. : set.newfile   ( --- )         \ setup memory for a new file
  221.                 creeol ."    New File Created "  creeol
  222.                 0.2 currentsize 2!
  223.                 off> curline                    \ clear current line
  224.                 off> lastline                   \ and total lines
  225.                 tsegb lineptr tl:!              \ first segment setup
  226.                 ?cs: nfil tsegb 0 3 cmovel      \ move in a counted CRLF $
  227.                 incr> lastline                  \ inrement total lines
  228.                 5 tenths ;
  229.  
  230. : ?softerror    ( bool a1 n1 --- )      \ bool = false if OK, else type msg
  231.                 rot
  232.                 if      >r 36 r@ 2/ - 6 over r@ + 2 + 9 box&fill
  233.                         space r> \type
  234.                         bcr ."   \1 Press - \2 ESC "
  235.                         cursor-off
  236.                         begin   beep
  237.                                 key 27 ( ESC ) =
  238.                         until
  239.                         cursor-on
  240.                 else    2drop
  241.                 then    ;
  242.  
  243. headers
  244.  
  245. : placeline     ( a1 --- )
  246.                 >r                      \ save line address
  247.                 ?cs: r@                 \ moving from line seg & address
  248.                 lineptr tl:@ 0          \ to text line seg and offset = 0
  249.                 r@ c@ len-accum         \ sum in length to total file size
  250.                 1+ cmovel               \ move the data
  251.                 r> c@ 1+ paragraph      \ calculate segments to next line
  252.                 lineptr tl:@ +          \ add to current lines segment
  253.                 incr> curline           \ bump to next line
  254.                 lineptr tl:!            \ save seg in line pointer table.
  255.                 incr> lastline ;        \ add a line to total lines
  256.  
  257. : ?0fix         ( a1 -- a1 )            \ fix files of zero length
  258.                 dup c@ 0=               \ if line is of length zero
  259.                 if      2573 over 1+ !  \ fill in a CRLF
  260.                         2 over c!       \ and set line length to 2
  261.                 then    ;
  262.  
  263. : read.openfile ( --- )                 \ read a file that is already open.
  264.                 ?<>bak
  265.                 ibfull =: iblen          \ set maximum length read buffer
  266.                 0.0 ed1hndl movepointer
  267.                 0.0 filepointer 2!
  268.                 ibreset
  269.                 0 save!> loadline
  270.                 ed1hndl save!> seqhandle
  271.                 read-from dup 1- 0max =: %read-from
  272.                 1 max 1       \ skip lines till read from line
  273.                 ?do     lineread drop
  274.                 loop    off> read-from  \ reset read from counter
  275.                 off> curline
  276.                 off> lastline
  277.                 0.0 currentsize 2!
  278.                 off> rmmax
  279.                 tsegb lineptr tl:!      \ first segment setup
  280.                 tsegb #edsegs + $100 - =: tend
  281.                 lineread ?0fix placeline
  282.                 begin   lineread rmsave endtst? and
  283.                 while   placeline
  284.                 repeat  drop
  285.                 restore> seqhandle
  286.                 restore> loadline ;
  287.  
  288. headerless
  289.  
  290. : .partial      ( --- )
  291.                 savecursor
  292.                 savescr
  293.                 cursor-off
  294.                 14 6 63 14 box&fill
  295.                 bcr ."     This file is \r TOO BIG \0 to fit in memory."
  296.                 bcr
  297.                 bcr ."    A partial read was performed. Press a \r KEY "
  298.                 bcr
  299.                 bcr ." \s10\1  Starting in BROWSE mode!!  \b"
  300.                 emptykbd key? if key drop then key drop
  301.                 on> ?browse
  302.                 restscr
  303.                 restcursor ;
  304.  
  305. headers
  306.  
  307. : read.oldfile ( --- )         \ get existing file
  308.                 off> newfl
  309.                 read.openfile           \ read it
  310.                 outbuf c@ 0<>           \ did we get it all
  311.                 if      .partial        \ if not then warn user a
  312.                 then    ;               \ partial read was performed
  313.  
  314. headerless
  315.  
  316. : warn-prompt   ( --- )
  317.                 ." \4 NO ROOM TO SAVE \0 changes made to this file !!\b\:03"
  318.                 bcr bcr
  319.                 ." \t  You might try using Alt-W to write to another drive."
  320.                 bcr
  321.                 bcr ." \s16PRESS A KEY to acknowledge \b"
  322.                 emptykbd key? if key drop then key drop ;
  323.  
  324. : ?diskfull     ( --- f1 )
  325.                 renaming 0= ?browse or
  326.                 if      false exit
  327.                 then
  328.                 ed1hndl >nam 1+ c@ ':' =
  329.                 if  ed1hndl >nam c@ bl or 96 - else 0 then
  330.                 getdiskfree * 0 128 um/mod nip UM*      \ 05/25/90 tjz
  331.                 65000.  128 um/mod nip 0 d< dup
  332.                 if      savescr cursor-off
  333.                         8 4 72 16 box&fill
  334.                         bcr ." \s24\2 WARNING !! "
  335.                         bcr
  336.                         bcr
  337.                         ."   You have LESS than 65000 bytes free on disk\b\:03"
  338.                         bcr
  339.                         bcr ."   There may be " warn-prompt
  340.                         off> renaming
  341.                         off> backingup
  342.                         restscr cursor-on
  343.                 then    ;
  344.  
  345. : ?enoughdisk   ( --- f1 )      \ true if there is enough disk space to save
  346.                 ed1hndl >nam 1+ c@ ':' =
  347.                 if  ed1hndl >nam c@ bl or 96 - else 0 then
  348.                 getdiskfree * 0
  349.                 renaming 0=
  350.                 if      currentsize 2@ d+
  351.                 then    128 um/mod nip UM*      \ 05/25/90 tjz
  352.                 #edsegs tend toff - - 5 / 4 * 8 / 0 d< dup
  353.                                         \ * .8 / 8 to 128 bytes units
  354.                 if      savescr cursor-off
  355.                         8 4 72 14 box&fill
  356.                         bcr ." \s24\4 WARNING !! \b\:03"
  357.                         bcr
  358.                         bcr ."   There is " warn-prompt
  359.                         restscr cursor-on
  360.                 then    0= ;
  361.  
  362. headers
  363.  
  364.                                 \ n1 = edit file line number
  365.                                 \ f1 = true if error
  366. : linewrite     ( n1 --- f1 )   \ write a text line and return flag
  367.                 >lineptr tl:@ dup>r 1   \ source segment & offset
  368.                 wseg wblen              \ dest   segment & offset
  369.                 r> 0 c@l dup>r cmovel   \ length and move it
  370.                 r> +!> wblen            \ bump length
  371.                 wblen writelim >
  372.                 if      0 wblen ed2hndl wseg exhwrite wblen = dup
  373.                         if      off> wblen
  374.                         then    0=
  375.                 else    false
  376.                 then    ;
  377.  
  378. : flushwrite    ( --- f1 )      \ write the remainder of the write buffer
  379.                 wblen 0<>
  380.                 if      0 wblen ed2hndl wseg exhwrite wblen = dup
  381.                         if      off> wblen
  382.                         then    0=
  383.                 else    false
  384.                 then    ;
  385.  
  386. : write.file    ( --- )         \ write file in ed2hndl
  387.                                 \ WRITE.FILE assumes we are on FIRST line.
  388.                 ?browse ?exit   \ leave if we are in browse mode
  389.                 ed1hndl ed2hndl b/hcb cmove     \ move name to work handle
  390.                 renaming
  391.                 if      " $$$" ">$ ed2hndl $>ext        \ write to .$$$
  392.                 then
  393.                 ed2hndl hcreate                 \ create the new file
  394.                 dup " \4 Error Making File " ?softerror ?exit  \ *** EXIT ***
  395.                 0.0 ed2hndl movepointer
  396.                 off> wblen                      \ reset write buffer
  397.                 lastline 1+ 1 max maxlines min 0
  398.                 ?do     i linewrite ?leave
  399.                 loop
  400.                 flushwrite      ( --- f1 )
  401.                 " \4 Error while writing, probably out of space " ?softerror
  402.                 ed2hndl hclose " \4 Error Closing File " ?softerror ;
  403.  
  404. headerless
  405.  
  406. 0 value escflg
  407.  
  408. : skeyfilter    ( n1 --- n2 )
  409.                 normfilter
  410.                 filtering 0= ?exit
  411. ( escape key )  dup  27 = if drop 13 on> escflg then
  412. ( Alt-F10 key)  dup 241 = if drop 13 on> escflg then
  413. (     F10 key)  dup 196 = if drop 13 on> escflg then ;
  414.  
  415. headers
  416.  
  417. : put           ( --- )         \ save a file
  418.                 write.file ;
  419.  
  420. : linebuf:      ( --- seg a1 )  \ a useful primitive
  421.                 ?cs: linebuf ;
  422.  
  423. : lineseginfo   ( --- seg a1 n1 )   \ segment of current line & length
  424.                 curline #lineseg 1 over 0 c@l ;
  425.  
  426. : showcur       ( --- )         \ display cursor at proper loc
  427.                 screenchar winoff - first.textcol +
  428.                 window.left max window.right min screenline at ;
  429.  
  430. : #lineseginfo  ( n1 --- seg a1 n2 )
  431.                 #lineseg 1 over 0 c@l ;
  432.  
  433. : stripbl's     ( --- )         \ strip off trailing blanks
  434.                 linebuf count -trailing linebuf c! drop ;
  435.  
  436. headerless
  437.  
  438. : discard.BAK   ( --- )
  439.                 renaming 0= ?exit
  440.                 ed1hndl ed2hndl $>handle
  441.                 " BAK" ">$ ed2hndl $>ext
  442.                 ed2hndl hdelete drop ;
  443.  
  444. : discard.$$$   ( --- )
  445.                 renaming 0= ?exit
  446.                 ed1hndl ed2hndl $>handle
  447.                 " $$$" ">$ ed2hndl $>ext
  448.                 ed2hndl hdelete drop ;
  449.  
  450. : norm>bak      ( --- err )     \ rename the normal filename to be .BAK
  451.                                 \ return err = error code if it failed
  452.                                 \ return err = 0 if no error
  453.                 read-write                      \ try to open it read/write
  454.                 ed1hndl hopen dup 0=            \ does original file exist?
  455.                 if      drop
  456.                         ed1hndl hclose drop     \ close it for now
  457.                         " BAK" ">$ ed2hndl $>ext \ change ED2HNDL to .BAK
  458.                         ed2hndl hdelete drop    \ delete old backup if there
  459.                         ed1hndl ed2hndl hrename \ rename original to .BAK
  460.                 then    ;                       \ exist, we don't care
  461.  
  462. : ?ferr         ( err -- err )
  463.                 dup dup
  464.                 case
  465.                         2 of    "  File does not exist "        endof
  466.                         3 of    "  No Path found "              endof
  467.                         5 of    "  File is READ ONLY "          endof
  468.                                 "  Unknown file error "
  469.                         drop
  470.                 endcase ?softerror ;
  471.  
  472. : recover.$$$   ( --- err )             \ return false if all is OK!
  473.                                         \ else return code for error
  474.                 renaming dup 0= ?exit drop
  475.                 ed1hndl ed2hndl $>handle
  476.                 " $$$" ">$ ed2hndl $>ext
  477.                 ed2hndl hopen dup 0= swap ?exit drop
  478.                                                 \ leave if .$$$ doesn't exist?
  479.                 ed2hndl hclose drop             \ close it for now
  480.                 norm>bak dup 0=                 \ no error,
  481.                 over 2 = or                     \ or file doen't exist
  482.                 if      drop                    \ then rename $$$ to norm
  483.                         " $$$" ">$ ed2hndl $>ext \ change ED2HNDL to .$$$
  484.                         ed2hndl ed1hndl hrename \ rename .$$$ to original
  485.                 then    ;
  486.  
  487. headers
  488.  
  489.  
  490. editor also
  491.  
  492. : ?expand_tabs  ( -- )                  \ conditionally expand tabs
  493.                 ?exp_tabs 0= ?exit      \ only if expand tabs flag is on
  494.                 linebuf 1+ linelen
  495.                 begin   9 scan dup
  496.                 while   over bl swap c!         \ change to a blank
  497.                         1 /string 2dup          \ step past tab
  498.                         linelen over -          \ calculate text position
  499.                         tabsize @ mod tabsize @ swap -
  500.                         tabsize @ mod >r        \ distance to move
  501.                         over r@ + swap cmove>   \ expand the text
  502.                         over r@ blank           \ fill expanded area with bl's
  503.                         swap r@ + swap          \ adjust remaining text
  504.                         r> +!> linelen          \ adjust line length
  505.                 repeat  2drop ;
  506.  
  507. : getline       ( --- )         \ get current line to linebuf.
  508.                 linebuf linebuf.len blank
  509.                 lineseginfo >r
  510.                 linebuf: 1+ r@ ch/l 2+ min cmovel  ( --- )
  511.                 r@ 2- =: linelen
  512.                 r> linebuf + 1- dup @ crlfval =
  513.                 if      blbl swap !
  514.                 else    drop  2 +!> linelen
  515.                 then    ?expand_tabs
  516.                 ch/l linebuf c! off> lchng ;
  517.  
  518. : putline       ( --- )
  519.                 lchng 0= ?exit          \ only save if changed
  520.                 stripbl's               \ restore linebuf to file
  521.                 crlfval linebuf count + !
  522.                 2 linebuf c+!
  523.                 lineptr tl:@ 0 c@l      \ Get OLD line length
  524.                 linebuf c@ - negate     \ NEW length from OLD = Difference
  525.                 s>d currentsize D+!     \ adjust file size for NEW line
  526.                 linebuf:                \ source in line buffer
  527.                 lineptr dup tl+ tl:@    \ next line segment
  528.                 linebuf c@ 1+ paragraph - \ minus segment for current line
  529.                 dup rot tl:!            \ seg current line segment
  530.                 dup =: tend             \ set TEND
  531.                 0 linebuf c@ 1+ cmovel ; \ move the data into text segment
  532.  
  533. : toline-       ( n1 --- )
  534.                 0MAX
  535.                 curline over <= if drop exit then
  536.                 dup>r #lineseg                  \ source line segment
  537.                 toff over - >r                  \ amount moved is saved
  538.                 tend r@ -                       \ destination line segment
  539.                 2dup - negate r@ swap >r        \ save distance moved
  540.                 cmove-pars>                     \ move the segments
  541.                 r> curline r> r@ swap >r
  542.                 adj_ptr_lines                   \ adjust the line ptr tbl
  543.                 r> negate dup +!> toff +!> tend
  544.                 r> =: curline ;
  545.  
  546. : toline+       ( n1 --- )
  547.                 lastline min
  548.                 curline over >= if drop exit then
  549.                 >r
  550.                 curline  #lineseg               \ start segment
  551.                 r@ #lineseg over - >r           \ amount moved is saved
  552.                 toff                            \ destination segment
  553.                 2dup - negate r@ swap >r        \ save distance moved
  554.                 cmove-pars                      \ move the segments
  555.                 r> r> r@ swap >r curline
  556.                 adj_ptr_lines                   \ adjust the line ptr tbl
  557.                 r> dup +!> toff +!> tend
  558.                 r> =: curline ;
  559.  
  560. : curline+      ( --- )         \ move down one line in text
  561.                 curline lastline = ?exit
  562.                 lineseginfo 1+ >r 1- toff 0 r@ cmovel
  563.                 toff lineptr tl:! r> paragraph +!> toff
  564.                 incr> curline lineptr tl:@ =: tend ;
  565.  
  566. : curline-      ( --- )         \ move up one line in text
  567.                 curline 0= ?exit
  568.                 curline 1- >lineptr tl:@ dup 0 c@l 1+ >r 0
  569.                 lineptr tl:@ r@ paragraph - 0 r@ cmovel
  570.                 r@ paragraph negate +!> toff
  571.                 lineptr dup tl:@ r> paragraph - swap tl- tl:!
  572.                 decr> curline lineptr tl:@ =: tend ;
  573.  
  574.                 \ conditional lastline and firstline tests
  575.  
  576. : ?lastline     ( --- f1 ) curline lastline >= ;
  577.  
  578. : ?firstline    ( --- f1 ) curline 1 < ;
  579.  
  580. headerless
  581.  
  582. : sinit         ( --- ) \ initialize file, and linelist table
  583.                 off> changed
  584.                 on> imode
  585.                 on> markstrt
  586.                 on> markend
  587.         \ setup tend to point to lst possible segment in 64k block
  588.                 tsegb #edsegs + =: tend
  589.                 lastline 1- >lineptr tl:@ dup 0 c@l paragraph + =: toff
  590.         \ set line beyond last actual line to just beyond end of buffer
  591.                 tsegb #edsegs + lastline >lineptr tl:!
  592.                 lastline =: curline
  593.                 0 toline-               \ go back to first line
  594.                 decr> lastline
  595.                 off> updated off> lookflg
  596.                 off> curline off> lmrgn
  597.                 first.textline =: screenline
  598.                 off> curline getline ;
  599.  
  600. : pagechar      ( --- )
  601.                 last.textcol ( 1- ) !> #out  ?DOSIO
  602.                 if      @> #out @> #line at
  603.                 then    ." \r" ;
  604.  
  605. code ?page-char ( n1 --- )
  606.                 pop ax
  607.                 sub dx, dx
  608.                 mov bx, ' prtlines >body        \ 08/06/90 TJZ allow PRTLINES
  609.                                                 \ to be changed to a VALUE
  610.                 div bx
  611.                 cmp dx, # 0
  612.              0= if      mov ax, # ' pagechar
  613.                         jmp ax
  614.                 then
  615.                 next    end-code
  616.  
  617. headers
  618.  
  619. defer sltypel   ' typeL is sltypel
  620.  
  621. : exsltypel     ( seg off len -- )      \ type and expand tabs
  622.                 rot save!> sseg
  623.                 begin   2dup 9 scan dup                 \ look for tab
  624.                 while   2dup 2>r                        \ save remainder
  625.                         nip -
  626.                         @> sseg -rot
  627.                         #out @ + last.textcol 1+ min #out @ -
  628.                                                         \ clip to scrn width
  629.                         typel                           \ output preceeding
  630.                         #OUT @ first.textcol - 0max
  631.                         TABSIZE @ MOD TABSIZE @ SWAP -
  632.                         #out @ + last.textcol 1+ min #out @ -
  633.                         SPACES
  634.                         2r> 1 /string                   \ recover remainder
  635.                                                         \ & remove the TAB
  636.                 repeat  2drop
  637.                 @> sseg -rot
  638.                 #out @ + last.textcol 1+ min #out @ -
  639.                 typel                                   \ type line remainder
  640.                 restore> sseg ;
  641.  
  642. : sltype        ( n1 --- ) \ n1 is data line
  643.                 ?DOSIO
  644.                 if      @> #out @> #line at
  645.                         (key?) if drop exit then
  646.                 then    >norm
  647.                 marking
  648.                 if      dup markstrt markend between
  649.                         if >rev then
  650.                 then
  651.                 on> nosetcur
  652.                 #lineseginfo 2- clipline sltypeL edeeol
  653.                 off> nosetcur ;
  654.  
  655. headerless
  656.  
  657. 0 value lincol          \ column of linenumber in status line
  658.  
  659. : doborder      ( --- )
  660.                 window.right cols <
  661.                 if      window.right  statusline       at .g'|
  662.                         window.left   last.textline 1+ at .g|.
  663.                 else    first.textcol last.textline 1+ at
  664.                 then
  665.                 ed1hndl count dup 8 +
  666.                 text.width 2- swap - 2 /
  667.                 1- >norm -s
  668.                 >attrib1 ."  File = " type space >norm
  669.                 window.right cols 1- min #out @ - 0MAX -s
  670.                 ?DOSIO 0=                       \ no lower right corner with
  671.                 window.right cols < and         \ DOS I/O
  672.                 if .g.| then
  673.                 window.left 2+ last.textline 1+ at
  674.                 ." \4 HELP=F1 "
  675.                 window.right 11 - last.textline 1+ at
  676.                 ." \4 MENU=ESC "
  677.                 window.right cols <
  678.                 if      last.textline 1+ first.textline
  679.                         ?do     ( last.textcol )
  680.                                 window.right i at .g|
  681.                                 window.left  i at .g|
  682.                         loop
  683.                         mouseflg
  684.                         if      >attrib4
  685.                                 window.right first.textline at          ." "
  686.                                 window.left first.textline  at          ." "
  687.                                 window.right 13 - last.textline 1+ at   ." "
  688.                                 window.right last.textline 4 - at       ." U"
  689.                                 window.right last.textline 3 - at       ." P"
  690.                                 window.right last.textline 1 - at       ." D"
  691.                                 window.right last.textline     at       ." N"
  692.                                 >norm
  693.                         then
  694.                 then    off> ?border ;
  695.  
  696. \ *************************************************************************
  697. \ Improvements to the status line of the editor           By John A. Peters
  698. \ *************************************************************************
  699.  
  700.   : <statfunc>  ( --- )         \ show file status to user
  701.                 >attrib1
  702.                 ."  Line="       @> #out =: lincol
  703.                                  curline %read-from +  1+ 1 .r
  704.                 ." /"            lastline %read-from + 1+ 3 .l
  705.                 30 sp>col
  706.                 ." Column="      screenchar            1+ 1 .r
  707.                 ." /"            rmargin @                3 .l
  708.                 45 sp>col
  709.                 ." Page="       curline prtlines /    1+ 1 .r
  710.                 ." /"            lastline prtlines /   1+ 3 .l
  711.                 59 sp>col
  712.                 ." Chars=" currentsize 2@        1   d.r
  713.                 window.right 7 - sp>col
  714.                 >norm window.right @> #out - 0MAX -s
  715.                 ?border
  716.                 if      doborder
  717.                 then    ;
  718.  
  719. \ *************************************************************************
  720. \ *************************************************************************
  721.  
  722. : fullfunc      ( --- ) \ status for when file is full > 64k
  723.                 window.left dup 0MAX statusline at >norm 0>=
  724.                 if      .g|'
  725.                 then    2 -s ." \5MEM FULL" <statfunc> ;
  726.  
  727. : statfunc      ( --- )
  728.                 window.left dup 0MAX statusline at >norm 0>=
  729.                 if      .g|'
  730.                 then    2 -s
  731.                 marking markdone 0= and
  732.                 if
  733. ." \2 MARKING TEXT \r  Use up and down arrow to select lines of text.  \2 F3=Done "
  734.                         2 -s
  735.                 else    ?browse
  736.                         if              ." \4 BROWSE "
  737.                         else    imode
  738.                                 if      ." \4 INSERT "
  739.                                 else    ." \1OVERTYPE"
  740.                                 then
  741.                         then    <statfunc>
  742.                         mouseflg
  743.                         if      71 statusline at ." \4\0─"
  744.                         else    73 statusline at
  745.                         then    >attrib4
  746.                         browselevel 0>
  747.                         if      ."  +"
  748.                                 browselevel 3 .l
  749.                         else    ."  F10 "
  750.                         then
  751.                 then    >norm ;
  752.  
  753. ' statfunc is showstat
  754.  
  755. headers
  756.  
  757. : ?full         ( --- f1 )      \ is memory full?
  758.                 tend toff - $100 < ;     \ need more than $100 = 1600 decimal
  759.  
  760. : ?showfull     ( --- f1 )      \ set status func for memory
  761.                 ?full dup       \ condition
  762.                 if      ['] fullfunc is showstat
  763.                 else    ['] statfunc is showstat
  764.                 then    ;
  765.  
  766. : ?maxlines     ( --- f1 )
  767.                 lastline 4 + maxlines u> ;
  768.  
  769. : ?left/right   ( --- )
  770.                 screenchar text.width 1- -      \ winoff must be at least
  771.                 winoff max                      \ but not less than now
  772.                 =: winoff                       \ new value
  773.                 screenchar winoff <             \ left edge check
  774.                 if      screenchar =: winoff
  775.                 then    ;
  776.  
  777. : sdisp         ( --- )
  778.                 first.textcol screenline at on> nosetcur
  779.                 marking
  780.                 if      curline markstrt markend between
  781.                         if >rev then
  782.                 then
  783.                 ?CS: linebuf 1+ linelen clipline typeL edeeol
  784.                 curline ?page-char off> nosetcur >norm ;
  785.  
  786. : scrshow       ( --- )         \ display screen full of file.
  787.                 cursor-off
  788.                 ?left/right
  789.                 first.textline curline screenline
  790.                 first.textline - -
  791.                 0MAX dup last.textline 1+ first.textline - + swap
  792.                 do      i curline =     >norm
  793.                         if      sdisp
  794.                         else    dup !> #line first.textcol =: #out
  795.                                 i lastline <=
  796.                                 if      i sltype
  797.                                 else    end-eeol
  798.                                 then    i ?page-char
  799.                         then    1+
  800.                 loop    drop >norm cursor-on ;
  801.  
  802. : <sdln>        ( --- ) putline curline+ getline ;
  803.  
  804. : <suln>        ( --- ) putline curline- getline ;
  805.  
  806. : sdisplay      ( --- )         \ display current screen line.
  807.                 cursor-off sdisp cursor-on ;
  808.  
  809. headerless
  810.  
  811. : ins.linelist  ( --- )                 \ add new entry to line pointer list.
  812.                 lineptr tl: dup tl+ tl:
  813.                 maxlines curline - 2- 2* cmovel>
  814.                 incr> lastline
  815.                 lineptr dup tl+ tl:@    \ next line segment
  816.                 1-                      \ minus segment for current line
  817.                 dup rot tl:!            \ seg current line segment
  818.                 =: tend                 \ set TEND
  819.                 lineptr tl:@
  820.                 2 over 0 c!l            \ set length to 0
  821.                 crlfval swap 1 !l       \ put in CRLF
  822.                 0.2 currentsize D+!     \ Adjust file size
  823.                 ;
  824.  
  825. : ?appendline   ( --- )
  826.                 ?lastline
  827.                 if      lineptr tl:@ dup>r 0    \ from  seg offset
  828.                         r@ 1- 0                 \ to    seg offset
  829.                         tsegb #edsegs + r> -    \ length in segments
  830.                         16 *                    \ convert to bytes
  831.                         cmovel                  \ move the data
  832.                         lineptr tl:@ 1-         \ correct line pointer value
  833.                         lineptr tl:!            \ save into line table
  834.                         tsegb #edsegs + 1-
  835.                         lineptr tl+ tl:!        \ new last = 1 before end
  836.                         lineptr tl+ tl:@        \ segment of NEW last line
  837.                            2 over 0 c!l         \ set count 2
  838.                         crlfval swap 1 !l       \ put in CRLF
  839.                         tsegb #edsegs +         \ get the last segment
  840.                         lineptr tl+ tl+ tl:!    \ save in lastline + 1
  841.                         incr> lastline          \ one more line
  842.                         0.2 currentsize D+!     \ adjust length
  843.                 then    ;
  844.  
  845. headers
  846.  
  847. : clipdown      ( --- )
  848.                 screenline >r
  849.                 last.textline lastline curline - 0MAX -
  850.                 screenline max last.textline min
  851.                 curline first.textline + min
  852.                 dup =: screenline r> <>
  853.                 if      scrshow then    ;
  854.  
  855. defer ?mark-plus        ' noop is ?mark-plus
  856.  
  857. : sdln          ( --- )         \ sequential line down
  858.                 ?lastline ?exit
  859.                 <sdln> incr> screenline
  860.                 ?mark-plus clipdown ;
  861.  
  862. : <shom>        ( --- )         \ home to beginning of file
  863.                 putline 0 toline-
  864.                 first.textline =: screenline
  865.                 getline ;
  866.  
  867. : shom          ( --- )
  868.                 <shom>
  869.                 off> screenchar
  870.                 off> lmrgn
  871.                 scrshow ;
  872.  
  873. : suln         ( --- )         \ sequential line up
  874.                 ?firstline if exit then
  875.                 <suln> decr> screenline
  876.                 ?mark-plus screenline >r
  877.                 screenline first.textline - curline min
  878.                 0MAX first.textline + dup =: screenline r> <>
  879.                 if      scrshow
  880.                 then    ;
  881.  
  882. headerless
  883.  
  884. : ?cursor       ( --- )
  885.                 imode if ins-cursor else norm-cursor then ;
  886.  
  887. : line>ldel.buf ( --- )
  888.                 dseg
  889.                 if      dseg ldel.buf 2dup mxlln +
  890.                         ldel.cnt maxdline 1- min mxlln * cmovel>
  891.                         ldel.cnt 1+ maxdline 1- min =: ldel.cnt
  892.                         linelen linebuf c! ?cs: linebuf dseg ldel.buf
  893.                         linelen 1+ mxlln min cmovel
  894.                 then    ;
  895.  
  896. : ldel>linebuf  ( --- )
  897.                 dseg
  898.                 if      dseg ldel.buf 2dup c@l
  899.                         ?cs: linebuf rot 1+ cmovel
  900.                         linebuf c@ =: linelen
  901.                         dseg ldel.buf 2dup mxlln + 2swap
  902.                         ldel.cnt maxdline min dup 1- =: ldel.cnt
  903.                         mxlln * cmovel
  904.                 then    ;
  905.  
  906. headers
  907.  
  908. : #deletelines  ( n1 --- )
  909.                 0MAX ?dup 0= ?exit
  910.                 >r curline r@ lastline min bounds
  911.                 ?do     i >lineptr tl:@ 0 c@l negate -1 currentsize D+!
  912.                 loop
  913.                 r@ tl* tl:@ =: tend
  914.                 lineptr tl: dup r@ tl* + tl: 2swap
  915.                 maxlines >lineptr lineptr r@ tl* + - cmovel
  916.                 r> negate +!> lastline
  917.                 getline modified ;
  918.  
  919. : linedelete    ( --- )
  920.                 ?lastline       \ if we are on the last line, then
  921.                                  \ just clear the line don't delete it.
  922.                 if      lineptr tl:@ 0 c@l negate s>d currentsize D+!
  923.                         2 s>d currentsize D+!
  924.                         tsegb #edsegs + 1- dup lineptr tl:! =: tend
  925.                            2 curline #lineseg 0 c!l   \ install count of 2
  926.                         crlfval curline #lineseg 1 !l \ containing only CRLF
  927.                 else    lineptr tl:@ 0 c@l negate s>d currentsize D+!
  928.                         lineptr dup tl+ tl:@ =: tend
  929.                         maxlines >lineptr over - >r
  930.                         tl: dup tl+ tl: 2swap r> cmovel
  931.                         decr> lastline
  932.                 then    getline modified ;
  933.  
  934. : <ldel>        ( --- )         \ delete the current line.
  935.                 line>ldel.buf linedelete ?showfull drop ;
  936.  
  937. : ldel          ( --- )
  938.                 ?browse ?exit
  939.                 <ldel> scrshow ;
  940.  
  941. : to.line       ( n1 --- )
  942.                 toline+ getline ;
  943.  
  944. : backto.line   ( n1 --- )
  945.                 toline- getline ;
  946.  
  947. : .elapse       ( --- )
  948.                 ." Edit time " time-elapsed b>t
  949.                 ttime 2@ form-time count type ;
  950.  
  951. : updt          ( --- )         \ save changes if any to disk.
  952.                 ?browse ?exit
  953.                 savescr
  954.                 cursor-off
  955.                 changed 0=
  956.                 if      8 6 70 10 box&fill
  957.                         bcr ."  \2 NO CHANGES to save in "
  958.                         >attrib2 .ed1hndl >norm 5 tenths
  959.                 else
  960.                         save> screenline
  961.                         curline >r
  962.                         8 7 70 9 box&fill
  963.                         ."  \2 Saving Changes to "
  964.                         >attrib2 .ed1hndl >norm
  965.                         <shom>
  966.                         discard.bak
  967.                         ?enoughdisk
  968.                         if      put off> changed on> updated
  969.                         else    showstat
  970.                         then
  971.                         r> to.line
  972.                         restore> screenline
  973.                 then    5 tenths scrshow ?cursor emptykbd off> fdbuf
  974.                 restscr cursor-on showcur ;
  975.  
  976. defer try_to_open       ' noop is try_to_open
  977.  
  978. : ?newopen      ( -- )
  979.                 ?eddone                 \ if ?eddone true
  980.                 hdepth 1 < and          \ and handle depth = 0
  981.                 leavesave 0= and        \ and leavesave is false
  982.                 leavenow 0= and         \ and doleave is false
  983.                 if      savescr
  984.                         18 15 62 18 box&fill
  985.                         ."  \1 Type in the name of a file to edit, or " bcr
  986.                         ."     \1 press \2 ESC \1 to leave the editor. "
  987.                         try_to_open
  988.                         restscr
  989.                         leavesave negate =: leavesave
  990.                                         \ convert -1 to 1 to make <RED>
  991.                                         \ not save where we are leaving from
  992.                 then    ;
  993.  
  994. : squt          ( c1 --- c1 )   \ discard changes and exit
  995.                 ?shiftkey >r
  996.                 off> loadline
  997.                 off> screenchar
  998.                 discard.$$$
  999.                 on> ?eddone
  1000.                 off> edready
  1001.                 r> 0=
  1002.                 if      ?newopen
  1003.                 else    on> pop-extra
  1004.                 then    0 rows 1- at
  1005.                 off> lmrgn ;
  1006.  
  1007. : sesc          ( c1 --- c1 )   \ save changes and exit
  1008.                 curline 1+ =: loadline
  1009.                 <shom>
  1010.                 cursor-off
  1011.                 changed
  1012.                 if      savescr
  1013.                         6 6 74 10 box&fill bcr
  1014.                         ."  Saving Changes to " .ed1hndl bcr
  1015.                         ?enoughdisk
  1016.                         if      discard.bak
  1017.                                 put
  1018.                                 recover.$$$ ?ferr 0=
  1019.                                 if      on> ?eddone
  1020.                                         off> changed
  1021.                                         7 tenths
  1022.                                 then    restscr
  1023.                                 ?newopen
  1024.                         else    restscr scrshow showstat
  1025.                         then
  1026.                 else    savescr
  1027.                         true    updated
  1028.                         if      drop recover.$$$ ?ferr 0=
  1029.                         then
  1030.                         if      on> ?eddone
  1031.                                 off> changed
  1032.                                 restscr
  1033.                                 ?newopen
  1034.                         else    restscr scrshow showstat
  1035.                         then
  1036.                 then    0 rows 1- at
  1037.                 off> lmrgn cursor-on ;
  1038.  
  1039. headerless
  1040.  
  1041. defer <nlnx>    ' noop is <nlnx>
  1042.  
  1043.                 \ conditionally add a line
  1044. : ?addline      ( --- )
  1045.                 ?lastline
  1046.                 if      screenchar ch/l =: screenchar
  1047.                         <nlnx> =: screenchar
  1048.                 then    ;
  1049.  
  1050. headers
  1051.  
  1052. : ?rightshow    ( --- )
  1053.                 winoff
  1054.                 screenchar text.width 1- -      \ winoff must be at least
  1055.                 winoff max                      \ but not less than now
  1056.                 dup =: winoff                   \ new value
  1057.                 <>                              \ if new not equal old
  1058.                 if      scrshow                 \ then update screen
  1059.                 then    ;
  1060.  
  1061. : rchr          ( --- )         \ right a character
  1062.                 screenchar 1+ ch/l 1- min dup =: screenchar
  1063.                 132 >=                  \ limit to column 132
  1064.                 if      off> screenchar ?addline sdln scrshow
  1065.                 then    ?rightshow ;
  1066.  
  1067. : chrptr        ( --- a1 )      \ cur character line pointer
  1068.                 screenchar linebuf 1+ + ;
  1069.  
  1070.                                 \ goto beginning of curent line
  1071. : shoml         ( --- )
  1072.                 off> screenchar
  1073.                 off> lmrgn
  1074.                 off> winoff
  1075.                 scrshow ;
  1076.  
  1077. : sendl         ( --- )         \ goto end of current line
  1078.                 stripbl's linebuf c@ =: linelen
  1079.                 ch/l linebuf c!
  1080.                 linelen =: screenchar
  1081.                 ?rightshow ;
  1082.  
  1083. : send          ( --- )         \ goto end of file
  1084.                 putline lastline toline+
  1085.                 last.textline curline 1+ min =: screenline
  1086.                 getline sendl scrshow ;
  1087.  
  1088. : ?leftshow     ( --- )         \ reshow screen of screen scrolled
  1089.                 screenchar winoff <
  1090.                 if      screenchar =: winoff
  1091.                         scrshow
  1092.                 then    ;
  1093.  
  1094. : lchr          ( --- )         \ left a character
  1095.                 -1 +!> screenchar screenchar 0<
  1096.                 if      off> screenchar suln sendl scrshow
  1097.                 else    ?leftshow
  1098.                 then    ;
  1099.  
  1100.   10 value autosave-minutes
  1101. true value autosaving?
  1102.  
  1103. headerless
  1104.  
  1105. 0 value keycnt
  1106. 0 value not-saved?
  1107. 2variable savetime
  1108.  
  1109. : autosave      ( --- )
  1110.                 ?browse ?exit
  1111.                 autosaving? 0= ?exit
  1112.                 keycnt 1000 >
  1113.                 if      not-saved?
  1114.                         if      gettime t>b savetime 2!
  1115.                                 off> not-saved?
  1116.                         else    off> keycnt
  1117.                                                 \ 60k = 10 minutes
  1118.                                 gettime t>b savetime 2@ d-
  1119.                                 autosave-minutes 6000 *d d>
  1120.                                 changed and
  1121.                                 if      off> not-saved?
  1122.                                         updt showcur
  1123.                                 then
  1124.                         then
  1125.                 else    incr> keycnt
  1126.                 then    ;
  1127.  
  1128. : ?showstatus   ( --- )
  1129.                 normbgstuff
  1130.                 autosave
  1131.                 vstaton 0= ?exit
  1132.                 statcnt 40 >
  1133.                 if      off> statcnt off> vstaton
  1134.                         @> #out @> #line showstat at ?cursor
  1135.                 then    incr> statcnt ;
  1136.  
  1137. : statkey       ( --- c1 )
  1138.                 normkey
  1139.                 off> keycnt
  1140.                 on> not-saved?
  1141.                 off> statcnt ;
  1142.  
  1143. headers
  1144.  
  1145. \ : pdn           ( --- )         \ go down a page in file
  1146. \                 ?lastline if exit then putline getline
  1147. \                 last.textline 1+ first.textline - 2- 3 screenline - + 1 max 0
  1148. \                ?do      putline curline+ getline
  1149. \                         ?lastline
  1150. \                         if      last.textline =: screenline leave then
  1151. \                 loop    3 last.textline min =: screenline
  1152. \                 ?mark-plus clipdown scrshow emptykbd ;
  1153.  
  1154. : pdn           ( --- )         \ go down a page in file
  1155.                 ?lastline if exit then putline getline
  1156.                 last.textline 1+ first.textline - 2- 0 max 0
  1157.                ?do      putline curline+ getline
  1158.                         ?lastline
  1159.                         if      last.textline =: screenline leave then
  1160.                 loop
  1161.                 ?mark-plus clipdown scrshow emptykbd ;
  1162.  
  1163. \ : pup           ( --- )         \ go up a page in file
  1164. \                 ?firstline if exit then putline getline
  1165. \                 last.textline 1+ first.textline - 2- screenline 3 - + 1 max 0
  1166. \                ?do      putline curline- getline
  1167. \                         ?firstline
  1168. \                         if      first.textline =: screenline leave then
  1169. \                 loop    3  first.textline curline + min =: screenline
  1170. \                 ?mark-plus scrshow emptykbd ;
  1171.  
  1172. : pup           ( --- )         \ go up a page in file
  1173.                 ?firstline if exit then putline getline
  1174.                 last.textline 1+ first.textline - 2- 0 max 0
  1175.                ?do      putline curline- getline
  1176.                         ?firstline
  1177.                         if      first.textline =: screenline leave then
  1178.                 loop    screenline first.textline curline + min =: screenline
  1179.                 ?mark-plus scrshow emptykbd ;
  1180.  
  1181. headerless
  1182.  
  1183. : >space        ( --- )         \ move to next space in line
  1184.                 linelen dup screenchar over min
  1185.                 ?do     linebuf 1+ i + c@ dup bl =
  1186.                         swap 127 > or
  1187.                         if      drop i leave then
  1188.                 loop    =: screenchar   ;
  1189.  
  1190. : space>        ( --- )         \ move to non blank in line
  1191.                 linelen dup screenchar over min
  1192.                 ?do     linebuf 1+ i + c@ dup bl <>
  1193.                         swap 127 > 0= and
  1194.                         if      drop i leave then
  1195.                 loop    linelen min =: screenchar ;
  1196.  
  1197. : <<space>      ( ---  n1 )     \ n1 = offset from line strt to prev space
  1198.                 0 dup screenchar
  1199.                 ?do     linebuf 1+ i + c@ dup bl =
  1200.                         swap 127 > or
  1201.                         if      drop i leave then
  1202.             -1 +loop    dup =: screenchar ;
  1203.  
  1204. : <text         ( --- )      \ move to previous text in line.
  1205.                 0 dup screenchar
  1206.                 ?do     linebuf 1+ i + c@ dup bl <>
  1207.                         swap 127 > 0= and
  1208.                         if      drop i leave then
  1209.             -1 +loop    =: screenchar ;
  1210.  
  1211. headers
  1212.  
  1213. : %scrllft      ( n1 --- )
  1214.                 winoff 0>
  1215.                 if      winoff over - 0MAX =: winoff
  1216.                         winoff text.width 1- + screenchar min =: screenchar
  1217.                         scrshow
  1218.                 then    drop ;
  1219.  
  1220. : scrllft       ( --- )
  1221.                 4 %scrllft ;
  1222.  
  1223. : %scrlrt       ( n1 --- )
  1224.                 winoff text.width + 252 <
  1225.                 if      dup +!> winoff
  1226.                         winoff screenchar max =: screenchar
  1227.                         scrshow
  1228.                 then    drop ;
  1229.  
  1230. : scrlrt        ( --- )
  1231.                 4 %scrlrt ;
  1232.  
  1233. : rwrd          ( --- )
  1234.                 ?shiftkey if scrlrt  exit then
  1235.                 screenchar linelen @> rmargin min =
  1236.                 ?lastline 0= and
  1237.                 if      off> screenchar sdln scrshow exit
  1238.                 then    >space
  1239.                 screenchar linelen >=
  1240.                 if      scrshow exit then
  1241.                 space> scrshow ;
  1242.  
  1243. : lwrd          ( --- )         \ go back to previous word.
  1244.                 ?shiftkey if scrllft  exit then
  1245.                 screenchar 0= ?firstline   0= and
  1246.                 if      suln linelen =: screenchar scrshow exit
  1247.                 then    screenchar 1- 0MAX =: screenchar
  1248.                 <text   screenchar 0=
  1249.                 if      scrshow exit
  1250.                 then    <<space>
  1251.                 if      incr> screenchar
  1252.                 then    @> rmargin screenchar min =: screenchar scrshow ;
  1253.  
  1254. headerless
  1255.  
  1256. : splitline     ( --- )
  1257.                 linebuf screenchar + 1+ dup split.buf 1+
  1258.                 linelen screenchar - 1+ 0MAX dup>r cmove
  1259.                 r> split.buf c! ch/l screenchar - blank
  1260.                 screenchar =: linelen
  1261.                 ?appendline modified <sdln>
  1262.                 linebuf linebuf.len blank
  1263.                 split.buf count linebuf 1+ lmrgn + swap cmove
  1264.                 split.buf c@ lmrgn + dup linebuf c! =: linelen
  1265.                 ins.linelist modified <suln> ;
  1266.  
  1267. : <nln>         ( --- ) \ inserts line if in insert mode.
  1268.                 ?showfull ?maxlines or
  1269.                 if beep exit then
  1270.                 imode
  1271.                 if      splitline
  1272.                 else    ?lastline
  1273.                         if      stripbl's linebuf c@ =: screenchar
  1274.                                 SplitLine
  1275.                         then
  1276.                 then    on> changed ;
  1277.  
  1278. ' <nln> is <nlnx>
  1279.  
  1280. headers
  1281.  
  1282. : nln           ( f1 --- f1 )   \ next line function
  1283.                                 \ inserts line if in insert mode.
  1284.                 ?browse
  1285.                 if      sdln
  1286.                 else    <nln>   sdln
  1287.                         lmrgn             =: screenchar
  1288.                         lmrgn linelen max =: linelen
  1289.                         ch/l linebuf c!
  1290.                 then    scrshow ;
  1291.  
  1292. : nodisp-nln    ( --- ) \ next line function
  1293.                         \ inserts line if in insert mode.
  1294.                 <nln>   <sdln> off> screenchar ch/l linebuf c! ;
  1295.  
  1296. headerless
  1297.  
  1298. : csaveon       on> csaveflg ;
  1299.  
  1300. : csaveoff      off> csaveflg ;
  1301.  
  1302. : csave         ( c1 --- )
  1303.                 csaveflg
  1304.                 if      fdbuf c@ 64  >
  1305.                         if      fdbuf count >r dup 1+ swap r> cmove
  1306.                                 fdbuf c@ 1- 0MAX fdbuf c!
  1307.                         then    fdbuf count + c! fdbuf c@ 1+ fdbuf c!
  1308.                 else    drop
  1309.                 then    ;
  1310.  
  1311. headers
  1312.  
  1313. : <fdel>        ( --- )
  1314.                 screenchar dup linebuf + 1+ dup c@ csave
  1315.                 dup 1+ swap rot ch/l 1+ swap - cmove
  1316.                 modified ?showfull drop decr> linelen ;
  1317.  
  1318. headerless
  1319.  
  1320. : ?lmargin      ( --- )
  1321.                 screenchar 0=
  1322.                 if      lmrgn =: screenchar then ;
  1323.  
  1324. : ?right        ( --- )
  1325.                 wrapped
  1326.                 if      screenchar wraploc 1- <
  1327.                         if      rchr ?lmargin
  1328.                         else    screenchar wraploc -
  1329.                                 lmrgn + 1+ =: screenchar
  1330.                                 sdln
  1331.                         then    scrshow
  1332.                 else    rchr    ?lmargin
  1333.                 then    ;
  1334.  
  1335. : del<>bl's     ( --- )         \ delete non blanks
  1336.                 begin   chrptr c@ bl <>
  1337.                 while   <fdel>
  1338.                 repeat  ;
  1339.  
  1340. : delbl's       ( --- )         \ delete blanks
  1341.                 ch/l screenchar
  1342.                 ?do      chrptr c@ bl <> ?leave <fdel>
  1343.                 loop    ;
  1344.  
  1345. : AppendLine    ( --- )         \ append this line to previous.
  1346.                 ?firstline if beep exit then
  1347.                 imode
  1348.         if      stripbl's split.buf linebuf.len blank
  1349.                 linebuf split.buf over c@ dup>r 1+ cmove
  1350.                 curline 1- #lineseg 0 c@l r> + ch/l 1- >
  1351.                 if      beep getline off> screenchar
  1352.                 else    ldel suln stripbl's
  1353.                         split.buf count linebuf count dup if 1+ then
  1354.                         dup>r + swap cmove  modified split.buf c@ r@ +
  1355.                         ch/l 10 - min dup 10 + linebuf c! =: linelen
  1356.                         r> @> rmargin 1- min =: screenchar putline
  1357.                         screenchar linelen 1- min 0MAX =: screenchar
  1358.                 then
  1359.         else    suln stripbl's linebuf c@ =: screenchar
  1360.         then    getline sdisplay ;
  1361.  
  1362. headers
  1363.  
  1364. : bdel          ( --- )         \ back delete
  1365.                 ?browse
  1366.         if      suln sendl
  1367.         else    screenchar 0=
  1368.                 if      AppendLine scrshow
  1369.                 else    imode
  1370.                         if      screenchar dup linebuf + 1+ dup 1-
  1371.                                 rot ch/l 1+ swap - cmove
  1372.                                 decr> screenchar
  1373.                                 linelen 1- screenchar max linelen min
  1374.                                 =: linelen
  1375.                         else    decr> screenchar
  1376.                                 bl chrptr c! modified putline getline
  1377.                         then    sdisplay screenchar lmrgn min =: lmrgn
  1378.                 then    modified
  1379.                 ?showfull drop ?leftshow
  1380.         then    ;
  1381.  
  1382. defer ?wrap     ' noop is ?wrap
  1383.  
  1384. : schr          ( c1 --- )    \ insert sequential char in line.
  1385.                 ?browse   if drop exit then
  1386.                 ?showfull ?exit
  1387.                 screenchar linelen max =: linelen
  1388.                 imode
  1389.         if      screenchar linebuf 1+ + dup 1+
  1390.                 linelen screenchar - 0MAX cmove> incr> linelen
  1391.         then    dup screenchar linebuf 1+ + c!  bl <>
  1392.                 if      linelen screenchar 1+ max =: linelen
  1393.                 then    sdisplay modified
  1394.                 ?wrap   ?right  ;
  1395.  
  1396. : wudel         ( --- )
  1397.                 ?browse ?exit
  1398.                 true save!> imode
  1399.                 fdbuf count bounds
  1400.                 ?do     fdbuf 1+ c@ >r                  \ get char
  1401.                         fdbuf 2+ fdbuf 1+               \ source destination
  1402.                         fdbuf c@ 1- 0MAX cmove         \ clip char out
  1403.                         fdbuf c@ 1- 0MAX fdbuf c!      \ reduce count
  1404.                         r> ?dup 0= ?leave               \ leave if null
  1405.                         schr                            \ insert it
  1406.                 loop    restore> imode ;
  1407.  
  1408. : @word@cur     ( -- a1 )
  1409.                 save> screenchar        \ save current cursor position
  1410.                 <<space>                \ if space found, then bump forward 1
  1411.                 linebuf 1+ + c@
  1412.                 dup bl =                \ did we find a space,
  1413.                 swap hyperchar = or     \ or the hyper character?
  1414.                 if      incr> screenchar
  1415.                 then
  1416.                 screenchar              \ cursor position
  1417.                 >space                  \ find next space
  1418.                 screenchar              \ get new cursor position ( old new )
  1419.                 swap =: screenchar      \ restore cursor position ( new )
  1420.                 screenchar - 0max >r    \ length of word under cursor saved
  1421.                 linebuf 1+ screenchar + \ source
  1422.                 r> here c!
  1423.                 here count cmove
  1424.                 restore> screenchar
  1425.                 here ;
  1426.  
  1427. headerless
  1428.  
  1429. : .nofound      ( --- )
  1430.                 savecursor
  1431.                 savescr
  1432.                 cursor-off
  1433.                 20 3 60 5 box&fill
  1434.                 ."  No text has been found.."
  1435.                 1 seconds
  1436.                 restscr
  1437.                 restcursor ;
  1438.  
  1439. : #linelook     ( n1 --- f1 )   \ look through line n1
  1440.                 >r slook.buf count r> #lineseg =: sseg
  1441.                 1 @> sseg 0 c@l
  1442.                 screenchar - 0MAX swap screenchar + swap
  1443.                 search tuck
  1444.                 if      +!> screenchar
  1445.                 else    drop
  1446.                 then    ;
  1447.  
  1448. 0 value looked
  1449.  
  1450. : ?exp_position ( f1 -- f1 )
  1451.                 dup ?exp_tabs and       \ found and expanding tabs
  1452.                 if      slook.buf count linebuf count search
  1453.                         if      dup =: screenchar
  1454.                         then    drop
  1455.                 then    ;
  1456.  
  1457. : look.till     ( --- f1 )
  1458.                 off> screenchar
  1459.                 putline
  1460.                 cursor-off
  1461.                 0               \ Leave false bool in case we don't find it.
  1462.                 lastline 1+ curline 1+ over min
  1463.                 ?do     slook.buf count i #lineseg =: sseg
  1464.                         0 @> sseg 0 c@l 1+ search
  1465.                         if      1- 0max =: screenchar
  1466.                                 i to.line 0=    \ change false bool to true
  1467.                                 leave           \ and leave
  1468.                         else    drop
  1469.                         then
  1470.                         i 127 and 0=
  1471.                         if      lincol statusline at
  1472.                                 I 1+ 4 >attrib1 .l >norm
  1473.                                 key? ?leave
  1474.                         then
  1475.                 loop    ?cs: =: sseg
  1476.                 getline ?exp_position
  1477.                 emptykbd ?cursor ;
  1478.  
  1479. : look.back     ( --- f1 )
  1480.                 off> screenchar putline
  1481.                 cursor-off
  1482.                 0               \ Leave false bool in case we don't find it.
  1483.                 0 curline 1- 0MAX
  1484.                 ?do     i #linelook
  1485.                         if      i backto.line 0=  \ change false bool to true
  1486.                                 leave             \ and leave
  1487.                         then
  1488.                         i 127 and 0=
  1489.                         if      lincol statusline at
  1490.                                 I 1+ 4 >attrib1 .l >norm
  1491.                                 key? ?leave
  1492.                         then
  1493.             -1 +loop    ?cs: =: sseg
  1494.                 getline ?exp_position
  1495.                 emptykbd ?cursor ;
  1496.  
  1497. : <slooker>     ( --- ) ?lastline if exit then
  1498.                 off> looked slook.buf c@ 0=
  1499.                 if      rwrd    exit    \ just step to next word
  1500.                 then    putline getline
  1501.                         curline >r r@ #linelook 0=
  1502.                         ?cs: =: sseg
  1503.                 if      look.till dup =: lookflg 0=
  1504.                         if      .nofound r@ backto.line
  1505.                         else    on> looked then
  1506.                 else    on> looked
  1507.                 then    r>drop ;
  1508.  
  1509. headers
  1510.  
  1511. : slooker       ( --- )
  1512.                 ?lastline if exit then
  1513.                 ?shiftkey 0= save!> caps
  1514.                 <slooker>
  1515.                 restore> caps
  1516.                 screenline 10 <
  1517.                 if      screenline 1+ curline first.textline +
  1518.                         min =: screenline
  1519.                 then    ;
  1520.  
  1521. : slookbk       ( --- )
  1522.                 true save!> caps
  1523.                 off> looked
  1524.                 curline >r
  1525.                 look.back dup =: lookflg 0=
  1526.                 if      .nofound r@ to.line
  1527.                 else    on> looked
  1528.                 then    r>drop
  1529.                 restore> caps ;
  1530.  
  1531. : sloob         ( --- ) \ search again backwards
  1532.                 slookbk scrshow clipdown ;
  1533.  
  1534. : slooa         ( --- ) \ search again forward
  1535.                 incr> screenchar slooker scrshow sdisplay ;
  1536.  
  1537. : sloon         ( --- )
  1538.                 savescr
  1539.                 15 6 64 10 box&fill
  1540.                 ."  \r Text to look for: \0   <Enter>=accept ESC=cancel"
  1541.                 bcr
  1542.                 bcr  ."    Press Alt-A to enter a special character"
  1543.                 off> stripping_bl's     \ don't string trailing blanks
  1544.                                         \ from search string.
  1545.                 on> autoclear
  1546.                 >attrib1
  1547.                 17 8 slook.buf 29 lineeditor       ( --- f1 )
  1548.                 >norm
  1549.                 if      cursor-off
  1550.                         17 9 at ." \s13\1 Looking ...."
  1551.                         63 @> #out - spaces
  1552.                         slooa cursor-on
  1553.                 then    restscr scrshow ;
  1554.  
  1555. : sloow         ( -- )          \ search for word under cursor
  1556.                 @word@cur count slook.buf c!
  1557.                 slook.buf count cmove
  1558.                 sloon ;
  1559.  
  1560. headerless
  1561.  
  1562. create rep.buf   32 allot       rep.buf  32 erase
  1563.  
  1564. 0 value repset
  1565.  
  1566. : <srepa>       ( --- )
  1567.                 looked repset and
  1568.                 if      true save!> imode
  1569.                         slook.buf c@ 0
  1570.                         ?do     <fdel>
  1571.                                 modified putline getline
  1572.                         loop
  1573.                         rep.buf count bounds
  1574.                         ?do     i c@ schr
  1575.                         loop    off> looked
  1576.                         restore> imode
  1577.                 else    .nofound
  1578.                 then    scrshow ;
  1579.  
  1580. headers
  1581.  
  1582. : srepa         ( --- )
  1583.                 ?browse ?exit
  1584.                 <srepa> slooa   ;
  1585.  
  1586. : srepn         ( --- )
  1587.                 ?browse ?exit
  1588.                 off> repset
  1589.                 looked 0=
  1590.                 if      .nofound
  1591.                 else    savescr
  1592.                         14 6 70 10 box&fill
  1593.         ."  \r Replace found text with: \0  <Enter>=accept ESC=cancel"
  1594.                         bcr
  1595.                         bcr ." \tPress Alt-A to enter a special character"
  1596.                         off> stripping_bl's     \ don't strip trailing balnks
  1597.                                                 \ from replace string
  1598.                         on> autoclear
  1599.                         >attrib1
  1600.                         16 8 rep.buf 29 lineeditor       ( --- f1 )
  1601.                         >norm
  1602.                         if      on> repset srepa
  1603.                         then
  1604.                         restscr
  1605.                 then    scrshow ;
  1606.  
  1607. : repall        ( --- )
  1608.                 ?browse ?exit
  1609.                 first.textcol statusline at
  1610.                 ." \4 Replacing \`"
  1611.                 slook.buf count type
  1612.                 ." \` with \`"
  1613.                 rep.buf count type
  1614.                 ." \` Press ESC to cancel" >attrib4 edeeol >norm
  1615.                 looked if <srepa> then
  1616.                 begin   slooa   looked
  1617.                         key?    if key 27 <> and then
  1618.                 while   <srepa>
  1619.                 repeat  ;
  1620.  
  1621. headerless
  1622.  
  1623. : already_exists?       ( --- f1 )      \ does filename in ed2hndl exist?
  1624.                 ed2hndl hopen 0=        \ if so, then prompt for overwrite.
  1625.                 if      ed2hndl hclose drop
  1626.                         cursor-off
  1627.                         10 11 at
  1628.                         ." \r ALREADY EXISTS, overwrite it? Y/N [N] "
  1629.                         key bl or 'y' <> dup
  1630.                         if      ." \rAborting...\:05"
  1631.                                 scrshow
  1632.                         else    10 11 at 61 spaces
  1633.                         then    cursor-on
  1634.                 else    false
  1635.                 then    ;
  1636.  
  1637. headers
  1638.  
  1639. : wr->fl        ( --- )
  1640.                 savescr
  1641.                  8 6 71 12 box&fill
  1642.         ."  \r Write the file in memory to: \0    <Enter>=accept ESC=cancel"
  1643.                 ed1hndl pad over c@ 1+ cmove
  1644.                 on> autoclear
  1645.                 >attrib1
  1646.                 10 9 pad 59 lineeditor       ( --- f1 )
  1647.                 >norm
  1648.                 if      pad
  1649.                         dup ed2hndl $>handle
  1650.                         ed2hndl pathset drop
  1651.                         already_exists?                 \ overwrite existing?
  1652.                         if      drop exit               \ if not then exit
  1653.                         then
  1654.                         ed1hndl $>handle
  1655.                         ed1hndl pathset drop
  1656.                         on> newfl on> changed
  1657.                         save> screenchar
  1658.                         save> screenline
  1659.                         curline >r
  1660.                         <shom>
  1661.                         10 11 at ." Saving As File..."
  1662.                         ?enoughdisk
  1663.                         if      put
  1664.                                 off> changed on> updated
  1665.                                 ." .DONE \:05"
  1666.                         else    showstat
  1667.                         then
  1668.                         begin   curline r@ <>
  1669.                         while   curline+
  1670.                         repeat r>drop
  1671.                         restore> screenline
  1672.                         restore> screenchar
  1673.                         getline
  1674.                 then    restscr on> ?border scrshow ;
  1675.  
  1676. headerless
  1677.  
  1678. : <joinln>      ( --- )
  1679.                 132 save!> rmargin              \ guarantee NO WRAP
  1680.                    '.' schr                     \ add an extra char
  1681.                 restore> rmargin                \ restore right margin
  1682.                 0 save!> screenchar
  1683.                    linelen dup 132 < >r >r      \ line < 132 chars long
  1684.                    sdln
  1685.                    linelen r> + 200 < r> and    \ and total chars < 200
  1686.                    if      bdel
  1687.                    else    suln
  1688.                    then
  1689.                 restore> screenchar
  1690.                 bdel ;                          \ delete extra char
  1691.  
  1692. : ?addbl        ( --- )         \ add a blank if char before cursor is NOT
  1693.                                 \ a blank, and SCREENCHAR is NOT zero.
  1694.                 screenchar ?dup 0= ?exit        \ leave if beginning of line
  1695.                 1- linebuf 1+ + c@ bl <>        \ or preceeded by a blank
  1696.                 if      bl schr
  1697.                 then    ;
  1698.  
  1699. headers
  1700.  
  1701. : joinln        ( --- )
  1702.                 ?browse ?exit
  1703.                 true save!> imode
  1704.                 0 save!> screenchar
  1705.                     sendl ?addbl <joinln> delbl's
  1706.                     modified putline getline
  1707.                 restore> screenchar
  1708.                 restore> imode
  1709.                 scrshow ;
  1710.  
  1711. : itgl          ( --- )         \ insert mode toggle
  1712.                 ?browse ?exit
  1713.                 imode 0= =: imode ?cursor ;
  1714.  
  1715. : fdel          ( --- )         \ forward delete
  1716.                 ?browse ?exit
  1717.                 screenchar linelen >=
  1718.                 if      ?addbl <joinln> delbl's
  1719.                 else    csaveon <fdel> csaveoff
  1720.                 then
  1721.                 modified putline getline
  1722.                 ?showfull drop sdisplay ;
  1723.  
  1724. : wdel          ( --- )
  1725.                 ?browse ?exit
  1726.                 screenchar linelen >=
  1727.                 if      ?addbl <joinln>         \ unwrap line
  1728.                         chrptr c@ bl =
  1729.                         if      delbl's
  1730.                         then
  1731.                 else    chrptr c@ bl <>
  1732.                         if      csaveon
  1733.                                 del<>bl's       \ delete non blank
  1734.                                 <fdel>          \ delete one blank
  1735.                                 0 csave         \ Append null delimiter
  1736.                                 csaveoff
  1737.                                 delbl's         \ and delete blanks
  1738.                         else    csaveoff
  1739.                                 delbl's
  1740.                         then                    \ for possible undelete
  1741.                 then
  1742.                 modified putline getline
  1743.                 ?showfull drop sdisplay ( scrshow ) ;
  1744.  
  1745. : mark-clear    ( -- )
  1746.                 off> marking
  1747.                 off> markstrt
  1748.                 off> markfst
  1749.                 off> markend
  1750.                 off> markdone ;
  1751.  
  1752. : mark-on/off   ( --- )
  1753.                 markdone
  1754.                 if      mark-clear
  1755.                         cursor-off
  1756.                         25 6 51 8 box&fill
  1757.                         ." \s01\r ** Mark is CLEARED ** \:07"
  1758.                         cursor-on
  1759.                 else    marking 0=
  1760.                         if      on> marking
  1761.                                 curline    =: markstrt
  1762.                                 curline    =: markend
  1763.                                 curline    =: markfst
  1764.                                 screenchar =: markchar
  1765.                         else    curline markfst >
  1766.                                 if      markfst    =: markstrt
  1767.                                         curline    =: markend
  1768.                                 else    markfst    =: markend
  1769.                                         curline    =: markstrt
  1770.                                         screenchar =: markchar
  1771.                                 then    on> markdone
  1772.                         then
  1773.                 then    scrshow ;
  1774.  
  1775. : %?mark-plus   ( -- )
  1776.                 marking markdone 0= and
  1777.                 if      curline markfst >
  1778.                         if      markfst =: markstrt
  1779.                                 curline =: markend
  1780.                         else    markfst =: markend
  1781.                                 curline =: markstrt
  1782.                         then    scrshow
  1783.                 then    ;
  1784.  
  1785. ' %?mark-plus is ?mark-plus
  1786.  
  1787. : smrk          ( --- )         \ mark line for get
  1788.                 mark-on/off ;
  1789.  
  1790. : dnln         ( --- ) sdln sdisplay emptykbd ;
  1791.  
  1792. : upln          ( --- ) suln sdisplay emptykbd ;
  1793.  
  1794. : >screenline   ( n1 -- )       \ goto screenline number n1
  1795.                 dup>r   screenline <
  1796.                 if      begin   ?firstline 0= screenline r@ > and
  1797.                         while   upln repeat
  1798.                 else    begin   ?lastline  0= screenline r@ < and
  1799.                         while   dnln repeat
  1800.                 then    r>drop ;
  1801.  
  1802. : tscrn         ( --- )         \ goto top of screen
  1803.                 first.textline >screenline ;
  1804.  
  1805. : bscrn         ( --- )         \ goto bottom of screen
  1806.                 last.textline >screenline ;
  1807.  
  1808. : tmscrn        ( --- )         \ goto top middle of screen
  1809.                 first.textline 7 + >screenline ;
  1810.  
  1811. : bmscrn        ( --- )         \ goto bottom middle of screen
  1812.                 last.textline 7 - >screenline ;
  1813.  
  1814. : scldn        ( --- )  screenline last.textline <>
  1815.                 if      decr> screenline
  1816.                         sdln scrshow
  1817.                 else    sdln
  1818.                 then    emptykbd ;
  1819.  
  1820. : sclup         ( --- ) screenline first.textline <>
  1821.                 if      incr> screenline
  1822.                         suln scrshow
  1823.                 else    suln
  1824.                 then    emptykbd ;
  1825.  
  1826. : bhyper        ( --- )
  1827.                 mxlln save!> rmargin
  1828.                 false save!> caps
  1829.                 off> looked
  1830.                 slook.buf @ >r
  1831.                 hyperchar slook.buf 1+ c! 1 slook.buf c!
  1832.                 curline >r
  1833.                 look.back dup =: lookflg 0=
  1834.                 if      .nofound r@ to.line
  1835.                 else    on> looked
  1836.                 then    curline r> - +!> screenline
  1837.                 screenline first.textline <
  1838.                 if      last.textline 6 -
  1839.                         curline first.textline + min =: screenline
  1840.                 then
  1841.                 r> slook.buf !
  1842.                 restore> caps
  1843.                 restore> rmargin scrshow sdisplay showcur ;
  1844.  
  1845. : nhyper        ( --- )         \ tab expansion word
  1846.                 slook.buf @ >r
  1847.                 hyperchar slook.buf 1+ c! 1 slook.buf c!
  1848.                 mxlln save!> rmargin
  1849.                 false save!> caps
  1850.                 incr> screenchar
  1851.                 curline >r
  1852.                 <slooker>
  1853.                 curline r> - +!> screenline     \ keep screen stable as long
  1854.                                                 \ as possible
  1855.                 screenline last.textline >=     \ then center on screen
  1856.                 if      last.textline 6 -
  1857.                         curline first.textline + min =: screenline
  1858.                 then
  1859.                 restore> caps
  1860.                 restore> rmargin
  1861.                 r> slook.buf ! scrshow ;
  1862.  
  1863. : sbtab         ( --- )         \ tab left on screen
  1864.                 ?browse
  1865.         if      bhyper
  1866.         else    lchr screenchar @> tabsize mod 0 ?do lchr loop
  1867.                 screenchar lmrgn min =: lmrgn
  1868.         then    ;
  1869.  
  1870. : stab          ( --- )         \ tab right on screen
  1871.                 ?browse
  1872.         if      nhyper
  1873.         else    @> tabsize screenchar @> tabsize mod -
  1874.                 imode
  1875.                 if      0
  1876.                        ?do      bl schr ?full
  1877.                                 screenchar lmrgn = or ?leave
  1878.                         loop
  1879.                 else    +!> screenchar
  1880.                 then    screenchar @> rmargin 1- >=
  1881.                 if      off> screenchar sdln
  1882.                 then    linebuf 1+ screenchar bl skip nip 0=
  1883.                 if      screenchar @> rmargin 6 - min =: lmrgn
  1884.                 then    scrshow
  1885.         then    ;
  1886.  
  1887. headerless
  1888.  
  1889. : <lundel>      ( --- )         \ undo line deletes
  1890.                 ldel.cnt 0= if beep exit then
  1891.                 true save!> imode
  1892.                 off> screenchar <nln> ( <suln> ) ldel>linebuf
  1893.                 modified putline getline
  1894.                 restore> imode ;
  1895.  
  1896. : .nomark       ( --- )         \ inform user no mark has been set
  1897.                 savescr cursor-off
  1898.                 ['] noop save!> dobutton
  1899.                 20 6 58 9 box&fill
  1900.                      ."  No MARK has been set, use F3 first."
  1901.                 bcr ."  Press a \r KEY \0 to continue editing."
  1902.                 beep key drop
  1903.                 restore> dobutton
  1904.                 cursor-on restscr ;
  1905.  
  1906. headers
  1907.  
  1908. : lundel        ( --- )         \ undo line deletes
  1909.                 ?browse ?exit
  1910.                 <lundel> scrshow ;
  1911.  
  1912. : sgetl         ( --- )
  1913.                 ?browse ?exit
  1914.                 markstrt lastline 2- > if exit then
  1915.                 marking 0= ?showfull or ?maxlines or if .nomark exit  then
  1916.                 true save!> imode on> changed
  1917.                 off> screenchar nln suln
  1918.                 restore> imode
  1919.                 markstrt curline >= if incr> markstrt then
  1920.                 linebuf linebuf.len blank
  1921.                 markstrt #lineseginfo 2- >r ?cs: linebuf 1+
  1922.                 r> ch/l 2+ min cmovel ch/l linebuf c!
  1923.                 modified putline getline sdln
  1924.                 incr> markstrt
  1925.                 markend markstrt max =: markend
  1926.                 scrshow ;
  1927.  
  1928. : spltln        ( --- )
  1929.                 ?browse ?exit
  1930.                 true save!> imode
  1931.                       save> screenchar
  1932.                 nln suln
  1933.                 restore> screenchar
  1934.                 restore> imode scrshow ;
  1935.  
  1936. : showscreen    ( --- )
  1937.                 showstat scrshow ?cursor ;
  1938.  
  1939.                 \ allow entry of any keyboard character
  1940. : ^cc           ( --- )
  1941.                 ?browse ?exit
  1942.                 window.left 0MAX statusline at
  1943.                 ." \2  Enter a key to insert "
  1944.                 showcur key schr ;
  1945.  
  1946. : lmset         ( --- )
  1947.                 screenchar =: lmrgn
  1948.                 savescr cursor-off
  1949.                 22 6 58 8 box&fill
  1950.                 ."  Left Margin set to column " screenchar .
  1951.                 5 tenths restscr cursor-on showcur ;
  1952.  
  1953. : tabset        ( --- )
  1954.                 putline
  1955.                 screenchar 1 max dup =: tabsize =: etabsize
  1956.                 savescr cursor-off
  1957.                 22 6 58 8 box&fill
  1958.                 ."  Tabs set column increment " @> tabsize .
  1959.                 5 tenths restscr
  1960.                 getline cursor-on showcur scrshow ;
  1961.  
  1962. forth definitions
  1963.  
  1964.