home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / sedshell.seq < prev    next >
Text File  |  1991-02-06  |  3KB  |  85 lines
  1. \ SEDSHELL      Shell to DOS from SED                   by Tom Zimmer
  2.  
  3. headerless
  4.  
  5. : ".errmsg      ( a1 n1 --- )
  6.                 savecursor
  7.                 savescr
  8.                 cursor-off
  9.                 18  6 52 12 box&fill
  10.                 bcr 2 spaces type
  11.                 bcr
  12.                 bcr ." \s9Press any \r KEY \b" key drop
  13.                 restscr
  14.                 restcursor ;
  15.  
  16. create command.buf 64 allot
  17.        command.buf off
  18.  
  19. : %doDOS        ( --- )                 \ perform DOS command in COMMAND.BUF
  20.                 putline                 \ save current line if needed
  21.                 >norm
  22.                 curline >r              \ where to come back to
  23.                 lastline toline+        \ goto the last file line
  24.  
  25.                 tend dup 0 c@l 1+       \ seg len ---
  26.                 0 swap                  \ seg off len
  27.  
  28. \ The 100 + is in segments, or 1600 bytes
  29. \ the minimum valid space between TOFF & TEND.
  30.  
  31.                 toff 100 + 0 rot        \ seg off seg off len
  32.                 cmovel                  \ move last line down
  33.                 ?cs:
  34.                 toff 100 + dup 0 c@l 1+ paragraph +     \ segment new-end
  35.                 ?cs: -
  36.                 setblock 0=             \ deallocate unneeded space
  37.                 if      command.buf $sys dup 2 =
  38.                         if      "  Couldn't find COMMAND.COM  " ".errmsg
  39.                         then    8 =
  40.                         if      " Not enough memory to run DOS" ".errmsg
  41.                         then    cursorset
  42.                 else            "  Couldn't free edit buffer  " ".errmsg
  43.                 then
  44.                 ?cs: #pars @ setblock 0=        \ reallocate space again
  45.                 if      toff 100 + dup 0 c@l 1+ paragraph \ seg len
  46.                         0 swap                           \ seg off len
  47.                         tend 0 rot                      \ seg off seg off len
  48.                         cmovel
  49.                 else            " Couldn't re-allocate buffer " ".errmsg
  50.                         toff 100 + lastline >lineptr tl:!
  51.                         toff 100 + dup 0 c@l 1+ paragraph +
  52.                         lastline 1+ >lineptr tl:!
  53.                 then
  54.                 r> backto.line          \ go back to where we came from
  55.                 getline ;
  56.  
  57. : docompile     ( --- )
  58.                 ?shiftkey
  59.                 if      command.buf c@ 0= ?exit
  60.                 else    savescr                 \ save the screen
  61.                         8 6 73 13 box&fill
  62.         ."  \r Enter a DOS command line. \0   \1 Enter \0=accept  ESC=cancel"
  63.                         bcr bcr bcr bcr
  64.         ."  Press \1 Enter \0 on an empty command line to spawn a DOS shell"
  65.                         bcr
  66.         ."  for multiple commands. Use \2 EXIT \0 to return to the editor."
  67.                         on> autoclear
  68.                         >attrib1
  69.                         10 9 command.buf 59 lineeditor       ( --- f1 )
  70.                         >norm
  71.                         restscr 0= ?exit        \ leave if canceled edit
  72.                 then
  73.                 savescr dark
  74.                 %doDOS
  75.                 command.buf c@ 0<>
  76.                 if      cr ." Press a \1 KEY \0 to return to the editor.."
  77.                         key drop
  78.                 then
  79.                 restscr scrshow ;
  80.  
  81. ' docompile is Ctrl-J
  82.  
  83. headers
  84.  
  85.