home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / sedcopy.seq < prev    next >
Encoding:
Text File  |  1991-03-06  |  6.1 KB  |  147 lines
  1. \ SEDCOPY.SEQ           Editor Cut Copy & Paste         by Tom Zimmer
  2.  
  3. : insertaline   ( a1 --- )
  4.                 ?showfull ?exit
  5.                 linebuf over c@ 1+ 2- cmove
  6.                 linebuf c@ dup =: linelen =: screenchar
  7.                 ch/l linebuf c!
  8.                 modified
  9.                 nodisp-nln ;
  10.  
  11. create cut/copy_file ," TEMP.SEQ"
  12.  
  13. : imp/exp.init  ( --- )
  14.                 cut/copy_file ed2hndl $>handle ;
  15.  
  16. : getinpfile    ( --- f1 )
  17.                 imp/exp.init
  18.                 ?shiftkey dup
  19.                 if      drop
  20.                         ['] femit  is emit
  21.                         ['] noop save!> doLF
  22.                         getfile 0=  showstat            \ get a filename
  23.                         restore> doLF
  24.                         ['] (emit) is emit
  25.                         dup 0=
  26.                         if      swap ed2hndl $>handle
  27.                         then
  28.                 then    ;
  29.  
  30. 0 value export$
  31.  
  32. : ?getexpfile   ( --- f1 )      \ get a filename, and test to see if it
  33.                                 \ already exists before overwriting it.
  34.                 imp/exp.init
  35.                 ?shiftkey dup
  36.                 if      drop
  37.                         8 6 73 12 box&fill
  38.                         space >rev export$ count type >norm
  39.                         ."    Enter=accept  ESC=cancel"
  40.                         " TEMP.SEQ" ">$ pad over c@ 1+ cmove
  41.                         on> autoclear
  42.                         >attrib1
  43.                         10 9 pad 59 lineeditor       ( --- f1 )
  44.                         >norm
  45.                         pad c@ 0<> and
  46.                         if      pad ed2hndl $>handle ed2hndl pathset drop
  47.                                 already_exists?         \ prompt for replace
  48.                                                         \ if already exists.
  49.                                 10 11 at
  50.                         else    true scrshow
  51.                         then
  52.                 else    10 6 70 8 box&fill space
  53.                 then    ;
  54.  
  55. : export        ( --- )
  56.                 putline
  57.                 marking 0=
  58.                 if      .nomark exit
  59.                 then    "  Copy marked text to filename: " ">$ =: export$
  60.                 ?getexpfile ?exit
  61.                 ." Copying text to " ed2hndl count type ." ..."
  62.                 ed2hndl hcreate 0=
  63.                 if      0.0 ed2hndl movepointer
  64.                         off> wblen
  65.                         markend 1+ markstrt
  66.                         ?do     i linewrite ?leave
  67.                         loop    flushwrite      ( --- f1 )
  68.                         if      true " \4 Failed, Disk FULL " ?softerror
  69.                         else    ." ..Done " ?doingmac 0=
  70.                                 if      7 tenths then
  71.                         then    ed2hndl hclose
  72.                         " \4 Error Closing File " ?softerror
  73.                         mark-clear
  74.                 else    true " \4 Failed, Couldn't CREATE file " ?softerror
  75.                 then    getline scrshow ;
  76.  
  77. ' export is exportx     \ patch into smaller editor
  78.  
  79. : excut         ( --- )         \ Cut out marked text
  80.                 ?browse ?exit
  81.                 putline
  82.                 marking 0=
  83.                 if      .nomark exit
  84.                 then    "  Cut marked text to filename: " ">$ =: export$
  85.                 ?getexpfile ?exit
  86.                 ." Cutting text to " ed2hndl count type ."  ..."
  87.                 ed2hndl hcreate 0=
  88.                 if      0.0 ed2hndl movepointer
  89.                         off> wblen
  90.                         markend 1+ markstrt
  91.                         do      i linewrite ?leave
  92.                         loop    flushwrite 0=
  93.                         if      ed2hndl hclose drop
  94.                                 curline markstrt >
  95.                                 if      markstrt backto.line
  96.                                 else    markstrt to.line
  97.                                 then    markend markstrt - #deletelines
  98.                                 linedelete      \ in case we're on last line
  99.                                 ." ..Done " ?doingmac 0=
  100.                                 if      7 tenths then
  101.                                 clipdown
  102.                         else    true " \4 Failed, Disk FULL " ?softerror
  103.                         then    mark-clear
  104.                 else    true " \4 Failed, Couldn't CREATE file " ?softerror
  105.                 then    getline scrshow ;
  106.  
  107. ' excut is excutx       \ patch into smaller editor
  108.  
  109. : import        ( --- )
  110.                 ?browse ?exit
  111.                 ?showfull ?exit
  112.                 getinpfile ?exit
  113.                 true save!> imode
  114.                 ed2hndl hopen 0=
  115.                 if      putline
  116.                         getline
  117.                         0.0 ed2hndl movepointer
  118.                         0.0 filepointer 2!
  119.                         off> loadline
  120.                         ibreset
  121.                         shoml nln suln
  122.                         10 09 70 12 box&fill
  123.                         ed2hndl save!> seqhandle
  124.                         ."  Importing from " seqhandle count type bcr
  125.                         ."  Inserting lines...     Press \r ESC \0 to Abort"
  126.                         57 11 at .time
  127.                         cursor-off
  128.                         ?doingmac 0=
  129.                         if      5 tenths then
  130.                         begin   lineread  dup c@ 0<> ?full 0= and
  131.                                 key? if key 27 <> and then
  132.                         while   loadline @ 7 and 0=
  133.                                 if      30 11 at >rev
  134.                                         loadline @ 4 .r >norm
  135.                                         loadline @ 31 and 0=
  136.                                         if      57 11 at .time
  137.                                         then
  138.                                 then    insertaline
  139.                         repeat  drop    <ldel>
  140.                         restore> seqhandle
  141.                         ed2hndl hclose drop
  142.                 then    scrshow cursor-on ?cursor
  143.                 restore> imode emptykbd ?showfull drop ;
  144.  
  145. ' import is importx     \ patch into smaller editor
  146.  
  147.