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