1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Joost van der Sluis
22
23 Abstract:
24 Registers the lfm resource format of forms.
25 }
26 unit lfmUnitResource;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, Laz_AVL_Tree,
34 // LCL
35 Forms,
36 // LazUtils
37 LazFileCache, LazFileUtils,
38 // Codetools
39 CodeCache, CodeToolManager,
40 // IDEIntf
41 UnitResources, SrcEditorIntf,
42 // IDE
43 CheckLFMDlg;
44
45 type
46
47 { TLFMUnitResourcefileFormat }
48
49 TLFMUnitResourcefileFormat = class(TCustomLFMUnitResourceFileFormat)
50 public
FindResourceDirectivenull51 class function FindResourceDirective(Source: TObject): boolean; override;
GetUnitResourceFilenamenull52 class function GetUnitResourceFilename(AUnitFilename: string; {%H-}Loading: boolean): string; override;
QuickCheckResourceBuffernull53 class function QuickCheckResourceBuffer(PascalBuffer, LFMBuffer: TObject; out
54 LFMType, LFMComponentName, LFMClassName: string; out LCLVersion: string;
55 out MissingClasses: TStrings): TModalResult; override;
56 end;
57
58 implementation
59
60 type
61 TLFMUnitResCacheItem = class
62 public
63 UnitFilename: string;
64 CodeBufStamp: integer;
65 ResourceDirective: string; // '*.lfm' or '*.dfm'
66 end;
67
68 var
69 LFMUnitResCache: TAvlTree;
70
CompareLFMUnitResCacheItemsnull71 function CompareLFMUnitResCacheItems(Cache1, Cache2: Pointer): integer;
72 var
73 Unit1: TLFMUnitResCacheItem absolute Cache1;
74 Unit2: TLFMUnitResCacheItem absolute Cache2;
75 begin
76 Result:=CompareFilenames(Unit1.UnitFilename,Unit2.UnitFilename);
77 end;
78
CompareFilenameWithLFMUnitResCacheItemnull79 function CompareFilenameWithLFMUnitResCacheItem(aFilename, aCache: Pointer
80 ): integer;
81 var
82 Unit1Filename: String;
83 Unit2: TLFMUnitResCacheItem absolute aCache;
84 begin
85 Unit1Filename:=AnsiString(aFilename);
86 Result:=CompareFilenames(Unit1Filename,Unit2.UnitFilename);
87 end;
88
GetLFMUnitResCachenull89 function GetLFMUnitResCache(UnitFilename: string; AutoCreate: boolean
90 ): TLFMUnitResCacheItem;
91 var
92 Node: TAvlTreeNode;
93 begin
94 Node:=LFMUnitResCache.FindKey(Pointer(UnitFilename),@CompareFilenameWithLFMUnitResCacheItem);
95 if Node<>nil then begin
96 Result:=TLFMUnitResCacheItem(Node.Data);
97 end else if AutoCreate then begin
98 Result:=TLFMUnitResCacheItem.Create;
99 Result.UnitFilename:=UnitFilename;
100 LFMUnitResCache.Add(Result);
101 end else
102 Result:=nil;
103 end;
104
105 { TLFMUnitResourcefileFormat }
106
TLFMUnitResourcefileFormat.FindResourceDirectivenull107 class function TLFMUnitResourcefileFormat.FindResourceDirective(Source: TObject): boolean;
108 var
109 NewCode: TCodeBuffer;
110 NewX,NewY,NewTopLine: integer;
111 CodeBuf: TCodeBuffer;
112 Cache: TLFMUnitResCacheItem;
113 begin
114 CodeBuf:=Source as TCodeBuffer;
115 Cache:=GetLFMUnitResCache(CodeBuf.Filename,true);
116 if Cache.CodeBufStamp<>CodeBuf.ChangeStep then begin
117 Cache.ResourceDirective:='';
118 Cache.CodeBufStamp:=CodeBuf.ChangeStep;
119 if CodeToolBoss.FindResourceDirective(CodeBuf,1,1,
120 NewCode,NewX,NewY,NewTopLine, ResourceDirectiveFilename,false)
121 then
122 Cache.ResourceDirective:=ResourceDirectiveFilename
123 else if (ResourceDirectiveFilename<>'*.dfm')
124 and CodeToolBoss.FindResourceDirective(CodeBuf,1,1,
125 NewCode,NewX,NewY,NewTopLine, '*.dfm',false)
126 then
127 Cache.ResourceDirective:='*.dfm';
128 end;
129 Result:=Cache.ResourceDirective<>'';
130 end;
131
TLFMUnitResourcefileFormat.GetUnitResourceFilenamenull132 class function TLFMUnitResourcefileFormat.GetUnitResourceFilename(
133 AUnitFilename: string; Loading: boolean): string;
134 var
135 DFMFilename: String;
136 begin
137 Result := ChangeFileExt(AUnitFilename,'.lfm');
138 if not FileExistsCached(Result)
139 and (SourceEditorManagerIntf.SourceEditorIntfWithFilename(Result)=nil)
140 then begin
141 DFMFilename:=ChangeFileExt(AUnitFilename,'.dfm');
142 if FileExistsCached(DFMFilename) then
143 Result:=DFMFilename;
144 end;
145 end;
146
TLFMUnitResourcefileFormat.QuickCheckResourceBuffernull147 class function TLFMUnitResourcefileFormat.QuickCheckResourceBuffer(PascalBuffer,
148 LFMBuffer: TObject; out LFMType, LFMComponentName, LFMClassName: string; out
149 LCLVersion: string; out MissingClasses: TStrings): TModalResult;
150 begin
151 Result := QuickCheckLFMBuffer(PascalBuffer as TCodeBuffer,
152 LFMBuffer as TCodeBuffer, LFMType, LFMComponentName, LFMClassName,
153 LCLVersion, MissingClasses);
154 end;
155
156 initialization
157 RegisterUnitResourcefileFormat(TLFMUnitResourcefileFormat);
158 LFMUnitResourceFileFormat:=TLFMUnitResourcefileFormat;
159 LFMUnitResCache:=TAvlTree.Create(@CompareLFMUnitResCacheItems);
160 finalization
161 LFMUnitResCache.FreeAndClear;
162 FreeAndNil(LFMUnitResCache);
163 end.
164
165