Support for relative symlink creation

4 files changed, 52 insertions, 3 deletions

diff --git a/UCore.pas b/UCore.pas
index b69b055..416bd45 100644
--- a/UCore.pas
+++ b/UCore.pas
@@ -2186,6 +2186,8 @@ begin
   Result := False;
   try
     AFSymlink := TFSymlink.Create(Application.MainForm);
+    AFSymLink.FileName := FileName;
+    AFSymLink.PossibleNewName := PossibleNewName;
     AFSymlink.FromEntry.Text := StrToUTF8(FileName);
     AFSymlink.ToEntry.Text := StrToUTF8(PossibleNewName);
     AFSymlink.ToEntry.SetFocus;
@@ -2261,6 +2263,7 @@ begin
     AFSymlink.FromEntry.Enabled := False;
     AFSymlink.ToEntry.Text := StrToUTF8(Data^.LnkPointTo);
     AFSymlink.ToEntry.SelectAll;
+    AFSymLink.RelativeCheckButton.Visible := False;
     if AFSymlink.Run = mbOK then Result := HandleEditSymlink(UTF8ToStr(AFSymlink.FromEntry.Text), UTF8ToStr(AFSymlink.ToEntry.Text));
   finally
     AFSymlink.Free;
diff --git a/UCoreUtils.pas b/UCoreUtils.pas
index 7a5a6b1..fa89eea 100644
--- a/UCoreUtils.pas
+++ b/UCoreUtils.pas
@@ -115,6 +115,9 @@ function Min(Val1, Val2: longint): longint;
 
 function XORStr(const s: string; Key: byte): string;
 
+function FindCommonRoot(BasePath, DestPath: string): string;
+function BuildRelativePath(BasePath, DestPath: string): string;
+
 procedure ReportGTKVersion;
 
 //  Internal locking
@@ -1591,6 +1594,38 @@ begin
 end;
 
 (********************************************************************************************************************************)
+function FindCommonRoot(BasePath, DestPath: string): string;
+var i, LastSlash: integer;
+begin
+  LastSlash := 0;
+  for i := 1 to Min(Length(BasePath), Length(DestPath)) do
+    if BasePath[i] = DestPath[i] then begin
+      if IsPathDelimiter(BasePath, i)
+        then LastSlash := i;
+    end else Break;
+  if (LastSlash) <= 0 then Result := ''
+                      else Result := Copy(BasePath, 1, LastSlash);
+end;
+
+function BuildRelativePath(BasePath, DestPath: string): string;
+var CommonRoot, RestSrc, RestDst: string;
+    SlashPos: integer;
+begin
+  CommonRoot := FindCommonRoot(BasePath, DestPath);
+  RestSrc := Copy(BasePath, Length(CommonRoot) + 1, Length(BasePath) - Length(CommonRoot));
+  RestDst := Copy(DestPath, Length(CommonRoot) + 1, Length(DestPath) - Length(CommonRoot));
+
+  Result := '';
+  SlashPos := Pos(PathDelim, RestDst);
+  while (SlashPos > 0) do begin
+    Result := Result + '../';
+    Delete(RestDst, 1, SlashPos);
+    SlashPos := Pos(PathDelim, RestDst);
+  end;
+  Result := Result + RestSrc;
+end;
+
+(********************************************************************************************************************************)
 
 procedure signal_proc(signal_number: integer); cdecl;
 var {pid,} status: integer;
diff --git a/UMain.pas b/UMain.pas
index fbcf334..83ea9a1 100644
--- a/UMain.pas
+++ b/UMain.pas
@@ -4221,7 +4221,7 @@ begin
     else s1 := IncludeTrailingPathDelimiter(Engine.Path) + PDataItem(AListView.Selected.Data)^.FName;
   if Engine.Path <> EngineOpposite.Path
     then s2 := IncludeTrailingPathDelimiter(EngineOpposite.Path) + PDataItem(AListView.Selected.Data)^.FName
-    else s2 := '';
+    else s2 := IncludeTrailingPathDelimiter(EngineOpposite.Path) + Format('Link to %s', [PDataItem(AListView.Selected.Data)^.FName]);
 
   if CreateSymlink(s1, s2, Engine) then begin
     DoRefresh(LeftPanel, True, True);
diff --git a/USymlink.pas b/USymlink.pas
index 704b500..7ce6fda 100644
--- a/USymlink.pas
+++ b/USymlink.pas
@@ -29,12 +29,14 @@ type
     Label1, Label2: TGTKLabel;
     FromEntry, ToEntry: TGTKEntry;
     Box: TGTKVBox;
+    RelativeCheckButton: TGTKCheckButton;
     procedure FormCreate(Sender: TObject); override;
     procedure FormKeyDown(Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean);
+    procedure RelativeCheckButtonToggled(Sender: TObject);
   private
     { Private declarations }
   public
-    { Public declarations }
+    FileName, PossibleNewName: string;
   end;
 
 var
@@ -42,7 +44,7 @@ var
 
 implementation
 
-uses ULocale;
+uses ULocale, UCoreUtils;
 
 
 procedure TFSymlink.FormCreate(Sender: TObject);
@@ -65,8 +67,11 @@ begin
   Label2.XPadding := 0;
   ToEntry := TGTKEntry.Create(Self);
   Label2.FocusControl := ToEntry;
+  RelativeCheckButton := TGTKCheckButton.CreateWithLabel(Self, '_Relative path');
+  RelativeCheckButton.OnToggled := RelativeCheckButtonToggled;
   Box.AddControlEx(Label1, False, False, 2);
   Box.AddControlEx(FromEntry, False, False, 0);
+  Box.AddControlEx(RelativeCheckButton, False, False, 0);
   Box.AddControlEx(TGTKHSeparator.Create(Self), False, False, 5);
   Box.AddControlEx(Label2, False, False, 2);
   Box.AddControlEx(ToEntry, False, False, 0);
@@ -84,6 +89,12 @@ begin
   end;
 end;
 
+procedure TFSymlink.RelativeCheckButtonToggled(Sender: TObject);
+begin
+  if RelativeCheckButton.Checked then FromEntry.Text := StrToUTF8(BuildRelativePath(FileName, PossibleNewName))
+                                 else FromEntry.Text := StrToUTF8(FileName);
+end;
+
 
 end.