home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / TOPEDIT.SEQ < prev    next >
Encoding:
Text File  |  1989-07-21  |  10.3 KB  |  280 lines
  1. \ TOPEDIT.SEQ   Memory edit.                            By Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   Memory edit, allows reentering the editor without having to re-read
  6. the edit file from disk. This results in a much faster turn around time
  7. for development.  Changes made during an edit will still be saved at
  8. the end of each edit session.
  9.  
  10. comment;
  11.  
  12. editor definitions
  13.  
  14. handle memfile
  15.  
  16. : ?readfile     ( --- )
  17.                 newfl ?exit   \ don't try to read if its a new file
  18.                 edinit
  19.                 ed1hndl memfile over c@ 1+ caps-comp \ if file not the same
  20.                 edready 0= or                      \ or editor not ready
  21.                 if      read-write
  22.                         ed1hndl hopen dup          \ try to open read-write
  23.                                                    \ if it fails, then try
  24.                         if      drop               \ read-only
  25.                                 read-only          \ open for reading
  26.                                 ed1hndl hopen      \ try to open the file
  27.                                 dup 0=             \ if it did, use browse
  28.                                                    \ mode, as it's read-only
  29.                                 if      on> ?browse
  30.                                 then
  31.                         then
  32.                         abort" Can't open file!"   \ abort if can't
  33.                         toggling 0=   \ make file switch as fast as possible!
  34.                         if      savecursor         \ save cursor position
  35.                                 savescr
  36.                                 15 8 65 12 box&fill bcr
  37.                                 ."  \1 Reading " space .ed1hndl
  38.                                 read.oldfile       \ read the file
  39.                                 3 tenths
  40.                                 restscr
  41.                                 restcursor         \ restore cursor position
  42.                         else    off> toggling
  43.                                 read.oldfile
  44.                         then
  45.                         ed1hndl memfile $>handle   \ copy to memfile
  46.                         ed1hndl hclose drop        \ close it
  47.                         sinit                      \ init mem structure
  48.                         on> edready                \ say everything ready
  49.                 then    ;
  50.  
  51. : cold-edinit        ( --- )
  52.                 defers initstuff
  53.                 memfile clr-hcb
  54.                 off> edready ;
  55.  
  56. ' cold-edinit is initstuff
  57.  
  58. forth definitions
  59.  
  60. : push/pop-level ( --- f1 )     \ push or pop a level on the edit nest stack
  61.                 leavesave
  62.                 if      leavesave 0>
  63.                         hdepth maxh < or
  64.                         if      leavesave 0<            \ push if -1
  65.                                 if      ed1>hstack
  66.                                 then
  67.                                 off> newfl              \ NOT a new file
  68.                                 hndlsave ed1hndl $>handle
  69.                                 listsave loadline !
  70.                                 off> screenchar
  71.                                 newbrowse =: ?browse
  72.                         else    cursor-off
  73.                                 22 6 58 10 box&fill bcr
  74.                                 ."   Link/Edit NEST LIMIT reached!"
  75.                                 beep 1 seconds cursor-on
  76.                         then    false           \ nest one
  77.                         off> leavesave
  78.                 else    hdepth
  79.                         if      hstack>ed1      \ popup one
  80.                                 hdepth 0= =: ?warnexit
  81.                                 on> backing-out \ we are poping 1 lvl
  82.                                 false
  83.                         else    true            \ at stack bottom
  84.                                 on> ?warnexit
  85.                         then
  86.                 then
  87.                 ?browse                         \ select the proper type
  88.                 if      ['] hypertypeL is typeL
  89.                 else    ?dosio
  90.                         if      ['] (typeL)        is typeL
  91.                         else    (lit) defers typeL is typeL
  92.                         then
  93.                 then    ;
  94.  
  95. : <red>         ( --- )
  96.                 savescr
  97.                 ?browse                         \ select the proper type
  98.                 if      ['] hypertypeL is typeL
  99.                 else    ?dosio
  100.                         if      ['] (typeL)        is typeL
  101.                         else    (lit) defers typeL is typeL
  102.                         then
  103.                 then
  104.                 on> ?warnexit
  105.                 off> hdepth                     \ clear handle stack
  106.                 off> backing-out                \ not backing out of edit
  107.                 backingup =: renaming
  108.                 begin   ?readfile
  109.                         backing-out 0=          \ only set screen line of new
  110.                                                 \ entry, not on returning
  111.                         if      newfl   0=      \ if its not a newfile
  112.                                 ?browse 0= and  \ and we aren't browsing
  113.                                 if      7
  114.                                 else    1
  115.                                 then    first.textline + =: scrline
  116.                         then    off> backing-out
  117.                         reedit
  118.                         ed1hndl memfile $>handle
  119.                         pop-extra
  120.                         if      begin   hdepth 0>
  121.                                 while   hstack>ed1      \ popup one
  122.                                 repeat
  123.                                 off> pop-extra
  124.                         then    push/pop-level
  125.                 until   off> ?browse
  126.                 ?dosio
  127.                 if      ['] (type)        is type
  128.                 else    (lit) defers type is type
  129.                 then
  130.                 cr ;
  131.  
  132. : <ed>          ( --- )         \ Redefined to work from memory.
  133.                 seding  0=
  134.                 if      ?fileopen
  135.                 then
  136.                 seqhandle hclose drop           \ close current file
  137.                 seqhandle ed1hndl $>handle      \ copy file to edit handle
  138.                 <red>
  139.                 seqhandle hopen drop            \ open current file
  140.                 ;
  141.  
  142. : file-line_view ( n1 a1 --- )
  143.                 $file 0=
  144.                 if      loadline !
  145.                         <ed>
  146.                 else    drop
  147.                         savecursor
  148.                         savescr
  149.                         cursor-off
  150.                         15 8 65 12 box&fill
  151.                         bcr ."   \4 Couldn't locate " >attrib4 .seqhandle
  152.                         62 #out @ - spaces >norm
  153.                         beep 15 tenths
  154.                         cursor-on
  155.                         restscr
  156.                         restcursor
  157.                 then ;
  158.  
  159. : cfa_view      ( a1 --- )
  160.                 >viewfile
  161.                 file-line_view ;
  162.  
  163. : view          ( | <word> --- )
  164.                 on> newbrowse
  165.                 on> ?browse
  166.                 off> seding
  167.                 off> newfl
  168.                 >in @ bl word swap >in ! c@
  169.                 if      bl word hfind 0= ?missing
  170.                         cfa_view
  171.                 else    <ed>
  172.                 then    ;
  173.  
  174. ' view   alias browse
  175. ' view   alias b
  176. ' view   alias v
  177. ' view   alias l
  178. ' view   alias LL
  179.  
  180. : ed            ( | word --- )
  181.                 off> newbrowse
  182.                 off> ?browse
  183.                 off> seding
  184.                 off> newfl
  185.                 >in @ bl word swap >in ! c@
  186.                 if      bl word hfind 0= ?missing
  187.                         cfa_view
  188.                 else    <ed>
  189.                 then    ;
  190.  
  191. ' ed is editfile
  192. ' ed alias e            \ an alias meaning Edit a word
  193.  
  194. : help          ( | <name> --- )
  195.                 on> newbrowse
  196.                 on> ?browse
  197.                 off> seding
  198.                 off> newfl
  199.                 >in @ bl word swap >in ! c@
  200.                 if      here helpbuf over c@ 2+ cmove
  201.                         bl word hfind 0= ?missing
  202.                         >viewfile                     \ -- offset a1
  203.                         " HLP" ">$ over $>ext
  204.                         $file 0=
  205.                         if      drop
  206.                                 findword
  207.                                 if      <ed>
  208.                                 then
  209.                         else    drop
  210.                         then
  211.                 else    dofhelp
  212.                 then    ;
  213.  
  214.  
  215. ' help alias h
  216.  
  217. : edit          ( n1 --- )
  218.                 off> newbrowse
  219.                 off> ?browse
  220.                 off> seding
  221.                 off> newfl
  222.                 1 ?enough =: loadline
  223.                 <ed> ;
  224.  
  225. : list          ( n1 --- )
  226.                 on> newbrowse
  227.                 on> ?browse
  228.                 off> seding
  229.                 off> newfl
  230.                 1 ?enough =: loadline
  231.                 <ed> ;
  232.  
  233. : viewfrom      ( n1 --- )              \ browse starting after line n1
  234.                 1 ?enough               \ need a parameter
  235.                 =: read-from            \ skips (doesn't read) n1 lines
  236.                 1 list ;                \ of the current file
  237.  
  238. ' viewfrom alias vf
  239.  
  240. : autosaveon    ( --- )                 \ turn ON automatic save on idle
  241.                 on> autosaving? ;
  242.  
  243. : autosaveoff   ( --- )                 \ turn OFF automatic save on idle
  244.                 off> autosaving? ;
  245.  
  246. : unedit        ( --- )         \ de-allocate the memory taken by SED
  247.                 tsegb 0= ?exit
  248.                 baseseg dealloc
  249.                 abort" Failed to properly deallocate edit buffers."
  250.                 off> tsegb
  251.                 off> lseg
  252.                 off> dseg
  253.                 off> baseseg
  254.                 off> maxsegs
  255.                 off> #edsegs
  256.                 off> edready
  257.                 off> ldel.cnt
  258.                 memfile clr-hcb ;
  259.  
  260. ' unedit is clearmem
  261.  
  262. defined elisting nip #if                \ only load if printing loaded
  263.  
  264. : listing       ( --- )
  265.                 decimal
  266.                 ?fileopen
  267.                 off> memfile
  268.                 seqhandle ed1hndl $>handle      \ copy file to edit handle
  269.                 off> newfl
  270.                 ?readfile
  271.                 off> renaming
  272.                 elisting
  273.                 off> memfile ;
  274.  
  275. ' listing is dolisting
  276.  
  277. #endif
  278.  
  279.  
  280.