IDE: Fix adding resource with same name but different extension. Issue #26813, patch from Denis Volodarsky.

git-svn-id: trunk@46513 -

ide/frames/project_resources_options.lfm

@@ -6,8 +6,8 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
   ClientHeight = 330
   ClientWidth = 742
   TabOrder = 0
-  DesignLeft = 561
+  DesignLeft = 735
-  DesignTop = 308
+  DesignTop = 393
   object lbResources: TListView
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = ToolBar1
@@ -36,10 +36,12 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
         Width = 326
       end>
     HideSelection = False
+    ReadOnly = True
     RowSelect = True
     TabOrder = 0
     ViewStyle = vsReport
     OnInsert = lbResourcesInsert
+    OnKeyDown = lbResourcesKeyDown
     OnSelectItem = lbResourcesSelectItem
   end
   object ToolBar1: TToolBar

ide/frames/project_resources_options.pas

@@ -32,16 +32,30 @@ type
     procedure btnDeleteClick(Sender: TObject);
     procedure cbResourceTypeChange(Sender: TObject);
     procedure edResourceNameEditingDone(Sender: TObject);
-    procedure edResourceNameKeyDown(Sender: TObject; var Key: Word;
+    procedure edResourceNameKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
-      Shift: TShiftState);
     procedure lbResourcesInsert(Sender: TObject; Item: TListItem);
-    procedure lbResourcesSelectItem(Sender: TObject; Item: TListItem;
+    procedure lbResourcesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
-      Selected: Boolean);
+    procedure lbResourcesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
   private
     FProject: TProject;
-    procedure AddResource(AFileName: String);
+  private
-    procedure AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
+    FAddResourceItemDuplicates: integer;
+    FResourceNameList: TStringList; // to keep resource names unique
+    FResourceFileNameList: TStringList; // to keep resource file names unique
+    // Used to know what was resource name before editing.
+    FCurrentResName: string;
+    // Begin adding resources.
+    procedure AddResourceBegin;
+    // Try to add resource. Result is false if resource is duplicate.
+    function AddResource(AFileName: String): boolean;
+    // Finish adding resources. If there were duplicate resources message will be shown.
+    procedure AddResourceEnd;
+    // Try to add resource item. Result is false if resource is duplicate.
+    function AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String): boolean;
   public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
     function GetTitle: string; override;
     procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
     procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
@@ -53,6 +67,10 @@ implementation
 
 {$R *.lfm}
 
+const
+  LVSUBITEM_TYPE = 0;
+  LVSUBITEM_NAME = 1;
+
 { TResourcesOptionsFrame }
 
 procedure TResourcesOptionsFrame.btnAddClick(Sender: TObject);
@@ -60,42 +78,86 @@ var
   FileName: String;
   aFilename: String;
 begin
-  if dlgOpen.Execute then
+  if dlgOpen.Execute() and (dlgOpen.Files.Count <> 0) then
   begin
+    AddResourceBegin;
+    try
       for FileName in dlgOpen.Files do
       begin
         aFilename := Filename;
         if not FProject.IsVirtual then
           aFileName := CreateRelativePath(aFileName, FProject.ProjectDirectory);
+
         AddResource(aFileName);
       end;
+    finally
+      AddResourceEnd;
+    end;
   end;
 end;
 
 procedure TResourcesOptionsFrame.btnClearClick(Sender: TObject);
 begin
   if IDEMessageDialog(lisConfirmDelete, rsResourceClear, mtConfirmation, [mbYes, mbNo]) = mrYes then
+  begin
     lbResources.Items.Clear;
+    FResourceNameList.Clear;
+    FResourceFileNameList.Clear;
+  end;
   btnClear.Enabled := lbResources.Items.Count > 0;
 end;
 
 procedure TResourcesOptionsFrame.btnDeleteClick(Sender: TObject);
+var
+  resName, resFileName: String;
 begin
   if Assigned(lbResources.Selected) then
+  begin
+    resName := lbResources.Selected.SubItems[LVSUBITEM_NAME];
+    resFileName := lbResources.Selected.Caption;
+
+    FResourceNameList.Delete(FResourceNameList.IndexOf(resName));
+    FResourceFileNameList.Delete(FResourceFileNameList.IndexOf(resFileName));
+
     lbResources.Items.Delete(lbResources.Selected.Index);
+  end;
   btnClear.Enabled := lbResources.Items.Count > 0;
 end;
 
 procedure TResourcesOptionsFrame.cbResourceTypeChange(Sender: TObject);
 begin
   if Assigned(lbResources.Selected) then
