Changeset 58 for trunk/UContact.pas

Timestamp:

Dec 8, 2021, 10:00:45 PM (3 years ago)

Author:

chronos

Message:

• Added: Social tab in contact form.
• Added: Allow to specify alternative property name for contact field definition to support various non-standard properties.

File:

• trunk/UContact.pas (modified) (16 diffs)

trunk/UContact.pas

@@ -13 +13 @@
   TErrorEvent = procedure (Text: string; Line: Integer) of object;
 
-  TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage, dtStringList);
+  TDataType = (dtNone, dtString, dtInteger, dtDate, dtDateTime, dtImage, dtStringList);
 
   TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTitleBefore,
@@ -28 +28 @@
     cfWorkAddressPostalCode, cfWorkAddressRegion, cfWorkAddressPostOfficeBox,
     cfXTimesContacted, cfXLastTimeContacted, cfPhoto, cfDayOfBirth, cfRevision,
-    cfVersion, cfAnniversary,
+    cfVersion, cfAnniversary, cfGender,
     cfJabber, cfIcq, cfWindowsLive, cfGoogleTalk, cfAim, cfQq, cfYahoo, cfIrc,
-    cfSkype, cfMsn);
+    cfSkype, cfMsn,
+    cfTwitter, cfFacebook, cfInstagram, cfSnapchat, cfMatrix, cfYoutube,
+    cfPeerTube, cfLinkedIn, cfMastodon, cfMySpace, cfReddit);
+
+  TContactFields = class;
 
   { TContactField }
@@ -42 +46 @@
     ValueIndex: Integer;
     DataType: TDataType;
+    Alternatives: TContactFields;
+    function AddAlternative(Name: string; Groups: array of string; NoGroups:
+      array of string): TContactField;
     function GroupsContain(Name: string): Boolean;
     function Match(ASysName: string; AGroups: TStringArray): Boolean;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -51 +60 @@
     function AddNew(Name: string; Groups: array of string; NoGroups: array of string;
       Title: string; Index: TContactFieldIndex; DataType:
-      TDataType; ValueIndex: Integer = -1): TContactField;
+      TDataType = dtNone; ValueIndex: Integer = -1): TContactField;
     function GetBySysName(SysName: string): TContactField;
     function GetBySysNameGroups(SysName: string; Groups: TStringArray): TContactField;
@@ -101 +110 @@
     Properties: TContactProperties;
     Parent: TContactsFile;
-    function GetProperty(Index: TContactFieldIndex): TContactProperty;
+    function GetProperty(Field: TContactField): TContactProperty; overload;
+    function GetProperty(FieldIndex: TContactFieldIndex): TContactProperty; overload;
     procedure Assign(Source: TContact);
     function UpdateFrom(Source: TContact): Boolean;
@@ -222 +232 @@
   SWebAddressHome = 'Web address home';
   SWebAddressWork = 'Web address work';
+  SGender = 'Gender';
+  // Chat
   SMsn = 'MSN';
   SGoogleTalk = 'Google Talk';
@@ -231 +243 @@
   SYahoo = 'Yahoo!';
   SSkype = 'Skype';
+  SMatrix = 'Matrix';
+  // Social
+  STwitter = 'Twitter';
+  SFacebook = 'Facebook';
+  SInstagram = 'Instagram';
+  SMastodon = 'Mastodon';
+  SSnapchat = 'Snapchat';
+  SLinkedIn = 'LinkedIn';
+  SYouTube = 'YouTube';
+  SPeerTube = 'PeerTube';
+  SReddit = 'Reddit';
+  SMySpace = 'MySpace';
 
 function GetNext(var Text: string; Separator: string): string;
@@ -256 +280 @@
 
 { TContactField }
+
+function TContactField.AddAlternative(Name: string; Groups: array of string;
+  NoGroups: array of string): TContactField;
+begin
+  Result := Alternatives.AddNew(Name, Groups, NoGroups, Title, Index, DataType, ValueIndex);
+end;
 
 function TContactField.GroupsContain(Name: string): Boolean;
@@ -282 +312 @@
     end;
   end;
+end;
+
+constructor TContactField.Create;
+begin
+  Alternatives := TContactFields.Create;
+end;
+
+destructor TContactField.Destroy;
+begin
+  FreeAndNil(Alternatives);
+  inherited;
 end;
 
@@ -520 +561 @@
 function TContactFields.AddNew(Name: string; Groups: array of string;
   NoGroups: array of string; Title: string; Index: TContactFieldIndex;
-  DataType: TDataType; ValueIndex: Integer = -1): TContactField;
+  DataType: TDataType = dtNone; ValueIndex: Integer = -1): TContactField;
 var
   I: Integer;
@@ -567 +608 @@
 var
   I: Integer;
-  C: Integer;
-begin
-  C := Count;
+begin
   I := 0;
   while (I < Count) and (Items[I].Index <> Index) do Inc(I);
@@ -594 +633 @@
 begin
   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
-  Prop := GetProperty(Index);
-  if Assigned(Prop) then begin
-    Field := Parent.Fields.GetByIndex(Index);
-    if Field.ValueIndex <> -1 then begin
-      Result := Prop.ValueItem[Field.ValueIndex]
-    end else Result := Prop.Value;
-  end else Result := '';
+  Field := Parent.Fields.GetByIndex(Index);
+  if Assigned(Field) then begin
+    Prop := GetProperty(Field);
+    if Assigned(Prop) then begin
+      Field := Parent.Fields.GetByIndex(Index);
+      if Field.ValueIndex <> -1 then begin
+        Result := Prop.ValueItem[Field.ValueIndex]
+      end else Result := Prop.Value;
+    end else Result := '';
+  end else raise Exception.Create(SFieldIndexNotDefined);
 end;
 
