instantfpc

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1535 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/instantfpc/README.txt

@@ -0,0 +1,26 @@
+instantfpc
+==========
+
+This tool allows to execute pascal programs as unix scripts.
+A unix script starts with a shebang #! and the program to execute. For example
+
+#!/usr/bin/env instantfpc
+begin
+  writeln('It works');
+end.
+
+If you save the above file as test.pas and set the execute permission
+(chmod a+x) you can execute the script simply with
+./test.pas
+
+
+Installation
+============
+
+1. Compile instantfpc.lpi using lazarus, lazbuild or via "fpc instantfpc.lpr"
+2. Put the executable "instantfpc" in PATH, for example into
+   /usr/bin/instantfpc or ~/bin/instantfpc.
+
+That's all.
+Now you can execute pascal programs as scripts.
+

applications/instantfpc/examples/envvars.pas

@@ -0,0 +1,13 @@
+#!/usr/bin/env instantfpc -Mobjfpc -Sh
+
+uses
+  SysUtils;
+var
+  i: Integer;
+begin
+  for i:=0 to Paramcount do
+    writeln('Param ',i,' ',ParamStr(i));
+  for i:=0 to GetEnvironmentVariableCount-1 do
+    writeln('Env ',GetEnvironmentString(i));
+end.
+

applications/instantfpc/examples/exitcode.pas

@@ -0,0 +1,13 @@
+#!/usr/bin/env instantfpc
+
+{$mode objfpc}{$H+}
+
+uses SysUtils;
+
+var i: integer;
+begin
+  i:=StrToInt(ParamStr(1));
+  writeln('exit code: ',i);
+  Halt(i);
+end.
+

applications/instantfpc/examples/helloworld.pas

@@ -0,0 +1,4 @@
+#!/usr/bin/env instantfpc
+begin
+   writeln('Hello world 2');
+end.

applications/instantfpc/instantfpc.lpi

@@ -0,0 +1,77 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InIDEConfig"/>
+      <MainUnit Value="0"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="instantfpc.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="instantfpc"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="instantfptools.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="InstantFPTools"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="10"/>
+    <Target>
+      <Filename Value="instantfpc"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

applications/instantfpc/instantfpc.lpr

@@ -0,0 +1,119 @@
+{ Compile and run a pascal program.
+
+  Copyright (C) 2011  Mattias Gaertner  mattias@freepascal.org
+
+  This source 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 code 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.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+  MA 02111-1307, USA.
+}
+program instantfpc;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, InstantFPTools;
+
+const
+  Version = '1.0';
+
+var
+  i: Integer;
+  p: String;
+  Filename: String;
+  Src: TStringList;
+  CacheDir: String;
+  CacheFilename: String;
+  OutputFilename: String;
+  ExeExt: String;
+begin
+  Filename:='';
+  { For example:
+      /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1
+  }
+  for i:=1 to Paramcount do begin
+    p:=ParamStr(i);
+    //writeln('Param: ',i,' ',p);
+    if p='' then
+      continue
+    else if p='-v' then begin
+      writeln('instantfpc '+Version);
+      Halt(1);
+    end
+    else if p='-h' then begin
+      writeln('instantfpc '+Version);
+      writeln;
+      writeln('instantfpc -h');
+      writeln('      This help message.');
+      writeln;
+      writeln('instantfpc -v');
+      writeln('      Print version and exit.');
+      writeln;
+      writeln('instantfpc [fpc compiler options] <source file> [program parameters]');
+      writeln('      Compiles source and runs program.');
+      writeln('      Source is compared with the cache. If cache is not valid then');
+      writeln('      source is copied to cache with the shebang line commented and');
+      writeln('      cached source is compiled.');
+      writeln('      If compilation fails the fpc output is written to stdout and');
+      writeln('      instantfpc exits with error code 1.');
+      writeln('      If compilation was successful the program is executed.');
+      writeln;
+      writeln('instantfpc --get-cache');
+      writeln('      Prints cache directory to stdout.');
+      writeln;
+      writeln('Normal usage is to add as first line "#!instantfpc" to a source');
+      Halt(0);
+    end else if p='--get-cache' then begin
+      CacheDir:=GetCacheDir;
+      write(CacheDir);
+      Halt(0);
+    end else if (p[1]<>'-') then begin
+      // the first non flag parameter is the file name of the script
+      // followed by the parameters for the script
+      Filename:=p;
+      break;
+    end;
+  end;
+  if Filename='' then begin
+    writeln('missing source file');
+    Halt(1);
+  end;
+
+  CheckSourceName(Filename);
+
+  Src:=TStringList.Create;
+  try
+    Src.LoadFromFile(Filename);
+    CommentShebang(Src);
+    CacheDir:=GetCacheDir;
+
+    // check cache
+    CacheFilename:=CacheDir+ExtractFileName(Filename);
+    ExeExt:='';
+    OutputFilename:=CacheDir+ChangeFileExt(ExtractFileName(Filename),ExeExt);
+    if not IsCacheValid(Src,CacheFilename,OutputFilename) then begin
+      // save source in cache to find out next time if something changed
+      Src.SaveToFile(CacheFilename);
+      Compile(CacheFilename,OutputFilename);
+    end;
+    // run
+    Run(OutputFilename);
+  finally
+    // memory is freed by OS, but for debugging puposes you can do it manually
+    {$IFDEF IFFreeMem}
+    Proc.Free;
+    Src.Free;
+    {$ENDIF}
+  end;
+end.
+

