mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 12:39:38 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			238 lines
		
	
	
		
			7.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			238 lines
		
	
	
		
			7.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2000 by Florian Klaempfl
 | 
						|
 | 
						|
    This program is free software; you can redistribute it and/or modify
 | 
						|
    it under the terms of the GNU General Public License as published by
 | 
						|
    the Free Software Foundation; either version 2 of the License, or
 | 
						|
    (at your option) any later version.
 | 
						|
 | 
						|
    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.  See the
 | 
						|
    GNU General Public License for more details.
 | 
						|
 | 
						|
    You should have received a copy of the GNU General Public License
 | 
						|
    along with this program; if not, write to the Free Software
 | 
						|
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | 
						|
 | 
						|
 ****************************************************************************}
 | 
						|
unit options;
 | 
						|
interface
 | 
						|
 | 
						|
const
 | 
						|
   version = '0.99.15';
 | 
						|
 | 
						|
var
 | 
						|
   inputfilename, outputfilename : string; { Filenames }
 | 
						|
   LibFileName, unitname         : string; { external library name }
 | 
						|
   CompactMode,
 | 
						|
   stripinfo,                 { Don't write info comments to output }
 | 
						|
   UseLib,                    { Append external to implementation ?  }
 | 
						|
   UseName,                   { Append 'libname name 'funcname ' }
 | 
						|
   UsePPOinters,              { Use P instead of ^ for pointers    }
 | 
						|
   EnumToConst,               { Write enumeration types as constants }
 | 
						|
   Win32headers,              { allows dec_specifier }
 | 
						|
   stripcomment,              { strip comments from inputfile }
 | 
						|
   PrependTypes,              { Print T in front of type names ?   }
 | 
						|
   RemoveUnderscore : Boolean;
 | 
						|
   usevarparas : boolean;     { generate var parameters, when a pointer }
 | 
						|
                              { is passed                               }
 | 
						|
   includefile : boolean;     { creates an include file instead of a unit }
 | 
						|
   palmpilot : boolean;       { handling of PalmOS SYS_CALLs }
 | 
						|
 | 
						|
{ Helpers }
 | 
						|
Function ForceExtension(Const HStr,ext:String):String;
 | 
						|
Function MaybeExtension(Const HStr,ext:String):String;
 | 
						|
 | 
						|
{ Options }
 | 
						|
Procedure ProcessOptions;
 | 
						|
 | 
						|
 | 
						|
Implementation
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                                 Helpers
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
Function ForceExtension(Const HStr,ext:String):String;
 | 
						|
{
 | 
						|
  Return a filename which certainly has the extension ext
 | 
						|
  (no dot in ext !!)
 | 
						|
}
 | 
						|
var
 | 
						|
  j : longint;
 | 
						|
begin
 | 
						|
  j:=length(Hstr);
 | 
						|
  while (j>0) and (Hstr[j]<>'.') do
 | 
						|
   dec(j);
 | 
						|
  if j=0 then
 | 
						|
   j:=255;
 | 
						|
  ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
Function MaybeExtension(Const HStr,ext:String):String;
 | 
						|
{
 | 
						|
  Return a filename which certainly has the extension ext
 | 
						|
  (no dot in ext !!)
 | 
						|
}
 | 
						|
var
 | 
						|
  j : longint;
 | 
						|
begin
 | 
						|
  j:=length(Hstr);
 | 
						|
  while (j>0) and (Hstr[j]<>'.') do
 | 
						|
   dec(j);
 | 
						|
  if j=0 then
 | 
						|
   MaybeExtension:=Hstr+'.'+Ext
 | 
						|
  else
 | 
						|
   MaybeExtension:=Hstr;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                                Options
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
Procedure Usage;
 | 
						|
begin
 | 
						|
  writeln ('Usage : ',paramstr(0),' [options]  filename');
 | 
						|
  writeln ('        Where [options] is one or more of:');
 | 
						|
  writeln ('        -d                 Use external;');
 | 
						|
  writeln ('        -D                 use external libname name ''func_name'';');
 | 
						|
  writeln ('        -e                 change enum type to list of constants');
 | 
						|
  writeln ('        -c                 Compact outputmode, less spaces and empty lines');
 | 
						|
  writeln ('        -i                 create include files (no unit header)');
 | 
						|
  writeln ('        -l libname         Specify the library name for external');
 | 
						|
  writeln ('        -o outputfilename  Specify the outputfilename');
 | 
						|
  writeln ('        -p                 Use "P" instead of "^" for pointers');
 | 
						|
  writeln ('        -s                 strip comments from inputfile');
 | 
						|
  writeln ('        -S                 strip comments and don''t write info to outputfile.');
 | 
						|
  writeln ('        -t                 Prepend typedef type names with T');
 | 
						|
  writeln ('        -T                 Prepend typedef type names with T, and remove _');
 | 
						|
  writeln ('        -u unitname        Specify the name of the unit.');
 | 
						|
  writeln ('        -v                 replace pointer parameters by call by');
 | 
						|
  writeln ('                           reference parameters');
 | 
						|
  writeln ('        -w                 special for win32 headers');
 | 
						|
  writeln ('        -x                 handle SYS_TRAP of PalmOS header files');
 | 
						|
  halt (0);
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
Procedure ProcessOptions;
 | 
						|
Var
 | 
						|
  cp : string;
 | 
						|
  I : longint;
 | 
						|
 | 
						|
  Function GetNextParam (const Opt,Name : String) : string;
 | 
						|
  begin
 | 
						|
   if i=paramcount then
 | 
						|
    begin
 | 
						|
      writeln ('Error : -',Opt,' : ',name,' expected');
 | 
						|
      halt(1);
 | 
						|
    end
 | 
						|
   else
 | 
						|
    begin
 | 
						|
      GetNextParam:=paramstr(i+1);
 | 
						|
      inc(i);
 | 
						|
    end;
 | 
						|
  end;
 | 
						|
 | 
						|
begin
 | 
						|
  if paramcount=0 then
 | 
						|
    Usage;
 | 
						|
  inputfilename:='';
 | 
						|
  outputfilename:='';
 | 
						|
  LibFileName:='';
 | 
						|
  UnitName:='';
 | 
						|
  CompactMode:=false;
 | 
						|
  UseLib:=false;
 | 
						|
  UseName:=false;
 | 
						|
  StripComment:=false;
 | 
						|
  StripInfo:=false;
 | 
						|
  UsePPointers:=false;
 | 
						|
  EnumToCOnst:=false;
 | 
						|
  usevarparas:=false;
 | 
						|
  palmpilot:=false;
 | 
						|
  includefile:=false;
 | 
						|
  i:=1;
 | 
						|
  while i<=paramcount do
 | 
						|
   begin
 | 
						|
     cp:=paramstr(i);
 | 
						|
     if cp[1]='-' then
 | 
						|
      begin
 | 
						|
        case cp[2] of
 | 
						|
         'c' : CompactMode:=true;
 | 
						|
         'e' : EnumToConst :=true;
 | 
						|
         'd' : UseLib      :=true;
 | 
						|
         'D' : begin
 | 
						|
                 UseLib      :=true;
 | 
						|
                 usename     :=true;
 | 
						|
               end;
 | 
						|
         'i' : includefile:=true;
 | 
						|
         'l' : LibFileName:=GetNextParam ('l','libname');
 | 
						|
         'o' : outputfilename:=GetNextParam('o','outputfilename');
 | 
						|
         'p' : UsePPointers:=true;
 | 
						|
         's' : stripcomment:=true;
 | 
						|
         'S' : begin
 | 
						|
                 stripcomment:=true;
 | 
						|
                 stripinfo:=true;
 | 
						|
               end;
 | 
						|
         't' : PrependTypes:=true;
 | 
						|
         'T' : begin
 | 
						|
                 PrependTypes:=true;
 | 
						|
                 RemoveUnderscore:=true;
 | 
						|
               end;
 | 
						|
         'u' : UnitName:=GetNextParam ('u','unitname');
 | 
						|
         'v' : usevarparas:=true;
 | 
						|
         'w' : begin
 | 
						|
                  Win32headers:=true;
 | 
						|
                  UseLib:=true;
 | 
						|
                  usename:=true;
 | 
						|
                  usevarparas:=true;
 | 
						|
                  LibFileName:='kernel32';
 | 
						|
               end;
 | 
						|
         'x' : palmpilot:=true;
 | 
						|
         else
 | 
						|
           Writeln ('Illegal option : ',cp);
 | 
						|
         end
 | 
						|
      end
 | 
						|
     else
 | 
						|
      begin { filename }
 | 
						|
        if inputfilename<>'' then
 | 
						|
         begin
 | 
						|
           writeln ('Error : only one filename supported. Found also :',cp);
 | 
						|
           halt(1);
 | 
						|
         end;
 | 
						|
        inputfilename:=MaybeExtension(cp,'h');
 | 
						|
        if outputfilename='' then
 | 
						|
         outputfilename:=ForceExtension (inputfilename,'pp');
 | 
						|
      end;
 | 
						|
     inc(i);
 | 
						|
   end;
 | 
						|
  If inputfilename='' then
 | 
						|
    Usage;
 | 
						|
  if UnitName='' then
 | 
						|
   begin
 | 
						|
     i:=pos('.',outputfilename)-1;
 | 
						|
     if i<=0 then
 | 
						|
      UnitName:=outputfilename
 | 
						|
     else
 | 
						|
      UnitName:=Copy(OutputFileName,1,i);
 | 
						|
   end;
 | 
						|
end;
 | 
						|
 | 
						|
end.
 | 
						|
{
 | 
						|
   $Log$
 | 
						|
   Revision 1.1  2000-07-13 10:16:24  michael
 | 
						|
   + Initial import
 | 
						|
 | 
						|
   Revision 1.4  2000/03/27 21:39:20  peter
 | 
						|
     + -S, -T, -c modes added
 | 
						|
     * crash fixes
 | 
						|
     * removed double opening of inputfile
 | 
						|
 | 
						|
}
 |