@@ -612 +654 @@
   Field := Parent.Fields.GetByIndex(Index);
   if Assigned(Field) then begin
-    Prop := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
+    Prop := GetProperty(Field);
     if (not Assigned(Prop)) and (AValue <> '') then begin
       Prop := TContactProperty.Create;
@@ -633 +675 @@
 end;
 
-function TContact.GetProperty(Index: TContactFieldIndex): TContactProperty;
+function TContact.GetProperty(Field: TContactField): TContactProperty;
+var
+  I: Integer;
+begin
+  Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
+  I := 0;
+  while (not Assigned(Result)) and (I < Field.Alternatives.Count) do begin
+    Result := Properties.GetByNameGroups(Field.Alternatives[I].SysName,
+      Field.Alternatives[I].Groups, Field.Alternatives[I].NoGroups);
+    if Assigned(Result) then Break;
+    Inc(I);
+  end;
+end;
+
+function TContact.GetProperty(FieldIndex: TContactFieldIndex): TContactProperty;
 var
   Field: TContactField;
 begin
   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
-  Field := Parent.Fields.GetByIndex(Index);
+  Field := Parent.Fields.GetByIndex(FieldIndex);
   if Assigned(Field) then begin
-    Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
-  end else raise Exception.Create(SFieldIndexNotDefined);
+    Result := GetProperty(Field);
+  end else Result := nil;
 end;
 
@@ -872 +928 @@
     AddNew('EMAIL', ['WORK'], [], SWorkEmail, cfEmailWork, dtString);
     AddNew('EMAIL', ['INTERNET'], [], SInternetEmail, cfEmailInternet, dtString);
-    AddNew('NICKNAME', [], [], SNickName, cfNickName, dtString);
+    with AddNew('NICKNAME', [], [], SNickName, cfNickName, dtString) do
+      AddAlternative('X-NICKNAME', [], []);
     AddNew('NOTE', [], [], SNote, cfNote, dtString);
     AddNew('ROLE', [], [], SRole, cfRole, dtString);
@@ -903 +960 @@
     AddNew('URL', ['HOME'], [], SWebAddressHome, cfUrlHome, dtString);
     AddNew('URL', ['WORK'], [], SWebAddressWork, cfUrlWork, dtString);
+    with AddNew('GENDER', [], [], SGender, cfGender, dtString) do
+      AddAlternative('X-CENTRUM-CZ-SEX', [], []);
+    // Chat
+    AddNew('X-MATRIX', [], [], SMatrix, cfMatrix, dtString);
     AddNew('X-JABBER', [], [], SJabber, cfJabber, dtString);
     AddNew('X-AIM', [], [], SAim, cfAim, dtString);
     AddNew('X-Windows Live', [], [], SWindowsLive, cfWindowsLive, dtString);
     AddNew('X-YAHOO', [], [], SYahoo, cfYahoo, dtString);
-    AddNew('X-SKYPE-USERNAME', [], [], SSkype, cfSkype, dtString);
+    with AddNew('X-SKYPE-USERNAME', [], [], SSkype, cfSkype, dtString) do begin
+      AddAlternative('X-SKYPE', [], []);
+      AddAlternative('X-CENTRUM-CZ-SKYPE', [], []);
+    end;
     AddNew('X-QQ', [], [], SQq, cfQq, dtString);
     AddNew('X-GOOGLE-TALK', [], [], SGoogleTalk, cfGoogleTalk, dtString);
-    AddNew('X-ICQ', [], [], SIcq, cfIcq, dtString);
+    with AddNew('X-ICQ', [], [], SIcq, cfIcq, dtString) do
+      AddAlternative('X-CENTRUM-CZ-ICQ', [], []);
     AddNew('X-IRC', [], [], SIrc, cfIrc, dtString);
-    AddNew('X-MSN', [], [], SMsn, cfMsn, dtString);
+    with AddNew('X-MSN', [], [], SMsn, cfMsn, dtString) do
+      AddAlternative('X-CENTRUM-CZ-MSN', [], []);
+    // Social
+    with AddNew('X-TWITTER', [], [], STwitter, cfTwitter, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['TWITTER'], []);
+    with AddNew('X-FACEBOOK', [], [], SFacebook, cfFacebook, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['FACEBOOK'], []);
+    with AddNew('X-MASTODON', [], [], SMastodon, cfMastodon, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['MASTODON'], []);
+    with AddNew('X-YOUTUBE', [], [], SYouTube, cfYouTube, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['YOUTUBE'], []);
+    with AddNew('X-PEERTUBE', [], [], SPeerTube, cfPeerTube, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['PEERTUBE'], []);
+    with AddNew('X-LINKEDIN', [], [], SLinkedIn, cfLinkedIn, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['LINKEDIN'], []);
+    with AddNew('X-SNAPCHAT', [], [], SSnapchat, cfSnapchat, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['SNAPCHAT'], []);
+    with AddNew('X-INSTAGRAM', [], [], SInstagram, cfInstagram, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['INSTAGRAM'], []);
+    with AddNew('X-REDDIT', [], [], SReddit, cfReddit, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['REDDIT'], []);
+    with AddNew('X-MYSPACE', [], [], SMySpace, cfMySpace, dtString) do
+      AddAlternative('X-SOCIALPROFILE', ['MYSPACE'], []);
   end;
 end;