home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 160.lha / CMS.mod < prev    next >
Encoding:
Text File  |  1988-04-27  |  4.7 KB  |  160 lines
  1. MODULE CMS; (* CMS 2.0  Compile with Benchmark Modula-2 *)
  2. (*
  3.    CMS 2.0              - ] Mike SCARY Scalora [ -            PLink : SCARY
  4.  
  5.    This MODULE is public domain.   Freely distributable as long as this 
  6.    notice stays in.
  7.  
  8.    This program was originally uploaded to PeopleLink's Amiga Zone.  The 
  9.    Amiga Zone has well over 3000 members, and a library of thousands of 
  10.    public domain files.  If you're interested in joining us, call 
  11.       800-524-0100 (voice) 
  12.    or 800-826-8855 (modem).
  13.  
  14.    2.0 - 11/28/87  - ] Mike SCARY Scalora [ -
  15.          Put in MAIN (saves space (allocates global vars on stack))
  16.          Took out RunTimeErrors
  17.          Took out WriteInt, not used
  18.          Added checking for CTRL-C
  19.  
  20. *)
  21. FROM AmigaDOS IMPORT FileLock, FileInfoBlockPtr,
  22.                      Lock, UnLock, Examine, ExNext, SharedLock;
  23. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  24. FROM SYSTEM IMPORT ADR, ADDRESS;
  25. FROM Terminal IMPORT WriteString;
  26. FROM System IMPORT StdOutput, CmdLinePtr, CmdLineLength;
  27. FROM Tasks  IMPORT TaskPtr, FindTask;
  28.  
  29. PROCEDURE MAIN;
  30.  
  31. VAR
  32.   File,Path : ARRAY [0..256] OF CHAR;
  33.   MyLock    : FileLock;
  34.   MyInfo    : FileInfoBlockPtr;
  35.   Pat       : BOOLEAN;
  36.   I,J       : CARDINAL;
  37.   CmdLine   : POINTER TO ARRAY [0..256] OF CHAR;
  38.   MyTask    : TaskPtr;
  39.  
  40. PROCEDURE CleanUp;
  41.   BEGIN
  42.     IF MyInfo#NIL THEN DEALLOCATE(MyInfo,SIZE(MyInfo^)); END;
  43.     IF MyLock#FileLock(0) THEN UnLock(MyLock); END;
  44.   END CleanUp;
  45.  
  46. PROCEDURE Match(VAR P,S : ARRAY OF CHAR): BOOLEAN;
  47. (* Input a pattern, P, and a string, S.  Returns TRUE if S fits the
  48.    pattern P.  For P, * will match to any number of any character and 
  49.    ? will match to any one character.                                  *)
  50.   PROCEDURE IsAMatch(PN,CN : CARDINAL): BOOLEAN;
  51.     BEGIN
  52.       CASE P[PN] OF
  53.       0C  : IF S[CN]=0C THEN RETURN(TRUE);
  54.             ELSE RETURN(FALSE); END; |
  55.       '*' : WHILE P[PN+1]='*' DO INC(PN); END;
  56.             IF S[CN]=0C THEN RETURN(IsAMatch(PN+1,CN));
  57.             ELSE 
  58.               LOOP
  59.                 IF IsAMatch(PN+1,CN) THEN RETURN(TRUE); END;
  60.                 INC(CN);
  61.                 IF S[CN]=0C THEN RETURN(IsAMatch(PN+1,CN)); END;
  62.               END;
  63.             END; |
  64.       '?' : IF S[CN]=0C THEN RETURN(FALSE) 
  65.             ELSE RETURN(IsAMatch(PN+1,CN+1)); END;
  66.       ELSE 
  67.         IF CAP(S[CN])=CAP(P[PN]) THEN RETURN(IsAMatch(PN+1,CN+1));
  68.         ELSE RETURN(FALSE); END;
  69.       END;
  70.       RETURN FALSE;
  71.     END IsAMatch;
  72.  
  73.   BEGIN
  74.     RETURN(IsAMatch(0,0));
  75.   END Match;
  76.  
  77. BEGIN 
  78.   MyTask := FindTask(NIL);
  79.   (* parse the first argument *)
  80.   I := 0; J := 0;
  81.   CmdLine := CmdLinePtr; CmdLine^[CARDINAL(CmdLineLength)-1] := 0C;
  82.   WHILE (CmdLine^[I]=' ') DO INC(I); END;
  83.   IF CmdLine^[I]='"' THEN
  84.     INC(I);
  85.     WHILE (CmdLine^[I]#'"') AND (CmdLine^[I]#0C) DO 
  86.       File[J] := CmdLine^[I]; INC(I); INC(J); END;
  87.     IF CmdLine^[I]='"' THEN INC(I); END;
  88.   ELSE
  89.     WHILE (CmdLine^[I]#' ') AND (CmdLine^[I]#0C) DO
  90.       File[J] := CmdLine^[I]; INC(I); INC(J); END;
  91.   END;
  92.   File[J] := 0C;
  93.  
  94.   J := 0;
  95.   WHILE (CmdLine^[I]=' ') DO INC(I); END;
  96.   IF CmdLine^[I]='"' THEN
  97.     INC(I);
  98.     WHILE (CmdLine^[I]#'"') AND (CmdLine^[I]#0C) DO 
  99.       Path[J] := CmdLine^[I]; INC(I); INC(J); END;
  100.   ELSE
  101.     WHILE (CmdLine^[I]#' ') AND (CmdLine^[I]#0C) DO
  102.       Path[J] := CmdLine^[I]; INC(I); INC(J); END;
  103.   END;
  104.   Path[J] := 0C;
  105.  
  106.   IF (File[0]=0C) THEN
  107.     WriteString('\nUsage:\n\n    CMS [ pattern [ path ] ]\n\n');
  108.     WriteString("NOTE: Use '*' to select all files\n\n");
  109.     HALT;
  110.   END;
  111.  
  112.   MyLock := FileLock(0); 
  113.  
  114.   WriteString('.key arg1,arg2\n');
  115.   WriteString('; Created by CMS 2.0   - ] Mike SCARY Scalora [ -  PLink:SCARY\n');
  116.  
  117.   IF File[0]#0C THEN 
  118.     WriteString("; pattern used       : '"); WriteString(File); 
  119.     WriteString("'\n"); 
  120.     IF ((File[0]='*') AND (File[1]=0C)) THEN Pat := FALSE;
  121.     ELSE Pat := TRUE; END;
  122.   ELSE
  123.     Pat := FALSE;
  124.   END;
  125.  
  126.   ALLOCATE(MyInfo,SIZE(MyInfo^));
  127.   IF MyInfo=NIL THEN WriteString('Not able to allocate FileInfoBlock!\n');
  128.     CleanUp; HALT; END;
  129.   
  130.   MyLock := Lock(ADR(Path),SharedLock);
  131.   IF MyLock=FileLock(0) THEN 
  132.     WriteString('Not able to get FileLock for "'); WriteString(Path); 
  133.     WriteString('"!\n'); CleanUp; HALT; 
  134.   END;
  135.  
  136.   IF NOT(Examine(MyLock,MyInfo^)) THEN
  137.     WriteString('Not able to Examine directory!'); CleanUp; HALT; END;
  138.  
  139.   WriteString("; directory searched : '"); 
  140.   WriteString(Path); WriteString("'\n");
  141.   
  142.   WHILE ExNext(MyLock,MyInfo^) DO
  143.     IF (MyInfo^.fibEntryType<0D) AND 
  144.        (NOT(Pat) OR Match(File,MyInfo^.fibFileName)) THEN
  145.       WriteString('<arg1> ');
  146.       WriteString(MyInfo^.fibFileName); 
  147.       WriteString(' <arg2>\n');
  148.     END;
  149.     IF 12 IN MyTask^.tcSigRecvd THEN
  150.       WriteString('\33[33mCTRL-C!\33[31m\n'); CleanUp; HALT; END;
  151.   END;
  152.  
  153.   CleanUp;
  154.  
  155. END MAIN;
  156.  
  157. BEGIN
  158.   MAIN;
  159. END CMS.
  160.