home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / topedit.seq < prev    next >
Text File  |  1991-02-25  |  11KB  |  292 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.                                 off> newfl              \ NOT a new file
  81.                                 on> backing-out \ we are poping 1 lvl
  82.                                 false
  83.                         else    true            \ at stack bottom
  84.                         then
  85.                 then
  86.                 ?browse                         \ select the proper type
  87.                 if      ['] hypertypeL is typeL
  88.                 else    ?dosio
  89.                         if      ['] (typeL)        is typeL
  90.                         else    (lit) defers typeL is typeL
  91.                         then
  92.                 then    ;
  93.  
  94. : <red>         ( --- )
  95.                 savescr
  96.                 ?browse                         \ select the proper type
  97.                 if      ['] hypertypeL is typeL
  98.                 else    ?dosio
  99.                         if      ['] (typeL)        is typeL
  100.                         else    (lit) defers typeL is typeL
  101.                         then
  102.                 then
  103.                 OFF> MARKING                    \ 05/25/90 tjz
  104.                 off> hdepth                     \ clear handle stack
  105.                 off> backing-out                \ not backing out of edit
  106.                 backingup =: renaming
  107.                 begin   ?readfile
  108.                         backing-out 0=          \ only set screen line of new
  109.                                                 \ entry, not on returning
  110.                         if      newfl   0=      \ if its not a newfile
  111.                                 ?browse 0= and  \ and we aren't browsing
  112.                                 if      7
  113.                                 else    1
  114.                                 then    first.textline + =: scrline
  115.                         then    off> backing-out
  116.                         reedit
  117.                         ed1hndl memfile $>handle
  118.                         pop-extra
  119.                         if      begin   hdepth 0>
  120.                                 while   hstack>ed1      \ popup one
  121.                                 repeat
  122.                                 off> pop-extra
  123.                         then    push/pop-level
  124.                 until   off> ?browse
  125.                 ?dosio
  126.                 if      ['] (typeL)        is typeL
  127.                 else    (lit) defers typeL is typeL
  128.                 then
  129.                 cr ;
  130.  
  131. : <ed>          ( --- )         \ Redefined to work from memory.
  132.                 seding  0=
  133.                 if      ?fileopen
  134.                 then
  135.                 seqhandle hclose drop           \ close current file
  136.                 seqhandle ed1hndl $>handle      \ copy file to edit handle
  137.                 <red>
  138.                 seqhandle hopen drop            \ open current file
  139.                 ;
  140.  
  141. : file-line_view ( n1 a1 --- )
  142.                 $file 0=
  143.                 if      loadline !
  144.                         <ed>
  145.                 else    drop
  146.                         savecursor
  147.                         savescr
  148.                         cursor-off
  149.                         15 8 65 12 box&fill
  150.                         bcr ."   \4 Couldn't locate " >attrib4 .seqhandle
  151.                         62 #out @ - spaces >norm
  152.                         beep 15 tenths
  153.                         cursor-on
  154.                         restscr
  155.                         restcursor
  156.                 then ;
  157.  
  158. : cfa_view      ( a1 --- )
  159.                 >viewfile
  160.                 file-line_view ;
  161.  
  162. : ?leave_set    ( -- )          \ set preference for leave or prompt on last
  163.                                 \ open file.
  164.                 ?leaveprompt 0= =: leavenow ;
  165.  
  166. : view          ( | <word> --- )
  167.                 on> newbrowse
  168.                 on> ?browse
  169.                 off> seding
  170.                 off> newfl
  171.                 ?leave_set
  172.                 >in @ bl word swap >in ! c@
  173.                 if      bl word hfind 0= ?missing
  174.                         cfa_view
  175.                 else    <ed>
  176.                 then    ;
  177.  
  178. ' view   alias browse
  179. ' view   alias b
  180. ' view   alias v
  181. ' view   alias l
  182. ' view   alias LL
  183.  
  184. : ed            ( | word --- )
  185.                 off> newbrowse
  186.                 off> ?browse
  187.                 off> seding
  188.                 off> newfl
  189.                 ?leave_set
  190.                 >in @ bl word swap >in ! c@
  191.                 if      bl word hfind 0= ?missing
  192.                         cfa_view
  193.                 else    <ed>
  194.                 then    ;
  195.  
  196. ' ed is editfile
  197. ' ed alias e            \ an alias meaning Edit a word
  198.  
  199. : help          ( | <name> --- )
  200.                 on> newbrowse
  201.                 on> ?browse
  202.                 off> seding
  203.                 off> newfl
  204.                 ?leave_set
  205.                 >in @ bl word swap >in ! c@
  206.                 if      here helpbuf over c@ 2+ cmove
  207.                         bl word hfind 0= ?missing
  208.                         >viewfile                     \ -- offset a1
  209.                         " HLP" ">$ over $>ext
  210.                         $file 0=
  211.                         if      drop
  212.                                 findword
  213.                                 if      <ed>
  214.                                 then
  215.                         else    drop
  216.                         then
  217.                 else    dofhelp
  218.                 then    ;
  219.  
  220.  
  221. ' help alias h
  222.  
  223. : edit          ( n1 --- )
  224.                 off> newbrowse
  225.                 off> ?browse
  226.                 off> seding
  227.                 off> newfl
  228.                 ?leave_set
  229.                 1 ?enough =: loadline
  230.                 <ed> ;
  231.  
  232. : list          ( n1 --- )
  233.                 on> newbrowse
  234.                 on> ?browse
  235.                 off> seding
  236.                 off> newfl
  237.                 ?leave_set
  238.                 1 ?enough =: loadline
  239.                 <ed> ;
  240.  
  241. : viewfrom      ( n1 --- )              \ browse starting after line n1
  242.                 1 ?enough               \ need a parameter
  243.                 =: read-from            \ skips (doesn't read) n1 lines
  244.                 1 list ;                \ of the current file
  245.  
  246. ' viewfrom alias vf
  247.  
  248. : leaveprompton ( -- )          \ prompt for new file on leaving editor
  249.                 on> ?leaveprompt ;
  250.  
  251. : leavepromptoff ( -- )         \ DON'T prompt for a new file on leaving edit
  252.                 off> ?leaveprompt ;
  253.  
  254. : autosaveon    ( --- )         \ turn ON automatic save on idle
  255.                 on> autosaving? ;
  256.  
  257. : autosaveoff   ( --- )         \ turn OFF automatic save on idle
  258.                 off> autosaving? ;
  259.  
  260. : unedit        ( --- )         \ de-allocate the memory taken by SED
  261.                 tsegb 0= ?exit
  262.                 unpointer> baseseg      \ release the editors text buffer
  263.                 off> tsegb
  264.                 off> lseg
  265.                 off> dseg
  266.                 off> maxsegs
  267.                 off> #edsegs
  268.                 off> edready
  269.                 off> ldel.cnt
  270.                 memfile clr-hcb ;
  271.  
  272. ' unedit is clearmem
  273.  
  274. defined elisting nip #if                \ only load if printing loaded
  275.  
  276. : listing       ( --- )
  277.                 decimal
  278.                 ?fileopen
  279.                 off> memfile
  280.                 seqhandle ed1hndl $>handle      \ copy file to edit handle
  281.                 off> newfl
  282.                 ?readfile
  283.                 off> renaming
  284.                 elisting
  285.                 off> memfile ;
  286.  
  287. ' listing is dolisting
  288.  
  289. #endif
  290.  
  291.  
  292.