summaryrefslogtreecommitdiff
path: root/src/corelib/fpg_utils.pas
blob: 899d419442f328b5f927866d51a66b7eb5fafa54 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
{
    fpGUI  -  Free Pascal GUI Toolkit

    Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

    See the file COPYING.modifiedLGPL, included in this distribution,
    for details about redistributing fpGUI.

    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.

    Description:
      Abstracted OS specific function to work in a cross-platform manner.
}

unit fpg_utils;

{$mode objfpc}{$H+}

interface

uses
  Classes,
  SysUtils,
  fpg_base;

// *** Platform specific functions ***

function  fpgToOSEncoding(aString: TfpgString): string;
function  fpgFromOSEncoding(aString: string): TfpgString;
procedure fpgOpenURL(const aURL: TfpgString);
function  fpgFileSize(const AFilename: TfpgString): integer;


// *** Common functions for all platforms ***

function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: Boolean = True): TfpgString;
function fpgAppendPathDelim(const Path: TfpgString): TfpgString;
function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
function fpgAllFilesMask: TfpgString;
function fpgConvertLineEndings(const s: TfpgString): TfpgString;
function fpgGetToolkitConfigDir: TfpgString;
{ This is so that when we support LTR and RTL languages, the colon will be
  added at the correct place. }
function fpgAddColon(const AText: TfpgString): TfpgString;
function fpgIsBitSet(const AData: integer; const AIndex: integer): boolean;


 // RTL wrapper filesystem functions with platform independant encoding
 // These functions are common for all platforms and rely on fpgXXXPlatformEncoding

function fpgApplicationName: TfpgString;
function fpgFindFirst(const Path: TfpgString; Attr: longint; out Rslt: TSearchRec): longint;
function fpgFindNext(var Rslt: TSearchRec): longint;
function fpgGetCurrentDir: TfpgString;
function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
function fpgExpandFileName(const FileName: TfpgString): TfpgString;
function fpgFileExists(const FileName: TfpgString): Boolean;
function fpgDeleteFile(const FileName: TfpgString): Boolean;
function fpgDirectoryExists(const ADirectory: TfpgString): Boolean;
function fpgExtractFileDir(const FileName: TfpgString): TfpgString;
function fpgExtractFilePath(const FileName: TfpgString): TfpgString;
function fpgExtractFileName(const FileName: TfpgString): TfpgString;
function fpgExtractFileExt(const FileName: TfpgString): TfpgString;
function fpgExtractRelativePath(const ABaseName, ADestName: TfpgString): TfpgString;
function fpgForceDirectories(const ADirectory: TfpgString): Boolean;
function fpgChangeFileExt(const FileName, Extension: TfpgString): TfpgString;
function fpgGetAppConfigDir(const Global: Boolean): TfpgString;
function fpgGetAppConfigFile(const Global: Boolean; const SubDir: Boolean): TfpgString;
function fpgGetExecutableName: TfpgString;
function fpgRenameFile(const OldName, NewName: TfpgString): Boolean;


implementation

 { No USES clause is allowed here! Add it to the include file shown below. }


 // Platform specific encoding handling functions
{$I fpg_utils_impl.inc}


function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: Boolean = True): TfpgString;
begin
  if ALine = '' then
  begin
    Result := ALine;
    Exit; //==>
  end;

  if ADuplicates then
  begin
    Result := ALine + AValue;
    Exit; //==>
  end;

  if (not SameText(Copy(ALine, Length(ALine) - Length(AValue) + 1, Length(AValue)), AValue)) then
    Result := ALine + AValue
  else
    Result := ALine;
end;

function fpgApplicationName: TfpgString;
begin
  Result := fpgFromOSEncoding(ApplicationName);
end;

function fpgFindFirst(const Path: TfpgString; Attr: longint; out Rslt: TSearchRec): longint;
begin
  Result    := FindFirst(fpgToOSEncoding(Path), Attr, Rslt);
  Rslt.Name := fpgFromOSEncoding(Rslt.Name);
end;

function fpgFindNext(var Rslt: TSearchRec): longint;
begin
  Result    := FindNext(Rslt);
  Rslt.Name := fpgFromOSEncoding(Rslt.Name);
end;

function fpgGetCurrentDir: TfpgString;
begin
  Result := fpgFromOSEncoding(GetCurrentDir);
end;

function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
begin
  Result := SetCurrentDir(fpgToOSEncoding(NewDir));
end;

function fpgExpandFileName(const FileName: TfpgString): TfpgString;
begin
  Result := fpgFromOSEncoding(ExpandFileName(fpgToOSEncoding(FileName)));
end;

function fpgFileExists(const FileName: TfpgString): Boolean;
begin
  Result := FileExists(fpgToOSEncoding(FileName));
end;

function fpgDeleteFile(const FileName: TfpgString): Boolean;
begin
  { Don't remove 'SysUtils.' prefix, it is required under Windows, other
    FPC tries to use Windows.DeleteFile API - which is wrong }
  Result := SysUtils.DeleteFile(fpgToOSEncoding(FileName));