applications/instantfpc/instantfptools.pas

@@ -0,0 +1,192 @@
+unit InstantFPTools;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Process, unix;
+
+procedure CheckSourceName(const Filename: string);
+procedure CommentShebang(Src: TStringList);
+function GetCacheDir: string;
+function IsCacheValid(Src: TStringList;
+                      const CachedSrcFile, CachedExeFile: string): boolean;
+procedure Compile(const CacheFilename, OutputFilename: string);
+function GetCompiler: string;
+function GetCompilerParameters(const SrcFilename, OutputFilename: string): string;
+procedure Run(const Filename: string);
+
+implementation
+
+procedure AddParam(p: string; var Line: string);
+begin
+  if p='' then exit;
+  if Line<>'' then Line:=Line+' ';
+  if (p[1]<>'"') and (System.Pos(' ',p)>0) then
+    p:='"'+p+'"';
+  Line:=Line+p;
+end;
+
+procedure CheckSourceName(const Filename: string);
+var
+  Ext: String;
+begin
+  // avoid name clashes
+  Ext:=lowercase(ExtractFileExt(Filename));
+  if (Ext<>'') and (Ext<>'.pas') and (Ext<>'.pp') and (Ext<>'.p')
+  and (Ext<>'.lpr') and (Ext<>'.txt') and (Ext<>'.sh')
+  then begin
+    writeln('invalid source extension ',Ext);
+    Halt(1);
+  end;
+end;
+
+procedure CommentShebang(Src: TStringList);
+var
+  Line: string;
+  i: Integer;
+begin
+  // comment shebang #!
+  if (Src.Count=0) then exit;
+  Line:=Src[0];
+  i:=1;
+  if copy(Line,1,3)=#$EF#$BB#$BF then
+    inc(i,3);// UTF8 BOM
+  if (i>length(Line)) or (Line[i]<>'#') then exit;
+  Src[0]:=copy(Line,1,i-1)+'//'+copy(Line,i,length(Line));
+end;
+
+function GetCacheDir: string;
+begin
+  Result:=GetEnvironmentVariable('INSTANTFPCCACHE');
+  if Result='' then begin
+    Result:=GetEnvironmentVariable('HOME');
+    if Result<>'' then
+      Result:=IncludeTrailingPathDelimiter(Result)+'.cache'+PathDelim+'instantfpc';
+  end;
+  if Result='' then begin
+    writeln('missing environment variable: HOME or INSTANTFPCCACHE');
+    Halt(1);
+  end;
+  Result:=IncludeTrailingPathDelimiter(ExpandFileName(Result));
+  if not ForceDirectories(Result) then begin
+    writeln('unable to create cache directory "'+Result+'"');
+    Halt(1);
+  end;
+end;
+
+function IsCacheValid(Src: TStringList; const CachedSrcFile,
+  CachedExeFile: string): boolean;
+var
+  OldSrc: TStringList;
+begin
+  Result:=false;
+  if not FileExists(CachedSrcFile) then exit;
+  if not FileExists(CachedExeFile) then exit;
+  OldSrc:=TStringList.Create;
+  OldSrc.LoadFromFile(CachedSrcFile);
+  Result:=Src.Equals(OldSrc);
+  {$IFDEF IFFreeMem}
+  OldSrc.Free;
+  {$ENDIF}
+end;
+
+function GetCompiler: string;
+var
+  Path: String;
+  p: Integer;
+  StartPos: LongInt;
+  Dir: String;
+  CompFile: String;
+begin
+  {$IFDEF Windows}
+  CompFile:='fpc.exe';
+  {$ELSE}
+  CompFile:='fpc';
+  {$ENDIF}
+  Path:=GetEnvironmentVariable('PATH');
+  if PATH<>'' then begin
+    p:=1;
+    while p<=length(Path) do begin
+      StartPos:=p;
+      while (p<=length(Path)) and (Path[p]<>':') do inc(p);
+      if StartPos<p then begin
+        Dir:=copy(Path,StartPos,p-StartPos);
+        Result:=ExpandFileName(IncludeTrailingPathDelimiter(Dir))+CompFile;
+        if FileExists(Result) then exit;
+      end;
+      inc(p);
+    end;
+  end;
+  writeln(CompFile+' not found in PATH');
+  Halt(1);
+end;
+
+procedure Compile(const CacheFilename, OutputFilename: string);
+var
+  Compiler: String;
+  CompParams: String;
+  Proc: TProcess;
+  Count: Int64;
+  ss: TStringStream;
+begin
+  Compiler:=GetCompiler;
+  CompParams:=GetCompilerParameters(CacheFilename,OutputFilename);
+  //writeln('Compiler=',Compiler,' Params=',CompParams);
+  if FileExists(OutputFilename) and not DeleteFile(OutputFilename) then begin
+    writeln('unable to delete ',OutputFilename);
+    Halt(1);
+  end;
+  Proc:=TProcess.Create(nil);
+  Proc.CommandLine:=Compiler+' '+CompParams;
+  Proc.Options:= [poUsePipes, poStdErrToOutput];
+  Proc.ShowWindow := swoHide;
+  Proc.Execute;
+  ss:=TStringStream.Create('');
+  repeat
+    Count:=ss.CopyFrom(Proc.Output,4096);
+  until Count=0;
+  if (not Proc.WaitOnExit) or (Proc.ExitStatus<>0) then begin
+    write(ss.DataString);
+    Halt(1);
+  end;
+  ss.Free;
+  Proc.Free;
+end;
+
+function GetCompilerParameters(const SrcFilename, OutputFilename: string): string;
+{ For example:
+    /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1
+  The shebang compile parameters: -MObjFpc -Sh
+}
+var
+  p: String;
+begin
+  Result:='';
+  if (Paramcount>0) then begin
+    p:=ParamStr(1);
+    if (p<>'') and (p[1]='-') then
+      Result:=p; // copy compile params from the script
+  end;
+  AddParam('-o'+OutputFilename,Result);
+  AddParam(SrcFilename,Result);
+end;
+
+procedure Run(const Filename: string);
+var
+  p: PPChar;
+begin
+  p:=argv;
+  inc(p);
+  while (p<>nil) do begin
+    if (p^<>nil) and (p^^<>'-') then begin
+      break;
+    end;
+    inc(p);
+  end;
+  Halt(FpExecV(Filename,p));
+end;
+
+end.
+

