home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OL / OLPrefs.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  13.2 KB  |  442 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OLPrefs.mod $
  4.   Description: Preferences editor for OL.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 02:07:58 $
  10.  
  11.   Copyright © 1995, Frank Copeland
  12.   This module forms part of the OLPrefs program
  13.   See OLPrefs.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *>
  20.  
  21. MODULE OLPrefs;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, Errors, e := Exec, u := Utility, d := Dos,
  25.   du := DosUtil, str := Strings, OLPrefsRev, OLSettings,
  26.   s := OLPrefsStrings, wb := Workbench, i := Icon, WbConsole;
  27.  
  28. CONST
  29.  
  30.   CopyrightStr = "Copyright © 1995 Frank Copeland\n";
  31.  
  32. VAR
  33.   startDir : d.FileLockPtr;
  34.  
  35. (* -- Command line template and parsing ------------------------------- *)
  36.  
  37. CONST
  38.  
  39.   template =
  40.     "FROM,SAVE/S,SYMSEARCH/K,OBJSEARCH/K,"
  41.     "WITHPATH/K,PROGPATH/K,SYMEXT/K,OBJEXT/K,WITHEXT/K,"
  42.     "LINKCMD/K,LINKARGS/K,ALINK/S,BLINK/S,DLINK/S,"
  43.     "VERBOSE/S,MAKEICONS/S,QUIET/S,NOICONS/S";
  44.  
  45.   optFROM      = 0;
  46.   optSAVE      = 1;
  47.   optSYMSEARCH = 2;
  48.   optOBJSEARCH = 3;
  49.   optWITHPATH  = 4;
  50.   optPROGPATH  = 5;
  51.   optSYMEXT    = 6;
  52.   optOBJEXT    = 7;
  53.   optWITHEXT   = 8;
  54.   optLINKCMD   = 9;
  55.   optLINKARGS  = 10;
  56.   optALINK     = 11;
  57.   optBLINK     = 12;
  58.   optDLINK     = 13;
  59.   optVERBOSE   = 14;
  60.   optMAKEICONS = 15;
  61.   optQUIET     = 16;
  62.   optNOICONS   = 17;
  63.   optCount     = 18;
  64.  
  65. VAR
  66.  
  67.   rdArgs : d.RDArgsPtr;
  68.   args : ARRAY optCount OF SYS.LONGWORD;
  69.  
  70.   (* These are filled in by ParseArgs() *)
  71.  
  72.   from : e.LSTRPTR;
  73.   save : BOOLEAN;
  74.  
  75. (*
  76. ** Actual name that OCPrefs was run under
  77. *)
  78.  
  79. VAR
  80.   progName : ARRAY 256 OF CHAR;
  81.  
  82. (*
  83. ** Console I/O
  84. *)
  85.  
  86. (*------------------------------------*)
  87. PROCEDURE OutStr* ( string : ARRAY OF CHAR );
  88. <*$CopyArrays-*>
  89. BEGIN (* OutStr *)
  90.   du.HaltIfBreak ({d.ctrlC});
  91.   IF d.PutStr (string) = 0 THEN END;
  92. END OutStr;
  93.  
  94.  
  95. (*------------------------------------*)
  96. PROCEDURE OutChar* ( c : CHAR );
  97. BEGIN (* OutChar *)
  98.   du.HaltIfBreak ({d.ctrlC});
  99.   d.PrintF ("%lc", c)
  100. END OutChar;
  101.  
  102.  
  103. (*------------------------------------*)
  104. PROCEDURE OutLn*;
  105. BEGIN (* OutLn *)
  106.   OutChar ("\n")
  107. END OutLn;
  108.  
  109.  
  110. (*------------------------------------*)
  111. PROCEDURE OutStr0* ( n : LONGINT );
  112.   VAR string : e.LSTRPTR;
  113. BEGIN (* OutStr0 *)
  114.   du.HaltIfBreak ({d.ctrlC});
  115.   string := s.GetString (n);
  116.   IF d.PutStr (string^) = 0 THEN END;
  117. END OutStr0;
  118.  
  119.  
  120. (*------------------------------------*)
  121. PROCEDURE OutStr1* ( n : LONGINT; string : ARRAY OF CHAR );
  122.   VAR format : e.LSTRPTR;
  123. <*$CopyArrays-*>
  124. BEGIN (* OutStr1 *)
  125.   du.HaltIfBreak ({d.ctrlC});
  126.   format := s.GetString (n);
  127.   d.PrintF (format^, SYS.ADR (string));
  128. END OutStr1;
  129.  
  130.  
  131. (*------------------------------------*)
  132. PROCEDURE OutBool* ( b : BOOLEAN );
  133. BEGIN (* OutBool *)
  134.   IF b THEN OutStr ("TRUE")
  135.   ELSE OutStr ("FALSE")
  136.   END
  137. END OutBool;
  138.  
  139.  
  140. (*------------------------------------*)
  141. PROCEDURE* Cleanup (VAR rc : LONGINT);
  142.   VAR oldDir : d.FileLockPtr;
  143. BEGIN (* Cleanup *)
  144.   IF rdArgs # NIL THEN
  145.     d.FreeArgs (rdArgs);
  146.     d.FreeDosObject (d.rdArgs, rdArgs);
  147.     rdArgs := NIL
  148.   END;
  149.   s.CloseCatalog();
  150.   IF Kernel.fromWorkbench THEN oldDir := d.CurrentDir (startDir) END
  151. END Cleanup;
  152.  
  153. (*------------------------------------*)
  154. PROCEDURE Init ();
  155.  
  156. BEGIN (* Init *)
  157.   Kernel.SetCleanup (Cleanup);
  158.   s.OpenCatalog (NIL, "");
  159.  
  160.   rdArgs := d.AllocDosObjectTags (d.rdArgs, u.end);
  161.   ASSERT (rdArgs # NIL)
  162. END Init;
  163.  
  164. (*------------------------------------*)
  165. PROCEDURE ParseArgs ();
  166.  
  167.   VAR
  168.     string : e.LSTRPTR;
  169.     i : INTEGER; ignore : BOOLEAN; ch : CHAR;
  170.     verbose, quiet, makeicons, noicons, scan, noscan, link, nolink,
  171.     alink, blink, dlink
  172.       : BOOLEAN;
  173.  
  174. BEGIN (* ParseArgs *)
  175.   from := SYS.VAL (e.LSTRPTR, args [optFROM]);
  176.   IF from = NIL THEN ignore := OLSettings.LoadPrefs ("OL.prefs")
  177.   ELSE ignore := OLSettings.LoadPrefs (from^)
  178.   END;
  179.  
  180.   save := (SYS.VAL (LONGINT, args [optSAVE]) # 0);
  181.  
  182.   string := SYS.VAL (e.LSTRPTR, args [optSYMSEARCH]);
  183.   IF string # NIL THEN COPY (string^, OLSettings.SymSearch) END;
  184.   string := SYS.VAL (e.LSTRPTR, args [optOBJSEARCH]);
  185.   IF string # NIL THEN COPY (string^, OLSettings.ObjSearch) END;
  186.  
  187.   string := SYS.VAL (e.LSTRPTR, args [optWITHPATH]);
  188.   IF string # NIL THEN COPY (string^, OLSettings.WithPath) END;
  189.   string := SYS.VAL (e.LSTRPTR, args [optPROGPATH]);
  190.   IF string # NIL THEN COPY (string^, OLSettings.ProgPath) END;
  191.  
  192.   string := SYS.VAL (e.LSTRPTR, args [optSYMEXT]);
  193.   IF string # NIL THEN COPY (string^, OLSettings.SymExt) END;
  194.   string := SYS.VAL (e.LSTRPTR, args [optOBJEXT]);
  195.   IF string # NIL THEN COPY (string^, OLSettings.ObjExt) END;
  196.   string := SYS.VAL (e.LSTRPTR, args [optWITHEXT]);
  197.   IF string # NIL THEN COPY (string^, OLSettings.WithExt) END;
  198.  
  199.   string := SYS.VAL (e.LSTRPTR, args [optLINKCMD]);
  200.   IF string # NIL THEN COPY (string^, OLSettings.LinkCmd) END;
  201.   string := SYS.VAL (e.LSTRPTR, args [optLINKARGS]);
  202.   IF string # NIL THEN COPY (string^, OLSettings.LinkArgs) END;
  203.  
  204.   alink := (SYS.VAL (LONGINT, args [optALINK]) # 0);
  205.   blink := (SYS.VAL (LONGINT, args [optBLINK]) # 0);
  206.   dlink := (SYS.VAL (LONGINT, args [optDLINK]) # 0);
  207.  
  208.   IF
  209.     (alink & (blink OR dlink))
  210.     OR (blink & (alink OR dlink))
  211.     OR (dlink & (alink OR blink))
  212.   THEN
  213.     OutStr0 (s.msg1); HALT (d.warn)
  214.   ELSIF alink THEN OLSettings.WithFmt := OLSettings.ALink
  215.   ELSIF blink THEN OLSettings.WithFmt := OLSettings.BLink
  216.   ELSIF dlink THEN OLSettings.WithFmt := OLSettings.DLink
  217.   END;
  218.  
  219.   verbose := (SYS.VAL (LONGINT, args [optVERBOSE]) # 0);
  220.   quiet := (SYS.VAL (LONGINT, args [optQUIET]) # 0);
  221.   IF verbose & quiet THEN OutStr0 (s.msg2); HALT (d.warn)
  222.   ELSIF verbose THEN OLSettings.Verbose := TRUE
  223.   ELSIF quiet THEN OLSettings.Verbose := FALSE
  224.   END;
  225.  
  226.   makeicons := (SYS.VAL (LONGINT, args [optMAKEICONS]) # 0);
  227.   noicons := (SYS.VAL (LONGINT, args [optNOICONS]) # 0);
  228.   IF makeicons & noicons THEN OutStr0 (s.msg3); HALT (d.warn)
  229.   ELSIF makeicons THEN OLSettings.MakeIcons := TRUE
  230.   ELSIF noicons THEN OLSettings.MakeIcons := FALSE
  231.   END;
  232. END ParseArgs;
  233.  
  234. (*------------------------------------*)
  235. PROCEDURE Main ();
  236.  
  237.   (*------------------------------------*)
  238.   PROCEDURE WbArgs ();
  239.  
  240.     VAR
  241.       wbStartup : wb.WBStartupPtr;
  242.       wbArg     : wb.WBArg;
  243.       diskObj   : wb.DiskObjectPtr;
  244.       toolTypes : wb.ToolTypePtr;
  245.       string    : e.LSTRPTR;
  246.  
  247.     (*------------------------------------*)
  248.     PROCEDURE CloneStr ( oldStr : e.LSTRPTR ) : e.LSTRPTR;
  249.       VAR newStr : e.LSTRPTR;
  250.     BEGIN (* CloneStr *)
  251.       SYS.NEW (newStr, str.Length (oldStr^) + 1);
  252.       COPY (oldStr^, newStr^);
  253.       RETURN newStr
  254.     END CloneStr;
  255.  
  256.   BEGIN (* WbArgs *)
  257.     wbStartup := SYS.VAL (wb.WBStartupPtr, Kernel.WBenchMsg);
  258.     IF wbStartup.numArgs > 2 THEN OutStr0 (s.msg12); HALT (d.warn) END;
  259.  
  260.     COPY (wbStartup.argList [0].name^, progName);
  261.     wbArg := wbStartup.argList [wbStartup.numArgs-1];
  262.     startDir := d.CurrentDir (wbArg.lock);
  263.  
  264.     IF i.base # NIL THEN
  265.       (* Attempt to load the icon *)
  266.       diskObj := i.GetDiskObject (wbArg.name^);
  267.       IF diskObj # NIL THEN
  268.         toolTypes := diskObj.toolTypes;
  269.         string := i.FindToolType (toolTypes, "FROM");
  270.         IF string # NIL THEN args [optFROM] := CloneStr (string) END;
  271.         string := i.FindToolType (toolTypes, "SAVE");
  272.         IF string # NIL THEN args [optSAVE] := TRUE END;
  273.  
  274.         string := i.FindToolType (toolTypes, "SYMSEARCH");
  275.         IF string # NIL THEN args [optSYMSEARCH] := CloneStr (string) END;
  276.         string := i.FindToolType (toolTypes, "OBJSEARCH");
  277.         IF string # NIL THEN args [optOBJSEARCH] := CloneStr (string) END;
  278.         string := i.FindToolType (toolTypes, "WITHPATH");
  279.         IF string # NIL THEN args [optWITHPATH] := CloneStr (string) END;
  280.         string := i.FindToolType (toolTypes, "PROGPATH");
  281.         IF string # NIL THEN args [optPROGPATH] := CloneStr (string) END;
  282.         string := i.FindToolType (toolTypes, "SYMEXT");
  283.         IF string # NIL THEN args [optSYMEXT] := CloneStr (string) END;
  284.         string := i.FindToolType (toolTypes, "OBJEXT");
  285.         IF string # NIL THEN args [optOBJEXT] := CloneStr (string) END;
  286.         string := i.FindToolType (toolTypes, "WITHEXT");
  287.         IF string # NIL THEN args [optWITHEXT] := CloneStr (string) END;
  288.         string := i.FindToolType (toolTypes, "LINKCMD");
  289.         IF string # NIL THEN args [optLINKCMD] := CloneStr (string) END;
  290.         string := i.FindToolType (toolTypes, "LINKARGS");
  291.         IF string # NIL THEN args [optLINKARGS] := CloneStr (string) END;
  292.         string := i.FindToolType (toolTypes, "ALINK");
  293.         IF string # NIL THEN args [optALINK] := TRUE END;
  294.         string := i.FindToolType (toolTypes, "BLINK");
  295.         IF string # NIL THEN args [optBLINK] := TRUE END;
  296.         string := i.FindToolType (toolTypes, "DLINK");
  297.         IF string # NIL THEN args [optDLINK] := TRUE END;
  298.         string := i.FindToolType (toolTypes, "VERBOSE");
  299.         IF string # NIL THEN args [optVERBOSE] := TRUE END;
  300.         string := i.FindToolType (toolTypes, "MAKEICONS");
  301.         IF string # NIL THEN args [optMAKEICONS] := TRUE END;
  302.         string := i.FindToolType (toolTypes, "QUIET");
  303.         IF string # NIL THEN args [optQUIET] := TRUE END;
  304.         string := i.FindToolType (toolTypes, "NOICONS");
  305.         IF string # NIL THEN args [optNOICONS] := TRUE END;
  306.  
  307.         i.FreeDiskObject (diskObj)
  308.       END
  309.     END;
  310.  
  311.     IF (SYS.VAL (LONGINT, args [optFROM]) = 0) & (wbStartup.numArgs = 2)
  312.     THEN
  313.       args [optFROM] := wbArg.name
  314.     END
  315.   END WbArgs;
  316.  
  317.   (*------------------------------------*)
  318.   PROCEDURE CliArgs ();
  319.     VAR ignore : BOOLEAN;
  320.   BEGIN (* CliArgs *)
  321.     ASSERT (d.GetProgramName (progName, LEN (progName)));
  322.     IF d.OldReadArgs (template, args, rdArgs) = NIL THEN
  323.       ignore := d.PrintFault (d.IoErr(), "");
  324.       HALT (d.warn)
  325.     END
  326.   END CliArgs;
  327.  
  328.   PROCEDURE PrintPrefs;
  329.     VAR i : INTEGER;
  330.   BEGIN (* PrintPrefs *)
  331.     OutStr0 (s.msg6);
  332.     IF from = NIL THEN OutStr ("OL.prefs")
  333.     ELSE OutStr (from^)
  334.     END;
  335.     OutLn; OutLn;
  336.     OutStr ("SymSearch ......: "); OutStr (OLSettings.SymSearch); OutLn;
  337.     OutStr ("ObjSearch ......: "); OutStr (OLSettings.ObjSearch); OutLn;
  338.     OutStr ("WithPath .......: "); OutStr (OLSettings.WithPath); OutLn;
  339.     OutStr ("ProgPath .......: "); OutStr (OLSettings.ProgPath); OutLn;
  340.     OutStr ("SymExt .........: "); OutStr (OLSettings.SymExt); OutLn;
  341.     OutStr ("ObjExt .........: "); OutStr (OLSettings.ObjExt); OutLn;
  342.     OutStr ("WithExt ........: "); OutStr (OLSettings.WithExt); OutLn;
  343.     OutStr ("LinkCmd ........: "); OutStr (OLSettings.LinkCmd); OutLn;
  344.     OutStr ("LinkArgs .......: "); OutStr (OLSettings.LinkArgs); OutLn;
  345.     OutStr ("WithFmt ........: ");
  346.     CASE OLSettings.WithFmt OF
  347.       OLSettings.ALink : OutStr ("ALink") |
  348.       OLSettings.BLink : OutStr ("BLink") |
  349.       OLSettings.DLink : OutStr ("DLink") |
  350.     END;
  351.     OutLn;
  352.     OutStr ("Verbose ........: "); OutBool (OLSettings.Verbose); OutLn;
  353.     OutStr ("MakeIcons ......: "); OutBool (OLSettings.MakeIcons); OutLn;
  354.     OutLn;
  355.   END PrintPrefs;
  356.  
  357.   (*------------------------------------*)
  358.   PROCEDURE MakeIcon ( file : ARRAY OF CHAR );
  359.  
  360.     CONST defPrefsIcon = "ENV:OLPrefs/def_prefs";
  361.  
  362.     VAR
  363.       icon    : ARRAY 256 OF CHAR;
  364.       diskObj : wb.DiskObjectPtr;
  365.       oldTool : e.LSTRPTR;
  366.  
  367.   <*$CopyArrays-*>
  368.   BEGIN (* MakeIcon *)
  369.     ASSERT (i.base # NIL, 100);
  370.     COPY (file, icon); str.Append (".info", icon);
  371.     IF ~du.FileExists (icon) THEN
  372.       diskObj := i.GetDiskObject (defPrefsIcon);
  373.       IF diskObj = NIL THEN diskObj := i.GetDefDiskObject (wb.project) END;
  374.       IF diskObj # NIL THEN
  375.         oldTool := diskObj.defaultTool;
  376.         diskObj.defaultTool := SYS.ADR (progName);
  377.         diskObj.currentX := wb.noIconPosition;
  378.         diskObj.currentY := wb.noIconPosition;
  379.         IF ~i.PutDiskObject (file, diskObj) THEN
  380.           IF d.PrintFault (d.IoErr(), "PutDiskObject") THEN END;
  381.           OutStr1 (s.msg10, icon)
  382.         END;
  383.         diskObj.defaultTool := oldTool;
  384.         i.FreeDiskObject (diskObj)
  385.       ELSE
  386.         IF d.PrintFault (d.IoErr(), "GetDiskObject") THEN END;
  387.         OutStr0 (s.msg11);
  388.       END
  389.     END
  390.   END MakeIcon;
  391.  
  392. BEGIN (* Main *)
  393.   OutStr (OLPrefsRev.vString);
  394.   OutStr (CopyrightStr);
  395.   OutStr0 (s.msg7);
  396.   OutLn;
  397.  
  398.   IF Kernel.fromWorkbench THEN WbArgs()
  399.   ELSE CliArgs()
  400.   END;
  401.   ParseArgs();
  402.   PrintPrefs();
  403.   IF save THEN
  404.     IF from = NIL THEN
  405.       IF OLSettings.SavePrefs ("OL.prefs") THEN OutStr1 (s.msg8, "OL.prefs")
  406.       ELSE OutStr1 (s.msg9, "OL.prefs")
  407.       END;
  408.       IF Kernel.fromWorkbench THEN MakeIcon ("OL.prefs") END
  409.     ELSE
  410.       IF OLSettings.SavePrefs (from^) THEN OutStr1 (s.msg8, from^)
  411.       ELSE OutStr1 (s.msg9, from^)
  412.       END;
  413.       IF Kernel.fromWorkbench THEN MakeIcon (from^) END
  414.     END
  415.   END;
  416. END Main;
  417.  
  418. BEGIN (* OLPrefs *)
  419.   ASSERT (e.SysBase.libNode.version >= 37);
  420.   Errors.Init;
  421.  
  422.   Init();
  423.   Main()
  424. END OLPrefs.
  425.  
  426. (***************************************************************************
  427.  
  428.   $Log: OLPrefs.mod $
  429. # Revision 1.3  1995/01/26  02:07:58  fjc
  430. # - Release 1.5
  431. #
  432. # Revision 1.2  1995/01/09  15:09:56  fjc
  433. # - Removed icon names, Scan and Link from command line
  434. #   template.
  435. # - Implemented Workbench arguments.
  436. # - Added MakeIcon() to create icons for preferences files.
  437. #
  438. # Revision 1.1  1995/01/06  16:28:46  fjc
  439. # Initial revision
  440. #
  441. ***************************************************************************)
  442.