home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / shell.seq < prev    next >
Encoding:
Text File  |  1990-04-19  |  5.3 KB  |  134 lines
  1. \\ SHELL.SEQ             A DOS Shell program             by Tom Zimmer
  2.  
  3. This file demonstrates a simple DOS shell program that will allow directory
  4. traversal, and program execution. Text type filew will be invoked with the
  5. SZ editor in BROWSE mode. Unknown type filew will prompt for a program to
  6. execute with the file as a parameter.
  7.  
  8.         Compile with: TCOM SHELL /OPT /NOINIT <Enter>
  9.  
  10. When compiling this program, the "/NOINIT" MUST BE INCLUDED, or SET_MEMORY
  11. will not work properly.
  12.  
  13. {
  14.  
  15. : unknown_type  ( a1 -- )
  16.                 ?dup 0= ?exit
  17.                 cr dup count type
  18.                 cr ." I don't know what to do with this file!"
  19.                 cr ." Type the name of a program to pass it to,"
  20.                 cr ." or press ESC to discard."
  21.                 cr ." ->"
  22.                 here 1+ 20 expect span c@ here c! cr
  23.                 esc_flg @ 0= here c@ 0> and
  24.                 if      "  "  here +place
  25.                         count here +place
  26.                         here $dosys
  27.                         key_wait
  28.                 else    drop
  29.                 then    ;
  30.  
  31. : $dosys        ( a1 -- )
  32.                 ." Executing ->" dup count type cr $sys ?syserror ;
  33.  
  34. : key_wait      ( -- )
  35.                 cr ." Press a key to return to the shell."
  36.                 key drop cr ;
  37.  
  38. : ?execute_prog ( a1 -- a1 | false )
  39.                 dup 0= ?exit
  40.                 dup handle>ext
  41.                 dup  " .COM" caps-comp 0=
  42.                 over " .EXE" caps-comp 0= or
  43.                 swap " .BAT" caps-comp 0= or
  44.                 if      $dosys false
  45.                         key_wait
  46.                 then    ;
  47.  
  48. : browse_file   ( a1 -- )
  49.                 " SZ " here  place
  50.                 count  here +place
  51.                 "  /B" here +place
  52.                 here $dosys ;
  53.  
  54. : edit_afile    ( a1 -- )
  55.                 " SZ " here  place
  56.                 count  here +place
  57.                 here $dosys ;
  58.  
  59. : DOS_shell     ( a1 -- )
  60.                 drop
  61.                 here off
  62.                 here $dosys ;
  63.  
  64. : ?edit_file    ( a1 -- a1 | false )
  65.                 dup 0= ?exit
  66.                 dup handle>ext
  67.                 dup  " .SEQ" caps-comp 0=
  68.                 over " .TXT" caps-comp 0= or
  69.                 over " .DOC" caps-comp 0= or
  70.                 over " .BAK" caps-comp 0= or
  71.                 over " .CFG" caps-comp 0= or
  72.                 over " .SYM" caps-comp 0= or
  73.                 over " .MAP" caps-comp 0= or
  74.                 over " .LST" caps-comp 0= or
  75.                 over " .HLP" caps-comp 0= or
  76.                 swap @   '.'            = or    \ no extension
  77.                 if      browse_file
  78.                         false
  79.                 then    ;
  80.  
  81. : my_winmsg     ( -- )          \ an extra message window to be added to
  82.                                 \ the popup window.
  83.                 59 06 at ." ─┬─────────────┐"
  84.                 59 07 at ."  │ F1=View file│"
  85.                 59 08 at ."  │ F2=Edit file│"
  86.                 59 09 at ."  │ F3=DOS shell│"
  87.                 59 10 at ."  │F10=Exit prog│"
  88.                 59 11 at ."  ├─────────────┘" ;
  89.  
  90. -1 value spfunc
  91.  
  92. : ?do_special   ( a1 -- a1 | false )
  93.                 spfunc 0< ?exit
  94.                 spfunc                  \ get value of spfunc
  95.                 -1 =: spfunc            \ reset spfunc to -1
  96.                 false -rot              \ ( a1 n1 -- false a1 n1 )
  97.                 exec: browse_file edit_afile DOS_shell ;
  98.  
  99. : my_winkey     ( c1 -- c1 )    \ Extra special functions to be performed
  100.                                 \ when specific keys are pressed.
  101.                                -1 =: spfunc
  102.         ( F1 )  dup 187 = if    0 =: spfunc drop 13 exit    then
  103.         ( F2 )  dup 188 = if    1 =: spfunc drop 13 exit    then
  104.         ( F3 )  dup 189 = if    2 =: spfunc drop 00 exit    then
  105.         ( F10)  dup 196 = if                drop 27 exit    then
  106.         ( LF )  dup  10 = if    2 =: spfunc drop 00 exit    then ;
  107.  
  108. : main          ( -- )          \ the main entry point for the program
  109.                 DECIMAL                         \ always select decimal
  110.                 INIT-CURSOR                     \ get intial cursor shape
  111.                 50 FUDGE !                      \ init MS timer, GUESS!!
  112.                 CAPS ON                         \ ignore cAsE
  113.                 ?DS: SSEG !                     \ init search segment
  114.                 DOSIO_INIT                      \ init EMIT, TYPE & SPACES
  115.                 PAD 200 + SET_MEMORY
  116.                 DOS_TO_TIB                      \ move command tail to TIB
  117.                 COMSPEC_INIT                    \ init command specification
  118.                 vmode.set
  119.                 dirinit
  120.                 ['] my_winkey is winkey         \ init dirkey function
  121.                 ['] my_winmsg is winmsg         \ additional window message
  122.                 begin   getfile                 \ -- a1 f1
  123.                 while   dup count + off         \ ends in NULL
  124.                         ?do_special
  125.                         ?execute_prog
  126.                         ?edit_file
  127.                         unknown_type
  128.                 repeat  ;                       \ after setting stacks, you
  129.                                                 \ can't just terminate, you
  130.                                                 \ must use bye.
  131.  
  132. }
  133.  
  134.