mirror of
https://github.com/keymanapp/keyman.git
synced 2026-09-16 04:37:41 +00:00
1310 lines
37 KiB
ObjectPascal
1310 lines
37 KiB
ObjectPascal
(*
|
|
Name: Keyman.Developer.System.Project.ProjectFile
|
|
Copyright: Copyright (C) SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 20 Jun 2006
|
|
|
|
Modified Date: 24 Aug 2015
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 20 Jun 2006 - mcdurdin - Initial version
|
|
01 Aug 2006 - mcdurdin - Rework for Keyman Developer 7, XML based project
|
|
23 Aug 2006 - mcdurdin - Add IDEState property for automatic saving/loading of IDE state
|
|
06 Oct 2006 - mcdurdin - Add pfaTestKeymanWeb
|
|
04 Dec 2006 - mcdurdin - Localize project templates
|
|
19 Mar 2007 - mcdurdin - I708 - Add IndexOfFileNameAndParent
|
|
16 May 2007 - mcdurdin - I791 - Unicode characters not rendering correctly in project
|
|
30 May 2007 - mcdurdin - I817 - Added pfaCompileInstaller
|
|
30 May 2007 - mcdurdin - I671 - Fixed crash when changing project
|
|
30 May 2007 - mcdurdin - I730 - Fixed details not updating in project
|
|
30 May 2007 - mcdurdin - I742 - Fixed crash when project folder is deleted
|
|
30 May 2007 - mcdurdin - I805 - Fixed crash when project folder is deleted
|
|
04 Jun 2007 - mcdurdin - Fix missing Result
|
|
19 Jun 2007 - mcdurdin - Fix crash when files are updated when loading a project
|
|
13 Jul 2007 - mcdurdin - I939 - Report script errors to website
|
|
23 Aug 2007 - mcdurdin - I1010 - persist untitled project
|
|
19 Nov 2007 - mcdurdin - I1157 - const string parameters
|
|
27 Mar 2008 - mcdurdin - I1221 - Fixup performance (only save at end of GetFileParamters)
|
|
14 Jun 2008 - mcdurdin - I1420 - Improve project performance
|
|
16 Jan 2009 - mcdurdin - I1685 - Fix crash when closing a file that has subfiles added to the project
|
|
09 Mar 2009 - mcdurdin - I1890 - Images missing in project the first time Keyman Developer ever starts
|
|
17 Dec 2010 - mcdurdin - I2595 - Remove GnuGetText from project as we are not using it and it crashes
|
|
18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support
|
|
08 Jun 2012 - mcdurdin - I3310 - V9.0 - Unicode in Delphi fixes
|
|
26 Jun 2012 - mcdurdin - I3377 - KM9 - Update code references from 8.0 to 9.0
|
|
26 Jun 2012 - mcdurdin - I3379 - KM9 - Remove old Winapi references now in Delphi libraries
|
|
19 Oct 2012 - mcdurdin - I3473 - V9.0 - Tidy up project loader encoding check to use DXE2 methods
|
|
24 Oct 2012 - mcdurdin - I3310 - buf reference was missing dereference in TFileStream.Read call
|
|
21 Feb 2014 - mcdurdin - I4057 - V9.0 - Keyman Developer Keyboard Font dialog helpful to reduce font confusion
|
|
01 May 2014 - mcdurdin - I4181 - V9.0 - Stop using DeleteFileAlways, MOVEFILE_DELAY_UNTIL_REBOOT
|
|
04 May 2015 - mcdurdin - I4687 - V9.0 - Split project UI actions into separate classes
|
|
04 May 2015 - mcdurdin - I4688 - V9.0 - Add build path to project settings
|
|
04 May 2015 - mcdurdin - I4692 - V9.0 - Add Clean as project action
|
|
04 May 2015 - mcdurdin - I4694 - V9.0 - Split UI actions from non-UI actions in projects
|
|
05 May 2015 - mcdurdin - I4698 - V9.0 - Split project and user preferences files
|
|
06 May 2015 - mcdurdin - I4702 - Package actions crash if package not part of a project [CrashID:tike.exe_9.0.496.0_008033BD_EAccessViolation]
|
|
06 May 2015 - mcdurdin - I4701 - V9.0 - If version is not specified in keyboard file, it gets blank instead of 1.0 in kmcomp .kpj
|
|
11 May 2015 - mcdurdin - I4706 - V9.0 - Update compile logging for silent and warning-as-error cleanness
|
|
11 May 2015 - mcdurdin - I4709 - V9.0 - Use static hashing for id for project files to avoid unnecessary changes
|
|
12 May 2015 - mcdurdin - I4710 - V9.0 - Project can crash if file parameters change during build
|
|
27 May 2015 - mcdurdin - I4720 - Compiling a standalone keyboard crashes Developer [CrashID:tike.exe_9.0.503.0_00A4316C_EAccessViolation]
|
|
27 May 2015 - mcdurdin - I4703 - Loading a non-project file as a project crashes Developer [CrashID:tike.exe_9.0.497.0_00813E09_EProjectLoader]
|
|
30 May 2015 - mcdurdin - I4729 - If you attempt to load a non-XML file as a project, it silently fails and overwrites the file
|
|
24 Aug 2015 - mcdurdin - I4866 - Add warn on deprecated features to project and compile
|
|
24 Aug 2015 - mcdurdin - I4865 - Add treat hints and warnings as errors into project
|
|
|
|
*)
|
|
unit Keyman.Developer.System.Project.ProjectFile; // I3306 // I4687
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes,
|
|
System.Contnrs,
|
|
System.SysUtils,
|
|
System.Types,
|
|
System.WideStrings,
|
|
Winapi.Messages,
|
|
Winapi.msxml,
|
|
Winapi.Windows,
|
|
Xml.Win.msxmldom,
|
|
Xml.xmldoc,
|
|
Xml.xmlintf,
|
|
|
|
mrulist,
|
|
Keyman.Developer.System.Project.ProjectLog,
|
|
TempFileManager,
|
|
utilfiletypes;
|
|
|
|
type
|
|
{ Forward declarations }
|
|
|
|
IProjectFileFreeNotification = interface;
|
|
|
|
TProjectFileList = class;
|
|
TProjectFile = class;
|
|
TProjectFileStates = class;
|
|
TProjectOptions = class;
|
|
|
|
TProjectState = (psCreating, psReady, psLoading, psSaving, psDestroying);
|
|
TProjectType = (ptUnknown, ptKeyboard, ptLexicalModel); // distinct from utilfiletypes.TKeymanProjectType
|
|
|
|
{ TProject }
|
|
|
|
IProjectUI = interface
|
|
['{FA8AF90B-7C98-4306-AAF1-A15C6E20CD0C}']
|
|
procedure Refresh;
|
|
end;
|
|
|
|
TProject = class
|
|
private
|
|
FBusy, FMustSave: Boolean;
|
|
FState: TProjectState;
|
|
FFileName: string;
|
|
FFiles: TProjectFileList;
|
|
FDisplayState: WideString;
|
|
FMRU: TMRUList;
|
|
FOptions: TProjectOptions;
|
|
|
|
procedure SetFileName(Value: string);
|
|
function ImportFromIni(FileName: string): Boolean;
|
|
function LoadFromXML(FileName: string): Boolean;
|
|
function ExpandMemberFileName(Root, FileName: string): string;
|
|
function GetSavedFileName: string;
|
|
function GetUntitled: Boolean;
|
|
//procedure ChildRefresh(Sender: TObject);
|
|
procedure ListNotify(Item: TProjectFile; Action: TListNotification);
|
|
procedure ChildRefresh(Sender: TObject);
|
|
procedure MRUChange(Sender: TObject);
|
|
procedure UpdateFileParameters;
|
|
procedure LoadPersistedUntitledProject;
|
|
function GetSavedUserFileName: string;
|
|
protected
|
|
procedure DoRefresh; virtual;
|
|
procedure DoRefreshCaption; virtual;
|
|
|
|
property State: TProjectState read FState;
|
|
property SavedFileName: string read GetSavedFileName;
|
|
property SavedUserFileName: string read GetSavedUserFileName;
|
|
|
|
public
|
|
procedure Log(AState: TProjectLogState; Filename, Msg: string; MsgCode, line: Integer); virtual;
|
|
|
|
constructor Create(AProjectType: TProjectType; AFileName: string; ALoadPersistedUntitledProject: Boolean = False); virtual;
|
|
destructor Destroy; override;
|
|
|
|
procedure Refresh;
|
|
|
|
procedure PersistUntitledProject;
|
|
|
|
function Render: WideString;
|
|
|
|
function Load: Boolean; virtual; // I4694
|
|
function Save: Boolean; virtual; // I4694
|
|
function SaveUser: Boolean; virtual; // I4694
|
|
|
|
class function StandardTemplatePath: string;
|
|
class function StringsTemplatePath: string;
|
|
|
|
class function GetUntitledProjectFilename(CurrentProcess: Boolean): string;
|
|
|
|
function GetTargetFilename(ATargetFile, ASourceFile, AVersion: string): string; // I4688
|
|
|
|
//procedure AddMRU(const FFileName: string);
|
|
property MRU: TMRUList read FMRU;
|
|
|
|
property Options: TProjectOptions read FOptions; // I4688
|
|
|
|
function FindFile(AFileName: string): TProjectFile;
|
|
|
|
//property StandardTemplatePath: string read GetStandardTemplatePath;
|
|
property FileName: string read FFileName write SetFileName;
|
|
property Untitled: Boolean read GetUntitled;
|
|
|
|
property Files: TProjectFileList read FFiles;
|
|
property DisplayState: WideString read FDisplayState write FDisplayState;
|
|
|
|
property Busy: Boolean read FBusy write FBusy;
|
|
property MustSave: Boolean read FMustSave write FMustSave;
|
|
|
|
public
|
|
class var CompilerMessageFile: TProjectFile; // I4694
|
|
end;
|
|
|
|
{ TProjectFile and associated classes }
|
|
|
|
TProjectFile = class
|
|
private
|
|
FNotifiers: TInterfaceList;
|
|
FProject: TProject;
|
|
FFileName: string;
|
|
FModified: Boolean;
|
|
FTag: Integer;
|
|
FParent: TProjectFile;
|
|
FID: string;
|
|
FParentFileID: string;
|
|
FIDEState: TProjectFileStates;
|
|
FFileVersion: string; // I4688
|
|
FUI: TObject; // I4687
|
|
FHasWarning: Boolean; // I4706
|
|
FCheckedParameters: Boolean; // I4710
|
|
procedure SetFileName(Value: string);
|
|
procedure SetModified(const Value: Boolean);
|
|
procedure SetParent(const Value: TProjectFile);
|
|
function GetName: string;
|
|
function CheckGetFileParameters: Boolean;
|
|
function CleanID(s: string): string;
|
|
function GetOwnerProject: TProject;
|
|
procedure UpdateID;
|
|
protected
|
|
procedure Log(AState: TProjectLogState; Msg: string; MsgCode, Line: Integer); // I4694 // I4706
|
|
|
|
procedure SetFileVersion(const AVersion: string); // I4688
|
|
//FFiles: TProjectFileList;
|
|
function GetRelativeOrder: Integer; virtual; abstract;
|
|
procedure GetFileParameters; virtual; abstract;
|
|
|
|
procedure CleanFile(ATargetFilename: string; ADontCleanIfInSource: Boolean = False); // I4692
|
|
|
|
property CheckedParameters: Boolean read FCheckedParameters write FCheckedParameters; // I4710
|
|
public
|
|
constructor Create(AProject: TProject; AFileName: string; AParent: TProjectFile); virtual;
|
|
destructor Destroy; override;
|
|
|
|
procedure Load(node: IXMLNode; LoadState: Boolean); virtual; // I4698
|
|
procedure LoadState(node: IXMLNode); virtual; // I4698
|
|
procedure Save(node: IXMLNode; SaveState: Boolean); virtual; // I4698
|
|
procedure SaveState(node: IXMLNode); virtual; // I4698
|
|
|
|
procedure AddFreeNotification(AClient: IProjectFileFreeNotification);
|
|
procedure RemoveFreeNotification(AClient: IProjectFileFreeNotification);
|
|
|
|
procedure SetUI(AUI: TObject); // I4687
|
|
|
|
property OwnerProject: TProject read GetOwnerProject;
|
|
property Project: TProject read FProject;
|
|
property FileName: string read FFileName write SetFileName;
|
|
property FileVersion: string read FFileVersion; // I4688
|
|
//property Files: TProjectFileList read FFiles;
|
|
property Modified: Boolean read FModified write SetModified;
|
|
property RelativeOrder: Integer read GetRelativeOrder;
|
|
property HasCompileWarning: Boolean read FHasWarning write FHasWarning; // I4706
|
|
|
|
property Parent: TProjectFile read FParent write SetParent;
|
|
property ParentFileID: string read FParentFileID write FParentFileID; // Used only in load
|
|
|
|
property Name: string read GetName;
|
|
property ID: string read FID;
|
|
|
|
property IDEState: TProjectFileStates read FIDEState;
|
|
|
|
property Tag: Integer read FTag write FTag;
|
|
|
|
property UI: TObject read FUI; // I4687
|
|
end;
|
|
|
|
TProjectFileClass = class of TProjectFile;
|
|
|
|
TProjectFileListNotificationEvent = procedure(Item: TProjectFile; Action: TListNotification) of object;
|
|
|
|
TProjectFileList = class(TObjectList)
|
|
private
|
|
FOnChange: TProjectFileListNotificationEvent;
|
|
//procedure SortByType;
|
|
protected
|
|
function Get(Index: Integer): TProjectFile;
|
|
procedure Put(Index: Integer; Item: TProjectFile);
|
|
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
|
public
|
|
property Items[Index: Integer]: TProjectFile read Get write Put; default;
|
|
function IndexOf(Item: TProjectFile): Integer;
|
|
function IndexOfID(ID: string): Integer;
|
|
function IndexOfFileName(Name: string): Integer;
|
|
function IndexOfFileNameAndParent(Name: string; Parent: TProjectFile): Integer;
|
|
function Add(Item: TProjectFile): Integer;
|
|
property OnChange: TProjectFileListNotificationEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
TProjectFileState = class
|
|
Name: WideString;
|
|
Value: WideString;
|
|
end;
|
|
|
|
TProjectFileStates = class(TObjectList)
|
|
private
|
|
function GetItem(Index: WideString): WideString;
|
|
procedure SetItem(Index, Value: WideString);
|
|
function IndexOfName(Name: WideString): Integer;
|
|
public
|
|
procedure Delete(Index: WideString);
|
|
property Items[Index: WideString]: WideString read GetItem write SetItem; default;
|
|
end;
|
|
|
|
IProjectFileFreeNotification = interface
|
|
['{C0B8261C-2F59-4C62-A59C-BAE3E09EEDDB}']
|
|
procedure ProjectFileDestroying(ProjectFile: TProjectFile);
|
|
end;
|
|
|
|
TProjectOptions = class // I4688
|
|
private
|
|
FBuildPath: string;
|
|
FWarnDeprecatedCode: Boolean; // I4866
|
|
FCompilerWarningsAsErrors: Boolean; // I4865
|
|
FCheckFilenameConventions: Boolean;
|
|
FProjectType: TProjectType;
|
|
public
|
|
constructor Create;
|
|
property BuildPath: string read FBuildPath write FBuildPath;
|
|
property WarnDeprecatedCode: Boolean read FWarnDeprecatedCode write FWarnDeprecatedCode; // I4866
|
|
property CompilerWarningsAsErrors: Boolean read FCompilerWarningsAsErrors write FCompilerWarningsAsErrors; // I4865
|
|
property CheckFilenameConventions: Boolean read FCheckFilenameConventions write FCheckFilenameConventions;
|
|
property ProjectType: TProjectType read FProjectType write FProjectType;
|
|
end;
|
|
|
|
const
|
|
WM_USER_ProjectUpdateDisplayState = WM_USER;
|
|
|
|
function GlobalProjectStateWndHandle: THandle;
|
|
function ProjectCompilerMessage(line: Integer; msgcode: LongWord; text: PAnsiChar): Integer; stdcall; // I3310 // I4694
|
|
function ProjectCompilerMessageW(line: Integer; msgcode: LongWord; const text: string): Integer;
|
|
procedure ProjectCompilerMessageClear;
|
|
|
|
function ProjectTypeFromString(s: string): TProjectType;
|
|
function ProjectTypeToString(pt: TProjectType): string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Winapi.ShlObj,
|
|
System.AnsiStrings,
|
|
System.IniFiles,
|
|
System.DateUtils,
|
|
System.Hash,
|
|
System.StrUtils,
|
|
System.Variants,
|
|
|
|
CompileErrorCodes,
|
|
Keyman.Developer.System.Project.Project,
|
|
Keyman.Developer.System.Project.ProjectFileType,
|
|
Keyman.Developer.System.Project.ProjectLoader,
|
|
Keyman.Developer.System.Project.ProjectSaver,
|
|
Keyman.Developer.System.Project.UrlRenderer,
|
|
RedistFiles,
|
|
RegistryKeys,
|
|
Unicode,
|
|
utildir,
|
|
utilsystem;
|
|
|
|
{ TProjectFileList }
|
|
|
|
function TProjectFileList.Add(Item: TProjectFile): Integer;
|
|
begin
|
|
Result := inherited Add(Item);
|
|
//SortByType;
|
|
end;
|
|
|
|
function TProjectFileList.Get(Index: Integer): TProjectFile;
|
|
begin
|
|
Result := TProjectFile(inherited Get(Index));
|
|
end;
|
|
|
|
function TProjectFileList.IndexOf(Item: TProjectFile): Integer;
|
|
begin
|
|
Result := inherited IndexOf(Item);
|
|
end;
|
|
|
|
function TProjectFileList.IndexOfFileName(Name: string): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if (Items[i].FParentFileID = '') and (AnsiCompareText(Items[i].FileName, Name) = 0) then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TProjectFileList.IndexOfFileNameAndParent(Name: string; Parent: TProjectFile): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if (Items[i].Parent = Parent) and (AnsiCompareText(Items[i].FileName, Name) = 0) then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TProjectFileList.IndexOfID(ID: string): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if Items[i].ID = ID then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TProjectFileList.Notify(Ptr: Pointer; Action: TListNotification);
|
|
begin
|
|
inherited;
|
|
if Assigned(FOnChange) then FOnChange(Ptr, Action);
|
|
end;
|
|
|
|
procedure TProjectFileList.Put(Index: Integer; Item: TProjectFile);
|
|
begin
|
|
inherited Put(Index, Item);
|
|
end;
|
|
|
|
{function ProjectFileListSortByType(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
Result := TProjectFile(Item1).RelativeOrder - TProjectFile(Item2).RelativeOrder;
|
|
end;}
|
|
|
|
{procedure TProjectFileList.SortByType;
|
|
begin
|
|
// function ensures that files will be compiled in the correct order
|
|
//Sort(ProjectFileListSortByType);
|
|
end;}
|
|
|
|
{ TProjectFile }
|
|
|
|
procedure TProjectFile.AddFreeNotification(
|
|
AClient: IProjectFileFreeNotification);
|
|
begin
|
|
if FNotifiers.IndexOf(AClient) < 0 then
|
|
FNotifiers.Add(AClient);
|
|
end;
|
|
|
|
function TProjectFile.CheckGetFileParameters: Boolean;
|
|
var
|
|
FileDateTime, ProjectDateTime: TDateTime;
|
|
begin
|
|
Result := False;
|
|
if not Assigned(FProject) then Result := True
|
|
else if FileAge(FFileName, FileDateTime) then
|
|
begin
|
|
if not FileAge(FProject.FFileName, ProjectDateTime) then Result := True
|
|
else if (FileDateTime >= ProjectDateTime) and (SecondsBetween(FileDateTime, ProjectDateTime) >= 0) then Result := True;
|
|
end;
|
|
if Result then GetFileParameters;
|
|
end;
|
|
|
|
procedure TProjectFile.CleanFile(ATargetFilename: string; ADontCleanIfInSource: Boolean); // I4692
|
|
var
|
|
FTargetPath: string;
|
|
FTargetFilename: string;
|
|
begin
|
|
// Sanity check.
|
|
if ATargetFilename = '' then
|
|
Exit;
|
|
|
|
// Go through the BuildPath and sub folders, removing any files that match AFileMask?
|
|
FTargetFilename := OwnerProject.GetTargetFilename(ATargetFilename, FileName, FileVersion);
|
|
if FTargetFilename = '' then
|
|
Exit;
|
|
|
|
// If the target is the source file, that means we are building to the source folder
|
|
// so we don't want to delete the output file. e.g. for .kvk files
|
|
if SameFileName(ATargetFilename, FTargetFilename) and ADontCleanIfInSource then
|
|
Exit;
|
|
|
|
// Delete file and remove the folder if empty
|
|
FTargetPath := ExtractFileDir(FTargetFilename);
|
|
if FileExists(FTargetFilename) then
|
|
System.SysUtils.DeleteFile(FTargetFilename);
|
|
if DirectoryExists(FTargetPath) and DirectoryEmpty(FTargetPath) then
|
|
RemoveDirectory(PChar(FTargetPath));
|
|
end;
|
|
|
|
function TProjectFile.CleanID(s: string): string;
|
|
begin
|
|
Result := AnsiReplaceText(s, '{', '');
|
|
Result := AnsiReplaceText(Result, '}', '');
|
|
Result := AnsiReplaceText(Result, '-', '');
|
|
if Copy(Result, 1, 3) <> 'id_' then Result := 'id_'+Result;
|
|
end;
|
|
|
|
constructor TProjectFile.Create(AProject: TProject; AFileName: string; AParent: TProjectFile);
|
|
begin
|
|
inherited Create;
|
|
|
|
FNotifiers := TInterfaceList.Create;
|
|
FIDEState := TProjectFileStates.Create;
|
|
FFileName := AFileName;
|
|
FProject := AProject;
|
|
FParent := AParent;
|
|
|
|
if not Assigned(AProject) then // I4720
|
|
CheckGetFileParameters;
|
|
|
|
if (GetCurrentThreadId = MainThreadID) and Assigned(FDoCreateProjectFileUI) then // I4702
|
|
FDoCreateProjectFileUI(Self); // I4687
|
|
|
|
UpdateID;
|
|
end;
|
|
|
|
destructor TProjectFile.Destroy;
|
|
var
|
|
i: Integer;
|
|
p: TProject;
|
|
begin
|
|
for i := 0 to FNotifiers.Count - 1 do
|
|
(FNotifiers.Items[i] as IProjectFileFreeNotification).ProjectFileDestroying(Self);
|
|
|
|
p := OwnerProject;
|
|
|
|
if Assigned(p) then
|
|
begin
|
|
p.Files.Extract(Self);
|
|
|
|
for i := p.Files.Count - 1 downto 0 do
|
|
if p.Files[i].Parent = Self then
|
|
p.Files.Delete(i);
|
|
end;
|
|
|
|
FreeAndNil(FIDEState);
|
|
|
|
FreeAndNil(FUI);
|
|
|
|
FNotifiers.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TProjectFile.GetName: string;
|
|
begin
|
|
Result := ExtractFileName(FFileName);
|
|
end;
|
|
|
|
function TProjectFile.GetOwnerProject: TProject;
|
|
begin
|
|
Result := FProject;
|
|
if Result = nil then
|
|
begin
|
|
if Assigned(FParent) then
|
|
Result := FParent.OwnerProject;
|
|
if Result = nil then
|
|
Result := FGlobalProject;
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectFile.Load(node: IXMLNode; LoadState: Boolean); // I4698
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if node.ChildNodes.IndexOf('ID') >= 0 then
|
|
FID := CleanID(VarToWideStr(node.ChildValues['ID']));
|
|
if node.ChildNodes.IndexOf('ParentFileID') >= 0 then
|
|
FParentFileID := CleanID(VarToWideStr(node.ChildValues['ParentFileID']));
|
|
|
|
if LoadState then
|
|
begin
|
|
FIDEState.Clear;
|
|
if node.ChildNodes.IndexOf('IDEState') >= 0 then
|
|
begin
|
|
node := node.ChildNodes.Nodes['IDEState'];
|
|
for i := 0 to node.ChildNodes.Count - 1 do
|
|
FIDEState[node.ChildNodes[i].NodeName] := node.ChildNodes[i].NodeValue;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectFile.LoadState(node: IXMLNode); // I4698
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if node.ChildNodes.IndexOf('IDEState') >= 0 then
|
|
begin
|
|
FIDEState.Clear;
|
|
node := node.ChildNodes.Nodes['IDEState'];
|
|
for i := 0 to node.ChildNodes.Count - 1 do
|
|
FIDEState[node.ChildNodes[i].NodeName] := node.ChildNodes[i].NodeValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectFile.Log(AState: TProjectLogState; Msg: string; MsgCode, Line: Integer); // I4694 // I4706
|
|
begin
|
|
OwnerProject.Log(AState, Filename, Msg, MsgCode, Line); // I4702 // I4706
|
|
end;
|
|
|
|
procedure TProjectFile.RemoveFreeNotification(
|
|
AClient: IProjectFileFreeNotification);
|
|
begin
|
|
FNotifiers.Remove(AClient);
|
|
end;
|
|
|
|
procedure TProjectFile.Save(node: IXMLNode; SaveState: Boolean); // I4698
|
|
var
|
|
I: Integer;
|
|
begin
|
|
node.AddChild('ID').NodeValue := FID;
|
|
node.AddChild('Filename').NodeValue := ExtractFileName(FFileName);
|
|
node.AddChild('Filepath').NodeValue := ExtractRelativePath(FProject.FileName, FFileName);
|
|
node.AddChild('FileVersion').NodeValue := FFileVersion; // I4701
|
|
node.AddChild('FileType').NodeValue := ExtractFileExt(FFileName);;
|
|
if Assigned(FParent) then
|
|
node.AddChild('ParentFileID').NodeValue := FParent.ID;
|
|
|
|
if SaveState then
|
|
begin
|
|
node.AddChild('FullPath').NodeValue := FFileName;
|
|
|
|
if FIDEState.Count > 0 then
|
|
begin
|
|
node := node.AddChild('IDEState');
|
|
for I := 0 to FIDEState.Count - 1 do
|
|
begin
|
|
with node.AddChild(TProjectFileState(FIDEState.Get(I)).Name) do
|
|
NodeValue := TProjectFileState(FIDEState.Get(I)).Value;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectFile.SaveState(node: IXMLNode); // I4698
|
|
var
|
|
I: Integer;
|
|
begin
|
|
node.AddChild('ID').NodeValue := FID;
|
|
node.AddChild('FullPath').NodeValue := FFileName;
|
|
|
|
if FIDEState.Count > 0 then
|
|
begin
|
|
node := node.AddChild('IDEState');
|
|
for I := 0 to FIDEState.Count - 1 do
|
|
begin
|
|
with node.AddChild(TProjectFileState(FIDEState.Get(I)).Name) do
|
|
NodeValue := TProjectFileState(FIDEState.Get(I)).Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectFile.UpdateID;
|
|
begin
|
|
if Assigned(FProject)
|
|
then FID := CleanID(THashMD5.GetHashString(LowerCase( ExtractRelativePath(FProject.FileName, FFileName) ))) // I4709
|
|
else FID := CleanID(THashMD5.GetHashString(LowerCase(FFileName)));
|
|
end;
|
|
|
|
procedure TProjectFile.SetFileName(Value: string);
|
|
begin
|
|
FFileName := Value;
|
|
UpdateID;
|
|
CheckGetFileParameters;
|
|
//if Assigned(FProject) then FProject.ChildRefresh(Self);
|
|
end;
|
|
|
|
procedure TProjectFile.SetFileVersion(const AVersion: string); // I4688
|
|
begin
|
|
FFileVersion := AVersion;
|
|
end;
|
|
|
|
procedure TProjectFile.SetModified(const Value: Boolean);
|
|
begin
|
|
if FModified <> Value then
|
|
begin
|
|
FModified := Value;
|
|
if FModified = False then
|
|
begin
|
|
CheckGetFileParameters;
|
|
if Assigned(FProject) then FProject.ChildRefresh(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TProjectFile.SetParent(const Value: TProjectFile);
|
|
begin
|
|
FParent := Value;
|
|
if Assigned(FProject) then FProject.ChildRefresh(Self);
|
|
end;
|
|
|
|
procedure TProjectFile.SetUI(AUI: TObject); // I4687
|
|
begin
|
|
FUI := AUI;
|
|
end;
|
|
|
|
{ TProject }
|
|
|
|
procedure TProject.ChildRefresh(Sender: TObject);
|
|
begin
|
|
if FState = psReady then
|
|
begin
|
|
Save;
|
|
Refresh;
|
|
end;
|
|
end;
|
|
|
|
constructor TProject.Create(AProjectType: TProjectType; AFileName: string; ALoadPersistedUntitledProject: Boolean = False);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FOptions := TProjectOptions.Create; // I4688
|
|
|
|
if AProjectType = ptUnknown
|
|
then FOptions.ProjectType := ptKeyboard
|
|
else FOptions.ProjectType := AProjectType;
|
|
|
|
FState := psCreating;
|
|
inherited Create;
|
|
FMRU := TMRUList.Create('');
|
|
FMRU.OnChange := MRUChange;
|
|
FFileName := AFileName;
|
|
FFiles := TProjectFileList.Create;
|
|
FFiles.OnChange := ListNotify;
|
|
|
|
FState := psReady;
|
|
|
|
FMustSave := False;
|
|
|
|
if (FFileName = '') and (ALoadPersistedUntitledProject) then
|
|
begin
|
|
FMustSave := True;
|
|
LoadPersistedUntitledProject; // I1010: Persist untitled project
|
|
end
|
|
else if not Load then // I4703
|
|
begin
|
|
FFileName := '';
|
|
if not Load then
|
|
begin
|
|
FMustSave := True;
|
|
LoadPersistedUntitledProject; // I4703
|
|
end;
|
|
end;
|
|
|
|
FBusy := True;
|
|
i := 0;
|
|
while i < FFiles.Count do
|
|
begin
|
|
if FFiles[i].CheckGetFileParameters then FMustSave := True;
|
|
Inc(i);
|
|
end;
|
|
|
|
FBusy := False;
|
|
if FMustSave then Save;
|
|
end;
|
|
|
|
destructor TProject.Destroy;
|
|
begin
|
|
FState := psDestroying;
|
|
FFiles.Free;
|
|
FMRU.Free;
|
|
FreeAndNil(FOptions); // I4688
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TProject.DoRefresh; // I4687
|
|
begin
|
|
end;
|
|
|
|
procedure TProject.DoRefreshCaption; // I4687
|
|
begin
|
|
end;
|
|
|
|
procedure TProject.SetFileName(Value: string);
|
|
begin
|
|
FFileName := Value;
|
|
DoRefreshCaption; // I4687
|
|
end;
|
|
|
|
procedure TProject.ListNotify(Item: TProjectFile; Action: TListNotification);
|
|
begin
|
|
if FState = psReady then
|
|
begin
|
|
if Action = lnAdded then
|
|
Item.GetFileParameters;
|
|
if FBusy then
|
|
FMustSave := True
|
|
else
|
|
begin
|
|
Save;
|
|
Refresh;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TProject.Load: Boolean;
|
|
var
|
|
buf: TBytes; // I3310
|
|
encoding: TEncoding;
|
|
begin
|
|
FState := psLoading;
|
|
try
|
|
SetLength(buf, 32);
|
|
if FileExists(SavedFileName) then
|
|
begin
|
|
with TFileStream.Create(SavedFileName, fmOpenRead) do
|
|
try
|
|
Read(buf[0], 32); // I3310
|
|
finally
|
|
Free;
|
|
end;
|
|
|
|
if (buf[0] = Ord('<')) or ((TEncoding.GetBufferEncoding(buf, encoding) > 0) and (encoding = TEncoding.UTF8)) // I3310, I3473
|
|
then Result := LoadFromXML(SavedFileName)
|
|
else Result := ImportFromIni(SavedFileName);
|
|
end
|
|
else if DirectoryExists(ExtractFilePath(SavedFileName)) then
|
|
Result := Save { Create a temporary project file }
|
|
else
|
|
begin
|
|
Result := False;
|
|
FFileName := '';
|
|
end;
|
|
|
|
UpdateFileParameters; // I4688
|
|
finally
|
|
FState := psReady;
|
|
end;
|
|
end;
|
|
|
|
// I1010: Persist untitled project - begin
|
|
|
|
procedure TProject.LoadPersistedUntitledProject;
|
|
begin
|
|
FFileName := TProject.GetUntitledProjectFilename(False);
|
|
try
|
|
Load;
|
|
finally
|
|
FFileName := '';
|
|
end;
|
|
end;
|
|
|
|
procedure TProject.Log(AState: TProjectLogState; Filename, Msg: string; MsgCode, line: Integer);
|
|
begin
|
|
// Do nothing
|
|
end;
|
|
|
|
procedure TProject.PersistUntitledProject;
|
|
var
|
|
path: string;
|
|
begin
|
|
path := TProject.GetUntitledProjectFilename(False);
|
|
|
|
FState := psSaving;
|
|
with TProjectSaver.Create(Self, path) do
|
|
try
|
|
Execute;
|
|
finally
|
|
Free;
|
|
end;
|
|
|
|
FState := psReady;
|
|
end;
|
|
|
|
procedure TProject.Refresh; // I4687
|
|
begin
|
|
DoRefresh;
|
|
end;
|
|
|
|
function TProject.Render: WideString;
|
|
var
|
|
doc, userdoc, xsl: IXMLDomDocument;
|
|
FLastDir: string;
|
|
i: Integer;
|
|
begin
|
|
if not FileExists(SavedFileName) then Save;
|
|
|
|
Result := '';
|
|
FLastDir := GetCurrentDir;
|
|
SetCurrentDir(StringsTemplatePath);
|
|
try
|
|
doc := MSXMLDOMDocumentFactory.CreateDOMDocument;
|
|
try
|
|
doc.async := False;
|
|
doc.load(SavedFileName);
|
|
|
|
//
|
|
// Inject the user settings to the loaded file
|
|
//
|
|
|
|
if FileExists(SavedUserFileName) then // I4698
|
|
begin
|
|
userdoc := MSXMLDOMDocumentFactory.CreateDOMDocument;
|
|
try
|
|
userdoc.async := False;
|
|
userdoc.load(SavedUserFileName);
|
|
|
|
for i := 0 to userdoc.documentElement.childNodes.length - 1 do
|
|
doc.documentElement.appendChild(userdoc.documentElement.childNodes.item[i].cloneNode(true));
|
|
finally
|
|
userdoc := nil;
|
|
end;
|
|
end;
|
|
|
|
//
|
|
// Inject state URLs into the loaded file
|
|
//
|
|
|
|
TProjectUrlRenderer.AddUrls(doc.documentElement);
|
|
|
|
xsl := MSXMLDOMDocumentFactory.CreateDOMDocument;
|
|
try
|
|
xsl.async := False;
|
|
xsl.resolveExternals := True;
|
|
xsl.validateOnParse := False;
|
|
xsl.load(StringsTemplatePath + 'project.xsl');
|
|
Result := doc.transformNode(xsl);
|
|
finally
|
|
xsl := nil;
|
|
end;
|
|
finally
|
|
doc := nil;
|
|
end;
|
|
finally
|
|
SetCurrentDir(FLastDir);
|
|
end;
|
|
end;
|
|
|
|
// I1010: Persist untitled project - end
|
|
|
|
function TProject.LoadFromXML(FileName: string): Boolean;
|
|
begin
|
|
with TProjectLoader.Create(Self, FileName) do
|
|
try
|
|
Execute;
|
|
finally
|
|
Free;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TProject.MRUChange(Sender: TObject);
|
|
begin
|
|
if FState = psReady then
|
|
begin
|
|
Save;
|
|
Refresh;
|
|
end;
|
|
end;
|
|
|
|
function TProject.ExpandMemberFileName(Root, FileName: string): string;
|
|
var
|
|
buf: array[0..260] of char;
|
|
p: PChar;
|
|
begin
|
|
Result := ExpandFileNameEx(ExtractFilePath(Root), FileName);
|
|
if GetFullPathName(PChar(Result), 260, buf, p) > 0 then Result := buf;
|
|
end;
|
|
|
|
function TProject.ImportFromIni(FileName: string): Boolean;
|
|
var
|
|
s: TStringList;
|
|
i: Integer;
|
|
FRootPath: string;
|
|
begin
|
|
with TStringStream.Create do // I4729
|
|
try
|
|
LoadFromFile(FileName);
|
|
if Copy(DataString, 1, 1) <> '[' then
|
|
raise EProjectLoader.Create('Not a valid project file');
|
|
finally
|
|
Free;
|
|
end;
|
|
|
|
FRootPath := ExtractFilePath(FileName);
|
|
s := TStringList.Create;
|
|
with TIniFile.Create(FileName) do
|
|
try
|
|
if not SectionExists('Files') then // I4729
|
|
raise EProjectLoader.Create('Not a valid project file');
|
|
|
|
ReadSection('Files', s);
|
|
for i := 0 to s.Count - 1 do
|
|
CreateProjectFile(Self, ExpandMemberFileName(FileName, s[i]), nil);
|
|
|
|
ReadSection('MRU', s);
|
|
for i := 0 to s.Count - 1 do
|
|
MRU.Append(s[i]);
|
|
finally
|
|
Free;
|
|
s.Free;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TProject.Save: Boolean;
|
|
begin
|
|
FState := psSaving;
|
|
try
|
|
with TProjectSaver.Create(Self, SavedFileName) do
|
|
try
|
|
Execute;
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
FState := psReady;
|
|
end;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function TProject.SaveUser: Boolean;
|
|
begin
|
|
FState := psSaving;
|
|
try
|
|
with TProjectSaver.Create(Self, SavedFileName) do
|
|
try
|
|
SaveUser;
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
FState := psReady;
|
|
end;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function TProject.GetSavedFileName: string;
|
|
begin
|
|
if FFileName = ''
|
|
then Result := TProject.GetUntitledProjectFilename(True) // I4181
|
|
else Result := FFileName;
|
|
end;
|
|
|
|
function TProject.GetSavedUserFileName: string;
|
|
begin
|
|
Result := ChangeFileExt(SavedFileName, Ext_ProjectSourceUser);
|
|
end;
|
|
|
|
function TProject.GetTargetFilename(ATargetFile, ASourceFile, AVersion: string): string; // I4688
|
|
begin
|
|
Result := Trim(Options.BuildPath);
|
|
if Result = '' then Result := '$SOURCEPATH';
|
|
Result := IncludeTrailingPathDelimiter(Result);
|
|
|
|
// Replace placeholders in the target path
|
|
Result := ReplaceText(Result, '$SOURCEPATH', ExtractFileDir(ExpandFileName(ASourceFile)));
|
|
if FFileName = '' // if we have an unsaved project, use the source path for project path
|
|
then Result := ReplaceText(Result, '$PROJECTPATH', ExtractFileDir(ExpandFileName(ASourceFile)))
|
|
else Result := ReplaceText(Result, '$PROJECTPATH', ExtractFileDir(ExpandFileName(FFileName)));
|
|
Result := ReplaceText(Result, '$VERSION', AVersion);
|
|
|
|
Result := Result + ExtractFileName(ATargetFile);
|
|
end;
|
|
|
|
class function TProject.StandardTemplatePath: string; //(const FileName: string): string;
|
|
begin
|
|
Result := StringsTemplatePath; // GetXMLTemplatePath + 'project\';
|
|
end;
|
|
|
|
class function TProject.StringsTemplatePath: string;
|
|
begin
|
|
Result := GetXMLTemplatePath + 'project\';
|
|
end;
|
|
|
|
class function TProject.GetUntitledProjectFilename(CurrentProcess: Boolean): string;
|
|
begin
|
|
if CurrentProcess
|
|
then Result := GetFolderPath(CSIDL_APPDATA) + SFolderKeymanDeveloper + '\Untitled.' + IntToStr(GetCurrentProcessId) + Ext_ProjectSource
|
|
else Result := GetFolderPath(CSIDL_APPDATA) + SFolderKeymanDeveloper + '\Untitled' + Ext_ProjectSource;
|
|
end;
|
|
|
|
procedure TProject.UpdateFileParameters; // I4688 // I4710
|
|
var
|
|
i: Integer;
|
|
f: TProjectFile;
|
|
begin
|
|
for i := 0 to Files.Count - 1 do
|
|
Files[i].CheckedParameters := False;
|
|
|
|
i := 0;
|
|
while i < Files.Count do
|
|
begin
|
|
if not Files[i].CheckedParameters then
|
|
begin
|
|
f := Files[i];
|
|
f.CheckedParameters := True;
|
|
f.GetFileParameters;
|
|
i := 0; // The file list can change
|
|
end
|
|
else
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
function TProject.GetUntitled: Boolean;
|
|
begin
|
|
Result := FFileName = '';
|
|
end;
|
|
|
|
{procedure TProject.ChildRefresh(Sender: TObject);
|
|
begin
|
|
if FState = psReady then
|
|
begin
|
|
Save;
|
|
Refresh;
|
|
end;
|
|
end;}
|
|
|
|
function TProject.FindFile(AFileName: string): TProjectFile;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Files.Count - 1 do
|
|
if Files[i].FileName = AFileName then
|
|
begin
|
|
Result := Files[i];
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
{ TProjectFileStates }
|
|
|
|
procedure TProjectFileStates.Delete(Index: WideString);
|
|
var
|
|
n: Integer;
|
|
begin
|
|
n := IndexOfName(Index);
|
|
if n >= 0 then
|
|
inherited Delete(n);
|
|
end;
|
|
|
|
function TProjectFileStates.GetItem(Index: WideString): WideString;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
n := IndexOfName(Index);
|
|
if n >= 0
|
|
then Result := (inherited GetItem(n) as TProjectFileState).Value
|
|
else Result := '';
|
|
end;
|
|
|
|
function TProjectFileStates.IndexOfName(Name: WideString): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if (inherited GetItem(i) as TProjectFileState).Name = Name then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TProjectFileStates.SetItem(Index, Value: WideString);
|
|
var
|
|
n: Integer;
|
|
pfs: TProjectFileState;
|
|
begin
|
|
n := IndexOfName(Index);
|
|
if n >= 0 then (inherited GetItem(n) as TProjectFileState).Value := Value
|
|
else
|
|
begin
|
|
pfs := TProjectFileState.Create;
|
|
pfs.Name := Index;
|
|
pfs.Value := Value;
|
|
Add(pfs);
|
|
end;
|
|
end;
|
|
|
|
const
|
|
MAX_MESSAGES = 100;
|
|
|
|
var
|
|
MessageCount: Integer = 0;
|
|
|
|
procedure ProjectCompilerMessageClear;
|
|
begin
|
|
MessageCount := 0;
|
|
end;
|
|
|
|
function ProjectCompilerMessage(line: Integer; msgcode: LongWord; text: PAnsiChar): Integer; stdcall; // I3310 // I4694
|
|
begin
|
|
Result := ProjectCompilerMessageW(line, msgcode, String_AtoU(text));
|
|
end;
|
|
|
|
function ProjectCompilerMessageW(line: Integer; msgcode: LongWord; const text: string): Integer; // I3310 // I4694
|
|
const // from compile.pas
|
|
CERR_FATAL = $00008000;
|
|
CERR_ERROR = $00004000;
|
|
CERR_WARNING = $00002000;
|
|
CERR_HINT = $00001000;
|
|
CWARN_Info = $0000208A;
|
|
var
|
|
FLogState: TProjectLogState;
|
|
begin
|
|
FLogState := plsInfo;
|
|
|
|
if msgcode <> CWARN_Info then
|
|
case msgcode and $F000 of
|
|
CERR_HINT: FLogState := plsHint;
|
|
CERR_WARNING: FLogState := plsWarning;
|
|
CERR_ERROR: FLogState := plsError;
|
|
CERR_FATAL: FLogState := plsFatal;
|
|
end;
|
|
|
|
if FLogState = plsWarning then // I4706
|
|
TProject.CompilerMessageFile.FHasWarning := True;
|
|
|
|
if FLogState in [plsWarning, plsError, plsFatal] then
|
|
begin
|
|
Inc(MessageCount);
|
|
if MessageCount > MAX_MESSAGES then
|
|
Exit(1);
|
|
end;
|
|
|
|
TProject.CompilerMessageFile.Log(FLogState, text, msgcode, line); // I4706
|
|
|
|
if (FLogState <> plsInfo) and (MessageCount = MAX_MESSAGES) then
|
|
TProject.CompilerMessageFile.Log(
|
|
plsWarning,
|
|
Format('More than %d warnings or errors received; suppressing further messages', [MAX_MESSAGES]),
|
|
CWARN_TooManyErrorsOrWarnings,
|
|
line);
|
|
|
|
Result := 1;
|
|
end;
|
|
|
|
{ TProjectOptions }
|
|
|
|
constructor TProjectOptions.Create;
|
|
begin
|
|
WarnDeprecatedCode := True; // I4866
|
|
CompilerWarningsAsErrors := False; // I4865
|
|
CheckFilenameConventions := True; // default to TRUE for new projects
|
|
ProjectType := ptKeyboard;
|
|
end;
|
|
|
|
type
|
|
TGlobalProjectStateWnd = class
|
|
private
|
|
procedure WndProc(var Message: TMessage);
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
var
|
|
FGlobalProjectStateWnd: TGlobalProjectStateWnd = nil;
|
|
|
|
// Make this a global to prevent potential race
|
|
// condition causing an access violation. If it
|
|
// is an invalid window handle or 0 at destruction time,
|
|
// it's no big deal...
|
|
FGlobalProjectStateWndHandle: THandle = 0;
|
|
|
|
{ TGlobalProjectStateWnd }
|
|
|
|
constructor TGlobalProjectStateWnd.Create;
|
|
begin
|
|
inherited Create;
|
|
FGlobalProjectStateWndHandle := AllocateHWnd(WndProc);
|
|
end;
|
|
|
|
destructor TGlobalProjectStateWnd.Destroy;
|
|
var
|
|
h: THandle;
|
|
begin
|
|
h := FGlobalProjectStateWndHandle;
|
|
FGlobalProjectStateWndHandle := 0;
|
|
DeallocateHWnd(h);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGlobalProjectStateWnd.WndProc(var Message: TMessage);
|
|
var
|
|
PPath, PDisplayState: PChar;
|
|
begin
|
|
if Message.Msg = WM_USER_ProjectUpdateDisplayState then
|
|
begin
|
|
PPath := PChar(Message.WParam);
|
|
PDisplayState := PChar(Message.LParam);
|
|
if Assigned(FGlobalProject) and (FGlobalProject.FileName = PPath) then
|
|
begin
|
|
FGlobalProject.DisplayState := PDisplayState;
|
|
FGlobalProject.SaveUser;
|
|
end;
|
|
StrDispose(PDisplayState);
|
|
StrDispose(PPath);
|
|
end;
|
|
DefWindowProc(FGlobalProjectStateWndHandle, Message.Msg, Message.WParam, Message.LParam);
|
|
end;
|
|
|
|
function GlobalProjectStateWndHandle: THandle;
|
|
begin
|
|
Result := FGlobalProjectStateWndHandle;
|
|
end;
|
|
|
|
function ProjectTypeFromString(s: string): TProjectType;
|
|
begin
|
|
if SameText(s, 'keyboard') then Result := ptKeyboard
|
|
else if SameText(s, 'lexicalmodel') then Result := ptLexicalModel
|
|
else Result := ptUnknown;
|
|
end;
|
|
|
|
function ProjectTypeToString(pt: TProjectType): string;
|
|
begin
|
|
case pt of
|
|
ptUnknown: Result := '';
|
|
ptKeyboard: Result := 'keyboard';
|
|
ptLexicalModel: Result := 'lexicalmodel';
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
FGlobalProjectStateWnd := TGlobalProjectStateWnd.Create;
|
|
finalization
|
|
// Deletes temporary session-local project
|
|
if FileExists(TProject.GetUntitledProjectFilename(True)) then
|
|
System.SysUtils.DeleteFile(TProject.GetUntitledProjectFilename(True));
|
|
if FileExists(ChangeFileExt(TProject.GetUntitledProjectFilename(True),Ext_ProjectSourceUser)) then
|
|
System.SysUtils.DeleteFile(ChangeFileExt(TProject.GetUntitledProjectFilename(True),Ext_ProjectSourceUser));
|
|
|
|
FGlobalProjectStateWnd.Free;
|
|
end.
|