home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / KRTOOL.ZIP / SHELL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-19  |  7.0 KB  |  231 lines
  1. {$A-}
  2. PROGRAM TOOLS;
  3. {$I TOOLU.PAS}
  4.  
  5.  
  6.   PROCEDURE INITCMD;
  7.     { Initialize command line; modified for double quotes }
  8.     { Pipes added -- Willett Kempton, 3 January 1985      }
  9.     { Multiple processes (sequential) added -- WK, 5 January 1985 }
  10.  
  11.   CONST
  12.     PIPE = BAR;
  13.     SEQPRCS = SEMICOL;
  14.   VAR
  15.     FD,FDJUNK:FILEDESC;
  16.     FNAME:XSTRING;
  17.     FT:FILTYP;
  18.     IDX:1..MAXSTR;
  19.     JSKIP:INTEGER;
  20.     PendingProcess, { local variable only }
  21.     JUNK:BOOLEAN;
  22.     i,DEBUG2: INTEGER;
  23.  
  24.  
  25.    BEGIN
  26.     CMDFIL[STDIN]:=STDIO;
  27.     { make STDOUT and STDERR normal buffered files; this eliminates
  28.       one layer of if checks and procedure calls }
  29.     NAMESTR(FNAME,'CON:');
  30.     for FD := STDOUT to STDERR do begin
  31.       CMDFIL[FD] := CLOSED;
  32.       FDJUNK := MUSTOPEN(FNAME,IOWRITE);
  33.     end;
  34. {    CMDFIL[STDOUT]:=STDIO;
  35.     CMDFIL[STDERR]:=STDIO;
  36. }
  37.     FOR FD:=SUCC(STDERR) TO MAXOPEN DO
  38.      CMDFIL[FD]:=CLOSED;
  39.     KBDN:=0;
  40.     if EntryFromHost then
  41.        begin
  42.         writeln('Software tools, version ',Version,
  43.                 ',  type "help" for command list');
  44.         PendingProcess := FALSE;
  45.         SetEntryFromHost(FALSE);
  46.        end
  47.      else PendingProcess := ActiveProcessQ;
  48.     FromPipe := PendingProcess and (PipeCount > 0);
  49.     if PendingProcess
  50.      then
  51.        begin
  52.         SCOPY(ProcessQueue,1,CMDLIN,1);
  53.         if Debug or ListProcess then
  54.           PUTSTR(CMDLIN,STDERR);
  55.         if FromPipe then
  56.            begin
  57.             XCLOSE(STDIN);
  58.             GenPipeName(PipeCount,FNAME);
  59.             FD := MUSTOPEN(FNAME,IOREAD);
  60.            end;
  61.        end
  62.      else
  63.        begin
  64.         PipeCount := 0;
  65.         write(ShellPrompt);
  66.         ReadingShellCmd := true; { flag for GETKBD }
  67.         if (not getline(cmdlin,STDIN,MAXSTR)) then begin
  68.           writeln('  eof to shell'); ExitToHost; end;
  69.         ReadingShellCmd := false;
  70.        end;
  71.     CMDARGS:=0;
  72.     JSKIP:=0;  { counts quotes already skipped }
  73.     IDX:=1;
  74.     WHILE  (not (CMDLIN[IDX] in [ENDSTR,NEWLINE,PIPE,SEQPRCS])) DO
  75.       BEGIN
  76.        WHILE((CMDLIN[IDX]=BLANK)AND(JSKIP MOD 2 <>1))DO
  77.         IDX:=IDX+1;
  78.        IF NOT(CMDLIN[IDX] IN [NEWLINE,PIPE,SEQPRCS]) THEN
  79.           BEGIN { next argument }
  80.            CMDARGS:=CMDARGS+1;
  81.            CMDIDX[CMDARGS]:=IDX-JSKIP;
  82.            WHILE((CMDLIN[IDX]<>NEWLINE) AND
  83.            (NOT(CMDLIN[IDX] IN [BLANK,PIPE,SEQPRCS])OR(ODD(JSKIP)))) DO
  84.              BEGIN
  85.               IF (CMDLIN[IDX]=DQUOTE)
  86.                THEN JSKIP:=JSKIP+1
  87.                ELSE CMDLIN[IDX-JSKIP]:=CMDLIN[IDX];
  88.               IDX := IDX+1;
  89.              END;
  90.            if (CMDLIN[IDX] IN [PIPE,SEQPRCS]) then
  91.              for i:= MAXSTR downto (IDX-JSKIP+1) do { don't overwrite }
  92.               CMDLIN[i] := CMDLIN[i-1];
  93.            CMDLIN[IDX-JSKIP]:=ENDSTR;
  94.            IDX:=IDX+1;
  95.            { redirection }
  96.            IF (CMDLIN[CMDIDX[CMDARGS]]=LESS) THEN
  97.               BEGIN
  98.                XCLOSE(STDIN);
  99.                CMDIDX[CMDARGS]:=CMDIDX[CMDARGS]+1;
  100.                JUNK:=GETARG(CMDARGS,FNAME,MAXSTR);
  101.                FD:=MUSTOPEN(FNAME,IOREAD);
  102.                CMDARGS:=CMDARGS-1;
  103.               END
  104.             ELSE
  105.              IF (CMDLIN[CMDIDX[CMDARGS]]=GREATER) THEN
  106.                 BEGIN
  107.                  XCLOSE(STDOUT);
  108.                  CMDIDX[CMDARGS]:=CMDIDX[CMDARGS]+1;
  109.                  JUNK:=GETARG(CMDARGS,FNAME,MAXSTR);
  110.                  FD:=MUSTCREATE(FNAME,IOWRITE);
  111.                  CMDARGS:=CMDARGS-1;
  112.                 END
  113.               ELSE
  114.                IF Debug then
  115.                   BEGIN
  116.                    WRITE(' arg ',CMDARGS:1,' ');
  117.                    DEBUG2 := CMDIDX[CMDARGS];
  118.                    WHILE CMDLIN[DEBUG2]<>ENDSTR DO
  119.                      BEGIN
  120.                       WRITE(CHR(CMDLIN[DEBUG2])); DEBUG2:=DEBUG2+1;
  121.                      END;
  122.                    WRITELN;
  123.                   END
  124.           END
  125.       END;
  126.     ToPipe := CMDLIN[IDX] = PIPE;
  127.     ActiveProcessQ := ToPipe or (CMDLIN[IDX]=SEQPRCS);
  128.     if ActiveProcessQ then
  129.        begin
  130.         SCOPY(CMDLIN,(IDX+1),ProcessQueue,1);{ preserve remainder of command }
  131.         if ToPipe then
  132.            begin
  133.             XCLOSE(STDOUT);  PipeCount := PipeCount+1;
  134.             GenPipeName(PipeCount,FNAME);
  135.             FD := MUSTCREATE(FNAME,IOWRITE);
  136.            end;
  137.        end;
  138.    END { INITCMD };
  139.  
  140.  
  141.  
  142. procedure Shell;
  143. { Chain to proper file }
  144. VAR CMDPTR:FILE;
  145.   str:STRING80;
  146.   COMMAND:XSTRING;
  147.   DONE:BOOLEAN;
  148.   I, Chapter, Position:INTEGER;
  149. CONST
  150.   (* This is horribly non-standard (only Turbo), but saves memory *)
  151.   AllCmds: array[0..8] of string [54] =
  152.     (* must have blank before AND after each command *)
  153.     (' quit help ',
  154.      ' charcount copy linecount wordcount detab list shell ',
  155.      ' entab overstrike compress expand echo translit ',
  156.      ' compare include concat print makecopy archive ',
  157.      ' sort unique kwic unrotate ',   { ' rotate ' not supported }
  158.      ' find change ',
  159.      ' edit ',
  160.      ' format ',
  161.      ' define macro ');
  162.  
  163.  procedure GiveHelp;
  164.  var ch: integer;
  165.  begin
  166.    writeln; writeln('Commands:');
  167.    for ch:= 1 to 8 do
  168.      begin write(AllCmds[ch]); if ch in[1..3,6] then writeln end;
  169.    writeln(AllCmds[0]); writeln;
  170.    writeln('Symbols:');
  171.    write(' ''|'' pipe, '';'' next process,');
  172.    writeln(' redirection: ''>'' to file, ''<'' from file.');
  173.    write(' ''^Z'' (control-Z) terminate console input,');
  174.    writeln('  " " quote arguments.');
  175.    writeln;
  176.  end { GiveHelp };
  177.  
  178.  
  179.  function LowCase(c:char):char;
  180.  begin
  181.    if c in ['A'..'Z']
  182.      then LowCase := char(ord(c)+32)
  183.      else LowCase := c;
  184.  end;
  185.  
  186.  
  187. PROCEDURE SETCHAIN(chapnum:char);
  188.   var len : integer; tempstr:string80;
  189. BEGIN
  190.   ASSIGN(CMDPTR,CONCAT(SystemDrive,'CHAPTER',chapnum,'.CHN'));
  191.   (* put non-abbreviated form in global variable *)
  192.   len := length(AllCmds[Chapter]);
  193.   tempstr := copy(AllCmds[Chapter],(Position+1),(len-Position));
  194.   GlobalArg1 :=
  195.         copy( tempstr, 1, (pos(' ',tempstr)-1) ); (* strip commands after *)
  196.   DONE:=TRUE
  197. END;
  198.  
  199.  
  200. BEGIN { Shell }
  201.   DONE:=FALSE;
  202.   repeat
  203.     INITCMD;
  204.     IF GETARG(1,COMMAND,MAXSTR) THEN BEGIN
  205.       str:=' ';
  206.       FOR I:=1 TO XLENGTH(COMMAND) DO
  207.          str := CONCAT(str,LowCase(chr(COMMAND[I])));
  208.       if not Abbreviate then str := concat(str,' ');
  209.       Chapter := -1;
  210.       repeat
  211.         Chapter := Chapter + 1;
  212.         Position := Pos(str,AllCmds[Chapter]); { Turbo, nonstandard }
  213.       until (Chapter=9) or (Position>0);
  214.       if Chapter=0 then {pseudo-chapter "0"}
  215.          begin if Position=1 then ExitToHost else GiveHelp end
  216.        else if Position>0
  217.         then SETCHAIN(chr(Chapter+ord('0')))   { good command, real chapter }
  218.         else  { bad command }
  219.                 BEGIN WRITELN(str,'?');DONE:=FALSE END;
  220.     END { IF GETARG };
  221.   until DONE;
  222.   CHAIN(CMDPTR)  { <--  if I/O Error 01, check configuration in TOOLU.PAS }
  223.  END { Shell };
  224.  
  225.  
  226. BEGIN
  227.   Shell;
  228. END.
  229.  
  230.  
  231.