components/orpheus/tests/TestTable/project1.lpi

@@ -1,19 +1,23 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
+    <Version Value="9"/>
     <PathDelim Value="\"/>
-    <Version Value="5"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
+      <ActiveWindowIndexAtStart Value="0"/>
-      <TargetFileExt Value=".exe"/>
-      <ActiveEditorIndexAtStart Value="1"/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
       <Language Value=""/>
       <CharSet Value=""/>
+      <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -23,7 +27,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="2">
@@ -34,43 +38,77 @@
         <PackageName Value="LCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="4">
       <Unit0>
         <Filename Value="project1.dpr"/>
         <IsPartOfProject Value="True"/>
-        <CursorPos X="40" Y="8"/>
-        <TopLine Value="1"/>
         <EditorIndex Value="0"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="1"/>
+        <CursorPos X="40" Y="8"/>
         <UsageCount Value="20"/>
         <Loaded Value="True"/>
+        <LoadedDesigner Value="True"/>
+        <DefaultSyntaxHighlighter Value="Delphi"/>
       </Unit0>
       <Unit1>
         <Filename Value="unit1.pas"/>
         <ComponentName Value="Form1"/>
         <HasResources Value="True"/>
         <UnitName Value="Unit1"/>
-        <CursorPos X="51" Y="7"/>
-        <TopLine Value="1"/>
         <EditorIndex Value="1"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="1"/>
+        <CursorPos X="35" Y="17"/>
         <UsageCount Value="10"/>
         <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Delphi"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="..\..\..\..\..\wichtig\lazarus\components\synedit\synedit.pp"/>
+        <UnitName Value="SynEdit"/>
+        <IsVisibleTab Value="True"/>
+        <EditorIndex Value="2"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="5112"/>
+        <CursorPos X="36" Y="5120"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\ovcef.pas"/>
+        <UnitName Value="ovcef"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="2796"/>
+        <CursorPos X="27" Y="2809"/>
+        <UsageCount Value="10"/>
+        <DefaultSyntaxHighlighter Value="Delphi"/>
+      </Unit3>
     </Units>
-    <JumpHistory Count="0" HistoryIndex="-1"/>
+    <JumpHistory Count="2" HistoryIndex="1">
+      <Position1>
+        <Filename Value="..\..\..\..\..\wichtig\lazarus\components\synedit\synedit.pp"/>
+        <Caret Line="19" Column="35" TopLine="1"/>
+      </Position1>
+      <Position2>
+        <Filename Value="..\..\..\..\..\wichtig\lazarus\components\synedit\synedit.pp"/>
+        <Caret Line="6985" Column="32" TopLine="6963"/>
+      </Position2>
+    </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="9"/>
     <PathDelim Value="\"/>
     <SearchPaths>
-      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+      <SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
-        <D2Extensions Value="False"/>
+        <SyntaxMode Value="Delphi"/>
         <CStyleOperator Value="False"/>
         <AllowLabel Value="False"/>
         <CPPInline Value="False"/>
-        <DelphiCompat Value="True"/>
+        <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
     <CodeGeneration>