diff options
| -rw-r--r-- | UCore.pas | 3 | ||||
| -rw-r--r-- | UCoreUtils.pas | 35 | ||||
| -rw-r--r-- | UMain.pas | 2 | ||||
| -rw-r--r-- | USymlink.pas | 15 |
4 files changed, 52 insertions, 3 deletions
@@ -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; @@ -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. |
