mirror of
https://github.com/keymanapp/keyman.git
synced 2026-09-12 18:47:41 +00:00
1856 lines
51 KiB
ObjectPascal
1856 lines
51 KiB
ObjectPascal
(*
|
|
Name: KeyboardParser
|
|
Copyright: Copyright (C) SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 23 Aug 2006
|
|
|
|
Modified Date: 23 Feb 2016
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 23 Aug 2006 - mcdurdin - Initial version
|
|
30 Aug 2006 - mcdurdin - Fix bug with parsing shift/ctrl/alt rules
|
|
28 Sep 2006 - mcdurdin - Move version line to start of file
|
|
19 Nov 2007 - mcdurdin - I1157 - const string parameters
|
|
18 Mar 2011 - mcdurdin - I2520 - Improve support for SMP characters
|
|
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
|
|
10 Jan 2014 - mcdurdin - I4021 - V9.0 - Redesign Keyboard Wizard to integrate V9 features
|
|
19 Mar 2014 - mcdurdin - I4145 - V9.0 - Deadkeys are corrupted by KeyboardParser
|
|
13 Oct 2014 - mcdurdin - I4329 - V9.0 - Sometimes when saving, the list of &WINDOWSLANGUAGES is doubled
|
|
23 Oct 2014 - mcdurdin - I4369 - V9.0 - Add kmw_embedcss to feature support in Developer
|
|
04 Nov 2014 - mcdurdin - I4504 - V9.0 - Consolidate the compile action into single command
|
|
30 Apr 2015 - mcdurdin - I4681 - V9.0 - mnemoniclayout store should be enough to block design view
|
|
24 Jul 2015 - mcdurdin - I4797 - Convert to characters tool is inconsistent
|
|
23 Feb 2016 - mcdurdin - I4979 - Importing a KMN into a KVK does not work if includecodes are in the keyboard
|
|
*)
|
|
unit KeyboardParser; // I3306
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Generics.Collections,
|
|
System.Classes,
|
|
System.Contnrs,
|
|
System.SysUtils,
|
|
System.WideStrings,
|
|
|
|
ExtShiftState,
|
|
kmxfile,
|
|
kmxfileconsts,
|
|
TextFileFormat,
|
|
UKeymanTargets,
|
|
utilfiletypes;
|
|
|
|
{$ASSERTIONS ON}
|
|
|
|
type
|
|
EKeyboardParser_TagRequired = class(Exception)
|
|
constructor Create(ALine, ATag: WideString);
|
|
end;
|
|
|
|
TKeyboardParser = class;
|
|
|
|
TKeyboardParser_Line = class
|
|
private
|
|
FLine: WideString;
|
|
FOwner: TKeyboardParser;
|
|
class function ExtShiftStateToString(s: TExtShiftState): WideString; static;
|
|
procedure SetLine(Value: WideString);
|
|
protected
|
|
class function GetTag(var s: WideString): WideString; static;
|
|
class procedure Require(var s: WideString; tagname: WideString); static;
|
|
class procedure TagRequired(s, tagname: WideString); static;
|
|
class function StrToXStr(s: WideString): WideString; static;
|
|
class function ParseKey(s: WideString; var key: Integer; var shiftstate: TExtShiftState): Boolean; static;
|
|
class function ParseKeyChar(s: WideString; var key: Integer; var shiftstate: TExtShiftState): Boolean; static;
|
|
class function XStrToStr(s: WideString; var xstr: WideString): Boolean; static; // I4797
|
|
property Line: WideString read FLine write SetLine;
|
|
procedure InitLine(ALine: WideString); virtual;
|
|
public
|
|
constructor Create(ALine: WideString); virtual;
|
|
constructor CreateNew;
|
|
procedure ConvertToANSI;
|
|
function IsComplexLine: Boolean; virtual;
|
|
class function IsType(ALine: WideString): Boolean; virtual;
|
|
class procedure Register;
|
|
|
|
class function GetXStr(var s, xstr: WideString): Boolean; static; // I4797
|
|
|
|
property Owner: TKeyboardParser read FOwner;
|
|
end;
|
|
|
|
TKeyboardParser_LineClass = class of TKeyboardParser_Line;
|
|
|
|
TKeyboardParser_BlankLine = class(TKeyboardParser_Line)
|
|
public
|
|
function IsComplexLine: Boolean; override;
|
|
class function IsType(ALine: WideString): Boolean; override;
|
|
end;
|
|
|
|
TKeyboardParser_SystemStore = class(TKeyboardParser_Line)
|
|
private
|
|
FSystemStoreType: TSystemStore;
|
|
FValue: WideString;
|
|
procedure SetValue(Value: WideString);
|
|
class function IsSystemStoreName(Value: WideString): Boolean;
|
|
class function ParseKeyOrXStr(ALine: WideString;
|
|
var Output: WideString): Boolean; static;
|
|
protected
|
|
procedure InitLine(ALine: WideString); override;
|
|
public
|
|
constructor CreateNew(ASystemStoreType: TSystemStore; AValue: WideString);
|
|
function IsComplexLine: Boolean; override;
|
|
class function IsType(ALine: WideString): Boolean; override;
|
|
property SystemStoreType: TSystemStore read FSystemStoreType;
|
|
property Value: WideString read FValue write SetValue;
|
|
end;
|
|
|
|
TKeyboardParser_Begin = class(TKeyboardParser_Line)
|
|
private
|
|
FIsUnicode: Boolean;
|
|
FGroupName: WideString;
|
|
procedure SetIsUnicode(const Value: Boolean);
|
|
procedure SetGroupName(Value: WideString);
|
|
protected
|
|
procedure InitLine(ALine: WideString); override;
|
|
public
|
|
constructor CreateNew(AIsUnicode: Boolean; AGroupName: WideString);
|
|
function IsComplexLine: Boolean; override;
|
|
class function IsType(ALine: WideString): Boolean; override;
|
|
property IsUnicode: Boolean read FIsUnicode write SetIsUnicode;
|
|
property GroupName: WideString read FGroupName write SetGroupName;
|
|
end;
|
|
|
|
TKeyboardParser_Group = class(TKeyboardParser_Line)
|
|
private
|
|
FGroupName: WideString;
|
|
FUsingKeys: Boolean;
|
|
procedure SetGroupName(Value: WideString);
|
|
procedure SetUsingKeys(const Value: Boolean);
|
|
procedure UpdateLine;
|
|
protected
|
|
procedure InitLine(ALine: WideString); override;
|
|
public
|
|
constructor CreateNew(AGroupName: WideString; AUsingKeys: Boolean);
|
|
class function IsType(ALine: WideString): Boolean; override;
|
|
function IsComplexLine: Boolean; override;
|
|
property GroupName: WideString read FGroupName write SetGroupName;
|
|
property UsingKeys: Boolean read FUsingKeys write SetUsingKeys;
|
|
end;
|
|
|
|
TKeyboardParser_Comment = class(TKeyboardParser_Line)
|
|
private
|
|
FValue: WideString;
|
|
procedure SetValue(Value: WideString);
|
|
protected
|
|
procedure InitLine(ALine: WideString); override;
|
|
public
|
|
constructor CreateNew(AValue: WideString; ANew: Boolean);
|
|
class function IsType(ALine: WideString): Boolean; override;
|
|
function IsComplexLine: Boolean; override;
|
|
property Value: WideString read FValue write SetValue;
|
|
end;
|
|
|
|
TKeyboardParser_LayoutRule = class(TKeyboardParser_Line)
|
|
private
|
|
FShift: TExtShiftState;
|
|
FOutput: WideString;
|
|
FVKey: Integer;
|
|
procedure UpdateLine;
|
|
procedure SetOutput(Value: WideString);
|
|
procedure SetShift(const Value: TExtShiftState);
|
|
procedure SetVKey(const Value: Integer);
|
|
protected
|
|
procedure InitLine(ALine: WideString); override;
|
|
public
|
|
constructor CreateNew(AVKey: Integer; AShift: TExtShiftState; AOutput: WideString);
|
|
class function IsType(ALine: WideString): Boolean; override;
|
|
function IsComplexLine: Boolean; override;
|
|
property VKey: Integer read FVKey write SetVKey;
|
|
property Shift: TExtShiftState read FShift write SetShift;
|
|
property Output: WideString read FOutput write SetOutput;
|
|
end;
|
|
|
|
TKeyboardParser_Lines = class(TObjectList)
|
|
private
|
|
FOwner: TKeyboardParser;
|
|
function GetLine(Index: Integer): TKeyboardParser_Line;
|
|
function GetString(Index: Integer): WideString;
|
|
protected
|
|
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
|
public
|
|
constructor Create(AOwner: TKeyboardParser);
|
|
function IndexOfClass(AClassType: TKeyboardParser_LineClass; APreviousIndex: Integer = -1): Integer;
|
|
property Lines[Index: Integer]: TKeyboardParser_Line read GetLine; default;
|
|
property Strings[Index: Integer]: WideString read GetString;
|
|
end;
|
|
|
|
TKeyboardParser_LineTypes = class(TClassList)
|
|
private
|
|
function GetItems(Index: Integer): TKeyboardParser_LineClass;
|
|
procedure SetItems(Index: Integer; const Value: TKeyboardParser_LineClass);
|
|
public
|
|
property Items[Index: Integer]: TKeyboardParser_LineClass read GetItems write SetItems; default;
|
|
end;
|
|
|
|
TKeyboardParser_WinLanguage = class // I4021
|
|
private
|
|
FName: string;
|
|
FID: Integer;
|
|
FIsDefault: Boolean;
|
|
FOwner: TKeyboardParser;
|
|
procedure SetIsDefault(const Value: Boolean);
|
|
public
|
|
constructor Create(AOwner: TKeyboardParser; AID: Integer);
|
|
property ID: Integer read FID;
|
|
property Name: string read FName;
|
|
property IsDefault: Boolean read FIsDefault write SetIsDefault;
|
|
end;
|
|
|
|
TKeyboardParser_WinLanguages = class(TObjectList<TKeyboardParser_WinLanguage>) // I4021
|
|
private
|
|
FOwner: TKeyboardParser;
|
|
constructor Create(AOwner: TKeyboardParser);
|
|
procedure Fill;
|
|
procedure UpdateSource;
|
|
protected
|
|
procedure Notify(const Value: TKeyboardParser_WinLanguage; Action: System.Generics.Collections.TCollectionNotification); override;
|
|
public
|
|
function Add(AID: Integer): Integer;
|
|
function IndexOfID(AID: Integer): Integer;
|
|
function IndexOfDefault: Integer;
|
|
end;
|
|
|
|
TKeyboardParser_FeatureID = (
|
|
kfIcon, kfOSK, kfTouchLayout,
|
|
kfEmbedJS, kfEmbedCSS, kfKMWHelp, kfIncludeCodes); // I4369
|
|
|
|
TKeyboardParser_Feature = class // I4021
|
|
private
|
|
FOwner: TKeyboardParser;
|
|
FFilename: string;
|
|
FID: TKeyboardParser_FeatureID;
|
|
function GetExpandedFilename: string;
|
|
public
|
|
constructor Create(AOwner: TKeyboardParser; AID: TKeyboardParser_FeatureID; const AFilename: string);
|
|
property Filename: string read FFilename;
|
|
property ExpandedFilename: string read GetExpandedFilename;
|
|
property ID: TKeyboardParser_FeatureID read FID;
|
|
end;
|
|
|
|
TKeyboardParser_Features = class(TObjectDictionary<TKeyboardParser_FeatureID,TKeyboardParser_Feature>) // I4021
|
|
private
|
|
FOwner: TKeyboardParser;
|
|
constructor Create(AOwner: TKeyboardParser);
|
|
procedure Fill;
|
|
procedure UpdateSource;
|
|
function GetDefaultFeatureFilename(ID: TKeyboardParser_FeatureID): string;
|
|
protected
|
|
procedure KeyNotify(const Key: TKeyboardParser_FeatureID; Action: System.Generics.Collections.TCollectionNotification); override;
|
|
procedure ValueNotify(const Value: TKeyboardParser_Feature; Action: System.Generics.Collections.TCollectionNotification); override;
|
|
public
|
|
procedure Add(Key: TKeyboardParser_FeatureID); overload;
|
|
end;
|
|
|
|
TKeyboardParser = class
|
|
private
|
|
FLines: TKeyboardParser_Lines;
|
|
FModified: Boolean;
|
|
FOnChanged: TNotifyEvent;
|
|
FWinLanguages: TKeyboardParser_WinLanguages;
|
|
FLoading: Boolean;
|
|
FFeatures: TKeyboardParser_Features;
|
|
FFileName: string;
|
|
function GetKeyboardText: WideString;
|
|
procedure SetKeyboardText(Value: WideString);
|
|
function GetIsComplex: Boolean;
|
|
procedure SetModified(const Value: Boolean);
|
|
function GetIsKeyboardUnicode: Boolean;
|
|
function GetInitialComment: WideString;
|
|
procedure SetInitialComment(Value: WideString);
|
|
procedure GetCommentLines(var Start, Finish: Integer);
|
|
function GetSystemStore(Index: TSystemStore): TKeyboardParser_SystemStore;
|
|
procedure MoveVersionLineToStart;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function AddLayoutRule(AVKey: Integer; AShift: TExtShiftState; AOutput: WideString): TKeyboardParser_LayoutRule;
|
|
//function AddSystemStore(ASystemStoreType: TSystemStore; const AValue: WideString): TKeyboardParser_SystemStore;
|
|
procedure DeleteSystemStore(ASystemStoreType: TSystemStore);
|
|
procedure SetSystemStoreValue(ASystemStoreType: TSystemStore; AValue: WideString);
|
|
function GetSystemStoreValue(ASystemStoreType: TSystemStore): WideString;
|
|
property SystemStores[Index: TSystemStore]: TKeyboardParser_SystemStore read GetSystemStore;
|
|
|
|
function GetKeyboardTextRaw: string; // I4979
|
|
|
|
procedure AddRequiredLines;
|
|
|
|
procedure LoadFromFile(FileName: WideString);
|
|
|
|
property WinLanguages: TKeyboardParser_WinLanguages read FWinLanguages;
|
|
|
|
property KeyboardText: WideString read GetKeyboardText write SetKeyboardText;
|
|
property Lines: TKeyboardParser_Lines read FLines;
|
|
|
|
property Features: TKeyboardParser_Features read FFeatures;
|
|
property FileName: string read FFileName write FFileName; // only used for feature file names
|
|
|
|
property Modified: Boolean read FModified write SetModified;
|
|
|
|
property IsComplex: Boolean read GetIsComplex;
|
|
|
|
property IsKeyboardUnicode: Boolean read GetIsKeyboardUnicode;
|
|
property InitialComment: WideString read GetInitialComment write SetInitialComment;
|
|
|
|
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
|
end;
|
|
|
|
const
|
|
KeyboardFeatureName: array[TKeyboardParser_FeatureID] of string = (
|
|
'Icon', 'Desktop On Screen Keyboard', 'Touch-Optimised Keyboard',
|
|
'Embedded Javascript', 'Embedded CSS', 'Web Help', 'Include Codes'); // I4369
|
|
KeyboardFeatureStore: array[TKeyboardParser_FeatureID] of TSystemStore = (
|
|
ssBitmap, ssVisualKeyboard, ssLayoutFile,
|
|
ssKMW_EmbedJS, ssKMW_EmbedCSS, ssKMW_HelpFile, ssIncludeCodes); // I4369
|
|
KeyboardFeatureFilename: array[TKeyboardParser_FeatureID] of string = (
|
|
'%s.ico', '%s'+Ext_VisualKeyboardSource, '%s'+Ext_KeymanTouchLayout,
|
|
'%s-code.js', '%s.css', '%s-help.htm', '%s-codes.txt'); // I4369
|
|
KeyboardFeatureEditorFormat: array[TKeyboardParser_FeatureID] of TEditorFormat = (
|
|
efText, efXML, efJSON,
|
|
efJS, efCSS, efHTML, efText
|
|
);
|
|
KeyboardFeatureTargets: array[TKeyboardParser_FeatureID] of TKeymanTargets = ( // I4504
|
|
// Due to Delphi compiler limitation, need to copy the target values, can't
|
|
// use the defined constants.
|
|
[ktWindows, ktMacosx, ktLinux, ktDesktop], //KMXKeymanTargets
|
|
[ktAny, ktWindows, ktMacosx, ktLinux, ktWeb, ktIphone, ktIpad, ktAndroidphone, ktAndroidtablet, ktMobile, ktDesktop, ktTablet], //AllKeymanTargets
|
|
[ktWeb, ktIphone, ktIpad, ktAndroidphone, ktAndroidtablet, ktMobile, ktTablet], //KMWKeymanTargets
|
|
[ktWeb, ktIphone, ktIpad, ktAndroidphone, ktAndroidtablet, ktMobile, ktTablet], //KMWKeymanTargets
|
|
[ktWeb, ktIphone, ktIpad, ktAndroidphone, ktAndroidtablet, ktMobile, ktTablet], //KMWKeymanTargets
|
|
[ktWeb, ktIphone, ktIpad, ktAndroidphone, ktAndroidtablet, ktMobile, ktTablet], //KMWKeymanTargets
|
|
[ktAny, ktWindows, ktMacosx, ktLinux, ktWeb, ktIphone, ktIpad, ktAndroidphone, ktAndroidtablet, ktMobile, ktDesktop, ktTablet] //AllKeymanTargets
|
|
);
|
|
|
|
implementation
|
|
|
|
uses
|
|
KeymanVersion,
|
|
Unicode,
|
|
utilstr,
|
|
utilsystem,
|
|
VKeys,
|
|
WindowsLanguages;
|
|
|
|
var
|
|
FLineTypes: TKeyboardParser_LineTypes = nil;
|
|
|
|
{ TKeyboardParser_Line }
|
|
|
|
procedure TKeyboardParser_Line.ConvertToANSI;
|
|
begin
|
|
InitLine(FLine);
|
|
end;
|
|
|
|
constructor TKeyboardParser_Line.Create(ALine: WideString);
|
|
begin
|
|
inherited Create;
|
|
InitLine(ALine);
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.GetTag(var s: WideString): WideString;
|
|
var
|
|
n: Integer;
|
|
ch: WideChar;
|
|
function IsWhiteSpace: Boolean;
|
|
begin
|
|
Result := CharInSet(s[n], [#1..#32]); // I3310
|
|
end;
|
|
function Finished: Boolean;
|
|
begin
|
|
Result := n > Length(s);
|
|
end;
|
|
function IsPunctuation: Boolean;
|
|
begin
|
|
Result := CharInSet(s[n], ['(',')','[',']','>']); // I3310
|
|
end;
|
|
function IsQuote: Boolean;
|
|
begin
|
|
Result := CharInSet(s[n], ['''','"']); // I3310
|
|
end;
|
|
function IsNumber: Boolean;
|
|
begin
|
|
Result := CharInSet(s[n], ['0'..'9']); // I3310
|
|
end;
|
|
begin
|
|
Result := '';
|
|
n := 1;
|
|
while not Finished and IsWhiteSpace do Inc(n);
|
|
if Finished then Exit;
|
|
|
|
Delete(s,1,n-1); n := 1;
|
|
|
|
{ The next character determines the tag type }
|
|
|
|
case s[n] of
|
|
'a'..'z','A'..'Z', '$', '&', '_': { a symbol name or potentially xvvv dvvv U+vvvv - allow any characters apart from ' " ( ) [ ] (whitespace) to continue it }
|
|
begin
|
|
while not Finished and not IsWhiteSpace and not IsPunctuation and not IsQuote do Inc(n);
|
|
Dec(n);
|
|
end;
|
|
'''','"': { a string }
|
|
begin
|
|
ch := s[n]; Inc(n);
|
|
while not Finished and (s[n] <> ch) do Inc(n);
|
|
end;
|
|
'0'..'9': { an 'octal' value (usually) }
|
|
begin
|
|
while not Finished and IsNumber do Inc(n);
|
|
Dec(n);
|
|
end;
|
|
{else punctuation - do nothing}
|
|
end;
|
|
|
|
Result := Copy(s,1,n);
|
|
Delete(s,1,n);
|
|
end;
|
|
|
|
constructor TKeyboardParser_Line.CreateNew;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.ExtShiftStateToString(s: TExtShiftState): WideString;
|
|
begin
|
|
Result := '';
|
|
if essShift in s then Result := Result + 'SHIFT ';
|
|
if essCtrl in s then Result := Result + 'CTRL ';
|
|
if essLCtrl in s then Result := Result + 'LCTRL ';
|
|
if essRCtrl in s then Result := Result + 'RCTRL ';
|
|
if essAlt in s then Result := Result + 'ALT ';
|
|
if essLAlt in s then Result := Result + 'LALT ';
|
|
if essRAlt in s then Result := Result + 'RALT ';
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.XStrToStr(s: WideString; var xstr: WideString): Boolean;
|
|
function OctToDec(n: Integer): Integer;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
Result := 0;
|
|
i := 10; j := 1; {ugly and does not check 8,9 but can't be bothered doing it nicely for this infrequent use}
|
|
while i div 10 <= n do
|
|
begin
|
|
Result := Result + (n mod i) div (i div 10) * j;
|
|
j := j * 8;
|
|
i := i * 10;
|
|
end;
|
|
end;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
Result := s <> '';
|
|
if Result then
|
|
case s[1] of
|
|
'U', 'u':
|
|
begin
|
|
if not (Length(s) in [6,7,8]) then Exit(False); // I4145
|
|
if s[2] <> '+' then Exit;
|
|
n := StrToIntDef('$'+Copy(s,3,6), 0);
|
|
if (n < 32) or (n > $10FFFF) then Exit(False); // I4145
|
|
xstr := xstr + Uni_UTF32CharToUTF16(n);
|
|
end;
|
|
'd':
|
|
begin
|
|
n := StrToIntDef(Copy(s,2,10), 0);
|
|
if (n < 32) or (n > $10FFFF) then Exit(False); // I4145
|
|
xstr := xstr + Uni_UTF32CharToUTF16(n);
|
|
end;
|
|
'x':
|
|
begin
|
|
n := StrToIntDef('$'+Copy(s,2,10), 0);
|
|
if (n < 32) or (n > $10FFFF) then Exit(False); // I4145
|
|
xstr := xstr + Uni_UTF32CharToUTF16(n);
|
|
end;
|
|
'0'..'7':
|
|
begin
|
|
n := StrToIntDef(s, 0);
|
|
if (n < 40) or (n > 4177777) then Exit(False); // I4145
|
|
xstr := xstr + Uni_UTF32CharToUTF16(OctToDec(n));
|
|
end;
|
|
'''', '"':
|
|
begin
|
|
xstr := xstr + Copy(s, 2, Length(s)-2);
|
|
end;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.GetXStr(var s, xstr: WideString): Boolean;
|
|
var
|
|
t: WideString;
|
|
begin
|
|
Result := False;
|
|
xstr := '';
|
|
t := GetTag(s);
|
|
while XStrToStr(t, xstr) do begin Result := True; t := GetTag(s); end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Line.InitLine(ALine: WideString);
|
|
begin
|
|
FLine := ALine;
|
|
end;
|
|
|
|
function TKeyboardParser_Line.IsComplexLine: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.IsType(ALine: WideString): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
class procedure TKeyboardParser_Line.Register;
|
|
begin
|
|
FLineTypes.Add(Self);
|
|
end;
|
|
|
|
class procedure TKeyboardParser_Line.Require(var s: WideString; tagname: WideString);
|
|
var
|
|
t: WideString;
|
|
begin
|
|
t := s;
|
|
if not WideSameText(GetTag(s), tagname) then
|
|
TagRequired(t, tagname);
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.ParseKey(s: WideString; var key: Integer; var shiftstate: TExtShiftState): Boolean;
|
|
var
|
|
u: WideString;
|
|
begin
|
|
Result := False;
|
|
|
|
Assert(GetTag(s) = '[');
|
|
|
|
shiftstate := [];
|
|
key := $FFFF;
|
|
u := UpperCase(GetTag(s));
|
|
while u <> ']' do
|
|
begin
|
|
if u = 'SHIFT' then Include(shiftstate, essShift)
|
|
else if u = 'CTRL' then Include(shiftstate, essCtrl)
|
|
else if u = 'ALT' then Include(shiftstate, essAlt)
|
|
else if u = 'LCTRL' then Include(shiftstate, essLCtrl)
|
|
else if u = 'LALT' then Include(shiftstate, essLAlt)
|
|
else if u = 'RCTRL' then Include(shiftstate, essRCtrl)
|
|
else if u = 'RALT' then Include(shiftstate, essRAlt)
|
|
else
|
|
begin
|
|
if key <> $FFFF then Exit;
|
|
key := FindVKeyName(u);
|
|
if key = $FFFF then Exit;
|
|
end;
|
|
u := UpperCase(GetTag(s));
|
|
end;
|
|
|
|
Result := key <> $FFFF;
|
|
end;
|
|
|
|
type
|
|
TKey10To11 = record
|
|
Char, Shifted: WideChar;
|
|
VKey: WideString;
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.ParseKeyChar(s: WideString; var key: Integer; var shiftstate: TExtShiftState): Boolean;
|
|
const
|
|
Key10To11: array[0..47] of TKey10To11 = (
|
|
(Char: '`'; Shifted: '~'; VKey: 'K_BKQUOTE'),
|
|
(Char: '1'; Shifted: '!'; VKey: 'K_1'),
|
|
(Char: '2'; Shifted: '@'; VKey: 'K_2'),
|
|
(Char: '3'; Shifted: '#'; VKey: 'K_3'),
|
|
(Char: '4'; Shifted: '$'; VKey: 'K_4'),
|
|
(Char: '5'; Shifted: '%'; VKey: 'K_5'),
|
|
(Char: '6'; Shifted: '^'; VKey: 'K_6'),
|
|
(Char: '7'; Shifted: '&'; VKey: 'K_7'),
|
|
(Char: '8'; Shifted: '*'; VKey: 'K_8'),
|
|
(Char: '9'; Shifted: '('; VKey: 'K_9'),
|
|
(Char: '0'; Shifted: ')'; VKey: 'K_0'),
|
|
(Char: '-'; Shifted: '_'; VKey: 'K_HYPHEN'),
|
|
(Char: '='; Shifted: '+'; VKey: 'K_EQUAL'),
|
|
(Char: 'q'; Shifted: 'Q'; VKey: 'K_Q'),
|
|
(Char: 'w'; Shifted: 'W'; VKey: 'K_W'),
|
|
(Char: 'e'; Shifted: 'E'; VKey: 'K_E'),
|
|
(Char: 'r'; Shifted: 'R'; VKey: 'K_R'),
|
|
(Char: 't'; Shifted: 'T'; VKey: 'K_T'),
|
|
(Char: 'y'; Shifted: 'Y'; VKey: 'K_Y'),
|
|
(Char: 'u'; Shifted: 'U'; VKey: 'K_U'),
|
|
(Char: 'i'; Shifted: 'I'; VKey: 'K_I'),
|
|
(Char: 'o'; Shifted: 'O'; VKey: 'K_O'),
|
|
(Char: 'p'; Shifted: 'P'; VKey: 'K_P'),
|
|
(Char: '['; Shifted: '{'; VKey: 'K_LBRKT'),
|
|
(Char: ']'; Shifted: '}'; VKey: 'K_RBRKT'),
|
|
(Char: '\'; Shifted: '|'; VKey: 'K_BKSLASH'),
|
|
(Char: 'a'; Shifted: 'A'; VKey: 'K_A'),
|
|
(Char: 's'; Shifted: 'S'; VKey: 'K_S'),
|
|
(Char: 'd'; Shifted: 'D'; VKey: 'K_D'),
|
|
(Char: 'f'; Shifted: 'F'; VKey: 'K_F'),
|
|
(Char: 'g'; Shifted: 'G'; VKey: 'K_G'),
|
|
(Char: 'h'; Shifted: 'H'; VKey: 'K_H'),
|
|
(Char: 'j'; Shifted: 'J'; VKey: 'K_J'),
|
|
(Char: 'k'; Shifted: 'K'; VKey: 'K_K'),
|
|
(Char: 'l'; Shifted: 'L'; VKey: 'K_L'),
|
|
(Char: ';'; Shifted: ':'; VKey: 'K_COLON'),
|
|
(Char: ''''; Shifted: '"'; VKey: 'K_QUOTE'),
|
|
(Char: 'z'; Shifted: 'Z'; VKey: 'K_Z'),
|
|
(Char: 'x'; Shifted: 'X'; VKey: 'K_X'),
|
|
(Char: 'c'; Shifted: 'C'; VKey: 'K_C'),
|
|
(Char: 'v'; Shifted: 'V'; VKey: 'K_V'),
|
|
(Char: 'b'; Shifted: 'B'; VKey: 'K_B'),
|
|
(Char: 'n'; Shifted: 'N'; VKey: 'K_N'),
|
|
(Char: 'm'; Shifted: 'M'; VKey: 'K_M'),
|
|
(Char: ','; Shifted: '<'; VKey: 'K_COMMA'),
|
|
(Char: '.'; Shifted: '>'; VKey: 'K_PERIOD'),
|
|
(Char: '/'; Shifted: '?'; VKey: 'K_SLASH'),
|
|
(Char: ' '; Shifted: ' '; VKey: 'K_SPACE')
|
|
);
|
|
var
|
|
j: Integer;
|
|
begin
|
|
for j := 0 to High(Key10To11) do
|
|
begin
|
|
if Key10To11[j].Shifted = s then
|
|
shiftstate := [essShift]
|
|
else if Key10To11[j].Char = s then
|
|
shiftstate := []
|
|
else Continue;
|
|
key := FindVKeyName(Key10To11[j].VKey);
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Line.SetLine(Value: WideString);
|
|
begin
|
|
FLine := Value;
|
|
if Assigned(FOwner) then FOWner.Modified := True;
|
|
end;
|
|
|
|
class function TKeyboardParser_Line.StrToXStr(s: WideString): WideString;
|
|
var
|
|
n: Integer;
|
|
inquote: Boolean;
|
|
begin
|
|
inquote := False;
|
|
Result := '';
|
|
for n := 1 to Length(s) do
|
|
begin
|
|
if (Ord(s[n]) < 32) or (s[n] = '''') then //WideChar(s[n]) in [#1..#31, ''''] then
|
|
begin
|
|
if inquote then
|
|
begin
|
|
inquote := False;
|
|
Result := Result + ''' ';
|
|
end;
|
|
Result := Result + 'U+'+IntToHex(Ord(s[n]), 4)+' ';
|
|
end
|
|
else
|
|
begin
|
|
if not inquote then
|
|
begin
|
|
inquote := True;
|
|
Result := Result + '''';
|
|
end;
|
|
Result := Result + s[n];
|
|
end;
|
|
end;
|
|
if inquote then
|
|
Result := Result + '''';
|
|
Result := Trim(Result);
|
|
|
|
if Result = '' then
|
|
Result := '""';
|
|
end;
|
|
|
|
class procedure TKeyboardParser_Line.TagRequired(s, tagname: WideString);
|
|
begin
|
|
raise EKeyboardParser_TagRequired.Create(s, tagname);
|
|
end;
|
|
|
|
{ TKeyboardParser_Begin }
|
|
|
|
procedure TKeyboardParser_Begin.InitLine(ALine: WideString);
|
|
var
|
|
t: WideString;
|
|
begin
|
|
inherited InitLine(ALine);
|
|
Assert(WideSameText(GetTag(ALine), 'begin'));
|
|
t := GetTag(ALine);
|
|
FIsUnicode := WideSameText(t, 'unicode');
|
|
|
|
if WideSameText(t, 'ansi') or FIsUnicode then Require(ALine, '>')
|
|
else if t <> '>' then TagRequired(ALine, '>');
|
|
Require(ALine, 'use');
|
|
Require(ALine, '(');
|
|
FGroupName := GetTag(ALine);
|
|
Require(ALine, ')');
|
|
end;
|
|
|
|
constructor TKeyboardParser_Begin.CreateNew(AIsUnicode: Boolean;
|
|
AGroupName: WideString);
|
|
begin
|
|
inherited CreateNew;
|
|
FGroupName := AGroupName;
|
|
IsUnicode := AIsUnicode; // Also sets Line
|
|
end;
|
|
|
|
function TKeyboardParser_Begin.IsComplexLine: Boolean;
|
|
begin
|
|
Result := not WideSameText(FGroupName, 'main');
|
|
end;
|
|
|
|
class function TKeyboardParser_Begin.IsType(ALine: WideString): Boolean;
|
|
var
|
|
t: WideString;
|
|
begin
|
|
Result := WideSameText(GetTag(ALine), 'begin');
|
|
if Result then
|
|
begin
|
|
t := GetTag(ALine);
|
|
if WideSameText(t, 'ansi') or WideSameText(t, 'unicode') then t := GetTag(ALine);
|
|
|
|
Result := (t = '>') and WideSameText(GetTag(ALine), 'use') and (GetTag(ALine) = '(');
|
|
if Result then
|
|
begin
|
|
GetTag(ALine);
|
|
Result := GetTag(ALine) = ')';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Begin.SetGroupName(Value: WideString);
|
|
begin
|
|
FGroupName := Value;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Begin.SetIsUnicode(const Value: Boolean);
|
|
begin
|
|
FIsUnicode := Value;
|
|
if FIsUnicode
|
|
then Line := 'begin Unicode > use('+FGroupName+')'
|
|
else Line := 'begin ANSI > use('+FGroupName+')';
|
|
end;
|
|
|
|
{ TKeyboardParser_Comment }
|
|
|
|
procedure TKeyboardParser_Comment.InitLine(ALine: WideString);
|
|
begin
|
|
inherited InitLine(ALine);
|
|
Assert(WideSameText(GetTag(ALine), 'c'));
|
|
FValue := Trim(ALine);
|
|
end;
|
|
|
|
constructor TKeyboardParser_Comment.CreateNew(AValue: WideString; ANew: Boolean);
|
|
begin
|
|
inherited CreateNew;
|
|
Value := AValue;
|
|
end;
|
|
|
|
function TKeyboardParser_Comment.IsComplexLine: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
class function TKeyboardParser_Comment.IsType(ALine: WideString): Boolean;
|
|
begin
|
|
Result := WideSameText(GetTag(ALine), 'c');
|
|
end;
|
|
|
|
procedure TKeyboardParser_Comment.SetValue(Value: WideString);
|
|
begin
|
|
FValue := Value;
|
|
Line := 'c '+FValue;
|
|
end;
|
|
|
|
{ EKeyboardParser_TagRequired }
|
|
|
|
constructor EKeyboardParser_TagRequired.Create(ALine, ATag: WideString);
|
|
begin
|
|
inherited Create('Expected tag "'+ATag+'" at '+ALine);
|
|
end;
|
|
|
|
{ TKeyboardParser_SystemStore }
|
|
|
|
procedure TKeyboardParser_SystemStore.InitLine(ALine: WideString);
|
|
var
|
|
s: WideString;
|
|
v2: Integer;
|
|
v1: Integer;
|
|
begin
|
|
inherited InitLine(ALine);
|
|
s := GetTag(ALine);
|
|
if WideSameText(s, 'store') then
|
|
begin
|
|
Assert(WideSameText(GetTag(ALine), '('));
|
|
FSystemStoreType := SystemStoreFromName(GetTag(ALine));
|
|
Assert(FSystemStoreType <> ssNone);
|
|
Assert(WideSameText(GetTag(ALine), ')'));
|
|
Assert(ParseKeyOrXStr(ALine, FValue));
|
|
end
|
|
else
|
|
begin
|
|
if WideSameText(s, 'message') or WideSameText(s, 'copyright') or WideSameText(s, 'name') or WideSameText(s, 'hotkey') then
|
|
begin
|
|
if WideSameText(s, 'message') then FSystemStoreType := ssMessage
|
|
else if WideSameText(s, 'copyright') then FSystemStoreType := ssCopyright
|
|
else if WideSameText(s, 'name') then FSystemStoreType := ssName
|
|
else if WideSameText(s, 'hotkey') then FSystemStoreType := ssHotkey;
|
|
s := GetTag(ALine);
|
|
Assert(Copy(s,1,1) = '"');
|
|
Delete(s,1,1); if (s <> '') and (s[Length(s)] = '"') then Delete(s,Length(s),1);
|
|
FValue := s;
|
|
end
|
|
else if WideSameText(s, 'version') then
|
|
begin
|
|
v1 := StrToInt(GetTag(ALine));
|
|
Assert(GetTag(ALine) = '.');
|
|
v2 := StrToInt(GetTag(ALine));
|
|
FSystemStoreType := ssVersion;
|
|
FValue := IntToStr(v1)+'.'+IntToStr(v2);
|
|
end
|
|
else if WideSameText(s, 'bitmap') then
|
|
begin
|
|
FSystemStoreType := ssBitmap;
|
|
s := GetTag(ALine);
|
|
if Copy(s,1,1) = '"' then
|
|
begin
|
|
Delete(s,1,1); if (s <> '') and (s[Length(s)] = '"') then Delete(s,Length(s),1);
|
|
end;
|
|
FValue := s;
|
|
end
|
|
else if WideSameText(s, 'shift') then
|
|
begin
|
|
Assert(WideSameText(GetTag(ALine), 'frees') and WideSameText(GetTag(ALine), 'caps'));
|
|
FSystemStoreType := ssShiftFreesCaps;
|
|
FValue := '1';
|
|
end
|
|
else if WideSameText(s, 'caps') then
|
|
begin
|
|
s := GetTag(ALine);
|
|
if WideSameText(s, 'always') then
|
|
begin
|
|
Assert(WideSameText(GetTag(ALine), 'off'));
|
|
FSystemStoreType := ssCapsAlwaysOff;
|
|
end
|
|
else
|
|
begin
|
|
Assert(WideSameText(s, 'on'));
|
|
Assert(WideSameText(GetTag(ALine), 'only'));
|
|
FSystemStoreType := ssCapsOnOnly;
|
|
end;
|
|
FValue := '1';
|
|
end
|
|
else if WideSameText(s, 'language') then
|
|
begin
|
|
v1 := StrToInt(GetTag(ALine));
|
|
Assert(GetTag(ALine) = ',');
|
|
v2 := StrToInt(GetTag(ALine));
|
|
FSystemStoreType := ssLanguage;
|
|
FValue := IntToStr(v1)+', '+IntToStr(v2);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TKeyboardParser_SystemStore.CreateNew(
|
|
ASystemStoreType: TSystemStore; AValue: WideString);
|
|
begin
|
|
inherited CreateNew;
|
|
FSystemStoreType := ASystemStoreType;
|
|
Value := AValue; // Also sets Line
|
|
end;
|
|
|
|
function TKeyboardParser_SystemStore.IsComplexLine: Boolean;
|
|
begin
|
|
Result := (FSystemStoreType = ssMnemonicLayout) and (Value = '1'); // I4681
|
|
end;
|
|
|
|
class function TKeyboardParser_SystemStore.IsSystemStoreName(Value: WideString): Boolean;
|
|
begin
|
|
Result := SystemStoreFromName(Value) <> ssNone;
|
|
end;
|
|
|
|
class function TKeyboardParser_SystemStore.ParseKeyOrXStr(ALine: WideString; var Output: WideString): Boolean;
|
|
var
|
|
t, ALine2: WideString;
|
|
FShift: TExtShiftState;
|
|
FVKey: Integer;
|
|
begin
|
|
ALine2 := ALine;
|
|
t := GetTag(ALine);
|
|
if t = '[' then
|
|
begin
|
|
Result := ParseKey(ALine2, FVKey, FShift);
|
|
if Result then
|
|
begin
|
|
// We'll wrap the hotkey in quotes and treat it like a
|
|
Output := '['+ExtShiftStateToString(FShift)+VKeyNames[FVKey]+']';
|
|
end;
|
|
end
|
|
else
|
|
Result := GetXStr(ALine2, Output); // it should be an xstring
|
|
end;
|
|
|
|
class function TKeyboardParser_SystemStore.IsType(ALine: WideString): Boolean;
|
|
var
|
|
t, s: WideString;
|
|
v: Integer;
|
|
begin
|
|
t := ALine;
|
|
Result :=
|
|
WideSameText(GetTag(ALine), 'store') and
|
|
WideSameText(GetTag(ALine), '(') and
|
|
IsSystemStoreName(GetTag(ALine)) and
|
|
WideSameText(GetTag(ALine), ')') and
|
|
ParseKeyOrXStr(ALine, s);
|
|
|
|
if not Result then
|
|
begin
|
|
{ read old header names }
|
|
// MESSAGE, COPYRIGHT, NAME, BITMAP, SHIFT FREES CAPS, CAPS ON ONLY, HOTKEY, LANGUAGE, LAYOUT, VERSION, CAPS ALWAYS OFF
|
|
ALine := t;
|
|
s := GetTag(ALine);
|
|
if WideSameText(s, 'message') or WideSameText(s, 'copyright') or WideSameText(s, 'name') or WideSameText(s, 'hotkey') then
|
|
begin
|
|
s := GetTag(ALine);
|
|
if Copy(s,1,1) <> '"' then Exit;
|
|
end
|
|
else if WideSameText(s, 'version') then
|
|
begin
|
|
if not TryStrToInt(GetTag(ALine), v) or (GetTag(ALine) <> '.') or not TryStrToInt(GetTag(ALine), v) then Exit;
|
|
end
|
|
else if WideSameText(s, 'bitmap') then
|
|
else if WideSameText(s, 'shift') then
|
|
begin
|
|
if not WideSameText(GetTag(ALine), 'frees') or not WideSameText(GetTag(ALine), 'caps') then Exit;
|
|
end
|
|
else if WideSameText(s, 'caps') then
|
|
begin
|
|
s := GetTag(ALine);
|
|
if not ((WideSameText(s, 'always') and WideSameText(GetTag(ALine), 'off')) or
|
|
(WideSameText(s, 'on') and WideSameText(GetTag(ALine), 'only'))) then Exit;
|
|
end
|
|
else if WideSameText(s, 'language') then
|
|
begin
|
|
if not TryStrToInt(GetTag(ALine), v) then Exit;
|
|
if GetTag(ALine) <> ',' then Exit;
|
|
if not TryStrToInt(GetTag(ALine), v) then Exit;
|
|
end
|
|
else Exit;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_SystemStore.SetValue(Value: WideString);
|
|
begin
|
|
if (FValue <> Value) or (Line = '') then
|
|
begin
|
|
FValue := Value;
|
|
Line := 'store(&'+SystemStoreNames[FSystemStoreType]+') '+StrToXStr(FValue);
|
|
end;
|
|
end;
|
|
|
|
{ TKeyboardParser_LayoutRule }
|
|
|
|
procedure TKeyboardParser_LayoutRule.InitLine(ALine: WideString);
|
|
var
|
|
t: WideString;
|
|
keystr: WideString;
|
|
begin
|
|
inherited InitLine(ALine);
|
|
Assert(GetTag(ALine) = '+');
|
|
|
|
t := GetTag(ALine);
|
|
if t = '[' then
|
|
begin
|
|
keystr := t;
|
|
while (t <> '') and (t <> ']') do
|
|
begin
|
|
t := GetTag(ALine);
|
|
keystr := keystr + t + ' ';
|
|
end;
|
|
Assert(t = ']');
|
|
Assert(ParseKey(keystr, FVKey, FShift));
|
|
end
|
|
else if XStrToStr(t, keystr) then
|
|
begin
|
|
{ alphanumeric key - mostly from KeymanWizard 1.0 }
|
|
Assert(ParseKeyChar(keystr, FVKey, FShift));
|
|
end
|
|
else
|
|
Assert(False);
|
|
|
|
Assert(GetTag(ALine) = '>');
|
|
Assert(GetXStr(ALine, FOutput));
|
|
end;
|
|
|
|
constructor TKeyboardParser_LayoutRule.CreateNew(AVKey: Integer; AShift: TExtShiftState; AOutput: WideString);
|
|
begin
|
|
inherited CreateNew;
|
|
FVKey := AVKey;
|
|
FShift := AShift;
|
|
FOutput := AOutput;
|
|
UpdateLine;
|
|
end;
|
|
|
|
function TKeyboardParser_LayoutRule.IsComplexLine: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
class function TKeyboardParser_LayoutRule.IsType(ALine: WideString): Boolean;
|
|
var
|
|
keystr, t: WideString;
|
|
VKey: Integer;
|
|
shiftstate: TExtShiftState;
|
|
begin
|
|
Result := (GetTag(ALine) = '+');
|
|
if Result then
|
|
begin
|
|
t := GetTag(ALine);
|
|
if t = '[' then
|
|
begin
|
|
keystr := t;
|
|
while (t <> '') and (t <> ']') do
|
|
begin
|
|
t := GetTag(ALine);
|
|
keystr := keystr + t + ' ';
|
|
end;
|
|
Result := ParseKey(keystr, VKey, shiftstate);
|
|
end
|
|
else if XStrToStr(t, keystr) then
|
|
begin
|
|
{ alphanumeric key - mostly from KeymanWizard 1.0 }
|
|
Result := ParseKeyChar(keystr, VKey, shiftstate);
|
|
end
|
|
else
|
|
Result := False;
|
|
|
|
if Result then
|
|
begin
|
|
Result := (GetTag(ALine) = '>') and GetXStr(ALine, keystr);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_LayoutRule.SetOutput(Value: WideString);
|
|
begin
|
|
FOutput := Value;
|
|
UpdateLine;
|
|
end;
|
|
|
|
procedure TKeyboardParser_LayoutRule.SetShift(const Value: TExtShiftState);
|
|
begin
|
|
FShift := Value;
|
|
UpdateLine;
|
|
end;
|
|
|
|
procedure TKeyboardParser_LayoutRule.SetVKey(const Value: Integer);
|
|
begin
|
|
FVKey := Value;
|
|
UpdateLine;
|
|
end;
|
|
|
|
procedure TKeyboardParser_LayoutRule.UpdateLine;
|
|
begin
|
|
Line := '+ ['+ExtShiftStateToString(FShift)+VKeyNames[FVKey]+'] > '+StrToXStr(FOutput);
|
|
end;
|
|
|
|
{ TKeyboardParser_Lines }
|
|
|
|
constructor TKeyboardParser_Lines.Create(AOwner: TKeyboardParser);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TKeyboardParser_Lines.GetLine(Index: Integer): TKeyboardParser_Line;
|
|
begin
|
|
Result := inherited GetItem(Index) as TKeyboardParser_Line;
|
|
end;
|
|
|
|
function TKeyboardParser_Lines.GetString(Index: Integer): WideString;
|
|
begin
|
|
Result := Lines[Index].FLine;
|
|
end;
|
|
|
|
function TKeyboardParser_Lines.IndexOfClass(
|
|
AClassType: TKeyboardParser_LineClass; APreviousIndex: Integer): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := APreviousIndex+1 to Count - 1 do
|
|
begin
|
|
if Items[i] is AClassType then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Lines.Notify(Ptr: Pointer; Action: TListNotification);
|
|
var
|
|
line: TKeyboardParser_Line;
|
|
begin
|
|
line := TKeyboardParser_Line(Ptr);
|
|
if Action = lnAdded then
|
|
if Assigned(line.FOwner)
|
|
then raise EListError.Create('Line is already owned by another parser.')
|
|
else line.FOwner := FOwner
|
|
else if Action in [lnExtracted, lnDeleted] then
|
|
line.FOwner := nil;
|
|
|
|
FOwner.Modified := True;
|
|
|
|
inherited Notify(Ptr, Action);
|
|
end;
|
|
|
|
{ TKeyboardParser_LineTypes }
|
|
|
|
function TKeyboardParser_LineTypes.GetItems(Index: Integer): TKeyboardParser_LineClass;
|
|
begin
|
|
Result := TKeyboardParser_LineClass(inherited GetItems(Index));
|
|
end;
|
|
|
|
procedure TKeyboardParser_LineTypes.SetItems(Index: Integer; const Value: TKeyboardParser_LineClass);
|
|
begin
|
|
inherited SetItems(Index, Value);
|
|
end;
|
|
|
|
{ TKeyboardParser }
|
|
|
|
procedure TKeyboardParser.AddRequiredLines;
|
|
var
|
|
i: Integer;
|
|
FLastSystemStore: Integer;
|
|
FGroupLine, FBeginLine: Integer;
|
|
FCommentEnd: Integer;
|
|
begin
|
|
{
|
|
begin > use(main)
|
|
group(main) using keys
|
|
}
|
|
|
|
FGroupLine := FLines.IndexOfClass(TKeyboardParser_Group);
|
|
|
|
FCommentEnd := -1; FBeginLine := -1; FLastSystemStore := -1;
|
|
for i := 0 to FLines.Count - 1 do
|
|
begin
|
|
if FLines[i] is TKeyboardParser_SystemStore then
|
|
FLastSystemStore := i
|
|
else if (Lines[i] is TKeyboardParser_Begin) and (FBeginLine < 0) then
|
|
FBeginLine := i
|
|
else if not (Lines[i] is TKeyboardParser_Comment) and (FCommentEnd < 0) then
|
|
FCommentEnd := i;
|
|
end;
|
|
|
|
if FCommentEnd < 0 then FCommentEnd := FLines.Count;
|
|
|
|
if FLastSystemStore < 0 then i := FCommentEnd
|
|
else i := FLastSystemStore + 1;
|
|
|
|
if FGroupLine < 0 then
|
|
begin
|
|
FLines.Insert(i, TKeyboardParser_Group.CreateNew('main', True));
|
|
FLines.Insert(i, TKeyboardParser_BlankLine.CreateNew);
|
|
end;
|
|
|
|
if FBeginLine < 0 then
|
|
begin
|
|
FLines.Insert(i, TKeyboardParser_Begin.CreateNew(True, 'main'));
|
|
FLines.Insert(i, TKeyboardParser_BlankLine.CreateNew);
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser.MoveVersionLineToStart;
|
|
var
|
|
FFirstNonBlankCommentLine, FVersionLine: Integer;
|
|
i: Integer;
|
|
begin
|
|
FFirstNonBlankCommentLine := -1;
|
|
FVersionLine := -1;
|
|
for i := 0 to FLines.Count - 1 do
|
|
begin
|
|
if (FLines[i] is TKeyboardParser_SystemStore) and ((FLines[i] as TKeyboardParser_SystemStore).SystemStoreType = ssVersion) then
|
|
FVersionLine := i;
|
|
if (FFirstNonBlankCommentLine < 0) and not (FLines[i] is TKeyboardParser_BlankLine) and not (FLines[i] is TKeyboardParser_Comment) then
|
|
FFirstNonBlankCommentLine := i;
|
|
end;
|
|
|
|
if (FVersionLine > FFirstNonBlankCommentLine) then
|
|
begin
|
|
if FFirstNonBlankCommentLine < 0
|
|
then FLines.Move(FVersionLine, 0)
|
|
else FLines.Move(FVersionLine, FFirstNonBlankCommentLine);
|
|
end;
|
|
end;
|
|
|
|
function TKeyboardParser.AddLayoutRule(AVKey: Integer; AShift: TExtShiftState; AOutput: WideString): TKeyboardParser_LayoutRule;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
AddRequiredLines;
|
|
|
|
Result := TKeyboardParser_LayoutRule.CreateNew(AVKey, AShift, AOutput);
|
|
n := FLines.IndexOfClass(TKeyboardParser_Group);
|
|
FLines.Insert(n+1, Result);
|
|
end;
|
|
|
|
constructor TKeyboardParser.Create;
|
|
begin
|
|
inherited Create;
|
|
FLines := TKeyboardParser_Lines.Create(Self);
|
|
FWinLanguages := TKeyboardParser_WinLanguages.Create(Self);
|
|
FFeatures := TKeyboardParser_Features.Create(Self);
|
|
end;
|
|
|
|
procedure TKeyboardParser.DeleteSystemStore(ASystemStoreType: TSystemStore);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FLines.Count - 1 do
|
|
if (FLines[i] is TKeyboardParser_SystemStore) and
|
|
((FLines[i] as TKeyboardParser_SystemStore).SystemStoreType = ASystemStoreType) then
|
|
begin
|
|
FLines.Delete(i);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
destructor TKeyboardParser.Destroy;
|
|
begin
|
|
FOnChanged := nil;
|
|
FLines.Free;
|
|
FWinLanguages.Free;
|
|
FFeatures.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TKeyboardParser.GetCommentLines(var Start, Finish: Integer);
|
|
begin
|
|
Start := 0;
|
|
Finish := -1;
|
|
while Start < FLines.Count do
|
|
begin
|
|
if FLines[Start] is TKeyboardParser_BlankLine then Inc(Start)
|
|
else if FLines[Start] is TKeyboardParser_Comment then Break
|
|
else
|
|
begin
|
|
Start := -1;
|
|
Exit; { no comment at start of file }
|
|
end;
|
|
end;
|
|
|
|
if Start = FLines.Count then
|
|
begin
|
|
Start := -1;
|
|
Exit; { Blank file }
|
|
end;
|
|
|
|
Finish := Start + 1;
|
|
while Finish < FLines.Count do
|
|
begin
|
|
if not (FLines[Finish] is TKeyboardParser_Comment) then Break;
|
|
Inc(Finish);
|
|
end;
|
|
Dec(Finish);
|
|
end;
|
|
|
|
function TKeyboardParser.GetInitialComment: WideString;
|
|
var
|
|
FStart, FEnd: Integer;
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
FStart := 0;
|
|
GetCOmmentLines(FStart, FEnd);
|
|
if FStart = -1 then Exit;
|
|
|
|
for i := FStart to FEnd do
|
|
Result := Result + (FLines[i] as TKeyboardParser_Comment).Value + #13#10;
|
|
end;
|
|
|
|
function TKeyboardParser.GetIsComplex: Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
for i := 0 to FLines.Count - 1 do
|
|
if FLines[i].IsComplexLine then Exit;
|
|
|
|
Result := False;
|
|
end;
|
|
|
|
function TKeyboardParser.GetIsKeyboardUnicode: Boolean;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
AddRequiredLines;
|
|
n := FLines.IndexOfClass(TKeyboardParser_Begin);
|
|
Result := (FLines[n] as TKeyboardParser_Begin).IsUnicode;
|
|
end;
|
|
|
|
function TKeyboardParser.GetKeyboardText: WideString;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FLoading := True;
|
|
try
|
|
FWinLanguages.UpdateSource;
|
|
FFeatures.UpdateSource;
|
|
finally
|
|
FLoading := False;
|
|
end;
|
|
|
|
Result := '';
|
|
for i := 0 to FLines.Count - 1 do
|
|
Result := Result + FLines[i].FLine + #13#10;
|
|
end;
|
|
|
|
function TKeyboardParser.GetKeyboardTextRaw: string; // I4979
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 0 to FLines.Count - 1 do
|
|
Result := Result + FLines[i].FLine + #13#10;
|
|
end;
|
|
|
|
procedure TKeyboardParser.SetInitialComment(Value: WideString);
|
|
var
|
|
FStart, FEnd: Integer;
|
|
i: Integer;
|
|
begin
|
|
with TWideStringList.Create do
|
|
try
|
|
Text := Trim(Value);
|
|
|
|
GetCommentLines(FStart, FEnd);
|
|
|
|
if FStart >= 0 then
|
|
begin
|
|
for i := FStart to FEnd do
|
|
FLines.Delete(FStart);
|
|
end;
|
|
{ Add new lines }
|
|
for i := 0 to Count-1 do
|
|
begin
|
|
FLines.Insert(i, TKeyboardParser_Comment.CreateNew(Strings[i], True));
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser.SetKeyboardText(Value: WideString);
|
|
var
|
|
s: TWideStrings;
|
|
i, j: Integer;
|
|
line: TKeyboardParser_Line;
|
|
begin
|
|
FModified := False;
|
|
FLoading := True;
|
|
try
|
|
FLines.Clear;
|
|
|
|
if Trim(Value) = '' then
|
|
begin
|
|
FLines.Add(TKeyboardParser_Begin.CreateNew(True, 'main'));
|
|
end
|
|
else
|
|
begin
|
|
s := TWideStringList.Create;
|
|
try
|
|
s.Text := Value;
|
|
for i := 0 to s.Count - 1 do
|
|
begin
|
|
line := nil;
|
|
for j := 0 to FLineTypes.Count - 1 do
|
|
if FLineTypes[j].IsType(s[i]) then
|
|
begin
|
|
line := FLineTypes[j].Create(s[i]);
|
|
Break;
|
|
end;
|
|
if not Assigned(line) then
|
|
// not a recognised line - just add it anyway
|
|
line := TKeyboardParser_Line.Create(s[i]);
|
|
FLines.Add(line);
|
|
end;
|
|
finally
|
|
s.Free;
|
|
end;
|
|
end;
|
|
|
|
MoveVersionLineToStart;
|
|
|
|
FWinLanguages.Fill;
|
|
FFeatures.Fill;
|
|
finally
|
|
FLoading := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser.SetModified(const Value: Boolean);
|
|
begin
|
|
if FLoading then
|
|
Exit;
|
|
|
|
if FModified <> Value then
|
|
begin
|
|
FModified := Value;
|
|
end;
|
|
if Assigned(FOnChanged) then FOnChanged(Self);
|
|
end;
|
|
|
|
procedure TKeyboardParser.SetSystemStoreValue(ASystemStoreType: TSystemStore; AValue: WideString);
|
|
begin
|
|
if AValue = ''
|
|
then DeleteSystemStore(ASystemStoreType)
|
|
else SystemStores[ASystemStoreType].Value := AValue;
|
|
end;
|
|
|
|
function TKeyboardParser.GetSystemStore(Index: TSystemStore): TKeyboardParser_SystemStore;
|
|
var
|
|
FCommentEnd, FBeginLine, i: Integer;
|
|
begin
|
|
AddRequiredLines;
|
|
|
|
FCommentEnd := -1; FBeginLine := -1;
|
|
for i := 0 to FLines.Count - 1 do
|
|
begin
|
|
if (Lines[i] is TKeyboardParser_SystemStore) and ((Lines[i] as TKeyboardParser_SystemStore).SystemStoreType = Index) then
|
|
begin
|
|
Result := Lines[i] as TKeyboardParser_SystemStore;
|
|
Exit;
|
|
end
|
|
else if (Lines[i] is TKeyboardParser_Begin) and (FBeginLine < 0) then
|
|
FBeginLine := i
|
|
else if not (Lines[i] is TKeyboardParser_Comment) and (FCommentEnd < 0) then
|
|
FCommentEnd := i;
|
|
end;
|
|
|
|
if FCommentEnd = -1 then FCommentEnd := FLines.Count;
|
|
|
|
Result := TKeyboardParser_SystemStore.CreateNew(Index, '');
|
|
if FBeginLine >= 0 then
|
|
begin
|
|
if (FBeginLine > 0) and (FLines[FBeginLine - 1] is TKeyboardParser_BlankLine) then Dec(FBeginLine);
|
|
FLines.Insert(FBeginLine, Result);
|
|
end
|
|
else
|
|
FLines.Insert(FCommentEnd, Result)
|
|
end;
|
|
|
|
function TKeyboardParser.GetSystemStoreValue(ASystemStoreType: TSystemStore): WideString;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FLines.Count - 1 do
|
|
if (FLines[i] is TKeyboardParser_SystemStore) and
|
|
((FLines[i] as TKeyboardParser_SystemStore).SystemStoreType = ASystemStoreType) then
|
|
begin
|
|
Result := (FLines[i] as TKeyboardParser_SystemStore).Value;
|
|
Exit;
|
|
end;
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TKeyboardParser.LoadFromFile(FileName: WideString);
|
|
begin
|
|
if FileExists(FileName) then
|
|
begin
|
|
with TStringList.Create do
|
|
try
|
|
LoadFromFile(FileName); // Let prolog decide encoding
|
|
KeyboardText := Text;
|
|
finally
|
|
Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FLines.Clear;
|
|
AddRequiredLines;
|
|
end;
|
|
end;
|
|
|
|
{ TKeyboardParser_BlankLine }
|
|
|
|
function TKeyboardParser_BlankLine.IsComplexLine: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
class function TKeyboardParser_BlankLine.IsType(ALine: WideString): Boolean;
|
|
begin
|
|
Result := Trim(ALine) = '';
|
|
end;
|
|
|
|
{ TKeyboardParser_Group }
|
|
|
|
procedure TKeyboardParser_Group.InitLine(ALine: WideString);
|
|
var
|
|
t: WideString;
|
|
begin
|
|
inherited InitLine(ALine);
|
|
Assert(WideSameText(GetTag(ALine), 'group'));
|
|
Assert(WideSameText(GetTag(ALine), '('));
|
|
FGroupName := GetTag(ALine);
|
|
Assert(WideSameText(GetTag(ALine), ')'));
|
|
t := GetTag(ALine);
|
|
if t = '' then FUsingKeys := False
|
|
else if not WideSameText(t, 'c') then
|
|
begin
|
|
Assert(WideSameText(t, 'using'));
|
|
Assert(WideSameText(GetTag(ALine), 'keys'));
|
|
FUsingKeys := True;
|
|
end;
|
|
end;
|
|
|
|
constructor TKeyboardParser_Group.CreateNew(AGroupName: WideString;
|
|
AUsingKeys: Boolean);
|
|
begin
|
|
inherited CreateNew;
|
|
FGroupName := AGroupName;
|
|
FUsingKeys := AUsingKeys;
|
|
UpdateLine;
|
|
end;
|
|
|
|
function TKeyboardParser_Group.IsComplexLine: Boolean;
|
|
begin
|
|
Result := not FUsingKeys or not WideSameText(FGroupName, 'main');
|
|
end;
|
|
|
|
class function TKeyboardParser_Group.IsType(ALine: WideString): Boolean;
|
|
var
|
|
t: WideString;
|
|
begin
|
|
Result := WideSameText(GetTag(ALine), 'group') and
|
|
WideSameText(GetTag(ALine), '(') and
|
|
(GetTag(ALine) <> '') and
|
|
WideSameText(GetTag(ALine), ')');
|
|
if Result then
|
|
begin
|
|
t := GetTag(ALine);
|
|
Result := (t = '') or WideSameText(t, 'c') or
|
|
(WideSameText(t, 'using') and WideSameText(GetTag(ALine), 'keys'));
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Group.SetGroupName(Value: WideString);
|
|
begin
|
|
FGroupName := Value;
|
|
UpdateLine;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Group.SetUsingKeys(const Value: Boolean);
|
|
begin
|
|
FUsingKeys := Value;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Group.UpdateLine;
|
|
begin
|
|
Line := 'group('+FGroupName+')';
|
|
if FUsingKeys then Line := Line + ' using keys';
|
|
end;
|
|
|
|
{ Utility functions }
|
|
|
|
function OctToDec(p: WideString): Integer;
|
|
var
|
|
i, j, n: Integer;
|
|
begin
|
|
n := StrToIntDef(p, 0);
|
|
Result := 0;
|
|
i := 10; j := 1; {ugly and does not check 8,9 but can't be bothered doing it nicely for this infrequent use}
|
|
while i div 10 <= n do
|
|
begin
|
|
Result := Result + (n mod i) div (i div 10) * j;
|
|
j := j * 8;
|
|
i := i * 10;
|
|
end;
|
|
end;
|
|
|
|
function xatoi(p: WideString): Integer;
|
|
begin
|
|
Result := 0;
|
|
if p = '' then Exit;
|
|
|
|
case UpCase(Char(p[1])) of
|
|
'U':
|
|
begin
|
|
if Copy(p,2,1) <> '+' then Exit;
|
|
Result := StrToIntDef('$'+Copy(p,3,6), 0);
|
|
end;
|
|
'X':
|
|
Result := StrToIntDef('$'+Copy(p,2,6), 0);
|
|
'D':
|
|
Result := StrToIntDef(Copy(p,2,6), 0);
|
|
'0'..'7':
|
|
Result := OctToDec(p);
|
|
end;
|
|
end;
|
|
|
|
{ TKeyboardParser_WinLanguages }
|
|
|
|
function TKeyboardParser_WinLanguages.Add(AID: Integer): Integer;
|
|
begin
|
|
Result := inherited Add(TKeyboardParser_WinLanguage.Create(FOwner, AID));
|
|
end;
|
|
|
|
constructor TKeyboardParser_WinLanguages.Create(AOwner: TKeyboardParser);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
procedure TKeyboardParser_WinLanguages.Fill;
|
|
var
|
|
FWinCodes: string;
|
|
FDefaultWinCode: string;
|
|
FPriLangID: Integer;
|
|
FSecondary: string;
|
|
FLangID: Integer;
|
|
s: string;
|
|
PriLangID, SubLangID: Integer;
|
|
n: Integer;
|
|
begin
|
|
Clear; // I4329
|
|
FWinCodes := FOwner.GetSystemStoreValue(ssWindowsLanguages);
|
|
FDefaultWinCode := FOwner.GetSystemStoreValue(ssLanguage);
|
|
|
|
{ Parse the FDefaultWinCode }
|
|
|
|
if FDefaultWinCode <> '' then
|
|
begin
|
|
FPriLangID := xatoi(StrToken(FDefaultWinCode, ', '));
|
|
FSecondary := StrToken(FDefaultWinCode, ' c'#10);
|
|
if FSecondary = '' then
|
|
begin
|
|
FLangID := FPriLangID;
|
|
end
|
|
else
|
|
begin
|
|
PriLangID := FPriLangID;
|
|
SubLangID := xatoi(FSecondary);
|
|
FLangID := PriLangID or (SubLangID shl 10);
|
|
end;
|
|
end
|
|
else
|
|
FLangID := 0;
|
|
|
|
s := StrToken(FWinCodes, ' ');
|
|
while s <> '' do
|
|
begin
|
|
n := xatoi(s);
|
|
if n = 0 then
|
|
Break;
|
|
Add(n);
|
|
s := StrToken(FWinCodes, ' ');
|
|
end;
|
|
|
|
if FLangID > 0 then
|
|
begin
|
|
n := IndexOfID(FLangID);
|
|
if n < 0 then
|
|
n := Add(FLangID);
|
|
|
|
Items[n].FIsDefault := True;
|
|
end;
|
|
end;
|
|
|
|
function TKeyboardParser_WinLanguages.IndexOfDefault: Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if Items[i].IsDefault then
|
|
Exit(i);
|
|
Exit(-1);
|
|
end;
|
|
|
|
function TKeyboardParser_WinLanguages.IndexOfID(AID: Integer): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if Items[i].ID = AID then
|
|
Exit(i);
|
|
Exit(-1);
|
|
end;
|
|
|
|
procedure TKeyboardParser_WinLanguages.Notify(
|
|
const Value: TKeyboardParser_WinLanguage;
|
|
Action: System.Generics.Collections.TCollectionNotification);
|
|
begin
|
|
inherited;
|
|
FOwner.Modified := True;
|
|
end;
|
|
|
|
procedure TKeyboardParser_WinLanguages.UpdateSource;
|
|
var
|
|
i, n: Integer;
|
|
FLanguage: string;
|
|
begin
|
|
n := IndexOfDefault;
|
|
|
|
if n < 0 then
|
|
FOwner.DeleteSystemStore(ssLanguage)
|
|
else
|
|
begin
|
|
FLanguage := 'x'+IntToHex(Items[n].ID, 4);
|
|
FOwner.SetSystemStoreValue(ssLanguage, FLanguage);
|
|
end;
|
|
|
|
FLanguage := '';
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
if i > 0 then FLanguage := FLanguage + ' ';
|
|
FLanguage := FLanguage + 'x'+IntToHex(Items[i].ID, 4);
|
|
end;
|
|
|
|
if FLanguage = ''
|
|
then FOwner.DeleteSystemStore(ssWindowsLanguages)
|
|
else FOwner.SetSystemStoreValue(ssWindowsLanguages, FLanguage);
|
|
end;
|
|
|
|
{ TKeyboardParser_WinLanguage }
|
|
|
|
constructor TKeyboardParser_WinLanguage.Create(AOwner: TKeyboardParser; AID: Integer);
|
|
var
|
|
wl: TWindowsLanguage;
|
|
begin
|
|
inherited Create;
|
|
|
|
FOwner := AOwner;
|
|
|
|
FID := AID;
|
|
|
|
wl := GetWindowsLanguage(ID);
|
|
|
|
if wl.Name = ''
|
|
then FName := 'Unknown language x'+IntToHex(AID, 4)
|
|
else FName := wl.Name;
|
|
end;
|
|
|
|
procedure TKeyboardParser_WinLanguage.SetIsDefault(const Value: Boolean);
|
|
begin
|
|
FIsDefault := Value;
|
|
FOwner.Modified := True;
|
|
end;
|
|
|
|
{ TKeyboardParser_Features }
|
|
|
|
procedure TKeyboardParser_Features.Add(Key: TKeyboardParser_FeatureID);
|
|
begin
|
|
inherited Add(Key, TKeyboardParser_Feature.Create(FOwner, Key, GetDefaultFeatureFilename(Key)));
|
|
end;
|
|
|
|
function TKeyboardParser_Features.GetDefaultFeatureFilename(ID: TKeyboardParser_FeatureID): string;
|
|
begin
|
|
Result := Format(KeyboardFeatureFilename[ID], [ChangeFileExt(ExtractFileName(FOwner.FileName), '')]);
|
|
end;
|
|
|
|
constructor TKeyboardParser_Features.Create(AOwner: TKeyboardParser);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Features.Fill;
|
|
var
|
|
kf: TKeyboardParser_FeatureID;
|
|
FValue: string;
|
|
begin
|
|
Clear;
|
|
for kf := Low(TKeyboardParser_FeatureID) to High(TKeyboardParser_FeatureID) do
|
|
begin
|
|
FValue := FOwner.GetSystemStoreValue(KeyboardFeatureStore[kf]);
|
|
if FValue <> '' then
|
|
begin
|
|
Add(kf, TKeyboardParser_Feature.Create(FOwner, kf, FValue));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Features.KeyNotify(
|
|
const Key: TKeyboardParser_FeatureID;
|
|
Action: System.Generics.Collections.TCollectionNotification);
|
|
begin
|
|
inherited;
|
|
FOwner.Modified := True;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Features.UpdateSource;
|
|
var
|
|
kf: TKeyboardParser_FeatureID;
|
|
begin
|
|
for kf := Low(TKeyboardParser_FeatureID) to High(TKeyboardParser_FeatureID) do
|
|
begin
|
|
if ContainsKey(kf) then
|
|
FOwner.SetSystemStoreValue(KeyboardFeatureStore[kf], Items[kf].Filename)
|
|
else
|
|
FOwner.DeleteSystemStore(KeyboardFeatureStore[kf]);
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyboardParser_Features.ValueNotify(
|
|
const Value: TKeyboardParser_Feature;
|
|
Action: System.Generics.Collections.TCollectionNotification);
|
|
begin
|
|
inherited;
|
|
FOwner.Modified := True;
|
|
end;
|
|
|
|
{ TKeyboardParser_Feature }
|
|
|
|
constructor TKeyboardParser_Feature.Create(AOwner: TKeyboardParser;
|
|
AID: TKeyboardParser_FeatureID;
|
|
const AFilename: string);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
FID := AID;
|
|
FFilename := AFilename;
|
|
end;
|
|
|
|
function TKeyboardParser_Feature.GetExpandedFilename: string;
|
|
begin
|
|
if FID = kfIcon then
|
|
if ExtractFileExt(FFilename) = '' then FFilename := FFilename + '.bmp';
|
|
|
|
Result := ExpandFileNameEx(FOwner.FileName, FFilename);
|
|
end;
|
|
|
|
initialization
|
|
FLineTypes := TKeyboardParser_LineTypes.Create;
|
|
TKeyboardParser_SystemStore.Register;
|
|
TKeyboardParser_Begin.Register;
|
|
TKeyboardParser_Comment.Register;
|
|
TKeyboardParser_LayoutRule.Register;
|
|
TKeyboardParser_BlankLine.Register;
|
|
TKeyboardParser_Group.Register;
|
|
finalization
|
|
FreeAndNil(FLineTypes);
|
|
end.
|