home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / oberon-a-1.4ß.lha / Oberon-A / source / amigautil / Args.mod < prev    next >
Text File  |  1994-08-08  |  5KB  |  185 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Args.mod $
  4.   Description: C-style command-line argument parsing
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 2.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:10:27 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE Args;
  18.  
  19. (*
  20. ** $C- CaseChk       $I- IndexChk  $L- LongAdr   $N- NilChk
  21. ** $P- PortableCode  $R- RangeChk  $S= StackChk  $T- TypeChk
  22. ** $V- OvflChk       $Z- ZeroVars
  23. *)
  24.  
  25. IMPORT E := Exec, D := Dos, WB := Workbench, SYS := SYSTEM;
  26.  
  27. TYPE
  28.   ArgVPtr *= POINTER TO ARRAY OF E.STRPTR;
  29.  
  30. VAR
  31.  
  32.   IsCLI *     : BOOLEAN;
  33.     (*
  34.      * TRUE = program started from CLI, FALSE = program started from
  35.      * Workbench
  36.      *)
  37.  
  38.   argc *      : LONGINT;
  39.     (* Number of arguments passed by CLI *)
  40.  
  41.   argv *      : ArgVPtr;
  42.     (*
  43.      * Array of argument strings passed by CLI.
  44.      * argv [0] is always the name of the program.
  45.      *)
  46.  
  47.   NumArgs *   : LONGINT;
  48.     (* Number of arguments passed by Workbench *)
  49.  
  50.   ArgList *   : WB.WBArgumentsPtr;
  51.     (* Array of WBArg structures passed by Workbench *)
  52.  
  53.   DosCmdLen * : LONGINT;
  54.     (* Length of the command string passed by the CLI *)
  55.  
  56.   DosArgs *   : E.STRPTR;
  57.     (* The actual command string passed by the CLI; !! DO NOT CHANGE !! *)
  58.  
  59.   argCopy     : E.STRPTR;
  60.     (* Copy of the command string passed by the CLI *)
  61.  
  62.   startDir    : D.FileLockPtr;
  63.  
  64. (*------------------------------------*)
  65. PROCEDURE GetArgs ();
  66.  
  67.   VAR argLen : LONGINT; args : E.APTR;
  68.  
  69.   (*------------------------------------*)
  70.   PROCEDURE CliArgs ();
  71.  
  72.     VAR index, index2 : LONGINT; nameLen : INTEGER;
  73.         process : D.ProcessPtr; prCLI : D.CommandLineInterfacePtr;
  74.  
  75.   BEGIN (* CliArgs *)
  76.     IsCLI := TRUE; NumArgs := 0; ArgList := NIL;
  77.     argCopy := NIL; argc := 1; (* First arg is always program name *)
  78.     DosCmdLen := argLen; DosArgs := args;
  79.  
  80.     IF DosCmdLen > 0 THEN
  81.       (* Make a copy of the command string *)
  82.       SYS.NEW (argCopy, SYS.STRLEN (DosArgs^) + 1);
  83.       COPY (DosArgs^, argCopy^);
  84.  
  85.       (*
  86.        * Scan the copy, planting a NUL at the end of each argument and
  87.        * keeping a count of the arguments found;
  88.        *)
  89.       index := 0;
  90.       LOOP
  91.         IF index >= DosCmdLen THEN (* last argument found *) EXIT END;
  92.         (* Kill any leading spaces *)
  93.         WHILE argCopy [index] = " " DO
  94.           argCopy [index] := 0X; INC (index)
  95.         END;
  96.         IF argCopy [index] = 22X THEN (* a quoted argument *)
  97.           (* zap the quote *)
  98.           argCopy [index] := 0X; INC (index);
  99.           (* scan for the next quote *)
  100.           WHILE argCopy [index] # 22X DO INC (index) END;
  101.           (* zap it too *)
  102.           argCopy [index] := 0X; INC (index);
  103.           INC (argc)
  104.         ELSIF argCopy [index] > " " THEN (* an unquoted argument *)
  105.           (* scan for the end of the argument *)
  106.           WHILE argCopy [index] > " " DO INC (index) END;
  107.           (* mark it *)
  108.           argCopy [index] := 0X; INC (index);
  109.           INC (argc)
  110.         ELSE
  111.           (*
  112.            * This is probably a dummy "\n" at the end of an empty command
  113.            * line.
  114.            *)
  115.           argCopy [index] := 0X; INC (index)
  116.         END; (* IF *)
  117.       END; (* LOOP *)
  118.  
  119.       (* Allocate the argv array *)
  120.       NEW (argv, argc + 1);
  121.  
  122.       IF argc > 0 THEN (* Fill argv with pointers to arguments *)
  123.         index := 0; index2 := 1;
  124.         WHILE index2 < argc DO
  125.           WHILE argCopy [index] = 0X DO INC (index) END;
  126.           argv [index2] := SYS.ADR (argCopy [index]);
  127.           INC (index2);
  128.           WHILE argCopy [index] # 0X DO INC (index) END
  129.         END; (* WHILE *)
  130.       END; (* IF *)
  131.  
  132.       (* Terminate it with a NIL *)
  133.       argv [argc] := NIL
  134.     ELSE
  135.       (* Create a dummy entry for argv *)
  136.       NEW (argv, 2);
  137.       argv [1] := NIL
  138.     END; (* ELSE *)
  139.  
  140.     (* Get the command name *)
  141.     process := SYS.VAL (D.ProcessPtr, E.base.FindTask (NIL));
  142.     nameLen := ORD (process.cli.commandName [0]);
  143.     SYS.NEW (argv [0], nameLen + 1, {E.memClear});
  144.     SYS.MOVE (SYS.ADR (process.cli.commandName [1]), argv [0], nameLen);
  145.     (* argv [0, nameLen] := 0X; *)
  146.  
  147.     startDir := NIL
  148.   END CliArgs;
  149.  
  150.   (*------------------------------------*)
  151.   PROCEDURE WBArgs ();
  152.  
  153.     VAR wbMsg : WB.WBStartupPtr;
  154.  
  155.   BEGIN (* WBArgs *)
  156.     IsCLI := FALSE; argc := 0; argv := NIL;
  157.     DosCmdLen := 0; DosArgs := NIL; argCopy := NIL;
  158.     wbMsg := args;
  159.     NumArgs := wbMsg.numArgs; ArgList := wbMsg.argList;
  160.     IF NumArgs = 1 THEN
  161.       startDir := D.base.CurrentDir (ArgList [0].lock)
  162.     ELSE
  163.       startDir := D.base.CurrentDir (ArgList [1].lock)
  164.     END
  165.   END WBArgs;
  166.  
  167. BEGIN (* GetArgs *)
  168.   SYS.ARGLEN (argLen); SYS.ARGS (SYS.VAL (LONGINT, args));
  169.   IF argLen >= 0 THEN CliArgs ()
  170.   ELSE WBArgs ()
  171.   END
  172. END GetArgs;
  173.  
  174. (*------------------------------------*)
  175. PROCEDURE* Cleanup ();
  176.  
  177. BEGIN (* Cleanup *)
  178.   IF startDir # NIL THEN startDir := D.base.CurrentDir (startDir) END
  179. END Cleanup;
  180.  
  181. BEGIN (* Args *)
  182.   GetArgs ();
  183.   SYS.SETCLEANUP (Cleanup)
  184. END Args.
  185.