home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / EDITSTUF.SEQ < prev    next >
Encoding:
Text File  |  1989-08-17  |  7.8 KB  |  196 lines
  1. \ EDITSTUF.SEQ  Stuff needed by the editor              by Tom Zimmer
  2.  
  3. only forth also definitions
  4. vocabulary editor
  5. editor definitions also hidden also
  6.  
  7. 0 value tsegb           \ text segment beginning for current file
  8. 0 value lseg            \ linelist save segment
  9. 0 value dseg            \ delete lines segment
  10. 0 value #edsegs         \ number of edit buffer segments
  11. 0 value maxsegs         \ maximum segments available
  12. 0 value baseseg         \ bottom of allocated segment space
  13. 0 value hseg            \ hyper or help seg
  14. 0 value toff
  15. 0 value tend
  16. 0 value linesave        \ a place to save the screen line
  17. 0 value screenline      \ current screen line
  18. 0 value lastline        \ last valid line in file.
  19. 0 value rmmax           \ right margin max for current doc
  20. 0 value rmset?          \ are we setting the right margin?
  21. 0 value ?browse         \ are we currently in browse mode?
  22. 0 value winoff          \ window horizontal scrolling offset
  23. 0 value read-from       \ start reading file at READ-FROM line
  24. 0 value newfl           \ was new file created?
  25. 0 value edready         \ ready to edit, we have a file, and can enter
  26.                         \ editor on it, with no problem.
  27. 0 value seding          \ are we in the SED editor
  28. 0 value backing-out     \ flag true if we are poping out of an edit
  29.  
  30. 0 value backingup
  31. 0 value renaming        \ are we keeping backup files?
  32.  TRUE =: renaming
  33. 0 value scrline         \ target screen edit line
  34.  
  35. handle ed1hndl          \ the file we are editing
  36. handle ed2hndl          \ a work handle
  37.  
  38. 2variable currentsize   \ size of the current file on disk in
  39.                         \ 128 byte sectors.
  40.  
  41. : .ed1hndl      ( --- )
  42.                 ed1hndl count type ;
  43.  
  44. \ For the largest window possible, set these values to those values shown
  45. \ to the right in the comments.
  46.  
  47.     1      value first.textline         \  1
  48.    23      value last.textline          \ 23
  49.     1      value first.textcol          \  0
  50.    78      value last.textcol           \ 80
  51.  
  52. : seginit       ( --- )
  53.                 defers initstuff
  54.                 0.0 currentsize 2!
  55.                 off> tsegb off> hseg
  56.                 off> lseg  off> dseg
  57.                 rows 2- =: last.textline
  58.                 cols 2- =: last.textcol ;
  59.  
  60. ' seginit is initstuff
  61.  
  62.  2000      constant writelim    \ write buffer full limit
  63.   132      constant mxlln       \ maximum line length
  64.     0      value maxlines       \ maximum number of edit file lines
  65.                                 \ dynamically adjusted to memory
  66.   100      value maxdline       \ number of saved deleted lines
  67.                                 \ adjusted down to 20 if low on memory
  68.  
  69.    20      constant maxh        \ maximum edit nest depth
  70. b/hcb 8 +  constant b/hstk      \ bytes per hyper stack entry
  71.  
  72. \   0      value screenchar     \ ********** moved to SEQREAD.SEQ ******
  73.     0      value curline
  74.     0      value wseg           \ the write buffer segment
  75.     0      value wblen          \ write buffer length
  76.                                 \ n1 = edit file line number
  77.  
  78. : memabort      ( n1 --- )
  79.                 8 = abort" Could not allocate memory for Editor" ;
  80.  
  81. : tbuf.init     ( --- )         \ Allocate the edit buffers.
  82.         tsegb 0=
  83.         if      -1 alloc 2drop          \ Consume all available memory
  84.  
  85. \ We MAY want to preserve enough memory to prevent the transient part of
  86. \   COMMAND.COM from being over written by the editor. If we do save 24k
  87. \   then DOS won't have to re-read COMMAND.COM back in when we leave,
  88. \   which saves time when returning to DOS.
  89.  
  90.                 1800 -  ( 24k )         \ enough for COMMAND.COM transient
  91.  
  92. \ But NOT RIGHT NOW. We only want to preserve enough for the additional
  93. \ needs of things like the window file selection mechanism.
  94.  
  95. \               700 -   ( 11k )         \ only enough for my needs
  96.  
  97.                 0max =: maxsegs         \ largest amount we will try to use.
  98.                 maxsegs 2/ =: maxlines  \ adjust lines to memory available
  99.                 maxsegs 3000 <          \ if avail. memory less than 48k
  100.                 if      20              \ only allow save of 20 deleted lines
  101.                 else    100 then =: maxdline
  102.                 maxsegs
  103.                 maxlines      2* paragraph 1+
  104.                 maxdline mxlln * paragraph 1+ +
  105.                 writelim 256 +   paragraph +
  106.                 maxh b/hstk *    paragraph +
  107.                 1024 + <                \ HAVE to HAVE at least 16k or
  108.                                         \ cmove-segs won't work properly
  109.                 if      8 memabort      \ force an error
  110.                 then
  111.                 maxsegs alloc memabort nip =: baseseg
  112.                 baseseg
  113.                 dup =: hseg     maxh b/hstk *    paragraph 1+ +
  114.                 dup =: lseg     maxlines      2* paragraph 1+ + \ ptr table
  115.                 dup =: dseg     maxdline mxlln * paragraph 1+ + \ delete buf
  116.                 dup =: wseg     writelim 256 +   paragraph +    \ write buf
  117.                 dup =: tsegb                                    \ text buffer
  118.                 baseseg - maxsegs swap - 10 -   =: #edsegs      \ edit size
  119.         then    ;
  120.  
  121. 0 value hdepth
  122. 0 value browselevel
  123.  
  124. : ed1>hstack    ( --- )         \ move the current edit handle to the
  125.                                 \ handle save stack
  126.                 hseg 0= ?exit
  127.                 hdepth maxh <
  128.                 if      ?cs: ed1hndl   hseg b/hstk hdepth *   b/hcb   cmovel
  129.                         hseg hdepth b/hstk * b/hcb + 2>r
  130.                         loadline @ 2r@     !L
  131.                         screenchar 2r@ 2+  !L
  132.                         ?browse    2r@ 4 + !L
  133.                         linesave   2r> 6 + !L
  134.                         incr> hdepth
  135.                         incr> browselevel
  136.                 then    ;
  137.  
  138. : hstack>ed1    ( --- )         \ move the top handle from the handle
  139.                                 \ save stack back to the edit handle
  140.                 hseg 0= ?exit
  141.                 decr> browselevel
  142.                 hdepth 1- 0MAX =: hdepth
  143.                 hseg b/hstk hdepth *   ?cs: ed1hndl   b/hcb   cmovel
  144.                 hseg hdepth b/hstk * b/hcb +
  145.                    2dup @L    loadline !
  146.                 2+ 2dup @L =: screenchar
  147.                 2+ 2dup @L =: ?browse
  148.                 2+      @L =: scrline ;
  149.  
  150. \ : hswap         ( --- )         \ Swap top two handle stack entries.
  151. \               hdepth 2 < ?exit
  152. \               hseg b/hstk hdepth 1- * hseg b/hstk hdepth    * b/hstk cmovel
  153. \               hseg b/hstk hdepth 2- * hseg b/hstk hdepth 1- * b/hstk cmovel
  154. \               hseg b/hstk hdepth    * hseg b/hstk hdepth 2- * b/hstk cmovel
  155. \               ;
  156.  
  157. : hrotate       ( --- )         \ rotate the handle stack.
  158.                 hseg 0      hseg b/hstk hdepth * b/hstk cmovel
  159.                 hseg b/hstk hseg 0      b/hstk hdepth * cmovel ;
  160.  
  161. : ?hstack       ( --- f1 )      \ return true if room on hstack
  162.                 hdepth maxh < ;
  163.  
  164. defer edinit            ' tbuf.init is edinit   \ Allocate the editor space
  165.  
  166. : edcr          ( --- )         \ CR for the editor subscreen scroll.
  167.                 last.textline rows 4 - >
  168.                 if      ['] crlf is cr          \ unlink this word from CR
  169.                         crlf                    \ do a real CR
  170.                 else    0 last.textline 2+ at
  171.                         -line 0 rows 1- at
  172.                 then    ;
  173.  
  174. : edscroll-on   ( --- )
  175.                 ['] edcr is cr ;
  176.  
  177. defer edscroll          ' edscroll-on is edscroll       \ setup scrolling
  178.  
  179. forth definitions
  180.  
  181. : done          ( --- )
  182.                 ['] crlf is cr ;
  183.  
  184. : nobackup      ( --- )
  185.                 off> backingup ;
  186.  
  187. ' nobackup alias backupoff
  188.  
  189. : backupon      ( --- )
  190.                 on> backingup ;
  191.  
  192. backupon        \ default to auto backup of data
  193.  
  194. forth definitions
  195.  
  196.