end;

function fpgDirectoryExists(const ADirectory: TfpgString): Boolean;
begin
  Result := DirectoryExists(fpgToOSEncoding(ADirectory));
end;

function fpgExtractFileDir(const FileName: TfpgString): TfpgString;
begin
  Result := ExtractFileDir(fpgToOSEncoding(FileName));
end;

function fpgExtractFilePath(const FileName: TfpgString): TfpgString;
begin
  Result := ExtractFilePath(fpgToOSEncoding(Filename));
end;

function fpgExtractFileName(const FileName: TfpgString): TfpgString;
begin
  Result := ExtractFileName(fpgToOSEncoding(Filename));
end;

function fpgExtractFileExt(const FileName: TfpgString): TfpgString;
begin
  Result := ExtractFileExt(fpgToOSEncoding(Filename));
end;

function fpgExtractRelativePath(const ABaseName, ADestName: TfpgString): TfpgString;
begin
  Result := ExtractRelativepath(fpgToOSEncoding(ABaseName), fpgToOSEncoding(ADestName));
end;

function fpgForceDirectories(const ADirectory: TfpgString): Boolean;
begin
  Result := ForceDirectories(fpgToOSEncoding(ADirectory));
end;

function fpgChangeFileExt(const FileName, Extension: TfpgString): TfpgString;
begin
  Result := ChangeFileExt(fpgToOSEncoding(Filename), Extension);
end;

function fpgGetAppConfigDir(const Global: Boolean): TfpgString;
begin
  Result := fpgFromOSEncoding(GetAppConfigDir(Global));
end;

function fpgGetAppConfigFile(const Global: Boolean; const SubDir: Boolean): TfpgString;
begin
  Result := fpgFromOSEncoding(GetAppConfigFile(Global, SubDir));
end;

function fpgGetExecutableName: TfpgString;
begin
  Result := fpgChangeFileExt(fpgExtractFileName(Paramstr(0)), '');
end;

function fpgRenameFile(const OldName, NewName: TfpgString): Boolean;
begin
  Result := RenameFile(fpgToOSEncoding(OldName), fpgToOSEncoding(NewName));
end;

function fpgAppendPathDelim(const Path: TfpgString): TfpgString;
begin
  if (Path <> '') and (Path[length(Path)] <> PathDelim) then
    Result := Path + PathDelim
  else
    Result := Path;
end;

{function fpgHasSubDirs returns True if the directory passed has subdirectories}
function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
var
  FileInfo: TSearchRec;
  FCurrentDir: TfpgString;
begin
  //Assume No
  Result := False;
  if Dir <> '' then
  begin
    FCurrentDir := fpgAppendPathDelim(Dir);
    FCurrentDir := FCurrentDir + fpgAllFilesMask;
    try
      if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
        repeat
          if FileInfo.Name = '' then
            Continue;

            // check if special file
          if ((FileInfo.Name = '.') or (FileInfo.Name = '..')) or
            // unix dot directories (aka hidden directories)
            ((FileInfo.Name[1] in ['.']) and AShowHidden) or
            // check Hidden attribute
            (((faHidden and FileInfo.Attr) > 0) and AShowHidden) then
            Continue;

          Result := ((faDirectory and FileInfo.Attr) > 0);

          //We found at least one non special dir, that's all we need.
          if Result then
            break;
        until fpgFindNext(FileInfo) <> 0;
    finally
      SysUtils.FindClose(FileInfo);
    end;
  end;
end;

function fpgAllFilesMask: TfpgString;
begin
  { Since FPC 2.2.2 we have the AllFilesMask variable, which is part of the RTL }
  Result := AllFilesMask;
end;

function fpgConvertLineEndings(const s: TfpgString): TfpgString;
var
  i: integer;
  EndingStart: longint;
begin
  Result := s;
  i      := 1;
  while (i <= length(Result)) do
    if Result[i] in [#10, #13] then
    begin
      EndingStart := i;
      Inc(i);
      if (i <= length(Result)) and (Result[i] in [#10, #13]) and (Result[i] <> Result[i - 1]) then
        Inc(i);
      if (length(LineEnding) <> i - EndingStart) or (LineEnding <> copy(Result, EndingStart, length(LineEnding))) then
      begin
        // line end differs => replace with current LineEnding
        Result := copy(Result, 1, EndingStart - 1) + LineEnding + copy(Result, i, length(Result));
        i      := EndingStart + length(LineEnding);
      end;
    end
    else
      Inc(i);
end;

function fpgGetToolkitConfigDir: TfpgString;
begin
  Result := fpgTrimR(fpgGetAppConfigDir(False), ApplicationName, True) + FPG_CONFIG_DIR;
end;

function fpgAddColon(const AText: TfpgString): TfpgString;
begin
  { TODO : Check language direction and add colon at appropriate end. This is very crude! }
  Result := AText + ':';
end;

function fpgIsBitSet(const AData: integer; const AIndex: integer): boolean;
begin
  Result := (AData and (1 shl AIndex) <> 0);
end;


end.