home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / sz.seq < prev    next >
Text File  |  1991-01-29  |  76KB  |  1,726 lines
  1. \\ SZ.SEQ                Small Zimmer's Editor           by Tom Zimmer
  2.  
  3.   In this file I will develop the code for an editor. This is a fairly
  4. simple editor, with a limited set of functions. It works with standard
  5. text files where lines are terminated with a carraige return and a
  6. linefeed. Only simple dump to the printer type printing from within the
  7. program is supported. It is useful for manipulating up to two text files
  8. at a time with each file limited to about 60000 characters.
  9.  
  10.   COMPILE with TCOM using the following command line:
  11.  
  12.         C:> TCOM SZ /OPT /NOINIT <Enter>
  13.  
  14.   This will build a new SZ.COM space and speed optimized, without the
  15. default initialization which is done internally by the editor. For most
  16. applications you would not include the "/MININIT" parameter. You
  17. normally want the I/O words and number BASE initialized so you can use
  18. them in your application.
  19.  
  20. {
  21.  
  22. FORTH DECIMAL
  23. DEFINED TARGET-INIT NIP 0= #IF  \ Test for NOT target compiling
  24.  
  25. \ ***************************************************************************
  26. \ If we are compiling with the F-PC compiler, then do these things instead.
  27. \ ***************************************************************************
  28. \ Some additional words need to be added that are in the target library, but
  29. \ are not in the normal F-PC Forth dictionary.
  30. \ ***************************************************************************
  31.  
  32.  
  33. VARIABLE HOSTING
  34. ALSO HIDDEN ALSO
  35.  
  36. CODE -SKIP      ( addr len char -- addr' len' ) \ skip char backwards
  37.                 pop ax
  38.                 pop cx
  39.           CX<>0 IF      pop di
  40.                         MOV DX, ES
  41.                         MOV BX, DS      MOV ES, BX
  42.                         STD     REPZ    SCASB   CLD
  43.                         MOV ES, DX
  44.                     0<> IF
  45.                                 INC CX
  46.                                 INC DI
  47.                         THEN
  48.                         push di
  49.                 THEN    push cx
  50.                 next    END-CODE
  51.  
  52.  
  53. VARIABLE ESC_FLG
  54.  
  55. CREATE TMPBUF 128 ALLOT
  56.  
  57. : #EXPECT       ( A1 N1 N2 -- )
  58.                 PLUCK >R SWAP DUP>R SPAN ! TMPBUF PLACE
  59.                 AT? TMPBUF R> LINEEDITOR
  60.                 IF      TMPBUF COUNT DUP SPAN ! R> SWAP CMOVE
  61.                 ELSE    R>DROP ESC_FLG ON
  62.                 THEN    ;
  63.  
  64. : +PLACE        DUP>R COUNT + SWAP DUP>R CMOVE R> R> C+! ;
  65.  
  66. : DS:ALLOC      ( n1 -- a1 )    \ allocate n1 bytes of DS: RAM at runtime,
  67.                                 \ returning a1 the address of the DS: RAM
  68.                 HERE SWAP DP +! ;
  69.  
  70. : DS:FREE?      ( -- n1 )       \ return the amount of free DS: RAM
  71.                 SP0 @ HERE - 300 - ;
  72.  
  73. : ?DS:          ?CS:    ;
  74. : DS:!          DROP    ;
  75. : DS:->SS:              ;
  76. : INIT-CURSOR           ;
  77. : dos_to_tib            ;
  78. : SETUP_MEMORY          ;
  79.  
  80. #ELSE
  81.  
  82. TARGET
  83.  
  84. #THEN
  85.  
  86.     1 constant scrfline         \ first screen line
  87.    22 constant scrlline         \ last screen line
  88.    79 constant maxcol           \ maximum right column position
  89.    80 constant columns          \ columns on screen
  90.   256 constant lbsiz            \ line buffer size
  91.   $0A constant alf              \ a linefeed character
  92. $2020 constant ablbl            \ two blanks
  93. $0A0D constant acrlf            \ a carraige return Linefeed character
  94.   $1E constant ylbl             \ green characters on a blue background
  95.   $03 constant cybk             \ cyan characters on a black background
  96.   $4F constant wtrd             \ white characters on a red background
  97.  1024 constant msg_max          \ length of message buffer
  98.  
  99. scrlline scrfline - 1-  constant pglines
  100. scrlline 1+             constant statline
  101.  
  102. \ It may hard to believe that a simple editor needs all of these
  103. \ variables, but it does.
  104.  
  105. $78 value stat_color            \ status and filename bar color
  106. $07 value text_color            \ colors for text
  107. $7F value end_color             \ color of end of file message
  108. $4F value err_color             \ color of error messages
  109.   0 value lbuf                  \ holds line buffer address
  110.   0 value fhndl                 \ current file handle
  111.   0 value ccphndl               \ cut copy paste handle
  112.   0 value tbuf                  \ Text buffer array pointer
  113.   0 value msg_buf               \ message buffer from compiler
  114.   0 value msg_len               \ message buffer length
  115.   0 value erroring
  116.   0 value ?got_msg              \ did we find a message file
  117.   0 value ?cmd                  \ do we leave in Command mode
  118.  
  119. variable totmem                 \ total memory used by editor
  120. variable rbuf                   \ holds replace buffer address
  121. variable sbuf                   \ holds search buffer address
  122. variable dbuf                   \ dos command line buffer
  123. variable scnt                   \ search count variable
  124. variable tbuf_end               \ address of end of text buffer
  125. variable read_len               \ bytes read from file
  126. variable read_end               \ pointer to end of read text
  127. variable curcol                 \ cursor column position
  128. variable currow                 \ cursor row position
  129. variable scrrow                 \ screen row position
  130. variable curadr                 \ address of current line
  131. variable scradr                 \ address of top of screen
  132. variable insmode                \ insert mode flag
  133. variable ?not_done              \ are we NOT done editing yet?
  134. variable changed                \ line changed flag
  135. variable modified               \ file modified flag
  136. variable modifiable             \ will we allow the file to be changed?
  137. variable totlines               \ total lines in file
  138. variable fullflag               \ memory full flag
  139. variable inserting              \ a disabling flag for ?FULL
  140. variable seg#                   \ file segment number
  141. variable didfind                \ we found the string
  142. variable f$                     \ filename string pointer
  143. variable file#                  \ current edit file
  144. variable #files                 \ number of files open
  145. variable ds_0                   \ first data segment
  146. variable tsize                  \ current tab size
  147. variable markflg                \ are we currently marking?
  148. variable mark1                  \ line to cut or copy from
  149. variable mark2                  \ the other line to cut or copy from
  150. variable sm$                    \ status message string pointer
  151. variable soff                   \ start displaying at column offset
  152. variable ?got_dir               \ did we make a directory file properly
  153.  
  154. : >text_color   ( -- )          \ select the character colors for normal text
  155.                 text_color attrib ! ;
  156.  
  157. : >stat_color   ( -- )          \ set the status line character colors
  158.                 stat_color attrib ! ;
  159.  
  160. : >end_color    ( -- )          \ set the End of file message colors
  161.                 end_color attrib ! ;
  162.  
  163. : >err_color    ( -- )
  164.                 err_color attrib ! ;
  165.  
  166. : color_init    ( -- )          \ init for color or monochrome
  167.                 ?vmode 7 <>
  168.                 if      ylbl =: stat_color      \ yellow on blue
  169.                         cybk =: end_color       \ cyan on black
  170.                         $07  =: text_color      \ normal text
  171.                         wtrd =: err_color       \ error messages
  172.                 then    ;
  173.  
  174. : tbuf_size     ( -- n1 )       \ max edit filesize in bytes
  175.                 tbuf_end @ tbuf - ;
  176.  
  177. : ?full         ( -- f1 )       \ is memory full
  178.                 tbuf_end @ read_end @ 255 + u< dup fullflag !
  179.                 inserting @ and ;
  180.  
  181. : dos_prep      ( -- )          \ prepare a section of the screen in case
  182.                                 \ there is an error while performing a DOS
  183.                                 \ function. We will fill it in again after
  184.                                 \ the DOS function is performed.
  185.                 0 scrlline 4 - at
  186.                 4 for cr eeol next
  187.                 0 scrlline 3 - at ;
  188.  
  189. }
  190.  
  191.  ***************************************************************************
  192.  exit command file creation. Allows passing a command back to the calling
  193.  program.
  194.  
  195.  Builds a file called ZZ.CMD. The file contains the following information:
  196.  
  197.         Size       Contents
  198.         --------------------------------------------------------
  199.         byte       Ascii command to Mini Shell ( Q | 1-9 ).
  200.         byte       Space filler.
  201.         variable   Upto 64 bytes of filename.
  202.         byte       Space filler.
  203.         4bytes     Row number in ascii, four digits.
  204.         byte       Space filler.
  205.         4bytes     Column number in ascii, four digits.
  206.         byte       Space filler.
  207.         2bytes     CRLF line and file terminator.
  208.         --------------------------------------------------------
  209.  
  210.  The command byte at offset zero is interpreted by the mini shell as
  211.  follows:
  212.  
  213.         Q       Quitting, return to DOS.
  214.         1-9     Perform the DOS commandline from the file ZZ.CFG using
  215.                 lines 2 through 10 respectively.
  216.  
  217.  ***************************************************************************
  218.  
  219. {
  220.  
  221. handle cmdhndl
  222.  
  223. : cmdmake       ( -- f1 )       \ make the command file, return true if OK
  224.                 " ZZ.CMD" ">$ cmdhndl $>handle
  225.                 cmdhndl hcreate 0= ;
  226.  
  227. : #write        ( n1 handle -- )        \ write n1 as four digits to handle
  228.                 >r 0 <# # # # # #> r> hwrite drop ;
  229.  
  230. : cwrite        ( c1 handle -- )
  231.                 >r sp@ 1 r> hwrite 2drop  ;             \ add space
  232.  
  233. : %cmd          ( c1 -- )       \ put command c1 into command file
  234.                 ?cmd    0=      if drop exit then       \ leave if no command
  235.                 cmdmake 0=      if drop exit then       \ leave if no make
  236.                                 cmdhndl cwrite          \ send cmd
  237.                 bl              cmdhndl cwrite          \ add space
  238.                 fhndl count     cmdhndl hwrite drop     \ append filename
  239.                 bl              cmdhndl cwrite          \ add space
  240.                 currow @ 1+     cmdhndl #write
  241.                 bl              cmdhndl cwrite          \ add space
  242.                 curcol @ 1+     cmdhndl #write
  243.                 bl              cmdhndl cwrite          \ add space
  244.                 $0D             cmdhndl cwrite          \ terminate file
  245.                 $0A             cmdhndl cwrite          \ with CRLF chars
  246.                                 cmdhndl hclose drop ;   \ and close it
  247.  
  248. : Q_CMD         ( -- )  'Q' %cmd ;
  249. : 1_CMD         ( -- )  '1' %cmd ;      \ control F1
  250. : 2_CMD         ( -- )  '2' %cmd ;      \ control F2
  251. : 3_CMD         ( -- )  '3' %cmd ;      \ control F3
  252. : 4_CMD         ( -- )  '4' %cmd ;      \ control F4
  253. : 5_CMD         ( -- )  '5' %cmd ;      \ F5
  254. : 6_CMD         ( -- )  '6' %cmd ;
  255. : 7_CMD         ( -- )  '7' %cmd ;      \ F7
  256. : 8_CMD         ( -- )  '8' %cmd ;
  257. : 9_CMD         ( -- )  '9' %cmd ;      \ F9
  258. : 10_CMD        ( -- )  '0' %cmd ;
  259. : 11_CMD        ( -- )  'A' %cmd ;      \ Shift-F1
  260. : 12_CMD        ( -- )  'B' %cmd ;
  261. : 13_CMD        ( -- )  'C' %cmd ;
  262. : 14_CMD        ( -- )  'D' %cmd ;
  263. : 15_CMD        ( -- )  'E' %cmd ;
  264. : 16_CMD        ( -- )  'F' %cmd ;
  265. : 17_CMD        ( -- )  'G' %cmd ;
  266. : 18_CMD        ( -- )  'H' %cmd ;      \ Shift-F8
  267.  
  268.  
  269.  
  270. \ ***************************************************************************
  271. \ get the message file from compiler
  272.  
  273. : get_MSG_file  ( -- )          \ get the message file to message buffer
  274.                 fhndl ccphndl $>handle
  275.                 " MSG" ">$  ccphndl $>ext
  276.                 ccphndl hopen dup 0= =: ?got_msg ?exit \ leave if no file
  277.                 msg_buf msg_max blank                   \ blank fill buffer
  278.                 msg_buf msg_max ccphndl hread =: msg_len \ read it into buffer
  279.                 $0A0D msg_buf msg_len + !               \ terminate with CRLF
  280.                 ;
  281.  
  282. 40 array msg_lptrs
  283. 0 value msg_num
  284.  
  285. : ?msg_mark     ( a1 -- )       \ does line start with our filename?
  286.                 dup 20 2dup $0A scan nip - '(' scan nip
  287.                                                 \ if we find a '(' in line
  288.                 if      dup msg_lptrs count 2* + !
  289.                         msg_lptrs incr
  290.                 then    drop ;
  291.  
  292. : msg_type      ( a1 -- )
  293. \                begin   dup c@ ')' <>           \ skip to ')'
  294. \                while   1+ repeat  1+           \ plus 1
  295.                 begin   dup c@ $0D <>
  296.                 while   dup c@ emit 1+
  297.                 repeat  drop ;
  298.  
  299. : process_msgs  ( -- )          \ look for error messages in message buffer
  300.                 msg_lptrs off
  301.                 off> msg_num
  302.                 msg_buf msg_len bounds
  303.                 ?do     i c@ $0A =
  304.                         if      i 1+ ?msg_mark
  305.                         then
  306.                 loop    ;
  307.  
  308. \ ***************************************************************************
  309.  
  310. : statline-at   ( n1 -- )       \ moves to column n1 of statline and
  311.                                 \ sets status color
  312.                 statline at >stat_color ;
  313.  
  314. : scrfline-at   ( n1 -- )       \ move to the first text line, erase it and
  315.                                 \ set the status line colors.
  316.                 scrfline 2dup at >stat_color eeol at ;
  317.  
  318. : end>rev       ( -- )          \ clear the status line, then select the
  319.                                 \ text colors.
  320.                 0 statline-at eeol >text_color ;
  321.  
  322. : .warning      ( a1 n1 -- )
  323.                 0 scrlline 2- at >stat_color
  324.                 2 for eeol cr next
  325.                 0 scrlline 2- at space type eeol
  326.                 cr ."  ** Press a key to return to the editor ** "
  327.                 cr >text_color
  328.                 beep key drop
  329.                 end>rev ;
  330.  
  331. : ?err          ( f1 a1 n1 -- f1 )      \ if f1 = true then display message
  332.                 rot
  333.                 if      .warning true
  334.                 else    2drop    false
  335.                 then    ;
  336.  
  337. : .by           ( -- )          \ my NON-COPYRIGHT message
  338.                 8 spaces
  339.                 ." Small Z editor was written by Tom Zimmer (public domain)" ;
  340.  
  341. : %szsave       ( -- f1 )       \ save changes, return true if failed
  342.                 fhndl hcreate dup ?exit drop
  343.                 tbuf read_len @ fhndl hwrite read_len @ -
  344.                 fhndl hclose or dup 0=
  345.                 if      modified off
  346.                 then    ;
  347.  
  348. : prevlf        ( a1 -- a2 )            \ a1 = address of char after LF
  349.                                         \ a2 = address of previous LF
  350.                 2- dup tbuf 1- - 255 umin alf -scan drop ;
  351.  
  352. : nextlf        ( a1 -- a2 )            \ a1 = address of char after LF
  353.                                         \ a2 = address of next LF
  354.                 read_end @ over - 1+ 255 umin alf scan drop ;
  355.  
  356. : parse_line    ( a1 -- a1 n1 )         \ given line a1, return length
  357.                 dup 255 alf scan drop 1+ read_end @ umin over - ;
  358.  
  359. : erase_below   ( -- )          \ erase the text line below the current line
  360.                 statline #line @ 1+ over min
  361.                 ?do     0 i at eeol
  362.                 loop    ;
  363.  
  364. : ?cursor-on    ( -- )          \ turn on cursor if in modifiable mode
  365.                 modifiable @
  366.                 if      cursor-on
  367.                 then    ;
  368.  
  369. create dashs ," ────────"
  370.  
  371. : --s           ( n1 -- )       \ display n1 - symbols
  372.                 dup u8/ 0 ?do dashs 1+ 8 type loop 7 and dashs 1+ swap type ;
  373.  
  374. : showbottom    ( -- )          \ the after last text line message, shown
  375.                                 \ in "end-color".
  376.                 0 #line @ 1+ at >end_color
  377.                 30 --s ."  End of file " 36 --s >text_color
  378.                 erase_below ;
  379.  
  380. : revset        ( n1 -- )       \ test and set reverse video if we are
  381.                                 \ on a line marked for cut or copy.
  382.                 markflg @ 0<                    \ marking, set mark2
  383.                 if      currow @ mark2 !
  384.                 then
  385.                 scrrow @ - currow @ +           \ then test for between
  386.                 mark1 @ mark2 @ 2dup u>         \ mark1 and mark2
  387.                 if swap then between
  388.                 if      >rev                    \ if so then display reverse
  389.                 then    ;
  390.  
  391. : ?rev_set      ( n1 -- )       \ conditionally set the current line to
  392.                                 \ reverse video if we are marking.
  393.                 markflg @ 0=
  394.                 if      drop exit               \ not marking then leave
  395.                 then
  396.                 revset  ;
  397.  
  398. : get_tline     ( a1 -- a2 a1 n1 ) \ return the address and length of line a1
  399.                 dup nextlf 1+ tuck over -
  400.                 2dup + 2- @ acrlf = if 2- then
  401.                 soff @ /string columns min ;
  402.  
  403. : #scrshow      ( a1 -- )       \ show a screen full of text starting at
  404.                                 \ line address a1.
  405.                 cursor-off
  406.                 statline scrfline
  407.                 do      dup read_end @ u>= ?leave
  408.                         get_tline
  409.                         0 i at i ?rev_set type eeol >text_color
  410.                 loop    drop
  411.                 #line @ scrlline <
  412.                 if      showbottom
  413.                 then
  414.                 ?cmd 0= if ?cursor-on exit then         \ leave here!!
  415.                 0 statline 1+ at
  416.                 msg_lptrs count
  417.                 if      >err_color msg_num 2* + @ msg_type eeol
  418.                         erroring
  419.                         if      0 0 at >err_color
  420.                                 ."     Press ESC to EDIT   "
  421.                         then
  422.                 else    ?got_msg
  423.                         if      >stat_color ."  No compile errors " eeol
  424.                         then
  425.                 then    drop >text_color
  426.                 ?cursor-on ;
  427.  
  428. : strip_bl's    ( -- )          \ strip blanks from the line buffer
  429.                 lbuf count tuck 1- + swap bl -skip nip lbuf c! ;
  430.  
  431. : adj_tbuf      ( a1 n1 -- a1 n1 )      \ adjust hole for edited line
  432.                 lbuf c@ 2dup - dup 0<   \ ?longer then make room
  433.                 if                                      \ dat olen nlen dif
  434.                         abs >r drop
  435.                         curadr @ dup r@ +               \ cur cur+dif
  436.                         read_end @ curadr @ -           \ rem_len
  437.                         2+ cmove>                       \ move the data
  438.                         r>                              \ dat olen dif
  439.                 else                    \ else shorten space
  440.                         >r drop
  441.                         curadr @ dup r@ + swap          \ cur+dif cur
  442.                         read_end @ curadr @ - r@ -
  443.                                                         \ rem_len
  444.                         2+ cmove
  445.                         r> negate                       \ dat olen -dif
  446.                 then
  447.                 dup read_len +!                         \ adj file length
  448.                     read_end +! ;                       \ & end address
  449.  
  450. : ltobuf        ( -- )          \ move the current line buffer to text buffer
  451.                 curadr @ parse_line dup lbuf c@ <>
  452.                 if      adj_tbuf                \ dat olen
  453.                         drop lbuf c@            \ discard olen add nlen
  454.                 then    ( -- a1 n1 )
  455.                 lbuf 1+ -rot cmove ;    \ put line in text buffer
  456.  
  457. : add_crlf      ( -- )          \ append CRLF to line buffer
  458.                 acrlf lbuf count + !
  459.                 2 lbuf c+! ;
  460.  
  461. : ?del_crlf     ( -- )          \ delete CRLF if they are there
  462.                 lbuf count + 2- @ acrlf =
  463.                 if      -2 lbuf c+!
  464.                         ablbl lbuf count + !
  465.                 then    ;
  466.  
  467. : putline       ( -- )          \ put the current line back in text body
  468.                                 \ if it has been changed.
  469.                 changed @ modifiable @ and      \ changes allowed?
  470.                 if      ?full ?exit
  471.                         strip_bl's              \ remove trailing blanks
  472.                         add_crlf
  473.                         ltobuf                  \ move line to buffer
  474.                         modified on             \ mark file as modified
  475.                         changed off             \ clear line changed flag
  476.                 then    ;
  477.  
  478. : getline       ( -- )          \ get a line from text body
  479.                 lbuf count blank
  480.                 curadr @ parse_line lbuf place ?del_crlf ;
  481.  
  482. : szline        ( -- )          \ show the current line
  483.                 0 scrrow @ at
  484.                 scrrow @ ?rev_set
  485.                 lbuf count soff @ /string columns min type
  486.                 eeol >text_color ;
  487.  
  488. : szshow        ( -- )          \ show the text on screen
  489.                 scradr @ #scrshow ;
  490.  
  491. : dosave        ( -- )          \ save changes to current file if there
  492.                                 \ have been any
  493.                 putline
  494.                 getline
  495.                 modified @ modifiable @ and 0= ?exit
  496.                 dos_prep
  497.                 %szsave " Error while writing file!" ?err drop
  498.                 end>rev
  499.                 szshow ;
  500.  
  501. : szsave        ( -- f1 )       \ save changes from edit
  502.                                 \ f1 = true if error
  503.                 modifiable @ modified @ and
  504.                 if      %szsave " Save ERROR!" ?err
  505.                 else    false
  506.                 then    ;
  507.  
  508. : space>col     ( n1 -- )       \ display spaces upto column n1
  509.                 #out @ - spaces ;
  510.  
  511. : szstatus      ( -- )          \ show cursor position in file
  512.                 1 statline-at
  513.                 ." Column " curcol @ 1+ .       12 space>col
  514.                 ." Line "   currow @ 1+ .       30 space>col
  515.                 modified @
  516.                 if      >end_color
  517.                 then    sm$ @ count type >stat_color
  518.                 seg# @ ?dup if 4 .r then
  519. \                45 space>col ." Stk = " depth .
  520.                 56 space>col
  521.                 ." Lines "
  522.                 totlines @ 5 .r
  523.                 ."  Bytes "
  524.                 read_len @ 0 <# #s #> type eeol >text_color
  525.                 fullflag @
  526.                 if      62 0 at >stat_color ."  ** MEMORY FULL **"
  527.                 then    >text_color ;
  528.  
  529. : szcursor      ( -- )          \ position the cursor at the proper location
  530.                                 \ on the screen.
  531.                 curcol @ soff @ - scrrow @ at ;
  532.  
  533. : %fdel         ( -- )          \ delete char under cursor
  534.                 lbuf count curcol @ /string dup
  535.                 if      swap dup 1+ swap rot cmove
  536.                         -1 lbuf c+!
  537.                 else    2drop
  538.                 then    changed on ;
  539.  
  540. : putchar       ( c1 -- )       \ put in one character to line buffer
  541.                 lbuf 1+ curcol @ + c!
  542.                 curcol @ lbuf c@ max lbuf c! ;
  543.  
  544. : linetotop     ( -- n1 )       \ lines to top of screen
  545.                 scrrow @ scrfline - ;
  546.  
  547. : <>near_end?   ( -- f1 )       \ true if closer to file end than PGLINES
  548.                 totlines @ 1- currow @ -        \ line from end
  549.                 pglines dup linetotop - + > ;   \ if more than pglines to end
  550.  
  551. : ?lastline     ( -- f1 )       \ is the current line the last line?
  552.                 currow @ totlines @ 1- >= ;
  553.  
  554. : %down1        ( a1 -- f1 )    \ a1 = addr we are adjusting
  555.                                 \ f1 = true if on last line
  556.                 dup>r @ nextlf 1+ dup read_end @ u<
  557.                 if      r> ! false
  558.                 else    drop
  559.                         read_end @ prevlf 1+ tbuf umax r> !
  560.                         true
  561.                 then    ;
  562.  
  563. : <down1>       ( -- f1 )       \ Move down one row in file
  564.                 scrrow @ scrlline >=    \ if at bottom of screen
  565.                 if      scradr %down1 drop
  566.                 else    scrrow incr
  567.                 then    curadr %down1 dup 0=
  568.                 if      currow incr
  569.                 then    ;
  570.  
  571. : %up1          ( a1 -- f1 )    \ move from line address in variable a1,
  572.                                 \ up one line and return a flag true if
  573.                                 \ we are at the beginning of the text buffer.
  574.                 dup>r @ prevlf 1+ tbuf umax dup r> ! tbuf u<= ;
  575.  
  576. : <up1>         ( -- )          \ backup one row in the text buffer, clipping
  577.                                 \ at the beginning of the text buffer.
  578.                 scrrow @ scrfline <=
  579.                 if      scradr %up1 drop
  580.                 else    scrrow decr
  581.                 then    curadr @ prevlf 1+ tbuf umax curadr !
  582.                 currow @ 1- 0max currow ! ;
  583.  
  584. : scrtop        ( -- )          \ move to top line on screen
  585.                 putline
  586.                 begin   scrrow @ scrfline >
  587.                 while   <up1>
  588.                 repeat
  589.                 getline ;
  590.  
  591. : scrbot        ( -- )          \ move to bottom line on screen
  592.                 putline true
  593.                 begin   ( -- f1 )
  594.                         scrrow @ scrlline < and
  595.                 while   <down1> 0=      ( -- f1 )       \ true if not at end
  596.                 repeat
  597.                 getline ;
  598.  
  599. : scrlup        ( -- )          \ scroll the screen up
  600.                 putline
  601.                 scradr @ tbuf u<=     \ if already at top
  602.                 if      <up1>           \ then up a line
  603.                 else    scradr %up1 drop
  604.                         curadr %up1 drop
  605.                         currow decr
  606.                 then
  607.                 getline szshow ;
  608.  
  609. : scrldn        ( -- )          \ scroll the screen down
  610.                 ?lastline ?exit
  611.                 putline
  612.                 totlines @ 1- currow @ -        \ line from end
  613.                 linetotop + pglines >
  614.                 if      scradr %down1 drop
  615.                         curadr %down1 drop
  616.                         currow incr
  617.                 else    <down1> drop
  618.                 then
  619.                 getline szshow ;
  620.  
  621. : down1         ( -- )          \ move down one line in the text buffer.
  622.                                 \ redisplay the screen if needed.
  623.                 ?lastline ?exit
  624.                 modifiable @ 0= if scrldn exit then
  625.                 putline
  626.                 <down1> drop
  627.                 getline
  628.                 scrrow @ scrlline >= markflg @ or
  629.                 if      szshow
  630.                 then    ;
  631.  
  632. : up1           ( -- )          \ go up one line in file, redisplay the
  633.                                 \ screen if needed.
  634.                 modifiable @ 0= if scrlup exit then
  635.                 putline
  636.                 <up1>
  637.                 getline
  638.                 scrrow @ scrfline <= markflg @ or
  639.                 if      szshow
  640.                 then    ;
  641.  
  642. : ?soffL!       ( n1 -- )       \ starting column offset set, with
  643.                                 \ screen redisplay if needed.
  644.                 soff @ over >=
  645.                 if      dup soff !
  646.                         szshow
  647.                 then    drop ;
  648.  
  649. : %left         ( -- )          \ move left one character column
  650.                 curcol @ 1- 0max dup curcol ! ?soffL! ;
  651.  
  652. : ?soff!        ( n1 -- )       \ set SOFF if n1 greater than columns
  653.                 maxcol - 0max ?dup
  654.                 if      soff @ max soff !
  655.                         szshow
  656.                 then    ;
  657.  
  658. : right1        ( -- )          \ go right a character in this line
  659.                 curcol @ 1+ 255 min dup curcol ! ?soff! ;
  660.  
  661. : homeln        ( -- )          \ go to beginning of line
  662.                 curcol off
  663.                 soff @ soff off
  664.                 if      szshow
  665.                 then    ;
  666.  
  667. : endln         ( -- )          \ go to the end of the line
  668.                 strip_bl's lbuf c@ dup curcol ! ?soff! ;
  669.  
  670. : linechar      ( n1 -- c1 )    \ return the n1 char of lbuf at c1
  671.                 lbuf 1+ + c@ ;
  672.  
  673. : >space        ( --- )         \ move to next space in line
  674.                 lbuf c@ dup curcol @ over min
  675.                 ?do     i linechar dup bl =
  676.                         swap 127 > or
  677.                         if      drop i leave then
  678.                 loop    255 min dup curcol ! ?soff! ;
  679.  
  680. : space>        ( --- )         \ move to non blank in line
  681.                 lbuf c@ dup curcol @ over min
  682.                 ?do     i linechar dup bl <>
  683.                         swap 127 > 0= and
  684.                         if      drop i leave then
  685.                 loop    lbuf c@ min 255 min dup curcol ! ?soff! ;
  686.  
  687. : <<space>      ( ---  n1 )     \ n1 = offset from line strt to prev space
  688.                 0 dup curcol @
  689.                 ?do     i linechar dup bl =
  690.                         swap 127 > or
  691.                         if      drop i leave then
  692.             -1 +loop    dup curcol ! dup ?soffL! ;
  693.  
  694. : <text         ( --- )      \ move to previous text in line.
  695.                 0 dup curcol @
  696.                 ?do     i linechar dup bl <>
  697.                         swap 127 > 0= and
  698.                         if      drop i leave then
  699.             -1 +loop    dup curcol ! ?soffL! ;
  700.  
  701. : wleft         ( -- )          \ word left with wrap at line start
  702.                 curcol @ 0= curadr @ tbuf u> and
  703.                 if      up1 endln szshow exit
  704.                 then    curcol @ 1- 0max curcol !
  705.                 <text   curcol @ 0=
  706.                 if      szshow exit
  707.                 then    <<space>
  708.                 if      curcol incr
  709.                 then    curcol @ 255 min curcol ! szshow ;
  710.  
  711. : wright        ( -- )          \ word right with wrap at line end
  712.                 curcol @ lbuf c@ 255 min =
  713.                 ?lastline 0= and
  714.                 if      curcol off
  715.                         soff off
  716.                         down1 szshow exit
  717.                 then    >space
  718.                 curcol @ lbuf c@ >=
  719.                 if      szshow exit then
  720.                 space> szshow ;
  721.  
  722. : left          ( -- )          \ move left one character on line, with
  723.                                 \ wrap up to end of previous line if at
  724.                                 \ line start.
  725.                 curcol @ 0>
  726.                 if      %left
  727.                 else    currow @ 0>
  728.                         if      up1
  729.                                 endln
  730.                         then
  731.                 then    ;
  732.  
  733. : merge_prev    ( -- )          \ merge thie line with the previous line
  734.                 curadr @                        \ save cur lines addr
  735.                 lbuf c@ >r up1 endln
  736.                 lbuf c@ r> + 255 >              \ don't make lines longer
  737.                 if      drop beep exit          \ than 255 characters
  738.                 then
  739.                 curadr @ over u<                \ if not on first line
  740.                 if      ablbl over 2- !         \ change CRLF to BLBL
  741.                         getline                 \ get line again
  742.                         %fdel                   \ del one blank
  743.                         curcol @ 0=             \ at line start?
  744.                         if      %fdel           \ then del both blanks
  745.                         else    right1          \ move right one
  746.                         then
  747.                         totlines decr
  748.                 then    drop ;
  749.  
  750. : %bdel         ( -- f1 )       \ backward delete, deletes char before cursor
  751.                                 \ return flag true if we need redisplay
  752.                 curcol @ 0=
  753.                 if      currow @ dup 0= ?exit drop
  754.                         insmode @
  755.                         if      modifiable @ 0= ?exit
  756.                                 merge_prev      true
  757.                         else    left            false
  758.                         then
  759.                 else    %left
  760.                         modifiable @ 0= ?exit
  761.                         insmode @
  762.                         if      %fdel
  763.                         else    bl putchar
  764.                         then                    false
  765.                 then    changed on ;
  766.  
  767. : bdel          ( -- )          \ backwards delete
  768.                 %bdel
  769.                 if      szshow
  770.                 then    ;
  771.  
  772. : calc_lines    ( -- )          \ determine the total number of lines in
  773.                                 \ the file, set TOTLINES according
  774.                 totlines off
  775.                 tbuf
  776.                 begin   nextlf read_end @ over u>=
  777.                 while   1+ totlines incr
  778.                 repeat  drop
  779.                 read_end @ 1- c@ alf <>         \ last line has no CRLF
  780.                 if      totlines incr           \ need to bump total line
  781.                 then                            \ count by one more
  782.                 totlines @ 1 max totlines ! ;
  783.  
  784. : %goend        ( -- )          \ goto end of text buffer/file.
  785.                 read_end @ prevlf 1+ dup scradr ! curadr !
  786.                 scrlline 2- 0
  787.                 do      scradr %up1 ?leave
  788.                 loop
  789.                 totlines @ 1- currow !
  790.                 scrlline 1- totlines @ 1- scrfline + min scrrow ! ;
  791.  
  792. : downpg        ( -- )          \ go down page lines in file
  793.                 putline
  794.                 <>near_end?
  795.                 if      pglines 0
  796.                         do      scradr %down1   ( -- f1 )
  797.                                 curadr %down1 drop
  798.                                 currow incr
  799.                                 ( -- f1 ) ?leave
  800.                         loop
  801.                 else    %goend
  802.                 then
  803.                 getline szshow ;
  804.  
  805. : %gohome       ( -- )          \ goto start of text buffer/file
  806.                 tbuf scradr !
  807.                 tbuf curadr !
  808.                 scrfline scrrow !
  809.                 currow off ;
  810.  
  811. : uppage        ( -- )          \ go up page lines in file
  812.                 putline
  813.                 scradr @ tbuf u<=
  814.                 if      %gohome
  815.                 else    pglines 0
  816.                         do      scradr %up1     ( -- f1 )
  817.                                 curadr %up1 drop
  818.                                 currow decr
  819.                                 ( -- f1 ) ?leave
  820.                         loop
  821.                 then
  822.                 getline szshow ;
  823.  
  824. : gohome        ( -- )          \ goto beginning of file
  825.                 putline %gohome curcol off soff off getline szshow ;
  826.  
  827. : goend         ( -- )          \ goto end of file
  828.                 putline %goend getline szshow ;
  829.  
  830. : instgl        ( -- )          \ insert mode toggle
  831.                 insmode @ 0= dup insmode !
  832.                 if      big-cursor
  833.                 else    norm-cursor
  834.                 then    ;
  835.  
  836. : kerr          ( c1 -- )       \ discard garbage key
  837.                 ;
  838.  
  839. : dochar        ( c1 -- )       \ handle displayable characters
  840.                 modifiable @ 0=         \ if not modifiable, or
  841.                 lbuf c@ 254 >  or       \ if line is full
  842.                 if drop exit then       \ then discard and leave
  843.                 insmode @       \ if in insert mode, make a hole for char
  844.                 if      lbuf count curcol @ /string
  845.                         swap dup 1+ rot cmove>
  846.                         1 lbuf c+!
  847.                 then    putchar
  848.                 changed on              \ mark line as changed
  849.                 right1                  \ bump to next cursor position
  850.                 curcol @ lbuf c@ max 255 min lbuf c! ;
  851.  
  852. : inspage       ( -- )          \ insert a page break at cursor
  853.                 ^L dochar ;
  854.  
  855. : dotab_keys    ( c1 -- f1 )    \ adjust the tab size till Enter is pressed
  856.                 dup  13 = if drop     true exit then    \ enter
  857.                 dup 203 = if tsize decr 0= exit then    \ left arrow
  858.                 dup 205 = if tsize incr 0= exit then    \ right arrow
  859.                 dup  45 = if tsize decr 0= exit then    \ -
  860.                 dup  43 = if tsize incr 0= exit then    \ +
  861.                 0= ;                                    \ all others
  862.  
  863. : tabclip       ( -- )          \ clip tabsize to valid range
  864.                 tsize @ 2 max 60 min tsize ! ;
  865.  
  866. : settab        ( -- )          \ set tab size
  867.                 cursor-off
  868.         begin   tabclip
  869.                 0 scrfline-at
  870.                 ."  TABs set every " tsize @ 2 .r
  871.                 ."  columns.  Press + and - to adjust; Enter when done"
  872.                 >text_color
  873.                 key dotab_keys
  874.         until   ?cursor-on
  875.                 szshow ;
  876.  
  877. : doachar       ( -- )          \ enter any character into the text file
  878.                 0 scrfline-at
  879.                 ."  Press the key you want to enter ->"
  880.                 key dochar
  881.                 >text_color
  882.                 szshow ;
  883.  
  884. : dotab         ( -- )          \ up to next tab position
  885.                 curcol @ 1+ tsize @ mod tsize @ swap -
  886.                 ?dup 0= ?exit 1-                \ leave if none to do
  887.                 insmode @
  888.                 if      for bl dochar  next     \ insert one or more blanks
  889.                 else    for right1     next     \ move right one or more chars
  890.                 then    ;
  891.  
  892. : btab          ( -- )          \ tab backwards
  893.                 curcol @ 0= if left then
  894.                 curcol @ 1+ tsize @ mod ?dup 0=
  895.                 if      8 curcol @ min
  896.                 then    1-
  897.                 for     left next    ;
  898.  
  899. : merge_next    ( -- )          \ merge thie line with the next line
  900.                 insmode dup @ >r on
  901.                 lbuf c@ >r
  902.                 '.' dochar      \ put a dummy char at end of line
  903.                 down1 homeln    \ down and left
  904.                 lbuf c@ r> + 255 <
  905.         if      bdel bdel bdel  \ delete to join, and del dummy char
  906.         else    bdel bdel
  907.         then    putline getline \ make sure trailing blanks removed
  908.                                 \ as occurs when joining an empty
  909.                 r> insmode ! ;  \ line to this line.
  910.  
  911. : fdel          ( -- )          \ forward delete a character
  912.                 modifiable @ 0= ?exit
  913.                 lbuf c@ curcol @ >
  914.                 if      %fdel                   \ and delete forward
  915.                 else    ?lastline 0=            \ if not on last line
  916.                         if      merge_next
  917.                                 szshow
  918.                         then
  919.                 then    ;
  920.  
  921. : %wdel         ( -- )          \ word delete low level
  922.                 begin   curcol @ linechar bl <>   \ till bl found
  923.                         lbuf c@ curcol @ > and  \ or lineend reached
  924.                 while   fdel
  925.                 repeat
  926.                 begin   curcol @ linechar bl =    \ till bl<>found and
  927.                         lbuf c@ curcol @ > and  \ or lineend reached
  928.                 while   fdel
  929.                 repeat  ;
  930.  
  931. : wdel          ( -- )          \ word delete
  932.                 modifiable @ 0= ?exit
  933.                 lbuf c@ curcol @ >      \ not at end of line
  934.                 if      %wdel           \ delete a word
  935.                 else    fdel            \ else just merge in next line
  936.                 then    ;
  937.  
  938. : %ldel         ( -- )          \ line delete without redisplay
  939.                 modifiable @ 0= ?exit
  940.                 homeln
  941.                 lbuf lbsiz blank
  942.                 0 lbuf c!
  943.                 changed on
  944.                 inserting off           \ disable inserting and ?FULL
  945.                 insmode dup @ >r on
  946.                 ?lastline
  947.                 if      putline                 getline
  948.                 else    putline <down1> drop    getline
  949.                         %bdel drop
  950.                 then
  951.                 r> insmode !
  952.                 inserting on    ;       \ re-enable inserting text
  953.  
  954. : ldel          ( -- )          \ line delete
  955.                 %ldel szshow ;
  956.  
  957. : doenter       ( -- )          \ process the ENTER key
  958.                 insmode @ ?lastline or
  959.                 if      insmode dup @ >r on
  960.                         acrlf split swap dochar dochar
  961.                         r> insmode !
  962.                         changed on
  963.                         putline                         \ save changed line
  964.                         getline                         \ and get it again
  965.                         changed on                      \ make sure trailing
  966.                         putline                         \ blanks are removed
  967.                         getline
  968.                         totlines incr
  969.                 then    down1 homeln
  970.                 szshow ;
  971.  
  972. : down_lines    ( n1 -- )       \ move down n1 lines in file
  973.                 scrrow @ 8 <
  974.                 if      dup 8 min 0 ?do <down1> drop loop
  975.                         8 - 0max
  976.                 then
  977.                 0
  978.                 ?do     scradr %down1   ( -- f1 )
  979.                         curadr %down1 drop
  980.                         currow incr
  981.                         ( -- f1 ) ?leave
  982.                 loop    ;
  983.  
  984. : toaline       ( n1 -- )
  985.                 putline %gohome down_lines
  986.                 curcol off soff off getline ;
  987.  
  988. \ ***************************************************************************
  989. \ display error locations
  990.  
  991. : to_errline    ( -- )
  992.                 msg_lptrs 1+ msg_num 2* + @ 80 2dup $0A scan nip -
  993.                 '(' scan 1 /string 2dup ')' scan nip - here place
  994.                 bl here count + c!
  995.                 here number? 2drop totlines @ min 1- 0max
  996.                 dup mark1 ! dup mark2 ! markflg on
  997.                 toaline ;
  998.  
  999. : do_err        ( n1 -- )
  1000.                 dup 200 = if    msg_num 1- 0max     =: msg_num  then
  1001.                 dup 208 = if    msg_num 1+
  1002.                                 msg_lptrs c@ 1- min =: msg_num  then
  1003.                 drop    ;
  1004.  
  1005. : doerrs        ( -- )
  1006.                 ?cmd 0= ?exit
  1007.                 msg_lptrs c@ 0= ?exit
  1008.                 on> erroring
  1009.                 begin   to_errline
  1010.                         szshow szstatus szcursor
  1011.                         key dup $1B <>
  1012.                 while   do_err
  1013.                 repeat  drop
  1014.                 off> erroring
  1015.                 markflg off
  1016.                 -1 mark1 !
  1017.                 -1 mark2 !
  1018.                 szshow szstatus .current ;
  1019.  
  1020. \ ***************************************************************************
  1021.  
  1022. : ?.row         ( -- )
  1023.                 scnt @ 31 and 0=
  1024.                 if      at? scnt @ 4 .r at
  1025.                 then    ;
  1026.  
  1027. : soffset       ( -- )          \ make sure found text is visible
  1028.                 curcol @ dup sbuf @ c@ 4 + + ?soff! dup soff @ <
  1029.                 if      dup soff !
  1030.                 then    drop ;
  1031.  
  1032. : szfinda       ( -- )          \ find next occurance of same text
  1033.                 sbuf @ c@ 0= if szshow exit then
  1034.                 putline
  1035.                 -1 didfind !    \ init to row -1
  1036.                 cursor-off
  1037.                 59 scrfline-at ."  Scanning lines "
  1038.                 curcol dup @ >r incr
  1039.                 scnt off
  1040.                 sbuf @ count curadr @
  1041.                 begin   3dup parse_line dup>r curcol @ /string search 0=
  1042.                         r> 0> and
  1043.                 while   drop nextlf 1+
  1044.                         scnt incr curcol off
  1045.                         ?.row
  1046.                 repeat  nip >text_color
  1047.                 scnt @ currow @ + totlines @ 1- <       \ before file end
  1048.                 if      curcol +! r>drop
  1049.                         scnt @ down_lines
  1050.                         currow @ didfind !
  1051.                         soffset
  1052.                 else    drop beep
  1053.                         r> curcol !
  1054.                 then    2drop
  1055.                 ?cursor-on
  1056.                 getline szshow ;
  1057.  
  1058. : .edit_info    ( -- )          \ display line edit options
  1059.                 0 scrfline 1+ at >stat_color
  1060.         ."  Press: [ESC] = cancel, [Enter] = accept, [Home] = clear line"
  1061.                 eeol >text_color ;
  1062.  
  1063. : szfind        ( -- )          \ search
  1064.                 .edit_info
  1065.                 0 scrfline-at ."  Enter text to search for ->"
  1066.                 sbuf @ count 30 swap #expect span @ sbuf @ c! >text_color
  1067.                 esc_flg @
  1068.                 if      szshow
  1069.                 else    szfinda
  1070.                 then    ;
  1071.  
  1072. : szrepla       ( -- )          \ replace again with same string
  1073.                                 \ and find next occurance to replace
  1074.                 didfind @ dup 0< swap currow @ <> or ?exit
  1075.                 insmode dup @ >r on
  1076.                 curcol @ >r
  1077.                 sbuf @ c@    0 ?do fdel              loop
  1078.                 rbuf @ count 0 ?do dup i + c@ dochar loop drop
  1079.                 r> curcol !
  1080.                 r> insmode !
  1081.                 didfind off
  1082.                 szline
  1083.                 szfinda ;
  1084.  
  1085. : szrepl        ( -- )          \ replace text just found
  1086.                 didfind @ 0< ?exit
  1087.                 .edit_info
  1088.                 0 scrfline-at ."  Enter replacement text ->"
  1089.                 rbuf @ count 30 swap #expect span @ rbuf @ c! >text_color
  1090.                 esc_flg @
  1091.                 if      szshow
  1092.                 else    szrepla
  1093.                 then    ;
  1094.  
  1095. : .current      ( -- )
  1096.                 0 scrfline 1- at >stat_color ."  F1-Help  F10-Save/exit │ "
  1097.                 f$ @ count type
  1098.                 fhndl count 60 min type eeol >text_color ;
  1099.  
  1100. : szwrite       ( -- )          \ search
  1101.                 .edit_info
  1102.                 0 scrfline-at ."  Enter NEW name for this file ->"
  1103.                 tib 1+ 30 expect span @ tib c! >text_color
  1104.                 esc_flg @ 0=
  1105.                 if      tib fhndl $>handle      \ change the name
  1106.                         .current
  1107.                         modified on
  1108.                         modifiable on
  1109.                 then    szshow ;
  1110.  
  1111. : canceled?     ( -- f1 )
  1112.                 esc_flg @ tib c@ 0= or ;
  1113.  
  1114. : ?get_dir      ( -- )          \ make and read a directory file if no file
  1115.                                 \ was specified, and we didn't press ESC.
  1116.                 tib c@ 0= esc_flg @ 0= and
  1117.                 if      " DIR *.*>TEMP.DIR" ">$ $sys 0=
  1118.                         if      " TEMP.DIR" tib place
  1119.                                 ?got_dir on
  1120.                         then
  1121.                 then    ;
  1122.  
  1123. : ?dir_del      ( -- )          \ delete the temporary directory file
  1124.                 ?got_dir @
  1125.                 if      " DEL TEMP.DIR" ">$ $sys drop
  1126.                         ?got_dir off
  1127.                 then    ;
  1128.  
  1129. : do_szprint    ( -- )          \ copy current file to printer
  1130.                 " COPY "    tib  place
  1131.                 fhndl count tib +place
  1132.                 "  PRN>NUL" tib +place
  1133.                 tib $sys drop
  1134.                 ^L pemit  ;                     \ send a FORMFEED
  1135.  
  1136. : szprnt        ( -- )          \ print current file
  1137.                 putline getline
  1138.                 szsave 0=               \ saved ok
  1139.                 cursor-off
  1140.                 ?printer.ready and      \ and printer is online
  1141.                 if      0 scrfline-at ."  Printing .... " >text_color
  1142.                         do_szprint
  1143.                 else    0 scrfline-at ."  *** Printer is OFFLINE ***"
  1144.                         >text_color
  1145.                         beep
  1146.                 then    ?cursor-on
  1147.                         szshow ;
  1148.  
  1149. : mark_CRLF's   ( -- )
  1150.                 acrlf tbuf 2- 2dup ! 2- !     \ mark begin with 2*CRLF
  1151.                 acrlf read_end @ ! ;            \ mark end of buf with CRLF
  1152.  
  1153. : %newfile      ( -- )
  1154.                 acrlf tbuf !
  1155.                 2 read_len !
  1156.                 tbuf 2+ read_end !
  1157.                 mark_CRLF's
  1158.                 modifiable on ;
  1159.  
  1160. : tglset        ( f1 -- )       \ set the status line message, and turn
  1161.                                 \ the cursor on or off according to edit
  1162.                                 \ or browse mode.
  1163.                 if      "  Edit MODE "    cursor-on
  1164.                 else    "  Browse MODE "  cursor-off
  1165.                 then    ">$ sm$ ! ;
  1166.  
  1167. : btgl          ( -- )          \ browse/edito mode toggle
  1168.                 modifiable @ 0= dup modifiable !
  1169.                 dup tglset
  1170.                 0= if modified off then ;
  1171.  
  1172. : %szread       ( -- )          \ read the currently open file
  1173.                 fhndl endfile or        \ if file has chars in it
  1174.                 if      seg# @ tbuf_size um* fhndl movepointer
  1175.                         tbuf tbuf_size fhndl hread dup read_len !
  1176.                         tbuf + read_end !
  1177.                         mark_CRLF's
  1178.                 else    %newfile        \ else just put in CRLF
  1179.                 then    fhndl endfile tbuf_size 0 d> 0=
  1180.                 dup tglset modifiable !
  1181.                 fhndl hclose drop ;
  1182.  
  1183. : szread        ( -- )                  \ read the current file
  1184.                 true modifiable !
  1185.                 true tglset
  1186.                 fhndl c@ 0=             \ default to untitled if no file
  1187.                                         \ was specified
  1188.                 if      " UNTITLED" ">$ fhndl $>handle
  1189.                 then    fhndl hopen     \ -- f1
  1190.                 if      %newfile        " NEW File = "
  1191.                 else    %szread         " Edit File = "
  1192.                 then    ">$ f$ !        .current
  1193.                 end>rev
  1194.                 modified off
  1195.                 changed off ;
  1196.  
  1197. : szopen        ( -- )          \ open another file to edit
  1198.                 .edit_info
  1199.                 0 scrfline 2+ at >stat_color 8 spaces
  1200.                 ." [Enter] alone = see a list of files [*.*]" eeol
  1201.                 0 scrfline-at ."  Enter NAME of file to edit ->"
  1202.                 tib 1+ 30 expect span @ tib c! >text_color
  1203.                 ?get_dir
  1204.                 canceled? 0=
  1205.                 if      dosave
  1206.                         tib fhndl $>handle
  1207.                         szread
  1208.                         calc_lines
  1209.                         ?dir_del
  1210.                         .current
  1211.                         gohome up1
  1212.                 then    szshow ;
  1213.  
  1214. : %switch_files ( -- )          \ switch to the other files data space
  1215.                 ds_0 @ ?ds: <>  \ copy stacks from current to other
  1216.                 if      ?ds: $FF00 ds_0 @       over $100 cmovel
  1217.                 else    ?ds: $FF00 over $1000 + over $100 cmovel
  1218.                 then
  1219.                 ds_0 @ file# @L 1+ 2 mod dup
  1220.                 ds_0 @ file# !L         ( -- n1 )
  1221.                                         \ returns number of next file 0 or 1
  1222.                 ds_0 @                  \ first 64k segment
  1223.                 swap $1000 * + ds:! ds:->ss: ;
  1224.  
  1225. : bump_#files   ( -- )
  1226.                 ds_0 @ #files @L 1+ ds_0 @ #files !L  ;
  1227.  
  1228. : seg_copy      ( -- )
  1229.                 0 save!> seg#                           \ clear seg#
  1230.                 save> sseg $1000 sseg +!                \ adj SSEG
  1231.                 ds_0 @ 0 over $1000 + 0 $FFF0 cmovel    \ copy ALL
  1232.                 restore> sseg                           \ restore SSEG
  1233.                 restore> seg#  ;                        \ restore seg#
  1234.  
  1235. : seg_dup       ( -- f1 )       \ duplicate the current segment and return
  1236.                                 \ a true flag if failed
  1237.                 $1000 totmem +!                                 \ bump by 64k
  1238.                 ?cs: totmem @ setblock 0=                       \ adj memory
  1239.                 if      seg_copy
  1240.                         false                                   \ return false
  1241.                 else    beep getline .current szshow
  1242.                         true                                    \ return true
  1243.                 then    ;
  1244.  
  1245. : ofile         ( -- )          \ other file
  1246.                 markflg off
  1247.                 putline
  1248.                 ds_0 @ #files @L        \ leave if more than zero=1 file
  1249.                 if      %switch_files
  1250.                         getline
  1251.                         .current szshow exit
  1252.                 then    $2000 totmem @ u>       \ already allocated?
  1253.                 if      seg_dup ?exit           \ then allocate and dup
  1254.                 then
  1255.                 %switch_files                   \ switch over
  1256.                 szopen                          \ try to open
  1257.                 canceled?                       \ canceled?
  1258.                 if      %switch_files           \ switch back
  1259.                 else    bump_#files             \ incr total
  1260.                 then    getline .current szshow ;
  1261.  
  1262. : %dodone       ( -- )          \ we are done editing, save changes
  1263.                 putline
  1264.                 ds_0 @ #files @L 0=
  1265.                 if      ?not_done off
  1266.                 else    szsave 0=
  1267.                         if      ofile                   \ switch files
  1268.                                 0 ds_0 @ #files !L      \ back to one file
  1269.                         else    beep
  1270.                         then
  1271.                 then    ;
  1272.  
  1273. : dodone        ( -- )          \ we are done editing, save changes
  1274.                 %dodone Q_CMD ;
  1275.  
  1276. : doquit        ( -- )          \ quit editing & discard changes
  1277.                 ds_0 @ #files @L 0=
  1278.                 if      ?not_done off
  1279.                         changed   off
  1280.                         modified  off
  1281.                 else    changed   off
  1282.                         modified  off
  1283.                         ofile
  1284.                         0 ds_0 @ #files !L      \ discard one file
  1285.                 then    Q_CMD ;
  1286.  
  1287. \ ***************************************************************************
  1288. \ exit with save, and pass commands to the calling program in file ZZ.CMD.
  1289.  
  1290. : cmd1          ( -- )  ?cmd if %dodone  1_cmd then ;
  1291. : cmd2          ( -- )  ?cmd if %dodone  2_cmd then ;
  1292. : cmd3          ( -- )  ?cmd if %dodone  3_cmd then ;
  1293. : cmd4          ( -- )  ?cmd if %dodone  4_cmd then ;
  1294. : cmd5          ( -- )  ?cmd if %dodone  5_cmd then ;
  1295. : cmd6          ( -- )  ?cmd if %dodone  6_cmd then ;
  1296. : cmd7          ( -- )  ?cmd if %dodone  7_cmd then ;
  1297. : cmd8          ( -- )  ?cmd if %dodone  8_cmd then ;
  1298. : cmd9          ( -- )  ?cmd if %dodone  9_cmd then ;
  1299. : cmd10         ( -- )  ?cmd if %dodone 10_cmd then ;
  1300. : cmd11         ( -- )  ?cmd if %dodone 11_cmd then ;
  1301. : cmd12         ( -- )  ?cmd if %dodone 12_cmd then ;
  1302. : cmd13         ( -- )  ?cmd if %dodone 13_cmd then ;
  1303. : cmd14         ( -- )  ?cmd if %dodone 14_cmd then ;
  1304. : cmd15         ( -- )  ?cmd if %dodone 15_cmd then ;
  1305. : cmd16         ( -- )  ?cmd if %dodone 16_cmd then ;
  1306. : cmd17         ( -- )  ?cmd if %dodone 17_cmd then ;
  1307. : cmd18         ( -- )  ?cmd if %dodone 18_cmd then ;
  1308.  
  1309.  
  1310. \ ***************************************************************************
  1311.  
  1312. : domark        ( -- )          \ start or end marking of text for
  1313.                                 \ cut or copy.
  1314.                 markflg @ 0=                            \ if not marking
  1315.                 if      currow @ mark1 !                \ then start mark
  1316.                         -1 markflg !
  1317.                         "  Marking " ">$ sm$ !
  1318.                         exit
  1319.                 then    markflg @ 0<                    \ if already started
  1320.                 if      currow @ mark2 !                \ then end marking
  1321.                         1 markflg !
  1322.                         "  Mark is SET " ">$ sm$ !
  1323.                 else    markflg off                     \ else clear mark
  1324.                         mark1 on
  1325.                         mark2 on
  1326.                         modifiable @ tglset
  1327.                 then    szshow ;
  1328.  
  1329. : toline        ( n1 -- )       \ goto the line n1
  1330.                 currow @ over =
  1331.                 if      drop exit then
  1332.                 currow @ over <
  1333.                 if      currow @      ?do <down1> drop loop
  1334.                 else    currow @ swap ?do <up1>        loop
  1335.                 then    ;
  1336.  
  1337. : set_ccpfile   ( -- )
  1338.                 " TEMP" ">$ ccphndl $>handle ;
  1339.  
  1340. : %copy_write   ( -- f1 )
  1341.                 mark1 @ mark2 @ 2dup min toline max 1+
  1342.                 curadr @ swap toline curadr @
  1343.                 ?lastline                       \ if last line, use file-end
  1344.                 if      drop read_end @         \ instead of curadr
  1345.                 then
  1346.                 over - dup>r
  1347.                 ccphndl hwrite r> -
  1348.                 ccphndl hclose or ;
  1349.  
  1350. : %docopy       ( -- f1 )       \ copy marked text while preserving our
  1351.                                 \ current edit location
  1352.                 set_ccpfile
  1353.                 ccphndl hcreate dup ?exit
  1354.                 scradr @ >r
  1355.                 curadr @ >r
  1356.                 scrrow @ >r
  1357.                 currow @ >r             \ save current line
  1358.                 %copy_write or          \ -- f1 = true if error
  1359.                 r> currow !
  1360.                 r> scrrow !
  1361.                 r> curadr !
  1362.                 r> scradr ! ;
  1363.  
  1364. : docopy        ( -- )          \ copy marked lines
  1365.                 markflg @ 0= ?exit              \ leave if not marked
  1366.                 markflg @ 0<
  1367.                 if      domark                  \ finish marking first
  1368.                 then
  1369.                 %docopy 0=
  1370.                 if      domark                  \ clear mark
  1371.                 else    beep                    \ beep on error
  1372.                 then    szshow ;
  1373.  
  1374. : %docut        ( -- )          \ cut the marked lines
  1375.                 mark1 @ mark2 @ 2dup min toline - abs 1+ 0
  1376.                 ?do     %ldel
  1377.                 loop    ;
  1378.  
  1379.  
  1380. : docut         ( -- )          \ cut marked lines
  1381.                 modifiable @ 0= if beep exit then
  1382.                 markflg @ 0= ?exit              \ leave if not marked
  1383.                 markflg @ 0<
  1384.                 if      domark                  \ finish marking first
  1385.                 then
  1386.                 %docopy 0=
  1387.                 if      %docut
  1388.                         domark
  1389.                 then    szshow ;
  1390.  
  1391. : %read_paste   ( d1 -- )               \ d1 = len to read
  1392.                 0 0 ccphndl movepointer \ move back to file beginning
  1393.                 drop >r                 \ low part of length < 64k
  1394.                 curadr @ dup r@ +               \ cur cur+dif
  1395.                 read_end @ curadr @ -           \ rem_len
  1396.                 cmove>                          \ move the data
  1397.                 curadr @ r>                     \ dat olen dif
  1398.                 ccphndl hread dup
  1399.                 read_len +!                     \ adj file length
  1400.                 read_end +! ;                   \ & end address
  1401.  
  1402. : dopaste       ( -- )          \ paste text into file
  1403.                 modifiable @ 0= if beep exit then
  1404.                 putline
  1405.                 set_ccpfile
  1406.                 ccphndl hopen
  1407.                 if      getline
  1408.                         beep exit
  1409.                 then
  1410.                 currow @ >r
  1411.                 ccphndl endfile 2dup            \ get file length
  1412.                 tbuf_end @ read_end @ - 0 d<    \ compare against available
  1413.                 if      %read_paste
  1414.                         calc_lines
  1415.                         %gohome
  1416.                         modified on             \ we have changed the file
  1417.                         r> down_lines
  1418.                 else    2drop r>drop
  1419.                         beep
  1420.                 then
  1421.                 ccphndl hclose drop
  1422.                 getline
  1423.                 szshow ;
  1424.  
  1425. : nseg          ( -- )          \ display next segment in file ~64k segments
  1426.                 seg# @ 1+ seg# !
  1427.                 szread
  1428.                 modifiable on btgl
  1429.                 calc_lines
  1430.                 gohome up1
  1431.                 0 scrfline at showbottom szshow ;
  1432.  
  1433. : pseg          ( -- )          \ previous segment in file ~64k segments
  1434.                 seg# @ 1- 0max seg# !
  1435.                 szread
  1436.                 modifiable on btgl
  1437.                 calc_lines
  1438.                 gohome szshow ;
  1439.  
  1440. : dodos         ( -- )          \ spawn a DOS shell after allowing the entry
  1441.                                 \ of a command line.
  1442.                 0 statline-at
  1443.                 ."  Enter a command line->" at? eeol at
  1444.                 dbuf @ count 80 swap #expect span @ dbuf @ c! >text_color
  1445.                 esc_flg @
  1446.                 if      end>rev
  1447.                         szshow exit     \ leave if user canceled
  1448.                 then
  1449.                 dark dbuf @ $sys drop
  1450.                 at? at                  \ re-init current cursor position
  1451.                 dbuf @ c@               \ if command line was empty,
  1452.                                         \ return without prompting
  1453.                 if      cr >end_color
  1454.                         ."  *** Press a key to continue editing ***"
  1455.                         >text_color cr
  1456.                         key drop
  1457.                 then    dark
  1458.                 instgl instgl
  1459.                 .current end>rev szstatus szshow ;
  1460.  
  1461. : dohelp2       ( -- )          \ display second help screen
  1462.  
  1463.                 0 scrfline 1- at erase_below
  1464.                 0 scrfline 1- at
  1465. cr >end_color
  1466.    ."  SZ was written by Tom Zimmer as an example TCOM application (Public Domain)."
  1467. cr ."  TCOM is a Forth Target COMpiler written by Tom Zimmer. Call - (408) 263-8859"
  1468. cr
  1469. cr ."  The development environment used to create SZ is available for $60.00 from:"
  1470. cr
  1471. cr ."        Tom Zimmer
  1472. cr ."        292 Falcato Drive"
  1473. cr ."        Milpitas, Ca. 95035"
  1474. cr
  1475. >text_color
  1476. cr ."             Control Function Keys              ┌────────────────────────────┐"
  1477. cr ."      ^F1│View compile msgs ^F2│Execute prog    │The operation of the Control│"
  1478. cr ."      ^F3│Compile optimized ^F4│Edit ZZ.CFG     │function keys at left is    │"
  1479. cr ."      ^F5│Review ERRORS     ^F6│<not defined>   │set in the file ZZ.CFG. See │"
  1480. cr ."      ^F7│<not defined>     ^F8│<not defined>   │the file ZZ.TXT for more    │"
  1481. cr ."      ^F9│<not defined>    ^F10│<not defined>   │information on these keys.  │"
  1482. cr 47 spaces                                      ." └────────────────────────────┘"
  1483. cr cr
  1484. >end_color
  1485. cr ."  ╔═ Press a key to continue editing ═╗  Maximum file size   ^ = Control"
  1486. cr ."  ╚═══════════════════════════════════╝  ~60000 characters"
  1487. cr ."  Use /B on the DOS command line to start the editor in browse mode."
  1488. cr ."  Use the format: SZ <filename> <row> <column>  to specify a starting location."
  1489. cr ."  If EDIT MODE below is the same color as this line, then file has been changed."
  1490.                 >text_color
  1491.                 key drop ;
  1492.  
  1493. : dohelp        ( -- )          \ display a help screen
  1494.                 putline getline
  1495.                 cursor-off
  1496.                 0 scrfline 1- at erase_below
  1497.                 0 scrfline 1- at
  1498. cr >end_color
  1499.    ."  SZ was written by Tom Zimmer as an example TCOM application (Public Domain)."
  1500. cr ."  TCOM is a Forth Target COMpiler written by Tom Zimmer. Call - (408) 263-8859"
  1501. >text_color
  1502. cr ."   ESC/F1│this HELP scrn     F2│screen Top       alt-F2│Browse prev 60k segment"
  1503. cr ."       F3│Mark start/end     F4│screen Bottom    alt-F4│Browse next 60k segment"
  1504. cr ."       F5│compile  <<────┐   F6│Search  new      alt-F6│Find    again same"
  1505. cr ."       F7│debug    <<────┤   F8│Replace new      alt-F8│replace again same"
  1506. cr ."       F9│ [ see ZZ.TXT ]┘  F10│Save & exit     alt-F10│Discard current file"
  1507. cr ."     Home│To line start    PgUp│Page up           alt-O│Open/switch 2nd file"
  1508. cr ."      End│To line end      Pgdn│Page down         alt-P│Print current file"
  1509. cr ."      Ins│Insert toggle     Del│Delete char       alt-W│Write as NEW filename"
  1510. cr ."      TAB│spaces to TAB                           alt-X│Cut   marked text (F3)"
  1511. cr ."    ^Home│File strt       ^PgUp│Scroll up         alt-C│Copy  marked text (F3)"
  1512. cr ."     ^End│File end        ^PgDn│Scroll down       alt-V│Paste cut/copied text"
  1513. cr ."       ^A│Word left          ^F│Word right        alt-T│Adjust TAB increment"
  1514. cr ."       ^G│Char delete        ^T│word delete       alt-A│Enter ANY character"
  1515. cr ."       ^Y│Line delete        ^U│Update disk   Shift-TAB│back to previous TAB"
  1516. cr ."       ^L│Ins page break-    ^O│Open a file    Shift-F9│Browse/Edit mode toggle"
  1517. cr ."   ^Enter│DOS command        ^Q│save & Quit   Shift-F10│Save & exit"
  1518. >end_color
  1519. cr ."  ╔═   Press any key for MORE HELP   ═╗  Maximum file size   ^ = Control"
  1520. cr ."  ╚═══════════════════════════════════╝  ~60000 characters"
  1521. cr ."  Use /B on the DOS command line to start the editor in browse mode."
  1522. cr ."  Use the format: SZ <filename> <row> <column>  to specify a starting location."
  1523. cr ."  If EDIT MODE below is the same color as this line, then file has been changed."
  1524.                 >text_color
  1525.                 key drop
  1526.                 dohelp2
  1527.                 ?cursor-on
  1528.                 szshow ;
  1529.  
  1530. : dofnc         ( c1 -- )       \ handle function characters
  1531.                 255 min 126 - 0max exec:
  1532. \       err     CBS Control Backspace
  1533.         kerr    fdel
  1534. \       A-9     A-0     A -     A =     CPGUP   133     134     135
  1535.         cmd9    cmd10   kerr    kerr    scrlup  kerr    kerr    kerr
  1536. \       136     137     138     139     140     141     142     BACKTAB
  1537.         kerr    kerr    kerr    kerr    kerr    kerr    kerr    btab
  1538. \       A-Q     A-W     A-E     A-R     A-T     A-Y     A-U     A-I
  1539.         kerr    szwrite kerr    kerr    settab  kerr    kerr    kerr
  1540. \       A-O     A-P     154     155     156     157     A-A     A-S
  1541.         ofile   szprnt  kerr    kerr    kerr    kerr    doachar kerr
  1542. \       A-D     A-F     A-G     A-H     A-J     A-K     A-L     167
  1543.         kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  1544. \       168     169     170     171     A-Z     A-X     A-C     A-V
  1545.         kerr    kerr    kerr    kerr    kerr    docut   docopy  dopaste
  1546. \       A-B     A-N     A-M     179     180     181     182     183
  1547.         kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  1548. \       184     185     186     F1      F2      F3      F4      F5
  1549.         kerr    kerr    kerr    dohelp  scrtop  domark  scrbot  cmd5
  1550. \       F6      F7      F8      F9      F10     197     198     HOME
  1551.         szfind  cmd7    szrepl  cmd9    dodone  kerr    kerr    homeln
  1552. \       UP      PgUp    202     LEFT    204     RIGHT   206     END
  1553.         up1     uppage  kerr    left    kerr    right1  kerr    endln
  1554. \       DOWN    PgDn    INS     DEL     SF1     SF2     SF3     SF4
  1555.         down1   downpg  instgl  fdel    cmd11   cmd12   cmd13   cmd14
  1556. \       SF5     SF6     SF7     SF8     SF9     SF10    CF1     CF2
  1557.         cmd15   cmd16   cmd17   cmd18   btgl    dodone  cmd1    cmd2
  1558. \       CF3     CF4     CF5     CF6     CF7     CF8     CF9     CF10
  1559.         cmd3    cmd4    doerrs  cmd6    cmd7    cmd8    cmd9    cmd10
  1560. \       AF1     AF2     AF3     AF4     AF5     AF6     AF7     AF8
  1561.         ofile   pseg    kerr    nseg    doerrs  szfinda kerr    szrepla
  1562. \       AF9     AF10    242     CLEFT   CRIGHT  CEND    CPGDN   CHOME
  1563.         kerr    doquit  kerr    wleft   wright  goend   scrldn  gohome
  1564. \       A-1     A-2     A-3     A-4     A-5     A-6     A-7     A-8
  1565.         cmd1    cmd2    cmd3    cmd4    cmd5    cmd6    cmd7    cmd8 ;
  1566.  
  1567. : doctrl        ( c1 -- )       \ handle control characters
  1568.                 exec:
  1569. \       0       1 A     2 B     3 C     4 D     5 E     6 F     7 G
  1570.         kerr    wleft   kerr    downpg  right1  up1     wright  fdel
  1571. \       8 H     9 TAB   10 J    11 K    12 L    13 M    14 N    15 O
  1572.         bdel    dotab   dodos   kerr    inspage doenter kerr    szopen
  1573. \       16 P    17 Q    18 R    19 S    20 T    21 U    22 V    23 W
  1574.         kerr    dodone  uppage  left    wdel    dosave  kerr    scrlup
  1575. \       24 X    25 Y    26 Z    27 ESC  28      29      30      31
  1576.         down1   ldel    scrldn  dohelp  kerr    kerr    kerr    kerr ;
  1577.  
  1578. : dokey         ( c1 -- )       \ process the key c1, and
  1579.                                 \ display results
  1580.                 dup 32 126 between if   dochar exit    then
  1581.                 dup    126       > if   dofnc  exit    then
  1582.                                         doctrl ;
  1583.  
  1584. : szedit        ( -- )          \ Edit the current file in memory
  1585.                 getline                 \ get line we are starting on
  1586.                 szshow                  \ show the screen
  1587.                 szline                  \ show current line
  1588.                 szstatus                \ show status info
  1589.                 szcursor                \ show edit cursor
  1590.                 ?not_done on            \ flag as not done yet
  1591.                 begin   key             \ get a key
  1592.                         dokey           \ process the key
  1593.                         ?not_done @     \ done yet?
  1594.                 while   szline          \ show line
  1595.                         szstatus        \ show status info
  1596.                         szcursor        \ show cursor
  1597.                 repeat  putline ;       \ save line changes
  1598.  
  1599. : fname>pad     ( -- a1 )               \ get string to a text pad
  1600. \ ***************************************************************************
  1601. \ If we are target compiling, start WORD at the beginning of the line.
  1602. \ ***************************************************************************
  1603. \U TARGET-INIT  >in off                 \ only if we are targeting
  1604.                 bl word ;
  1605.  
  1606. : ?st_browse    ( -- )          \ do we want to start in browse mode?
  1607.                 >in @ >r
  1608.                 bl word 1+ @
  1609.                 dup  $422F ( /B ) =
  1610.                 swap $622F ( /b ) = or
  1611.                 if      modifiable off
  1612.                         false tglset
  1613.                         r>drop exit
  1614.                 then    r> >in ! ;
  1615.  
  1616. : ?ex_cmd       ( -- )          \ do we want to exit with a command byte?
  1617.                 off> ?cmd
  1618.                 >in @ >r
  1619.                 bl word 1+ @
  1620.                 dup  $432F ( /C ) =             \       /CMD or
  1621.                 swap $632F ( /c ) = or          \       /cmd
  1622.                 if      on> ?cmd
  1623.                         get_MSG_file
  1624.                         process_msgs
  1625.                         doerrs
  1626.                         r>drop exit
  1627.                 then    r> >in ! ;
  1628.  
  1629. : ?line/col     ( -- )          \ do we want to start at line/column
  1630.                 >in @ >r
  1631.                 bl word number? 0= if 2drop r> >in ! exit then drop
  1632.                 1- 0max down_lines
  1633.                 r>drop >in @ >r
  1634.                 bl word number? 0= if 2drop r> >in ! exit then drop
  1635.                 1- 0max dup curcol ! ?soff!
  1636.                 r>drop ;
  1637.  
  1638. : szinit        ( -- )                  \ small Z editor initialization
  1639.                 ?ds: ds_0 !                     \ init DSEG zero
  1640.                 color_init                      \ init attrib vars for screen
  1641.                 >text_color                     \ normal text color output
  1642.                 inserting on                    \ default to Insert mode
  1643.                 8 tsize !                       \ default tabs to 8 chars
  1644.                 markflg off                     \ marking is off
  1645.                 -1 mark1 !                      \ no valid mark start
  1646.                 -1 mark2 !                      \ no valid mark end
  1647.                 -1 didfind !                    \ mark as no text found
  1648.                 seg# off                        \ current segment is zero
  1649.                 curcol off                      \ first column of
  1650.                 currow off                      \ first row
  1651.                 soff off                        \ left edge offset is zero
  1652.                 fullflag off                    \ memory is not full yet
  1653.                 scrfline scrrow !               \ start displaying at scr top
  1654.              32 ds:alloc dup off sbuf !         \ search string buffer
  1655.              32 ds:alloc dup off rbuf !         \ replace string buffer
  1656.              64 ds:alloc dup off dbuf !         \ DOS command line buffer
  1657.         msg_max ds:alloc dup off =: msg_buf     \ message buffer
  1658.           lbsiz ds:alloc dup off =: lbuf        \ line buffer
  1659.           b/hcb ds:alloc dup off =: fhndl       \ main file handle
  1660.           b/hcb ds:alloc dup off =: ccphndl     \ cut copy paste handle
  1661.  ds:free? 300 - ds:alloc =: tbuf                \ initialize text buffer with
  1662.                                                 \ all remaining ram
  1663.              10 ds:alloc tbuf_end !             \ initialize text buffer end
  1664.                 tbuf curadr !                   \ init current line addr ptr
  1665.                 tbuf scradr !                   \ and screen top line addr ptr
  1666.                 lbuf lbsiz blank                \ init LBUF to all spaces
  1667.                 insmode off instgl              \ start in insert mode
  1668.                 ;
  1669.  
  1670. : sz            ( -- )          \ top level editor application
  1671.                 szinit                                  \ init most variable
  1672.                 fname>pad fhndl $>handle                \ get filename
  1673.                 fhndl 1+ c@ '/' =                       \ if no filename
  1674.                 if      fhndl off >in off               \ reset to beginning
  1675.                 then                                    \ of line
  1676.                 szread                                  \ read in the file
  1677.                 calc_lines                              \ calculate # lines
  1678.                 ?st_browse                              \ ? browse mode
  1679.                 ?line/col                               \ starting line/col
  1680.                 ?st_browse                              \ ?browse mode again
  1681.                 ?ex_cmd                                 \ exit with command
  1682.                 begin   szedit                          \ enter editor
  1683.                         dos_prep                        \ prepare for save
  1684.                         szsave 0= dup                   \ save if needed
  1685.                         if      ds_0 @ #files @L 0 <>   \ more than one file
  1686.                                 if      drop            \ discard prev bool
  1687.                                         ofile           \ then switch files
  1688.                                         szsave 0=       \ save it to
  1689.                                 then
  1690.                         then
  1691.                 until                                   \ if we didn't cancel
  1692.                 szshow                                  \ final show screen
  1693.                 szstatus
  1694.                 cursor-on                               \ turn cursor on
  1695.                 norm-cursor                             \ rest cursor shape
  1696.                 ?cmd
  1697.                 if      0 statline 1+ 2dup at >text_color eeol at
  1698.                 else    0 statline at >text_color .by eeol \ erase last line
  1699.                 then    ;                                  \ and leave
  1700.  
  1701. FORTH DECIMAL
  1702. DEFINED TARGET-INIT NIP #IF     \ Test for whether we are target compiling
  1703.  
  1704. \ ***************************************************************************
  1705. \ If we are compiling with the TARGET compiler, then do these things.
  1706. \ ***************************************************************************
  1707.  
  1708. TARGET
  1709.  
  1710. : MAIN          ( -- )
  1711.                 DECIMAL                         \ always select decimal
  1712.                 INIT-CURSOR                     \ get intial cursor shape
  1713.                 CAPS ON                         \ ignore cAsE
  1714.                 ?DS: SSEG !                     \ init search segment
  1715.                 $FFF0 SET_MEMORY                \ default to 64k code space
  1716.                 ?ds: ?cs: - $1000 + totmem !    \ save segments used
  1717.                 DOS_TO_TIB                      \ move command tail to TIB
  1718.                 COMSPEC_INIT                    \ init command specification
  1719.                 VMODE.SET                       \ initialize video display
  1720.                 SZ ;            \ call the real start of the program
  1721.  
  1722. #THEN
  1723.  
  1724. }
  1725.  
  1726.