(* 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 procedure ProjectCompilerMessageClear; function ProjectTypeFromString(s: string): TProjectType; function ProjectTypeToString(pt: TProjectType): string; implementation uses Winapi.ShlObj, System.AnsiStrings, System.IniFiles, System.DateUtils, 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, UMD5Hash, 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(MD5Hash(LowerCase( ExtractRelativePath(FProject.FileName, FFileName) ))) // I4709 else FID := CleanID(MD5Hash(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 := ExtractFilePath(ParamStr(0)) + 'locale\' + 'en'; // I2595 if FileExists(Result + '\xml\project\project.xsl') then Result := Result + '\xml\project\' else begin Result := ExtractFilePath(ParamStr(0)) + 'locale\' + 'en'; // I2595 if FileExists(Result + '\xml\project\project.xsl') then Result := Result + '\xml\project\' else Result := GetXMLTemplatePath + 'project\'; end; 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 const // from compile.pas CERR_FATAL = $00008000; CERR_ERROR = $00004000; CERR_WARNING = $00002000; CERR_MEMORY = $00001000; CWARN_Info = $0000208A; var FLogState: TProjectLogState; begin FLogState := plsInfo; if msgcode <> CWARN_Info then case msgcode and $F000 of CERR_MEMORY: FLogState := plsFatal; 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, String_AtoU(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.