+ Added getappconfigdir calls

rtl/objpas/sysutils/osutil.inc

@@ -0,0 +1,85 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    <What does this file>
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+    Application name
+  ---------------------------------------------------------------------}
+  
+Function ApplicationName : String;
+
+begin
+  If Assigned(OnGetApplicationName) then 
+    Result:=OnGetApplicationName()
+  else
+    Result:=ChangeFileExt(ExtractFileName(Paramstr(0)),'');
+end;
+
+{ ---------------------------------------------------------------------
+    Default implementations for AppConfigDir implementation.
+  ---------------------------------------------------------------------}
+
+Function DGetAppConfigDir(Global : Boolean) : String;
+
+begin
+  Result:=ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
+end;
+
+Function DGetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+  Result:=ExtractFilePath(ParamStr(0));
+  If SubDir then
+    Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
+  Result:=Result+ApplicationName+ConfigExtension; 
+end;
+
+Function GetAppConfigFile(Global : Boolean) : String;
+
+begin
+  Result:=GetAppConfigFile(Global,False);
+end;
+
+
+{ ---------------------------------------------------------------------
+    Fallback implementations for AppConfigDir implementation.
+  ---------------------------------------------------------------------}
+{
+ If a particular OS does it different:
+ - set the HAVE_OSCONFIG define before including sysutils.inc.
+ - implement the functions.
+ Default config assumes a DOS-like configuration.
+}
+
+{$ifndef HAS_OSCONFIG}
+Function GetAppConfigDir(Global : Boolean) : String;
+
+begin
+  Result:=DGetAppConfigDir(Global);
+end;
+
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+  Result:=DGetAppConfigFile(Global,Subdir);
+end;
+{$endif}
+
+{  
+  $Log$
+  Revision 1.1  2004-08-05 07:28:01  michael
+  + Added getappconfigdir calls
+
+}

rtl/objpas/sysutils/osutilsh.inc

@@ -26,9 +26,29 @@ procedure Sleep(milliseconds: Cardinal);
 function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
 function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
 
+Function GetAppConfigDir(Global : Boolean) : String;
+Function GetAppConfigFile(Global : Boolean) : String;
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+Function ApplicationName : String;
+
+Const
+  ConfigExtension : String = '.cfg';
+  SysConfigDir    : String = '';   
+  
+Type 
+  TGetAppNameEvent = Function : String;
+
+Var
+  OnGetApplicationName : TGetAppNameEvent;
+
+
+
 {
   $Log$
-  Revision 1.6  2004-02-13 13:02:21  marco
+  Revision 1.7  2004-08-05 07:28:01  michael
+  + Added getappconfigdir calls
+
+  Revision 1.6  2004/02/13 13:02:21  marco
    * addition of second executeprocess prototype
 
   Revision 1.5  2004/02/08 11:02:40  michael

rtl/objpas/sysutils/sysutils.inc

@@ -70,6 +70,9 @@
   { CPU Specific code }
   {$i sysutilp.inc}
 
+  { OS utility code }
+  {$i osutil.inc}
+   
     procedure FreeAndNil(var obj);
       var
         temp: tobject;