(* Tux Commander - UCoreUtils - Some other useful core functions Copyright (C) 2008 Tomas Bzatek Check for updates on tuxcmd.sourceforge.net This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) unit UCoreUtils; interface uses SysUtils, Classes, lazglib2, lazgobject2, lazgdk3, lazgtk3, GTKClasses, UEngines, ULibc; type PCharArray = array[0..0] of PChar; TOpenStringArray = array of string; TOpenPCharArray = array of PChar; const ConstQuotationCharacters = [' ', '"', '''', '(', ')', ':', '&']; ConstURIIllegalCharacters = '%:@/'; function FormatSize(Value: Int64; Base: integer; OverrideSizeFormat: integer = -1): string; function FormatDate(Value: time_t; const DoFormatTime, DoFormatDate: boolean; OverrideTimeFormat: integer = -1; OverrideDateFormat: integer = -1; OverrideDateTimeFormat: integer = -1; OverrideCustomDateFormat: string = ''; OverrideCustomTimeFormat: string = ''): string; function StripDate(Value: time_t): time_t; function IncludeLeadingDot(s: string): string; function AttrToStr(const Mode: Cardinal; IncludeFileType: boolean = True): string; function AttrToOctal(const Mode: Cardinal): integer; function OctalToAttr(Octal: Cardinal): Cardinal; { Convert an octal specified number to decimal } { Copied from linux.pp (Free Pascal run time library) - Copyright (c) 1999-2000 by Michael Van Canneyt, BSD parts (c) 2000 by Marco van de Voort, members of the Free Pascal development team } function PosEnd(Substr: string; S: string): Integer; function GetHomePath: string; function GetUserName: string; procedure SeparateExt(const Original: string; var Name, Ext: string); procedure SeparateNameDir(Original: string; var Path, FileName: string); function PadRightStr(const Str: string; Len: byte): string; function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean; { IsWild compares InputString with WildCard string and returns True if corresponds. } { Copied from Delphi VCL Extensions (RX) - Copyright (c) 1995, 1996 AO ROSNO, Copyright (c) 1997, 1998 Master-Bank } function ReplaceStr(const S, Srch, Replace: string): string; { Returns string with every occurrence of Srch string replaced with Replace string. } { Copied from Delphi VCL Extensions (RX) - Copyright (c) 1995, 1996 AO ROSNO, Copyright (c) 1997, 1998 Master-Bank } function NumCountChars(const Char: char; const S: string): integer; procedure ParseString(const Str, Separator: string; var SubStrings: TOpenStringArray); function MakeString(const Separator: string; var SubStrings: TOpenStringArray): string; procedure CopyArray(var src: TOpenStringArray; var dst: TOpenStringArray); procedure DeleteFromArray(Index: integer; var SubStrings: TOpenStringArray); function ExtractAccelerator(const LabelText: string): string; function ProcessPattern(Engine: TPanelEngine; Pattern, APath, FileName: string; const Directory: boolean): string; // Processess pattern with FileName located in APath and return destination path+filename procedure ShowAbout; procedure SetupAppIcon; procedure TrimCRLFESC(var s: string); procedure TrimQuotes(var s: string); function QuoteStr(const Str: string): string; function QuoteMarkupStr(const Str: string; MarkupUnderscore: boolean = False): string; function RemoveQuotation(const Str: string): string; function GetStrSize(s: string): Int64; procedure DebugMsg(Params: array of const); function ExecuteProgram(const AppCMDLine, CWD: string; const AutodetectGUI, RunInTerminal: boolean; var ErrorString: string): boolean; function IsItX11App(const Application: string): boolean; function HandleSystemCommand(const Command: string; var ErrorString: string): boolean; function CompareTextsEx(S1, S2: PChar): integer; function LVCompareItems(Data1, Data2: PDataItem; const Ascending: boolean; const SortColumnID: integer): integer; procedure SortDataList(var List: TList; const Ascending: boolean; const SortColumnID: integer); procedure GetFirstLastPanelColumn(var FirstColumn, LastColumn: integer); procedure SetupColors; function ConstructURI(IncludePasswd, HidePasswd: boolean; Protocol, Server, Username, Password, Dir: string): string; function URIHidePassword(const SrcURI: string): string; function UnEscapeURI(const Str: string): string; function EscapeURI(const Str: string; const IllegalChars: string): string; function URIRipPassword(var URI: string; const RemovePassword: boolean): string; function GetURIPrefix(const URI: string): string; function StrTotimetDef(const S: string; const Default: time_t): time_t; procedure SaveItemToHistory(s: string; History: TStringList); // All the UTF-8 conversion functions do strdup() function StrToUTF8(s: string): string; overload; function UTF8ToStr(s: string): string; overload; function StrToUTF8(s: PChar): PChar; overload; function UTF8ToStr(s: PChar): PChar; overload; function EnsureUTF8String(s: PChar): PChar; overload; function Min(Val1, Val2: longint): longint; function XORStr(const s: string; Key: byte): string; function CLAMP(x, MinX, MaxX: integer): integer; function FindCommonRoot(BasePath, DestPath: string): string; function BuildRelativePath(BasePath, DestPath: string): string; // Internal locking procedure InternalLock; procedure InternalUnLock; function InternalLockUnlocked: boolean; procedure InternalLockInit(Locked: boolean); var AppPath, IconPath: string; // Used in UFileTypeSettings NormalItemGDKColor, ActiveItemGDKColor, InactiveItemGDKColor, SelectedItemGDKColor, DotFileItemGDKColor, LinkItemGDKColor, NormalItemGDKBackground, ActiveItemGDKBackground, InactiveItemGDKBackground: PGdkRGBA; implementation uses DateUtils, GTKForms, GTKStdCtrls, GTKUtils, GTKView, ULocale, UConfig, UCore, UGnome, UMain, UFileAssoc; (********************************************************************************************************************************) function FormatFloat64(Value: Int64; Sep: string): string; var i : integer; Orig : string; begin Result := IntToStr(Value); Orig := Result; if (Sep <> '') and (Length(Result) > 2) then for i := Length(Result) downto 2 do if (Length(Orig) - i + 1) mod 3 = 0 then Insert(Sep, Result, i); end; function FormatSize(Value: Int64; Base: integer; OverrideSizeFormat: integer = -1): string; var s: string; f, i: integer; p: PChar; x: gdouble; begin if Base < 1 then Base := 1; f := OverrideSizeFormat; if f < 0 then f := ConfSizeFormat; case f of 0 : begin // System default formatting p := g_strdup_printf('%''llu', [Int64(Value div Base)]); if p = nil then begin DebugMsg(['FormatSize(0): sprintf() failed, using old format function.']); Result := FormatFloat('###,###,##0', Value div Base); end else begin Result := StrToUTF8(p); g_free(p); end; end; 1 : begin // 123456 Result := IntToStr(Value div Base); end; 2 : begin // 123,456 Result := FormatFloat64(Value div Base, ','); end; 3 : begin // 123 456 Result := FormatFloat64(Value div Base, ' '); end; 4 : begin // 123'456 Result := FormatFloat64(Value div Base, ''''); end; 5 : begin // 123kB - Grouped if (Value >= 1024*1024*1024) or (Base = 1024*1024*1024) then begin x := Value / (1024*1024*1024); p := g_strdup_printf(PChar('%''.' + IntToStr(ConfSizeGroupPrecision) + 'f GB'), [x]); end else if (Value >= 1024*1024) or (Base = 1024*1024) then begin x := Value / (1024*1024); p := g_strdup_printf(PChar('%''.' + IntToStr(ConfSizeGroupPrecision) + 'f MB'), [x]); end else if (Value >= 1024) or (Base = 1024) then begin x := Value / 1024; p := g_strdup_printf(PChar('%''.' + IntToStr(ConfSizeGroupPrecision) + 'f kB'), [x]); end else p := g_strdup_printf('%d', [Value]); if p = nil then begin DebugMsg(['FormatSize(5): g_strdup_printf() failed, using old format function.']); s := '###,###,##0'; if ConfSizeGroupPrecision > 0 then begin s := s + '.'; for i := 1 to ConfSizeGroupPrecision do if ConfSizeGroupRequestZeroDigits then s := s + '0' else s := s + '#'; end; if (Value >= 1024*1024*1024) or (Base = 1024*1024*1024) then Result := FormatFloat(s + ' GB', Value / (1024*1024*1024)) else if (Value >= 1024*1024) or (Base = 1024*1024) then Result := FormatFloat(s + ' MB', Value / (1024*1024)) else if (Value >= 1024) or (Base = 1024) then Result := FormatFloat(s + ' kB', Value / (1024)) else Result := IntToStr(Value); end else begin Result := StrToUTF8(p); g_free(p); end; end; end; if ConfSizeFormat in [0..4] then begin if Result = '' then Result := '0'; if Base = 1024 then Result := Result + ' kB' else if Base = 1024*1024 then Result := Result + ' MB' else if Base = 1024*1024*1024 then Result := Result + ' GB'; end; if Result = '' then Result := '0'; end; (********************************************************************************************************************************) function FormatDate(Value: time_t; const DoFormatTime, DoFormatDate: boolean; OverrideTimeFormat: integer = -1; OverrideDateFormat: integer = -1; OverrideDateTimeFormat: integer = -1; OverrideCustomDateFormat: string = ''; OverrideCustomTimeFormat: string = ''): string; var DateString, TimeString: string; DateFormat, TimeFormat: string; CustDateFormat, CustTimeFormat: string; df, tf, dtf: integer; time_tm: Ptm; Buf: PChar; placed: integer; begin DateString := ''; TimeString := ''; DateFormat := ''; TimeFormat := ''; Result := ''; if OverrideDateFormat >= 0 then df := OverrideDateFormat else df := ConfDateFormat; if OverrideTimeFormat >= 0 then tf := OverrideTimeFormat else tf := ConfTimeFormat; if OverrideDateTimeFormat >= 0 then dtf := OverrideDateTimeFormat else dtf := ConfDateTimeFormat; if Length(Trim(OverrideCustomDateFormat)) > 0 then CustDateFormat := OverrideCustomDateFormat else CustDateFormat := ConfCustomDateFormat; if Length(Trim(OverrideCustomTimeFormat)) > 0 then CustTimeFormat := OverrideCustomTimeFormat else CustTimeFormat := ConfCustomTimeFormat; time_tm := localtime(@Value); if DoFormatDate then begin case df of 0: DateFormat := '%x'; // System format 1: DateFormat := '%Y-%m-%d'; // 2008-06-24 2: DateFormat := '%Y/%m/%d'; // 2008/06/24 3: DateFormat := '%d.%m.%Y'; // 24.06.2008 4: DateFormat := '%d.%m.%y'; // 24.06.08 5: DateFormat := '%d-%m-%Y'; // 24-06-2008 6: DateFormat := '%d/%m/%Y'; // 24/06/2008 7: DateFormat := '%m-%d-%Y'; // 06-24-2008 8: DateFormat := '%m/%d/%Y'; // 06/24/2008 9: DateFormat := '%d-%m-%y'; // 24-06-08 10: DateFormat := '%d/%m/%y'; // 24/06/08 11: DateFormat := '%m-%d-%y'; // 06-24-08 12: DateFormat := '%m/%d/%y'; // 06/24/08 13: DateFormat := '%y-%m-%d'; // 08-06-24 14: DateFormat := '%y/%m/%d'; // 08/06/24 else DateFormat := CustDateFormat; // Custom date format end; Buf := libc_malloc(255); memset(Buf, 0, 255); placed := strftime(Buf, 254, PChar(DateFormat), time_tm); if placed <= 0 then DebugMsg(['FormatDate: error converting date. The result will be unpredictable.']); DateString := String(StrToUTF8(Buf)); libc_free(Buf); end; if DoFormatTime then begin case tf of 0: TimeFormat := '%X'; // System format 1: TimeFormat := '%I:%M %P'; // 01:11 pm 2: TimeFormat := '%l:%M %P'; // 1:11 pm 3: TimeFormat := '%I:%M:%S %P'; // 01:11:11 pm 4: TimeFormat := '%l:%M:%S %P'; // 1:11:11 pm 5: TimeFormat := '%I:%M %p'; // 01:11 PM 6: TimeFormat := '%l:%M %p'; // 1:11 PM 7: TimeFormat := '%I:%M:%S %p'; // 01:11:11 PM 8: TimeFormat := '%l:%M:%S %p'; // 1:11:11 PM 9: TimeFormat := '%k:%M'; // 13:11 10: TimeFormat := '%k:%M:%S'; // 13:11:11 11: TimeFormat := '%H%M'; // 1311 else TimeFormat := CustTimeFormat; // Custom Time format end; Buf := libc_malloc(255); memset(Buf, 0, 255); placed := strftime(Buf, 254, PChar(TimeFormat), time_tm); if placed <= 0 then DebugMsg(['FormatDate: error converting time. The result will be unpredictable.']); TimeString := String(StrToUTF8(Buf)); libc_free(Buf); end; if DoFormatDate and DoFormatTime then begin case dtf of 0: Result := Format('%s %s', [DateString, TimeString]); else Result := Format('%s %s', [TimeString, DateString]); end; end else if DoFormatTime then Result := TimeString else if DoFormatDate then Result := DateString; end; function StripDate(Value: time_t): time_t; var time_tm: Ptm; begin time_tm := localtime(@Value); Result := time_tm^.tm_hour*60*60 + time_tm^.tm_min*60 + time_tm^.tm_sec; end; (********************************************************************************************************************************) function AttrToStr(const Mode: Cardinal; IncludeFileType: boolean = True): string; begin if IncludeFileType then begin if __S_ISTYPE(Mode, __S_IFLNK) then Result := 'l' else if __S_ISTYPE(Mode, __S_IFDIR) then Result := 'd' else if __S_ISTYPE(Mode, __S_IFBLK) then Result := 'b' else if __S_ISTYPE(Mode, __S_IFCHR) then Result := 'c' else if __S_ISTYPE(Mode, __S_IFIFO) then Result := 'f' else if __S_ISTYPE(Mode, __S_IFSOCK) then Result := 's' else Result := '-'; end else Result := ''; if Mode and S_IRUSR = S_IRUSR then Result := Result + 'r' else Result := Result + '-'; if Mode and S_IWUSR = S_IWUSR then Result := Result + 'w' else Result := Result + '-'; if Mode and __S_ISUID = __S_ISUID then if Mode and S_IXUSR = S_IXUSR then Result := Result + 's' else Result := Result + 'S' else if Mode and S_IXUSR = S_IXUSR then Result := Result + 'x' else Result := Result + '-'; if Mode and S_IRGRP = S_IRGRP then Result := Result + 'r' else Result := Result + '-'; if Mode and S_IWGRP = S_IWGRP then Result := Result + 'w' else Result := Result + '-'; if Mode and __S_ISGID = __S_ISGID then if Mode and S_IXGRP = S_IXGRP then Result := Result + 's' else Result := Result + 'S' else if Mode and S_IXGRP = S_IXGRP then Result := Result + 'x' else Result := Result + '-'; if Mode and S_IROTH = S_IROTH then Result := Result + 'r' else Result := Result + '-'; if Mode and S_IWOTH = S_IWOTH then Result := Result + 'w' else Result := Result + '-'; if Mode and __S_ISVTX = __S_ISVTX then if Mode and S_IXOTH = S_IXOTH then Result := Result + 't' else Result := Result + 'T' else if Mode and S_IXOTH = S_IXOTH then Result := Result + 'x' else Result := Result + '-'; end; (********************************************************************************************************************************) function AttrToOctal(const Mode: Cardinal): integer; var x, Mult: Cardinal; begin Result := 0; Mult := 1; x := Mode; while x > 0 do begin Result := Result + Integer((x mod 8) * Mult); x := x div 8; Mult := Mult * 10; end; end; (********************************************************************************************************************************) function OctalToAttr(Octal: Cardinal): Cardinal; var octnr, oct : Cardinal; begin octnr := 0; oct := 0; while (Octal > 0) do begin oct := oct or ((Octal mod 10) shl octnr); Octal := Octal div 10; inc(octnr, 3); end; Result := oct; end; (********************************************************************************************************************************) function PosEnd(Substr: string; S: string): Integer; var i : integer; begin Result := 0; if (Length(Trim(S)) < 1) or (Length(Trim(Substr)) < 1) or (Length(Trim(Substr)) > Length(Trim(S))) then Exit; for i := Length(S) - Length(SubStr) downto 1 do if Copy(s, i, Length(Substr)) = SubStr then begin Result := i; Break; end; end; (********************************************************************************************************************************) function IncludeLeadingDot(s: string): string; begin s := Trim(s); if s[1] <> '.' then Result := '.' + s else Result := s; end; (********************************************************************************************************************************) function GetHomePath: string; begin Result := String(g_get_home_dir); end; (********************************************************************************************************************************) function GetUserName: string; begin Result := String(g_get_user_name); end; (********************************************************************************************************************************) procedure SeparateExt(const Original: string; var Name, Ext: string); var j: integer; begin Ext := ''; Name := Original; if {(Pos('.', Original) > 1) and } (Length(Original) > 2) then begin j := LastDelimiter('.', Original); if (j > 1) and (j < Length(Original)) then begin Ext := Copy(Original, j + 1, Length(Original) - j); Delete(Name, j, Length(Name) - j + 1); end; end; end; (********************************************************************************************************************************) procedure SeparateNameDir(Original: string; var Path, FileName: string); var j: integer; begin Original := ExcludeTrailingPathDelimiter(Original); Path := Original; FileName := ''; if (Pos('/', Original) > 0) and (Length(Original) > 2) then begin j := LastDelimiter('/', Original); if j > 0 then begin FileName := Copy(Original, j + 1, Length(Original) - j); Delete(Path, j, Length(Original) - j + 1); end; end; end; (********************************************************************************************************************************) function PadRightStr(const Str: string; Len: byte): string; var i: integer; begin Result := Str; for i := 1 to Len - Length(Str) do Insert(' ', Result, 1); end; (********************************************************************************************************************************) function SearchNext(var Wilds: string): Integer; { looking for next *, returns position and string until position } begin Result := Pos('*', Wilds); if Result > 0 then Wilds := Copy(Wilds, 1, Result - 1); end; function FindPart(const HelpWilds, InputStr: string): Integer; { FindPart compares a string with '?' and another, returns the position of HelpWilds in InputStr. } var I, J: Integer; Diff: Integer; begin I := Pos('?', HelpWilds); if I = 0 then begin { if no '?' in HelpWilds } Result := Pos(HelpWilds, InputStr); Exit; end; { '?' in HelpWilds } Diff := Length(InputStr) - Length(HelpWilds); if Diff < 0 then begin Result := 0; Exit; end; { now move HelpWilds over InputStr } for I := 0 to Diff do begin for J := 1 to Length(HelpWilds) do begin if (InputStr[I + J] = HelpWilds[J]) or (HelpWilds[J] = '?') then begin if J = Length(HelpWilds) then begin Result := I + 1; Exit; end; end else Break; end; end; Result := 0; end; function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean; var CWild, CInputWord: Integer; { counter for positions } I, LenHelpWilds: Integer; MaxInputWord, MaxWilds: Integer; { Length of InputStr and Wilds } HelpWilds: string; begin if Wilds = InputStr then begin Result := True; Exit; end; repeat { delete '**', because '**' = '*' } I := Pos('**', Wilds); if I > 0 then Wilds := Copy(Wilds, 1, I - 1) + '*' + Copy(Wilds, I + 2, MaxInt); until I = 0; if (Wilds = '*') or (Wilds = '*.*') then begin { for fast end, if Wilds only '*' } Result := True; Exit; end; MaxInputWord := Length(InputStr); MaxWilds := Length(Wilds); if IgnoreCase then begin { upcase all letters } InputStr := WideUpperCase(InputStr); Wilds := WideUpperCase(Wilds); end; if (MaxWilds = 0) or (MaxInputWord = 0) then begin Result := False; Exit; end; CInputWord := 1; CWild := 1; Result := True; repeat if InputStr[CInputWord] = Wilds[CWild] then begin { equal letters } { goto next letter } Inc(CWild); Inc(CInputWord); Continue; end; if Wilds[CWild] = '?' then begin { equal to '?' } { goto next letter } Inc(CWild); Inc(CInputWord); Continue; end; if Wilds[CWild] = '*' then begin { handling of '*' } HelpWilds := Copy(Wilds, CWild + 1, MaxWilds); I := SearchNext(HelpWilds); LenHelpWilds := Length(HelpWilds); if I = 0 then begin { no '*' in the rest, compare the ends } if HelpWilds = '' then Exit; { '*' is the last letter } { check the rest for equal Length and no '?' } for I := 0 to LenHelpWilds - 1 do begin if (HelpWilds[LenHelpWilds - I] <> InputStr[MaxInputWord - I]) and (HelpWilds[LenHelpWilds - I]<> '?') then begin Result := False; Exit; end; end; Exit; end; { handle all to the next '*' } Inc(CWild, 1 + LenHelpWilds); I := FindPart(HelpWilds, Copy(InputStr, CInputWord, MaxInt)); if I = 0 then begin Result := False; Exit; end; CInputWord := I + LenHelpWilds; Continue; end; Result := False; Exit; until (CInputWord > MaxInputWord) or (CWild > MaxWilds); { no completed evaluation } if CInputWord <= MaxInputWord then Result := False; if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result := False; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) type TPatternCacheItem = record Pattern, APath, FileName: string; DirDidNotExist: boolean; end; var PatternCache : array of TPatternCacheItem; function ProcessPattern(Engine: TPanelEngine; Pattern, APath, FileName: string; const Directory: boolean): string; var Path : string; procedure ProcessParam(const Part: string); begin // Check for upper directory if (Length(Part) >= 2) and (Copy(Part, 1, 2) = '..') then begin if (Path <> '/') and (LastDelimiter('/', Path) > 1) then begin Path := ExcludeTrailingPathDelimiter(Path); Delete(Path, LastDelimiter('/', Path), Length(Path) - LastDelimiter('/', Path) + 1); Path := IncludeTrailingPathDelimiter(Path); end; end else if Part = '.' then begin end else // On current dir ('.') do nothing // Add directory Path := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Path) + Part); end; function ProcessPart(WildPart, FilePart: string): string; var i, j, CWild, CInputWord, MaxInputWord, MaxWilds, LenHelpWilds: integer; HelpWilds, s: string; begin Result := ''; if (WildPart = '*') or (Length(WildPart) = 0) then Result := FilePart else if LastDelimiter('*?', WildPart) = 0 then Result := WildPart else begin repeat { delete '**', because '**' = '*' } I := Pos('**', WildPart); if I > 0 then WildPart := Copy(WildPart, 1, I - 1) + '*' + Copy(WildPart, I + 2, MaxInt); until I = 0; MaxInputWord := Length(FilePart); MaxWilds := Length(WildPart); CInputWord := 1; CWild := 1; repeat if not (WildPart[CWild] in ['?', '*']) then begin Result := Result + WildPart[CWild]; if WildPart[CWild] = FilePart[CInputWord] then Inc(CInputWord); Inc(CWild); Continue; end; if WildPart[CWild] = '?' then begin if Length(FilePart) <= CWild then Result := Result + FilePart[CWild]; Inc(CWild); if Length(FilePart) < CWild then Inc(CInputWord); Continue; end; if WildPart[CWild] = '*' then begin { handling of '*' } HelpWilds := Copy(WildPart, CWild + 1, MaxWilds); I := SearchNext(HelpWilds); LenHelpWilds := Length(HelpWilds); if (I = 0) and (HelpWilds = '') then begin { no '*' in the rest, compare the ends } Result := Result + Copy(FilePart, CInputWord, MaxInputWord - CInputWord + 1); Break; { '*' is the last letter } end; if (I = 0) and (Pos('?', HelpWilds) = 0) then begin Result := Result + Copy(FilePart, CInputWord, MaxInputWord - CInputWord + 1) + HelpWilds; Break; end; s := Copy(FilePart, CInputWord, MaxInputWord - CInputWord + 1); i := FindPart(HelpWilds, s); if i = 0 then Result := Result + HelpWilds else begin for j := 1 to Length(HelpWilds) do if HelpWilds[j] = '?' then HelpWilds[j] := s[j - 1 + i]; Result := Result + Copy(s, 1, i + Length(HelpWilds) - 1); Inc(CInputWord, i + LenHelpWilds - 1); end; Inc(CWild, 1 + LenHelpWilds); Continue; end; Break; until (CInputWord > MaxInputWord) or (CWild > MaxWilds); end; end; function ProcessWilds(WildStr, AFile: string): string; var i, j, WPC, FPC: integer; DotFile: boolean; begin if (WildStr = '*.*') or (WildStr = '') then Result := AFile else if WildStr = '*' then begin if (Pos('.', AFile) = 0) or (Copy(AFile, 1, 1) = '.') then Result := AFile else Result := Copy(AFile, 1, LastDelimiter('.', AFile) - 1); end else begin Result := ''; DotFile := False; if (Length(AFile) > 0) and (AFile[1] = '.') then begin DotFile := True; Delete(AFile, 1, 1); end; // Trim redundant parameters WPC := 0; for i := 1 to Length(WildStr) do if WildStr[i] = '.' then Inc(WPC); FPC := 0; for i := 1 to Length(AFile) do if AFile[i] = '.' then Inc(FPC); if WPC > FPC then for j := 1 to WPC - FPC do begin Result := '.' + Copy(WildStr, LastDelimiter('.', WildStr) + 1, Length(WildStr) - LastDelimiter('.', WildStr)) + Result; Delete(WildStr, LastDelimiter('.', WildStr), Length(WildStr) - LastDelimiter('.', WildStr) + 1); end; // Going processing while (LastDelimiter('.', WildStr) > 0) and (LastDelimiter('.', AFile) > 0) do begin Result := '.' + ProcessPart(Copy(WildStr, LastDelimiter('.', WildStr) + 1, Length(WildStr) - LastDelimiter('.', WildStr)), Copy(AFile, LastDelimiter('.', AFile) + 1, Length(AFile) - LastDelimiter('.', AFile))) + Result; Delete(WildStr, LastDelimiter('.', WildStr), Length(WildStr) - LastDelimiter('.', WildStr) + 1); Delete(AFile, LastDelimiter('.', AFile), Length(AFile) - LastDelimiter('.', AFile) + 1); end; if WildStr <> '' then Result := ProcessPart(WildStr, AFile) + Result; if DotFile then Result := '.' + Result; end; // Trim unwanted characters if Length(Result) > 0 then for i := 1 to Length(Result) do if Result[i] in ['*', '?', '/'] then Result[i] := '_'; end; function FindInCache: integer; var i: integer; begin Result := -1; if LengtH(PatternCache) > 0 then for i := 0 to Length(PatternCache) - 1 do if (PatternCache[i].Pattern = Pattern) and (PatternCache[i].APath = APath) and (Pos(PatternCache[i].FileName, FileName) = 1) then begin Result := i; Break; end; end; function CaseDirExists(DPath, DFileName: string): boolean; begin if (WideCompareStr(Pattern, FileName) <> 0) and (WideCompareText(Pattern, FileName) = 0) and Directory and Engine.TwoSameFiles(DPath + Pattern, DPath + FileName, True) then Result := False else Result := Engine.DirectoryExists(DPath + DFileName, True); end; var s: string; x: integer; begin Result := ''; if Pattern = '' then Exit; // Select basic directory case Pattern[1] of '/' : begin Path := '/'; if Length(Pattern) > 1 then Delete(Pattern, 1, 1); end; '~' : begin Path := IncludeTrailingPathDelimiter(GetHomePath); Delete(Pattern, 1, 1); end; else Path := IncludeTrailingPathDelimiter(APath); end; // Process directories in pattern while Pos('/', Pattern) > 0 do begin s := Copy(Pattern, 1, Pos('/', Pattern) - 1); Delete(Pattern, 1, Pos('/', Pattern)); ProcessParam(s); end; // Add rest of pattern parts if (Pos('?', Pattern) = 0) and (Pos('*', Pattern) = 0) then begin if (Pattern <> '.') and (Pattern <> '..') and (not CaseDirExists(IncludeTrailingPathDelimiter(Path), Pattern)) then begin if Directory then Path := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Path) + Pattern) else Path := ExcludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Path) + Pattern); SetLength(PatternCache, Length(PatternCache) + 1); PatternCache[Length(PatternCache) - 1].Pattern := Pattern; PatternCache[Length(PatternCache) - 1].APath := APath; PatternCache[Length(PatternCache) - 1].FileName := FileName; end else begin if Length(Pattern) > 0 then ProcessParam(Pattern); x := FindInCache; if x < 0 then begin Path := IncludeTrailingPathDelimiter(Path) + FileName; end else begin Delete(FileName, 1, Length(IncludeTrailingPathDelimiter(PatternCache[x].FileName))); Path := IncludeTrailingPathDelimiter(Path) + FileName; end; if Directory then Path := IncludeTrailingPathDelimiter(Path) else Path := ExcludeTrailingPathDelimiter(Path); end; end else Path := Path + ProcessWilds(Pattern, FileName); Result := Path; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ShowAbout; const Authors : array[0..1] of PChar = ('Tomáš Bžatek ', nil); Translations : PChar = 'Tomáš Bžatek - English, Czech'#10 + 'Gvorcek Spajreh - Russian'#10 + 'Jürgen Schubert - German'#10 + 'Johan Åkesson - Swedish'#10 + 'Marie-Agnès Pauchet-Le Héricy - French'#10 + 'Daniel Areiza - Spanish'#10 + 'Dominik Zabłotny - Polish'#10 + 'Serhij Dubyk - Ukrainian'#10 + 'Nikola Radovanović - Serbian'#10 + 'Marián Képesi - Hungarian'#10 + 'Francesco Turco - Italian'#10 + 'Kend - Simplified Chinese'#10 + 'Kend - Traditional Chinese'#10 + 'Jozef Štaffen - Slovak'#10 + 'Américo Monteiro - Portuguese'#10 + 'Sewon Jang - Korean'; var about_dialog: PGtkWidget; begin about_dialog := gtk_about_dialog_new(); gtk_about_dialog_set_program_name(PGtkAboutDialog(about_dialog), PChar('Tux Commander')); gtk_about_dialog_set_version(PGtkAboutDialog(about_dialog), PChar(Format(LANGAboutStringGnome, [ConstAboutVersion, ConstAboutBuildDate]))); gtk_about_dialog_set_copyright(PGtkAboutDialog(about_dialog), PChar('Copyright © 2002-2024 Tomáš Bžatek')); gtk_about_dialog_set_website(PGtkAboutDialog(about_dialog), PChar('https://tuxcmd.sourceforge.net/')); gtk_about_dialog_set_authors(PGtkAboutDialog(about_dialog), @Authors); gtk_about_dialog_set_translator_credits(PGtkAboutDialog(about_dialog), Translations); gtk_about_dialog_set_logo(PGtkAboutDialog(about_dialog), AppIcon128.FPixbuf); gtk_window_set_transient_for(PGtkWindow(about_dialog), PGtkWindow(FMain.FWidget)); gtk_dialog_run(PGtkDialog(about_dialog)); gtk_widget_destroy(about_dialog); end; procedure SetupAppIcon; var List: PGList; begin List := nil; List := g_list_append(List, AppIcon16.FPixbuf); List := g_list_append(List, AppIcon24.FPixbuf); List := g_list_append(List, AppIcon32.FPixbuf); List := g_list_append(List, AppIcon48.FPixbuf); List := g_list_append(List, AppIcon64.FPixbuf); List := g_list_append(List, AppIcon128.FPixbuf); gtk_window_set_default_icon_list(List); g_list_free(List); end; (********************************************************************************************************************************) procedure TrimCRLFESC(var s: string); begin while (Length(s) > 0) and (s[1] in [#13, #10, #27]) do Delete(s, 1, 1); while (Length(s) > 0) and (s[Length(s)] in [#13, #10, #27]) do Delete(s, Length(s), 1); end; (********************************************************************************************************************************) procedure TrimQuotes(var s: string); begin while (Length(s) > 0) and (s[1] in ['"', '''']) do Delete(s, 1, 1); while (Length(s) > 0) and (s[Length(s)] in ['"', '''']) do Delete(s, Length(s), 1); end; (********************************************************************************************************************************) function QuoteStr(const Str: string): string; var i: integer; begin Result := ''; if Length(Str) > 0 then for i := 1 to Length(Str) do begin if Str[i] in ConstQuotationCharacters then Result := Result + '\'; Result := Result + Str[i]; end; end; (********************************************************************************************************************************) function QuoteMarkupStr(const Str: string; MarkupUnderscore: boolean = False): string; var i: integer; begin Result := ''; if Length(Str) > 0 then for i := 1 to Length(Str) do begin if Str[i] = '<' then Result := Result + '<' else if Str[i] = '>' then Result := Result + '>' else if Str[i] = '&' then Result := Result + '&' else if (Str[i] = '_') and MarkupUnderscore then Result := Result + '__' else Result := Result + Str[i]; end; end; (********************************************************************************************************************************) function RemoveQuotation(const Str: string): string; var b: boolean; i: integer; begin Result := Str; if Length(Result) < 2 then Exit; b := True; for i := 2 to Length(Result) do if (Result[i] in ConstQuotationCharacters) and (Result[i - 1] <> '\') then b := False; if b then for i := Length(Result) downto 2 do if (Result[i] in ConstQuotationCharacters) and (Result[i - 1] = '\') then Delete(Result, i - 1, 1); end; (********************************************************************************************************************************) function ReplaceStr(const S, Srch, Replace: string): string; var I: Integer; Source: string; begin Source := S; Result := ''; repeat I := Pos(Srch, Source); if I > 0 then begin Result := Result + Copy(Source, 1, I - 1) + Replace; Source := Copy(Source, I + Length(Srch), MaxInt); end else Result := Result + Source; until I <= 0; end; (********************************************************************************************************************************) function NumCountChars(const Char: char; const S: string): integer; var i: integer; begin Result := 0; if Length(S) > 0 then for i := 1 to Length(S) do if S[i] = Char then Inc(Result); end; (********************************************************************************************************************************) procedure ParseString(const Str, Separator: string; var SubStrings: TOpenStringArray); var s: string; i: integer; begin s := Str; while Pos(Separator, s) > 0 do begin i := Pos(Separator, s); SetLength(SubStrings, Length(SubStrings) + 1); SubStrings[Length(SubStrings) - 1] := Copy(s, 1, i - 1); Delete(s, 1, i); end; if Length(s) > 0 then begin // Add the last element SetLength(SubStrings, Length(SubStrings) + 1); SubStrings[Length(SubStrings) - 1] := s; end; end; function MakeString(const Separator: string; var SubStrings: TOpenStringArray): string; var i: integer; begin Result := ''; if Length(SubStrings) > 0 then begin for i := 0 to Length(SubStrings) - 2 do Result := Result + SubStrings[i] + Separator; Result := Result + SubStrings[Length(SubStrings) - 1]; end; end; procedure CopyArray(var src: TOpenStringArray; var dst: TOpenStringArray); var i: integer; begin SetLength(dst, Length(src)); for i := 0 to Length(src) - 1 do dst[i] := src[i]; end; procedure DeleteFromArray(Index: integer; var SubStrings: TOpenStringArray); var i: integer; begin if Length(SubStrings) > 0 then begin if Index < Length(SubStrings) - 1 then for i := Index to Length(SubStrings) - 2 do SubStrings[i] := SubStrings[i + 1]; SetLength(SubStrings, Length(SubStrings) - 1); end; end; (********************************************************************************************************************************) function ExtractAccelerator(const LabelText: string): string; begin Result := ''; if (Pos('_', LabelText) > 0) and (Pos('_', LabelText) < Length(LabelText)) then Result := Copy(LabelText, Pos('_', LabelText) + 1, 1); end; (********************************************************************************************************************************) function GetStrSize(s: string): Int64; var i: integer; x: Double; b: boolean; begin Result := 0; x := 0; s := WideUpperCase(Trim(s)); if Length(s) = 0 then Exit; for i := Length(s) downto 1 do if s[i] in [#32, ThousandSeparator] then Delete(s, i, 1); b := False; for i := 2 to Length(s) do if not (s[i] in ['0', '1'..'9', DecimalSeparator]) then begin x := StrToFloatDef(Copy(s, 1, i - 1), 0); case s[i] of 'G': x := x * 1000 * 1000 * 1000; 'M': x := x * 1000 * 1000; 'K': x := x * 1024; end; b := True; Break; end; if not b then x := StrToInt64Def(s, Trunc(x)); Result := Trunc(x); end; (********************************************************************************************************************************) function ConstructURI(IncludePasswd, HidePasswd: boolean; Protocol, Server, Username, Password, Dir: string): string; begin Result := Protocol + '://'; if Length(Username) > 0 then begin Result := Result + EscapeURI(Username, ConstURIIllegalCharacters); if (Length(Password) > 0) and IncludePasswd then begin if HidePasswd then Result := Result + ':' + StringOfChar('*', Length(EscapeURI(Password, ConstURIIllegalCharacters))) else Result := Result + ':' + EscapeURI(Password, ConstURIIllegalCharacters); end; Result := Result + '@'; end; Result := Result + Server; if Length(Dir) > 0 then begin if Dir[1] <> '/' then Result := Result + '/'; Result := Result + Dir; end; end; (********************************************************************************************************************************) function URIHidePassword(const SrcURI: string): string; var i: integer; InPasswd, BeforeServer: boolean; begin Result := SrcURI; InPasswd := False; BeforeServer := True; if Length(SrcURI) > 0 then if Pos('://', SrcURI) > 0 then for i := Pos('://', SrcURI) + 2 to Length(SrcURI) do begin if SrcURI[i] = '@' then begin InPasswd := False; BeforeServer := False; end; if (not InPasswd) or (not BeforeServer) then InPasswd := BeforeServer and (SrcURI[i] = ':') else Result[i] := '*'; end; end; (********************************************************************************************************************************) function UnEscapeURI(const Str: string): string; var i: integer; begin Result := ''; if Length(Str) > 0 then begin i := 1; while i <= Length(Str) do begin if (Str[i] = '%') and (i <= Length(Str) - 2) then begin Result := Result + Chr(StrToInt('$' + Copy(Str, i + 1, 2))); Inc(i, 3); end else begin Result := Result + Str[i]; Inc(i); end; end; end; end; function EscapeURI(const Str: string; const IllegalChars: string): string; var i: integer; begin Result := ''; if Length(Str) > 0 then for i := 1 to Length(Str) do begin if (Ord(Str[i]) >= $80) or (Pos(Str[i], IllegalChars) > 0) then Result := Result + '%' + IntToHex(Ord(Str[i]), 2) else Result := Result + Str[i]; end; end; function URIRipPassword(var URI: string; const RemovePassword: boolean): string; var p: integer; s: string; SchemeStart, LoginEnd, PasswordStart: integer; begin Result := ''; SchemeStart := Pos('://', URI); if SchemeStart < 1 then Exit; s := Copy(URI, SchemeStart + 3, Length(URI) - SchemeStart - 3); p := Pos('/', s); if p < 1 then p := Length(s); Delete(s, p, Length(s) - p + 1); p := PosEnd('@', s); if p < 1 then Exit; LoginEnd := p + SchemeStart + 2; Delete(s, p, Length(s) - p + 1); p := Pos(':', s); if p < 1 then Exit; PasswordStart := p + SchemeStart + 2; Result := Copy(URI, PasswordStart + 1, LoginEnd - PasswordStart - 1); if RemovePassword then Delete(URI, PasswordStart, LoginEnd - PasswordStart); end; function GetURIPrefix(const URI: string): string; begin if Pos('://', URI) > 0 then Result := Copy(URI, 1, Pos('://', URI) + 2) else Result := ''; end; (********************************************************************************************************************************) procedure DebugMsg(Params: array of const); var I: Integer; P: PChar; begin if ParamDebug then begin for I := 0 to High(Params) do with Params[I] do case VType of vtPointer: begin {$IFDEF CPU64} P := g_strdup_printf('%.16p', [VPointer]); {$ELSE} P := g_strdup_printf('%.8p', [VPointer]); {$ENDIF} Write(ErrOutput, P); g_free(P); end; vtInteger: Write(ErrOutput, IntToStr(VInteger)); vtBoolean: Write(ErrOutput, VBoolean); vtChar: Write(ErrOutput, VChar); vtExtended: Write(ErrOutput, FloatToStr(VExtended^)); vtString: Write(ErrOutput, VString^); vtPChar: Write(ErrOutput, VPChar); vtObject: Write(ErrOutput, VObject.ClassName); vtClass: Write(ErrOutput, VClass.ClassName); vtAnsiString: Write(ErrOutput, string(VAnsiString)); vtCurrency: Write(ErrOutput, CurrToStr(VCurrency^)); vtVariant: Write(ErrOutput, string(VVariant^)); vtInt64: Write(ErrOutput, IntToStr(VInt64^)); vtQWord: Write(ErrOutput, IntToStr(VQWord^)); end; WriteLn(ErrOutput); end; end; (********************************************************************************************************************************) function ExecuteProgram(const AppCMDLine, CWD: string; const AutodetectGUI, RunInTerminal: boolean; var ErrorString: string): boolean; var s: string; Term: boolean; i: integer; argvp: PPgchar; p: Pgchar; pcwd: Pgchar; error: PGerror; begin error := nil; Result := False; DebugMsg(['*** Running ExecuteProgram begin: ', AppCMDLine]); s := Trim(AppCMDLine); Term := RunInTerminal; if AutodetectGUI then Term := not IsItX11App(s); if Term then begin if not g_shell_parse_argv(PChar(ConfTerminalCommand), nil, @argvp, @error) then begin ErrorString := String(error^.message); DebugMsg(['ExecuteProgram: Error parsing commandline: ', ErrorString]); g_error_free(error); Exit; end; for i := 0 to g_strv_length(argvp) - 1 do begin if strstr(argvp[i], '%s') <> nil then begin p := argvp[i]; argvp[i] := g_strdup_printf(p, [PChar(AppCMDLine)]); g_free(p); end; if strstr(argvp[i], '%cwd') <> nil then begin // TODO: g_shell_quote() the argument? s := ReplaceStr(String(argvp[i]), '%cwd', QuoteStr(CWD)); g_free(argvp[i]); argvp[i] := g_strdup(PChar(s)); end; end; end else begin if not g_shell_parse_argv(PChar(s), nil, @argvp, @error) then begin ErrorString := String(error^.message); DebugMsg(['ExecuteProgram: Error parsing commandline: ', ErrorString]); g_error_free(error); Exit; end; end; if ParamDebug then for i := 0 to g_strv_length(argvp) - 1 do DebugMsg([' argvp[', i, '] = "', argvp[i], '"']); pcwd := nil; if Length(CWD) > 0 then pcwd := PChar(CWD); Result := g_spawn_async(pcwd, argvp, nil, [G_SPAWN_SEARCH_PATH, G_SPAWN_STDOUT_TO_DEV_NULL, G_SPAWN_STDERR_TO_DEV_NULL, G_SPAWN_CLOEXEC_PIPES], nil, nil, nil, @error); if not Result then begin ErrorString := String(error^.message); DebugMsg(['ExecuteProgram: Error spawning command: ', ErrorString]); g_error_free(error); end; DebugMsg(['*** Running ExecuteProgram end']); end; (********************************************************************************************************************************) function IsItX11App(const Application: string): boolean; var environ: PPgchar; argvp: PPgchar; stdout: Pgchar; error: PGerror; begin Result := False; DebugMsg(['***** function IsItX11App(''', Application, ''') begin --']); error := nil; stdout := nil; if not g_shell_parse_argv(PChar(Application), nil, @argvp, @error) then begin DebugMsg(['IsItX11App: Error parsing commandline: ', String(error^.message)]); g_error_free(error); Exit; end; environ := g_get_environ(); environ := g_environ_setenv(environ, 'LD_TRACE_LOADED_OBJECTS', '1', True); if not g_spawn_sync(nil, argvp, environ, [G_SPAWN_SEARCH_PATH, G_SPAWN_STDERR_TO_DEV_NULL, G_SPAWN_CLOEXEC_PIPES], nil, nil, @stdout, nil, nil, @error) then begin DebugMsg(['IsItX11App: Error spawning command: ', String(error^.message)]); g_error_free(error); end else Result := strstr(stdout, 'libX11.so') <> nil; g_free(stdout); g_strfreev(environ); g_strfreev(argvp); DebugMsg(['***** function IsItX11App(''', Application, ''') = ', Result]); end; function HandleSystemCommand(const Command: string; var ErrorString: string): boolean; var argvp: PPgchar; stderr: Pgchar; wait_status: gint; error: PGerror; begin Result := False; DebugMsg(['***** function HandleSystemCommand(''', Command, ''') begin --']); error := nil; stderr := nil; if not g_shell_parse_argv(PChar(Command), nil, @argvp, @error) then begin ErrorString := String(error^.message); DebugMsg(['HandleSystemCommand: Error parsing commandline: ', ErrorString]); g_error_free(error); Exit; end; Result := g_spawn_sync(nil, argvp, nil, [G_SPAWN_SEARCH_PATH, G_SPAWN_CLOEXEC_PIPES], nil, nil, nil, @stderr, @wait_status, @error); if Result then Result := g_spawn_check_exit_status(wait_status, @error); if not Result then begin if (stderr <> nil) and (strlen(stderr) > 0) then ErrorString := String(stderr) else ErrorString := String(error^.message); DebugMsg(['HandleSystemCommand:: Error spawning command: ', ErrorString]); g_error_free(error); end; g_free(stderr); g_strfreev(argvp); DebugMsg(['***** finished function HandleSystemCommand(''', Command, ''') = ', Result]); end; (********************************************************************************************************************************) function CompareTextsEx(S1, S2: PChar): integer; const PriorityChars = '.[]_0123456789'; var i, j, k, l1, l2 : integer; Str1, Str2: string; begin Result := -2; Str1 := UpperCase(String(S1)); Str2 := UpperCase(String(S2)); l1 := Length(Str1); l2 := Length(Str2); if (l1 > 0) and (l2 > 0) then begin if (Str1[1] = '.') and (Str2[1] <> '.') then Result := -1 else // Priority for dot files if (Str2[1] = '.') and (Str1[1] <> '.') then Result := 1 else for i := 1 to l1 do if l2 >= i then if Str1[i] <> Str2[i] then begin j := Pos(Str1[i], PriorityChars); k := Pos(Str2[i], PriorityChars); if (j > 0) and (k > 0) then begin if j < k then Result := -1 else if j > k then Result := 1; end else if j > 0 then Result := -1 else if k > 0 then Result := 1; Break; end; if Result = -2 then Result := CompareText(Str1, Str2); end else Result := CompareText(Str1, Str2); end; (********************************************************************************************************************************) function LVCompareItems(Data1, Data2: PDataItem; const Ascending: boolean; const SortColumnID: integer): integer; var mp: integer; s1, s2, s3, s4: string; begin if Ascending then mp := 1 else mp := -1; if Data1^.UpDir then Result := -1*mp else if Data2^.UpDir then Result := 1*mp else if Data1^.IsDir and (not Data2^.IsDir) then Result := -1*mp else if Data2^.IsDir and (not Data1^.IsDir) then Result := 1*mp else if Data1^.IsDir and Data2^.IsDir and (not ConfSortDirectoriesLikeFiles) then Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName)*mp else case SortColumnID of 1, 2 : Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 3 : begin SeparateExt(String(Data1^.FDisplayName), s1, s2); SeparateExt(String(Data2^.FDisplayName), s3, s4); if WideUpperCase(s2) <> WideUpperCase(s4) then Result := CompareTextsEx(PChar(s2), PChar(s4)) else Result := CompareTextsEx(PChar(s1), PChar(s3)); end; 4 : if Data1^.Size > Data2^.Size then Result := -1 else if Data1^.Size < Data2^.Size then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 5, 6 : if Data1^.mtime > Data2^.mtime then Result := -1 else if Data1^.mtime < Data2^.mtime then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 7 : if StripDate(Data1^.mtime) > StripDate(Data2^.mtime) then Result := -1 else if StripDate(Data1^.mtime) < StripDate(Data2^.mtime) then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 8 : if Data1^.UID > Data2^.UID then Result := -1 else if Data1^.UID < Data2^.UID then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 9 : if Data1^.GID > Data2^.GID then Result := -1 else if Data1^.GID < Data2^.GID then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 10 : if Data1^.Mode > Data2^.Mode then Result := -1 else if Data1^.Mode < Data2^.Mode then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); else Result := 0; end; end; (********************************************************************************************************************************) procedure SortDataList(var List: TList; const Ascending: boolean; const SortColumnID: integer); var AscCorr: integer; procedure QuickSort(iLo, iHi: Integer); var Lo, Hi : Integer; Mid, x: Pointer; begin Lo := iLo; Hi := iHi; Mid := List[(Lo + Hi) div 2]; repeat while LVCompareItems(List[Lo], Mid, Ascending, SortColumnID)*AscCorr < 0 do Inc(Lo); while LVCompareItems(List[Hi], Mid, Ascending, SortColumnID)*AscCorr > 0 do Dec(Hi); if Lo <= Hi then begin x := List[Lo]; List[Lo] := List[Hi]; List[Hi] := x; Inc(Lo); Dec(Hi); end; until Lo > Hi; if Hi > iLo then QuickSort(iLo, Hi); if Lo < iHi then QuickSort(Lo, iHi); end; begin AscCorr := 2*Ord(Ascending) - 1; QuickSort(0, List.Count - 1); end; (********************************************************************************************************************************) function StrToUTF8(s: string): string; begin Result := String(StrToUTF8(PChar(s))); end; function UTF8ToStr(s: string): string; var bytes_read, bytes_written: gsize; error: PGError; begin error := nil; bytes_read := 0; bytes_written := 0; Result := g_locale_from_utf8(PChar(s), Length(s), @bytes_read, @bytes_written, @error); if error <> nil then begin // fallback to original string to avoid data loss Result := s; DebugMsg(['*** UTF8ToStr: error converting "', s, '" from UTF-8 (read ', bytes_read, ', written ', bytes_written, '): ', error^.message]); g_error_free(error); end; end; function StrToUTF8(s: PChar): PChar; var bytes_read, bytes_written: gsize; error: PGError; ns, nss: PChar; m: PChar; begin if g_utf8_validate(s, strlen(s), nil) then begin Result := strdup(s); Exit; end; // DebugMsg(['StrToUTF8: string "', s, '" is not valid UTF-8.']); error := nil; bytes_read := 0; bytes_written := 0; ns := g_locale_to_utf8(s, strlen(s), @bytes_read, @bytes_written, @error); if ns = nil then begin // fallback to original string to avoid data loss ns := g_strdup(s); if error <> nil then m := error^.message else m := 'unknown'; DebugMsg(['*** StrToUTF8: error converting "', s, '" to UTF-8 (read ', bytes_read, ', written ', bytes_written, '): ', m]); g_error_free(error); end; nss := g_filename_display_name(ns); Result := strdup(nss); // PPC compatibility g_free(nss); g_free(ns); end; function UTF8ToStr(s: PChar): PChar; var bytes_read, bytes_written: gsize; error: PGError; begin error := nil; bytes_read := 0; bytes_written := 0; Result := g_locale_from_utf8(s, strlen(s), @bytes_read, @bytes_written, @error); if error <> nil then begin // fallback to original string to avoid data loss Result := s; DebugMsg(['*** UTF8ToStr: error converting "', s, '" from UTF-8 (read ', bytes_read, ', written ', bytes_written, '): ', error^.message]); g_error_free(error); end; end; function EnsureUTF8String(s: PChar): PChar; begin Result := g_filename_display_name(s); end; (********************************************************************************************************************************) function Min(Val1, Val2: longint): longint; begin if Val1 < Val2 then Result := Val1 else Result := Val2; end; function XORStr(const s: string; Key: byte): string; var i: integer; begin Result := s; if Length(Result) > 0 then for i := 1 to Length(Result) do Result[i] := Char(Byte(Result[i]) xor Key); 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 SetupColors; begin if Assigned(NormalItemGDKColor) then gdk_rgba_free(NormalItemGDKColor); if Assigned(ActiveItemGDKColor) then gdk_rgba_free(ActiveItemGDKColor); if Assigned(InactiveItemGDKColor) then gdk_rgba_free(InactiveItemGDKColor); if Assigned(SelectedItemGDKColor) then gdk_rgba_free(SelectedItemGDKColor); if Assigned(DotFileItemGDKColor) then gdk_rgba_free(DotFileItemGDKColor); if Assigned(LinkItemGDKColor) then gdk_rgba_free(LinkItemGDKColor); if Assigned(NormalItemGDKBackground) then gdk_rgba_free(NormalItemGDKBackground); if Assigned(ActiveItemGDKBackground) then gdk_rgba_free(ActiveItemGDKBackground); if Assigned(InactiveItemGDKBackground) then gdk_rgba_free(InactiveItemGDKBackground); NormalItemGDKColor := nil; ActiveItemGDKColor := nil; InactiveItemGDKColor := nil; SelectedItemGDKColor := nil; DotFileItemGDKColor := nil; LinkItemGDKColor := nil; NormalItemGDKBackground := nil; ActiveItemGDKBackground := nil; InactiveItemGDKBackground := nil; if not ConfNormalItemDefaultColors then begin NormalItemGDKColor := StringToGDKRGBA(ConfNormalItemFGColor); NormalItemGDKBackground := StringToGDKRGBA(ConfNormalItemBGColor); end; if not ConfCursorDefaultColors then begin ActiveItemGDKColor := StringToGDKRGBA(ConfActiveItemFGColor); ActiveItemGDKBackground := StringToGDKRGBA(ConfActiveItemBGColor); end; if not ConfInactiveItemDefaultColors then begin InactiveItemGDKColor := StringToGDKRGBA(ConfInactiveItemFGColor); InactiveItemGDKBackground := StringToGDKRGBA(ConfInactiveItemBGColor); end; SelectedItemGDKColor := StringToGDKRGBA(ConfSelectedItemFGColor); DotFileItemGDKColor := StringToGDKRGBA(ConfDotFileItemFGColor); LinkItemGDKColor := StringToGDKRGBA(ConfLinkItemFGColor); end; (********************************************************************************************************************************) var InternalLockVar: integer; procedure InternalLock; begin Inc(InternalLockVar); DebugMsg(['Lock']); end; procedure InternalUnLock; begin Dec(InternalLockVar); if InternalLockVar < 0 then InternalLockVar := 0; DebugMsg(['Unlock']); end; function InternalLockUnlocked: boolean; begin Result := InternalLockVar = 0; end; procedure InternalLockInit(Locked: boolean); begin InternalLockVar := Ord(Locked); end; (********************************************************************************************************************************) procedure GetFirstLastPanelColumn(var FirstColumn, LastColumn: integer); var i: integer; begin FirstColumn := 1; LastColumn := ConstNumPanelColumns; for i := 1 to ConstNumPanelColumns do if ConfColumnVisible[i] then begin FirstColumn := i; Break; end; for i := ConstNumPanelColumns downto 1 do if ConfColumnVisible[i] then begin LastColumn := i; Break; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) function StrTotimetDef(const S: string; const Default: time_t): time_t; begin try Result := DateTimeToUnix(StrToDate(S)); except Result := Default; end; end; (********************************************************************************************************************************) procedure SaveItemToHistory(s: string; History: TStringList); var i: integer; begin s:= Trim(s); if Length(s) > 0 then begin if History.IndexOf(s) > -1 then History.Delete(History.IndexOf(s)); History.Insert(0, s); if History.Count > ConfNumHistoryItems then for i := History.Count downto ConfNumHistoryItems do History.Delete(i - 1); end; end; (********************************************************************************************************************************) function CLAMP(x, MinX, MaxX: integer): integer; begin if x < MinX then Result := MinX else if x > MaxX then Result := MaxX else Result := x; end; initialization // Set path separators only to a standard Unix slash -- otherwise all path functions will treat ending backslash as a delimiter, // causing problems with directory names ending with a backslash (it's a valid character in Unix). // Kylix behaves fine, only forward slash is honored. AllowDirectorySeparators := ['/']; InternalLockInit(True); NormalItemGDKColor := nil; ActiveItemGDKColor := nil; InactiveItemGDKColor := nil; SelectedItemGDKColor := nil; DotFileItemGDKColor := nil; LinkItemGDKColor := nil; NormalItemGDKBackground := nil; ActiveItemGDKBackground := nil; InactiveItemGDKBackground := nil; AppPath := IncludeTrailingPathDelimiter(GetHomePath); IconPath := IncludeTrailingPathDelimiter(GetHomePath); end.