diff options
Diffstat (limited to 'closures/compiler/comprsrc.pas')
| -rw-r--r-- | closures/compiler/comprsrc.pas | 523 |
1 files changed, 523 insertions, 0 deletions
diff --git a/closures/compiler/comprsrc.pas b/closures/compiler/comprsrc.pas new file mode 100644 index 0000000000..8988263bf0 --- /dev/null +++ b/closures/compiler/comprsrc.pas @@ -0,0 +1,523 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl + + Handles the resource files handling + + 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 comprsrc; + +{$i fpcdefs.inc} + +interface + + uses + Systems, cstreams, Script; + +type + tresoutput = (roRES, roOBJ); + + tresourcefile = class(TAbstractResourceFile) + private + fname : ansistring; + protected + function SetupCompilerArguments(output: tresoutput; const OutName : + ansistring; respath: ansistring; out ObjUsed : boolean) : ansistring; virtual; + public + constructor Create(const fn : ansistring);override; + function Compile(output: tresoutput; const OutName: ansistring) : boolean; virtual; + procedure PostProcessResourcefile(const s : ansistring);virtual; + function IsCompiled(const fn : ansistring) : boolean;virtual; + procedure Collect(const fn : ansistring);virtual; + procedure EndCollect; virtual; + end; + + TWinLikeResourceFile = class(tresourcefile) + private + fResScript : TScript; + fScriptName : ansistring; + fCollectCount : integer; + protected + function SetupCompilerArguments(output: tresoutput; const OutName : + ansistring; respath: ansistring; out ObjUsed : boolean) : ansistring; override; + public + constructor Create(const fn : ansistring);override; + destructor Destroy; override; + function Compile(output: tresoutput; const OutName: ansistring) : boolean; override; + function IsCompiled(const fn : ansistring) : boolean;override; + procedure Collect(const fn : ansistring);override; + procedure EndCollect; override; + end; + +procedure CompileResourceFiles; +procedure CollectResourceFiles; + +Var + ResCompiler : String; + RCCompiler : String; + +implementation + +uses + SysUtils, + cutils,cfileutl,cclasses, + Globtype,Globals,Verbose,Fmodule, comphook,cpuinfo; + +{**************************************************************************** + TRESOURCEFILE +****************************************************************************} + +constructor tresourcefile.create(const fn : ansistring); +begin + fname:=fn; +end; + + +procedure tresourcefile.PostProcessResourcefile(const s : ansistring); +begin +end; + + +function tresourcefile.IsCompiled(const fn: ansistring): boolean; +begin + Result:=CompareText(ExtractFileExt(fn), target_info.resobjext) = 0; +end; + +procedure tresourcefile.Collect(const fn: ansistring); +begin + if fn='' then + exit; + fname:=fn; + Compile(roOBJ, ChangeFileExt(fn, target_info.resobjext)); +end; + +procedure tresourcefile.EndCollect; +begin + +end; + +function tresourcefile.SetupCompilerArguments(output: tresoutput; const OutName + : ansistring; respath: ansistring; out ObjUsed : boolean) : ansistring; +var + s : TCmdStr; +begin + if output=roRES then + begin + s:=target_res.rccmd; + Replace(s,'$RES',maybequoted(OutName)); + Replace(s,'$RC',maybequoted(fname)); + ObjUsed:=False; + end + else + begin + s:=target_res.rescmd; + ObjUsed:=(pos('$OBJ',s)>0); + Replace(s,'$OBJ',maybequoted(OutName)); + Replace(s,'$RES',maybequoted(fname)); + end; + Result:=s; +end; + +function tresourcefile.compile(output: tresoutput; const OutName: ansistring) + : boolean; + + Function SelectBin(Const Bin1,Bin2 : String) : String; + begin + If (Bin1<>'') then + SelectBin:=Bin1 + else + SelectBin:=Bin2; + end; + +var + respath, + s, + bin, + resbin : TCmdStr; + resfound, + objused : boolean; +begin + Result:=true; + if output=roRES then + Bin:=SelectBin(RCCompiler,target_res.rcbin) + else + Bin:=SelectBin(ResCompiler,target_res.resbin); + if bin='' then + begin + Result:=false; + exit; + end; + resfound:=false; + if utilsdirectory<>'' then + resfound:=FindFile(utilsprefix+bin+source_info.exeext,utilsdirectory,false,resbin); + if not resfound then + begin + resfound:=FindExe(utilsprefix+bin,false,resbin); + if not resfound and (utilsprefix<>'') and ( (output=roRES) or (Pos('$ARCH', target_res.rescmd)<>0) ) then + { Search for resource compiler without utilsprefix, if RC->RES compiler is called } + { or RES->OBJ compiler supports different architectures. } + resfound:=FindExe(bin,false,resbin); + end; + { get also the path to be searched for the windres.h } + respath:=ExtractFilePath(resbin); + if (not resfound) and not(cs_link_nolink in current_settings.globalswitches) then + begin + Message1(exec_e_res_not_found, utilsprefix+bin+source_info.exeext); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + Result:=false; + end; + s:=SetupCompilerArguments(output,OutName,respath,objused); +{ Execute the command } +{ Always try to compile resources. but don't complain if cs_link_nolink } + if resfound then + begin + Message1(exec_i_compilingresource,fname); + Message2(exec_d_resbin_params,resbin,s); + FlushOutput; + try + if ExecuteProcess(resbin,s) <> 0 then + begin + if not (cs_link_nolink in current_settings.globalswitches) then + Message(exec_e_error_while_compiling_resources); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + Result:=false; + end; + except + on E:EOSError do + begin + if not (cs_link_nolink in current_settings.globalswitches) then + Message1(exec_e_cant_call_resource_compiler, resbin); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + Result:=false; + end + end; + end; + { Update asmres when externmode is set and resource compiling failed } + if (not Result) and (cs_link_nolink in current_settings.globalswitches) then + AsmRes.AddLinkCommand(resbin,s,OutName); + if Result and (output=roOBJ) and ObjUsed then + current_module.linkunitofiles.add(OutName,link_always); +end; + +constructor TWinLikeResourceFile.Create(const fn : ansistring); +begin + inherited Create(fn); + fResScript:=nil; + fCollectCount:=0; + if (tf_use_8_3 in target_info.flags) then + fScriptName:=ChangeFileExt(fn,'.rls') + else + fScriptName:=ChangeFileExt(fn,'.reslst'); +end; + +destructor TWinLikeResourceFile.Destroy; +begin + if fResScript<>nil then + fResScript.Free; + inherited; +end; + +function TWinLikeResourceFile.SetupCompilerArguments(output: tresoutput; const + OutName : ansistring; respath : ansistring; out ObjUsed : boolean) : ansistring; +var + srcfilepath, + preprocessorbin, + s : TCmdStr; + arch, + subarch: ansistring; + + function WindresFileName(filename: TCmdStr): TCmdStr; + // to be on the safe side, for files that are passed to the preprocessor, + // only give short file names with forward slashes to windres + var + i: longint; + begin + Result := GetShortName(filename); + for I:=1 to Length(Result) do + if Result[I] in AllowDirectorySeparators then + Result[i]:='/'; + end; + +begin + srcfilepath:=ExtractFilePath(current_module.mainsource^); + if output=roRES then + begin + s:=target_res.rccmd; + if target_res.rcbin = 'windres' then + Replace(s,'$RC',WindresFileName(fname)) + else + Replace(s,'$RC',maybequoted(fname)); + Replace(s,'$RES',maybequoted(OutName)); + ObjUsed:=False; + end + else + begin + s:=target_res.rescmd; + if (res_external_file in target_res.resflags) then + ObjUsed:=false + else + ObjUsed:=(pos('$OBJ',s)>0); + Replace(s,'$OBJ',maybequoted(OutName)); + subarch:='all'; + arch:=cpu2str[target_cpu]; + if (source_info.cpu=systems.cpu_arm) then + begin + //Differentiate between arm and armeb + if (source_info.endian=endian_big) then + arch:=arch+'eb'; + end; + Replace(s,'$ARCH',arch); + if target_info.system=system_arm_darwin then + subarch:=lower(cputypestr[current_settings.cputype]); + Replace(s,'$SUBARCH',subarch); + case target_info.endian of + endian_little : Replace(s,'$ENDIAN','littleendian'); + endian_big : Replace(s,'$ENDIAN','bigendian'); + end; + //call resource compiler with debug switch + if (status.verbosity and V_Debug)<>0 then + Replace(s,'$DBG','-v') + else + Replace(s,'$DBG',''); + if fCollectCount=0 then + s:=s+' '+maybequoted(fname) + else + s:=s+' '+maybequoted('@'+fScriptName); + end; + { windres doesn't like empty include paths } + if respath='' then + respath:='.'; + Replace(s,'$INC',maybequoted(respath)); + if (output=roRes) and (target_res.rcbin='windres') then + begin + { try to find a preprocessor } + preprocessorbin := respath+'cpp'+source_info.exeext; + if FileExists(preprocessorbin,true) then + s:='--preprocessor='+preprocessorbin+' '+s; + if (srcfilepath<>'') then + s:='--include '+WindresFileName(srcfilepath)+' '+s; + end; + Result:=s; +end; + +function TWinLikeResourceFile.compile(output: tresoutput; + const OutName: ansistring) : boolean; +begin + Result:=inherited compile(output,OutName); + //delete fpc-res.lst file if things went well + if Result and (output=roOBJ) then + DeleteFile(fScriptName); +end; + +function TWinLikeResourceFile.IsCompiled(const fn: ansistring): boolean; +const + ResSignature : array [1..32] of byte = + ($00,$00,$00,$00,$20,$00,$00,$00,$FF,$FF,$00,$00,$FF,$FF,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00); + knownexts : array[1..4] of string[4] = ('.lfm', '.dfm', '.xfm', '.tlb'); +var + f : file; + oldfmode : byte; + buf: array[1..32] of byte; + i: longint; + ext : shortstring; +begin + ext:=lower(ExtractFileExt(fn)); + Result:=CompareText(ext, target_info.resext) = 0; + if not Result then + for i:=1 to high(knownexts) do + begin + Result:=CompareText(ext, knownexts[i]) = 0; + if Result then break; + end; + + if Result or not FileExists(fn, False) then exit; + oldfmode:=Filemode; + Filemode:=0; + assign(f,fn); + reset(f,1); + BlockRead(f, buf, SizeOf(buf), i); + close(f); + Filemode:=oldfmode; + + if i<>SizeOf(buf) then + exit; + + for i:=1 to 32 do + if buf[i]<>ResSignature[i] then + exit; + + Result:=True; +end; + +procedure TWinLikeResourceFile.Collect(const fn: ansistring); +begin + if fResScript=nil then + fResScript:=TScript.Create(fScriptName); + fResScript.Add(MaybeQuoted(fn)); + inc(fCollectCount); +end; + +procedure TWinLikeResourceFile.EndCollect; +begin + if fResScript<>nil then + begin + fResScript.WriteToDisk; + FreeAndNil(fResScript); + Compile(roOBJ,ChangeFileExt(fname,target_info.resobjext)); + end; +end; + + +function CopyResFile(inf,outf : TCmdStr) : boolean; +var + src,dst : TCCustomFileStream; +begin + { Copy .res file to units output dir. } + Result:=false; + src:=CFileStreamClass.Create(inf,fmOpenRead or fmShareDenyNone); + if CStreamError<>0 then + begin + Message1(exec_e_cant_open_resource_file, src.FileName); + Include(current_settings.globalswitches, cs_link_nolink); + exit; + end; + dst:=CFileStreamClass.Create(current_module.outputpath^+outf,fmCreate); + if CStreamError<>0 then + begin + Message1(exec_e_cant_write_resource_file, dst.FileName); + Include(current_settings.globalswitches, cs_link_nolink); + exit; + end; + dst.CopyFrom(src,src.Size); + dst.Free; + src.Free; + Result:=true; +end; + +procedure CompileResourceFiles; +var + resourcefile : tresourcefile; + res: TCmdStrListItem; + p,s : TCmdStr; + outfmt : tresoutput; +begin + { Don't do anything for systems supporting resources without using resource + file classes (e.g. Mac OS). They process resources elsewhere. } + if (target_info.res<>res_none) and (target_res.resourcefileclass=nil) then + exit; + + p:=ExtractFilePath(ExpandFileName(current_module.mainsource^)); + res:=TCmdStrListItem(current_module.ResourceFiles.First); + while res<>nil do + begin + if target_info.res=res_none then + Message(scan_e_resourcefiles_not_supported); + s:=res.FPStr; + if not path_absolute(s) then + s:=p+s; + if not FileExists(s, True) then + begin + Message1(exec_e_cant_open_resource_file, s); + Include(current_settings.globalswitches, cs_link_nolink); + exit; + end; + resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s)); + if resourcefile.IsCompiled(s) then + begin + resourcefile.free; + if AnsiCompareFileName(IncludeTrailingPathDelimiter(ExpandFileName(current_module.outputpath^)), p) <> 0 then + begin + { Copy .res file to units output dir. Otherwise .res file will not be found + when only compiled units path is available } + res.FPStr:=ExtractFileName(res.FPStr); //store file name only in PPU. + if not CopyResFile(s,res.FPStr) then exit; + end; + end + else + begin + res.FPStr:=ExtractFileName(res.FPStr); + if (target_res.rcbin='') and (RCCompiler='') then + begin + { if target does not have .rc to .res compiler, create obj } + outfmt:=roOBJ; + res.FPStr:=ChangeFileExt(res.FPStr,target_info.resobjext); + end + else + begin + outfmt:=roRES; + res.FPStr:=ChangeFileExt(res.FPStr,target_info.resext); + end; + resourcefile.compile(outfmt, current_module.outputpath^+res.FPStr); + resourcefile.free; + end; + res:=TCmdStrListItem(res.Next); + end; +end; + + +procedure CollectResourceFiles; +var + resourcefile : tresourcefile; + + procedure ProcessModule(u : tmodule); + var + res : TCmdStrListItem; + s : TCmdStr; + begin + res:=TCmdStrListItem(u.ResourceFiles.First); + while assigned(res) do + begin + if path_absolute(res.FPStr) then + s:=res.FPStr + else + begin + s:=u.path^+res.FPStr; + if not FileExists(s,True) then + s:=u.outputpath^+res.FPStr; + end; + resourcefile.Collect(s); + res:=TCmdStrListItem(res.Next); + end; + end; + +var + hp : tused_unit; + s : TCmdStr; +begin + if (target_info.res=res_none) or ((target_res.resbin='') + and (ResCompiler='')) then + exit; +// if cs_link_nolink in current_settings.globalswitches then +// exit; + s:=ChangeFileExt(current_module.ppufilename^,target_info.resobjext); + if (res_arch_in_file_name in target_res.resflags) then + s:=ChangeFileExt(s,'.'+cpu2str[target_cpu]+target_info.resobjext); + resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s)); + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + ProcessModule(hp.u); + hp:=tused_unit(hp.next); + end; + ProcessModule(current_module); + { Finish collection } + resourcefile.EndCollect; + resourcefile.free; +end; + +end. |