-    lbResources.Selected.SubItems[0] := ResourceTypeToStr[TUserResourceType(cbResourceType.ItemIndex)];
+    lbResources.Selected.SubItems[LVSUBITEM_TYPE] := ResourceTypeToStr[TUserResourceType(cbResourceType.ItemIndex)];
 end;
 
 procedure TResourcesOptionsFrame.edResourceNameEditingDone(Sender: TObject);
+var
+  newResName: string;
 begin
   if Assigned(lbResources.Selected) then
-    lbResources.Selected.SubItems[1] := edResourceName.Text;
+  begin
+    newResName := edResourceName.Text;
+    // Exit if resName wasn't changed.
+    if newResName = FCurrentResName then
+      exit;
+    // Check if new name is unique.
+    if FResourceNameList.IndexOf(newResName) <> -1 then
+    begin
+      // If new name is not unique show message and restore edited name.
+      ShowMessage(lisResourceNameMustBeUnique);
+      edResourceName.Text := FCurrentResName;
+      edResourceName.SetFocus; // assume user want to continue editing
+      exit;
+    end;
+    // Remove old name.
+    FResourceNameList.Delete(FResourceNameList.IndexOf(FCurrentResName));
+    // Add new name.
+    FResourceNameList.Add(newResName);
+    // Update in list view.
+    lbResources.Selected.SubItems[LVSUBITEM_NAME] := newResName;
+    // Update current name.
+    FCurrentResName := newResName;
+  end;
 end;
 
 procedure TResourcesOptionsFrame.edResourceNameKeyDown(Sender: TObject;
@@ -103,58 +165,130 @@ procedure TResourcesOptionsFrame.edResourceNameKeyDown(Sender: TObject;
 begin
   if Key = VK_RETURN then
   begin
-    edResourceName.EditingDone;
+    // Shouldn't call edResourceName.EditingDone because when control will lose
+    // focus it will call EditingDone one more time.
+    // Instead set focus to list view.
+    lbResources.SetFocus;
     Key := 0;
   end;
 end;
 
-procedure TResourcesOptionsFrame.lbResourcesInsert(Sender: TObject;
+procedure TResourcesOptionsFrame.lbResourcesInsert(Sender: TObject; Item: TListItem);
-  Item: TListItem);
 begin
   btnClear.Enabled := lbResources.Items.Count > 0;
 end;
 
+procedure TResourcesOptionsFrame.lbResourcesKeyDown(Sender: TObject;
+  var Key: Word; Shift: TShiftState);
+begin
+  case Key of
+    VK_INSERT:
+      btnAddClick(nil);
+    VK_DELETE:
+      btnDeleteClick(nil);
+  end;
+end;
+
 procedure TResourcesOptionsFrame.lbResourcesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
 begin
   btnDelete.Enabled := Assigned(lbResources.Selected);
+
   edResourceName.Enabled := Assigned(lbResources.Selected);
   if edResourceName.Enabled then
-    edResourceName.Text := lbResources.Selected.SubItems[1]
+    edResourceName.Text := lbResources.Selected.SubItems[LVSUBITEM_NAME]
   else
     edResourceName.Text := '';
+
+  FCurrentResName := edResourceName.Text;
+
   cbResourceType.Enabled := Assigned(lbResources.Selected);
   if cbResourceType.Enabled then
-    cbResourceType.ItemIndex := Ord(StrToResourceType(lbResources.Selected.SubItems[0]))
+    cbResourceType.ItemIndex := Ord(StrToResourceType(lbResources.Selected.SubItems[LVSUBITEM_TYPE]))
   else
     cbResourceType.ItemIndex := -1;
 end;
 
-procedure TResourcesOptionsFrame.AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
+procedure TResourcesOptionsFrame.AddResourceBegin;
-var
-  Item: TListItem;
 begin
-  Item := lbResources.Items.Add;
+  // Initialize duplicated resource counter.
-  Item.Caption := ResFile;
+  FAddResourceItemDuplicates := 0;
-  Item.SubItems.Add(ResourceTypeToStr[ResType]);
-  Item.SubItems.Add(ResName);
 end;
 
-procedure TResourcesOptionsFrame.AddResource(AFileName: String);
+function TResourcesOptionsFrame.AddResource(AFileName: String): boolean;
 var
   ResName, Ext: String;
 begin
   Ext := UTF8UpperCase(ExtractFileExt(AFileName));
   ResName := UTF8UpperCase(ExtractFileNameOnly(AFileName));
   case Ext of
-    '.BMP': AddResourceItem(AFileName, rtBitmap, ResName);
+    '.BMP': Result := AddResourceItem(AFileName, rtBitmap, ResName);
-    '.CUR': AddResourceItem(AFileName, rtCursor, ResName);
+    '.CUR': Result := AddResourceItem(AFileName, rtCursor, ResName);
-    '.ICO': AddResourceItem(AFileName, rtIcon, ResName);
+    '.ICO': Result := AddResourceItem(AFileName, rtIcon, ResName);
-    //'.FNT', '.FON', '.TTF': AddResourceItem(AFileName, rtFont, ResName);
+    //'.FNT', '.FON', '.TTF': Result := AddResourceItem(AFileName, rtFont, ResName);
   else
-    AddResourceItem(AFileName, rtRCData, ResName);
+    Result := AddResourceItem(AFileName, rtRCData, ResName);
   end;
 end;
 
+procedure TResourcesOptionsFrame.AddResourceEnd;
+begin
+  if FAddResourceItemDuplicates <> 0 then
+  begin
+    ShowMessageFmt(lisFailedToAddNNotUniqueResources, [FAddResourceItemDuplicates]);
+    FAddResourceItemDuplicates := 0;
+  end;
+end;
+
+function TResourcesOptionsFrame.AddResourceItem(ResFile: String;
+  ResType: TUserResourceType; ResName: String): boolean;
+var
+  Item: TListItem;
+begin
+  if FResourceFileNameList.IndexOf(ResFile) <> -1 then
+  begin
+    // Such file name is already in list.
+    // Ignore adding.
+    exit(true);
+  end;
+
+  if FResourceNameList.IndexOf(ResName) <> -1 then
+  begin
+    // Such res. name already exists.
+    // Don't add it twice.
+    inc(FAddResourceItemDuplicates);
+    exit(false);
+  end;
+
+  Item := lbResources.Items.Add;
+  Item.Caption := ResFile;                       // path
+  Item.SubItems.Add(ResourceTypeToStr[ResType]); // type
+  Item.SubItems.Add(ResName);                    // name
+
+  FResourceFileNameList.Add(ResFile);
+  FResourceNameList.Add(ResName);
+  exit(true);
+end;
+
+constructor TResourcesOptionsFrame.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FResourceNameList := TStringList.Create;
+  FResourceNameList.Sorted := True;
+  FResourceNameList.Duplicates := dupError;
+
+  FResourceFileNameList := TStringList.Create;
+  FResourceFileNameList.Sorted := True;
+  FResourceFileNameList.Duplicates := dupError;
+end;
+
+destructor TResourcesOptionsFrame.Destroy;
+begin
+  FResourceNameList.Free;
+  FResourceFileNameList.Free;
+  inherited Destroy;
+end;
+
 function TResourcesOptionsFrame.GetTitle: string;
 begin
   Result := dlgPOResources;
@@ -193,6 +327,8 @@ begin
   FProject := (AOptions as TProjectIDEOptions).Project;
   lbResources.Items.Clear;
   List := FProject.ProjResources.UserResources.List;
+  AddResourceBegin;
+  try
     lbResources.Items.BeginUpdate;
     try
       for I := 0 to List.Count - 1 do
@@ -200,6 +336,9 @@ begin
     finally
       lbResources.Items.EndUpdate;
     end;
+  finally
+    AddResourceEnd;
+  end;
   btnClear.Enabled := lbResources.Items.Count > 0;
 end;
 
@@ -212,7 +351,7 @@ begin
   Project.ProjResources.UserResources.List.Clear;
   for I := 0 to lbResources.Items.Count - 1 do
     Project.ProjResources.UserResources.List.AddResource(lbResources.Items[I].Caption,
-      StrToResourceType(lbResources.Items[I].SubItems[0]), lbResources.Items[I].SubItems[1]);
+      StrToResourceType(lbResources.Items[I].SubItems[LVSUBITEM_TYPE]), lbResources.Items[I].SubItems[LVSUBITEM_NAME]);
 end;
 
 class function TResourcesOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;

ide/lazarusidestrconsts.pas

@@ -135,6 +135,8 @@ resourcestring
   lrsRescanLplFiles = 'Rescan lpl files';
   lrsPLDDeleteSelected = 'Delete selected';
   lisRenameShowResult = 'Show list of renamed Identifiers';
+  lisResourceNameMustBeUnique = 'Resource name must be unique';
+  lisFailedToAddNNotUniqueResources = 'Failed to add %d not unique resource(s)';
 
   // errors
   lisErrInvalidOption = 'Invalid option at position %d: "%s"';
@@ -152,8 +154,7 @@ resourcestring
   lisSkipLoadingLastProject = 'Skip loading last project';
   lisOverrideLanguage = 'Override language. For example --language=de.'+
     ' For possible values see files in the languages directory.';
-  lissecondaryConfigDirectoryWhereLazarusSearchesFor =
+  lissecondaryConfigDirectoryWhereLazarusSearchesFor = 'secondary config '+
-    'secondary config '+
     'directory, where Lazarus searches for config template files. Default is ';
   lisFileWhereDebugOutputIsWritten =
     'file, where debug output is written to. If it is '+