(* 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 gtk2, gdk2, glib2, SysUtils, Classes, ULibc, GTKClasses, UEngines; type PIntArray = ^TIntArray; TIntArray = array[0..1023] of LongWord; TOpenStringArray = array of string; TOpenPCharArray = array of PChar; const ConstERRSpawn = 26; ConstQuotationCharacters = [' ', '"', '''', '(', ')', ':', '&']; ConstURIIllegalCharacters = '%:@/'; function GetErrorString(ErrorNo: integer): string; function GetSignalString(SignalNo: integer): string; function FormatSize(Value: Int64; Base: integer; OverrideSizeFormat: integer = -1): string; function FormatDate(Value: time_t; const FormatTime, FormatDate: 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; function GetHostName: 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 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 QuotePercentStr(const Str: string): string; function RemoveQuotation(const Str: string): string; function GetStrSize(s: string): Int64; procedure DebugMsg(Params: array of const); function SpawnProcess(const AppPath: string; var Running: boolean; const Parameters: array of string): Cardinal; function ExecuteProgram(const AppCMDLine, CWD: string; const AutodetectGUI, RunInTerminal: boolean; var ErrorSignal: integer): boolean; function IsItX11App(const Application: string): boolean; function HandleSystemCommand(const Command, ErrorText: 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: string): string; overload; function EnsureUTF8String(s: PChar): PChar; overload; 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 procedure InternalLock; procedure InternalUnLock; function InternalLockUnlocked: boolean; procedure InternalLockInit(Locked: boolean); var ChildExitStatus: sig_atomic_t; AppPath, IconPath: string; // Used in UFileTypeSettings NormalItemGDKColor, ActiveItemGDKColor, InactiveItemGDKColor, SelectedItemGDKColor, DotFileItemGDKColor, LinkItemGDKColor, NormalItemGDKBackground, ActiveItemGDKBackground, InactiveItemGDKBackground: PGdkColor; InactiveItemBGColorNum: LongWord; implementation uses DateUtils, GTKForms, GTKUtils, GTKView, ULocale, UConfig, UCore, UGnome, UMain, UFileAssoc; (********************************************************************************************************************************) function GetErrorString(ErrorNo: integer): string; begin if ErrorNo >= 0 then Result := StrToUTF8(String(strerror(ErrorNo))) else case ErrorNo of ERRException : Result := LANGUnknownException; ERRNoAccess : Result := LANGNoAccess; else Result := LANGUnknownError; end; end; (********************************************************************************************************************************) function GetSignalString(SignalNo: integer): string; begin Result := StrToUTF8(strsignal(SignalNo)); end; (********************************************************************************************************************************) 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('%''lu', 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 FormatTime, FormatDate: 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 FormatDate 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 := 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 FormatTime 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 := 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 FormatDate and FormatTime then begin case dtf of 0: Result := Format('%s %s', [DateString, TimeString]); else Result := Format('%s %s', [TimeString, DateString]); end; end else if FormatTime then Result := TimeString else if FormatDate 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 := PgcharToString(g_get_home_dir); end; (********************************************************************************************************************************) function GetUserName: string; begin Result := PgcharToString(g_get_user_name); end; (********************************************************************************************************************************) function GetHostName: string; var s: PChar; begin s := malloc(65536); memset(s, 0, 65536); ULibc.gethostname(s, 65536); Result := PgcharToString(strdup(s)); libc_free(s); 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 '?' } {$R-} 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; {$R+} 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) then Result := False else Result := Engine.DirectoryExists(DPath + DFileName); 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'; var AboutBox: PGtkWidget; begin if (libGnomeUI2Handle = nil) or (@gnome_about_new = nil) then Application.MessageBox(Format(LANGAboutString, [ConstAboutVersion, ConstAboutBuildDate])) else begin AboutBox := gnome_about_new('Tux Commander', nil, 'Copyright © 2009 Tomáš Bžatek', PChar(Format(LANGAboutStringGnome, [ConstAboutVersion, ConstAboutBuildDate])), @Authors, nil, Translations, AppIcon128.FPixbuf); gtk_window_set_transient_for(GTK_WINDOW(AboutBox), GTK_WINDOW(FMain.FWidget)); gtk_dialog_run(GTK_DIALOG(AboutBox)); end; 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 QuotePercentStr(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] = '%' 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 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; begin if ParamDebug then begin for I := 0 to High(Params) do with Params[I] do case VType of 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^)); {$IFDEF FPC} vtQWord: Write(ErrOutput, IntToStr(VQWord^)); {$ENDIF} end; WriteLn(ErrOutput); end; end; (********************************************************************************************************************************) function SpawnProcess(const AppPath: string; var Running: boolean; const Parameters: array of string): Cardinal; var child_pid: __pid_t; args_list: PPChar; i: integer; sv: sigval_t; begin Result := 0; Running := False; ChildExitStatus := -1; // Make the args_list array args_list := nil; if Length(Parameters) > 0 then begin args_list := malloc((Length(Parameters) + 1) * sizeof(PChar)); memset(args_list, 0, (Length(Parameters) + 1) * sizeof(PChar)); for I := 0 to Length(Parameters) - 1 do begin {$R-} PCharArray(args_list^)[I] := strdup(PChar(Parameters[i])); {$R+} end; {$R-} PCharArray(args_list^)[Length(Parameters)] := nil; {$R+} end; // Duplicate this process DebugMsg(['SpawnProcess: before fork']); child_pid := fork; if child_pid <> 0 then begin Result := child_pid; Sleep(100); //* FIXME: strange behaviour when freed { for i := 0 to Length(Parameters) - 1 do if PCharArray(args_list^)[i] <> nil then libc_free(PCharArray(args_list^)[i]); } if args_list <> nil then libc_free(args_list); Application.ProcessMessages; Running := ChildExitStatus < 0; DebugMsg(['SpawnProcess: ChildExitStatus = ', ChildExitStatus]); if not Running then Result := 0; if not WIFEXITED(ChildExitStatus) then Result := WTERMSIG(ChildExitStatus); DebugMsg(['SpawnProcess: Result = ', Result]); end else begin // Now execute AppPath, searching for it in the path execvp(PChar(AppPath), args_list); // The execvp function returns only if an error occurs sigqueue(getppid, SIGUSR1, sv); DebugMsg(['SpawnProcess: forked: error, sending SIGUSR1']); _exit(ConstERRSpawn); end; ChildExitStatus := -1; end; (********************************************************************************************************************************) procedure SplitArgs(var Args: TOpenStringArray; CMDLine: string); var InQuotes: boolean; i, Start: integer; QuoteChar: char; s: string; begin SetLength(Args, 0); InQuotes := False; CMDLine := Trim(CMDLine); if Length(CMDLine) = 0 then Exit; Start := 1; QuoteChar := #0; for i := 1 to Length(CMDLine) do case CMDLine[i] of ' ': if (not InQuotes) and ((i = 1) or (CMDLine[i - 1] <> '\')) then begin s := Trim(Copy(CMDLine, Start, i - Start)); TrimQuotes(s); Start := i; if s = '' then Continue; SetLength(Args, Length(Args) + 1); Args[Length(Args) - 1] := s; end; '"', '''': if (i = 1) or (CMDLine[i - 1] <> '\') then if not InQuotes then begin InQuotes := True; QuoteChar := CMDLine[i]; // Start := i; end else if CMDLine[i] = QuoteChar then begin InQuotes := False; s := Trim(Copy(CMDLine, Start, i + 1 - Start)); TrimQuotes(s); Start := i; if s = '' then Continue; if (Pos('"', s) > 1) and (Pos('"', s) < Length(s)) and (NumCountChars('"', s) mod 2 = 1) then s := s + '"'; // if (Pos('''', s) > 1) and (Pos('''', s) < Length(s)) and (NumCountChars('''', s) mod 2 = 1) then s := s + ''''; SetLength(Args, Length(Args) + 1); Args[Length(Args) - 1] := s; end; end; if (Start <> Length(CMDLine)) or (Start = 1) then begin SetLength(Args, Length(Args) + 1); Args[Length(Args) - 1] := Trim(Copy(CMDLine, Start, Length(CMDLine) + 1 - Start)); TrimQuotes(Args[Length(Args) - 1]); end; end; function ExecuteProgram(const AppCMDLine, CWD: string; const AutodetectGUI, RunInTerminal: boolean; var ErrorSignal: integer): boolean; var Args: TOpenStringArray; s, s2: string; Running, Term: boolean; x: integer; begin Result := False; try DebugMsg(['*** Running ExecuteProgram begin']); // DebugMsg(['ExecuteProgram: ConfTerminalCommand = "', ConfTerminalCommand, '"']); s := Trim(AppCMDLine); ErrorSignal := 0; Term := RunInTerminal; SplitArgs(Args, s); if AutodetectGUI then if Length(Trim(Args[0])) > 0 then Term := not IsItX11App(Trim(Args[0])); if Term then begin x := 1; while x <= Length(s) do begin if (s[x] in [{'"',} '''']) and ((x = 1) or (s[x - 1] <> '\')) then Insert('\', s, x); Inc(x); end; s2 := ReplaceStr(ConfTerminalCommand, '%cwd', QuoteStr(CWD)); s := Format(s2, [s]); SplitArgs(Args, s); end; if ConfUseLibcSystem then begin s := s + ' &'; DebugMsg([s]); DebugMsg(['**** Running system']); x := libc_system(PChar(s)); Result := x <> -1; // -1 means fork failed DebugMsg(['**** Running system = ', x, ' --- done']); end else begin if Length(Args) = 0 then Exit; for x := 0 to Length(Args) - 1 do Args[x] := RemoveQuotation(Args[x]); DebugMsg(['**** Running spawn']); x := -1; try x := SpawnProcess(Args[0], Running, Args); except on E: Exception do DebugMsg(['ExecuteProgram(AppCMDLine = ''', AppCMDLine, '''): Exception: ', E.Message]); end; DebugMsg(['**** Running spawn -- done']); Result := Running; if not Running then ErrorSignal := x; end; except end; DebugMsg(['*** Running ExecuteProgram end']); end; (********************************************************************************************************************************) function IsItX11App(const Application: string): boolean; const BSize = 65536; What = 'libX11.so'; var stream: PFILE; Buffer: Pointer; i: integer; str: string; begin Result := False; DebugMsg(['***** function IsItX11App(''', Application, ''') begin --']); try // setenv('LD_TRACE_LOADED_OBJECTS', '1', True); stream := popen(PChar('LD_TRACE_LOADED_OBJECTS=1 ' + Application), 'r'); // stream := popen(PChar(Application), 'r'); DebugMsg(['***** IsItX11App: popen OK']); if Assigned(stream) then begin Buffer := malloc(BSize); if buffer = nil then Writeln('buffer nil: ', integer(errno)); if stream = nil then Writeln('stream nil'); memset(Buffer, 0, BSize); DebugMsg(['***** IsItX11App: malloc() OK']); while feof(stream) = 0 do begin i := fread(Buffer, 1, BSize, stream); if i > 0 then begin SetLength(str, i); memcpy(@str[1], Buffer, i); Result := Result or (Pos(What, str) > 0); end; end; pclose(stream); libc_free(Buffer); SetLength(str, 0); end; // unsetenv('LD_TRACE_LOADED_OBJECTS'); except on E: Exception do DebugMsg(['*** IsItX11App(''', Application, '''):Exception: ', E.Message]); end; DebugMsg(['***** function IsItX11App(''', Application, ''') = ', Result]); end; function HandleSystemCommand(const Command, ErrorText: string): boolean; const BSize = 65536; var stream: PFILE; Buffer: Pointer; i, NumRead: integer; child_pid: __pid_t; fds: array[0..1] of integer; Parameters: TOpenStringArray; args_list: System.PPChar; Temp, s: string; begin Result := False; DebugMsg(['***** function HandleSystemCommand(''', Command, ''') begin --']); try DebugMsg(['***** HandleSystemCommand: before fork']); pipe(@fds); child_pid := fork; DebugMsg(['***** HandleSystemCommand: fork, child_pid = ', child_pid]); // Main application if child_pid <> 0 then begin libc_close(fds[1]); stream := fdopen(fds[0], 'r'); Buffer := malloc(BSize); // DebugMsg(['x0']); memset(Buffer, 0, BSize); // DebugMsg(['x1']); if buffer = nil then Writeln('buffer nil: ', integer(errno)); if stream = nil then Writeln('stream nil'); SetLength(s, 0); while feof(stream) = 0 do begin NumRead := fread(Buffer, 1, BSize, stream); DebugMsg(['***** HandleSystemCommand: NumRead = ', NumRead]); if NumRead > 0 then begin SetLength(s, Length(s) + NumRead); memcpy(@s[Length(s) - NumRead + 1], Buffer, NumRead); end; end; libc_close(fds[0]); // DebugMsg(['x2']); TrimCRLFESC(s); // DebugMsg(['x3']); libc_free(Buffer); // DebugMsg(['x4']); end // forked PID else begin args_list := nil; try SplitArgs(Parameters, Command); // Fill the args_list array if Length(Parameters) > 0 then begin args_list := malloc((Length(Parameters) + 1) * SizeOf(PChar)); memset(args_list, 0, (Length(Parameters) + 1) * SizeOf(PChar)); for I := 0 to Length(Parameters) - 1 do begin Temp := Parameters[i]; {$R-} // PCharArray(args_list^)[I] := malloc(Length(Temp)+1); // memset(PCharArray(args_list^)[I], 0, Length(Temp)+1); // StrCopy(PCharArray(args_list^)[I], PChar(Temp)); PCharArray(args_list^)[I] := strdup(PChar(Temp)); {$R+} end; {$R-} PCharArray(args_list^)[Length(Parameters)] := nil; {$R+} end; except on E: Exception do DebugMsg(['*** forked ** function HandleSystemCommand(''', Command, '''):Exception: ', E.Message]); end; libc_close(fds[0]); // Close copy of reader file descriptor dup2(fds[1], STDERR_FILENO); execvp(PChar(Parameters[0]), args_list); DebugMsg(['***** HandleSystemCommand: failed execvp: something went wrong...']); WriteLn(erroutput, 'Error executing command'); _exit(ConstERRSpawn); end; Result := Length(s) = 0; if not Result then Application.MessageBox(Format('%s%s', [ErrorText, StrToUTF8(s)]), [mbOK], mbError, mbOK, mbOK); SetLength(s, 0); except on E: Exception do DebugMsg(['***** function HandleSystemCommand(''', Command, '''):Exception: ', E.Message]); end; 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^.ModifyTime > Data2^.ModifyTime then Result := -1 else if Data1^.ModifyTime < Data2^.ModifyTime then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 7 : if StripDate(Data1^.ModifyTime) > StripDate(Data2^.ModifyTime) then Result := -1 else if StripDate(Data1^.ModifyTime) < StripDate(Data2^.ModifyTime) 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 := strndup(s, strlen(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; if @g_filename_display_name <> nil then begin nss := g_filename_display_name(ns); Result := strdup(nss); // PPC compatibility g_free(nss); end else Result := strdup(ns); // PPC compatibility 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: string): string; begin Result := s; if @g_filename_display_name <> nil then Result := g_filename_display_name(PChar(s)); end; } function EnsureUTF8String(s: PChar): PChar; begin Result := s; if @g_filename_display_name <> nil then 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 signal_proc(signal_number: integer); cdecl; var {pid,} status: integer; begin // !!!!!!!!!! Warning // There should be no debug outputs in this function because it probably cause program freezes after fork // I mean REALLY NO outputs to console // DebugMsg(['SIGCHLD signal received']); // DebugMsg(['Signal received: ', signal_number]); // DebugMsg(['*** Signal received: ', signal_number, ' = ', GetSignalString(signal_number)]); case signal_number of { SIGUSR1: begin DebugMsg(['begin wait']); wait(@status); DebugMsg(['end wait']); ChildExitStatus := status; end;} SIGCHLD, SIGUSR1: begin // DebugMsg(['begin wait']); // wait(@status); {pid :=} waitpid(-1, @status, WNOHANG); // DebugMsg(['**** waitpid result: pid = ', pid, ', status = ', status]); // DebugMsg(['end wait']); if signal_number = SIGUSR1 then ChildExitStatus := status; end; end; end; procedure SetupSignals; var sigchld_action: _sigaction; begin memset(@sigchld_action, 0, SizeOf(__sigaction)); sigchld_action.__sigaction_handler := @signal_proc; sigaction(SIGUSR1, @sigchld_action, nil); sigaction(SIGCHLD, @sigchld_action, nil); end; procedure SetupColors; var Color: TGDKColor; LocalListView: TGTKListView; begin LocalListView := TGTKListView.Create(Application); try if ConfNormalItemDefaultColors then begin NormalItemGDKColor := GetDefaultTextColor(LocalListView, GTK_STATE_NORMAL); NormalItemGDKBackground := GetDefaultBaseColor(LocalListView, GTK_STATE_NORMAL); end else begin StringToGDKColor(ConfNormalItemFGColor, Color); NormalItemGDKColor := GDKColorToPGdkColor(Color); StringToGDKColor(ConfNormalItemBGColor, Color); NormalItemGDKBackground := GDKColorToPGdkColor(Color); end; if ConfCursorDefaultColors then begin ActiveItemGDKColor := GetDefaultTextColor(LocalListView, GTK_STATE_SELECTED); ActiveItemGDKBackground := GetDefaultBaseColor(LocalListView, GTK_STATE_SELECTED); end else begin StringToGDKColor(ConfActiveItemFGColor, Color); ActiveItemGDKColor := GDKColorToPGdkColor(Color); StringToGDKColor(ConfActiveItemBGColor, Color); ActiveItemGDKBackground := GDKColorToPGdkColor(Color); end; if ConfInactiveItemDefaultColors then begin InactiveItemGDKColor := GetDefaultTextColor(LocalListView, GTK_STATE_ACTIVE); InactiveItemGDKBackground := GetDefaultBaseColor(LocalListView, GTK_STATE_ACTIVE); end else begin StringToGDKColor(ConfInactiveItemFGColor, Color); InactiveItemGDKColor := GDKColorToPGdkColor(Color); StringToGDKColor(ConfInactiveItemBGColor, Color); InactiveItemGDKBackground := GDKColorToPGdkColor(Color); end; StringToGDKColor(ConfSelectedItemFGColor, Color); SelectedItemGDKColor := GDKColorToPGdkColor(Color); StringToGDKColor(ConfDotFileItemFGColor, Color); DotFileItemGDKColor := GDKColorToPGdkColor(Color); StringToGDKColor(ConfLinkItemFGColor, Color); LinkItemGDKColor := GDKColorToPGdkColor(Color); try InactiveItemBGColorNum := $FF + (InactiveItemGDKBackground^.red div 256) shl 24 + (InactiveItemGDKBackground^.green div 256) shl 16 + (InactiveItemGDKBackground^.blue div 256) shl 8; except InactiveItemBGColorNum := $D0D0D0FF; end; finally LocalListView.Free; end; end; procedure ReportGTKVersion; begin {$IFDEF FPC} DebugMsg(['Reported GTK version: ', gtk_major_version, '.', gtk_minor_version, '.', gtk_micro_version]); {$ENDIF} if Application.GTKVersion_2_8_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.8.0']) else if Application.GTKVersion_2_6_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.6.0']) else if Application.GTKVersion_2_4_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.4.0']) else if Application.GTKVersion_2_2_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.2.0']) else if Application.GTKVersion_2_0_5_Up then DebugMsg(['Using quirks for GTK+ >= 2.0.5']) else DebugMsg(['Using quirks for GTK+ < 2.0.5']); 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; (********************************************************************************************************************************) initialization InternalLockInit(True); SetupSignals; // Parse tuxcmd rc file gtk_rc_parse_string(tuxcmd_rc_file); AppPath := IncludeTrailingPathDelimiter(GetHomePath); IconPath := IncludeTrailingPathDelimiter(GetHomePath); end.