pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

20070415 revision of XDev Toolkit - initial commit to SVN.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@179 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
2007-06-08 20:50:29 +00:00
parent 33ee591a38
commit 9077a895ca
13 changed files with 2292 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

282
components/xdev_toolkit/CvtHelp.pas Normal file
View File

@ -0,0 +1,282 @@
program CvtHelp;
{
Input files: HTML file created from WinHelp .rtf file by saving it
in Word's "Web Page, Filtered" format. Also looks for WinHelp .hpj
file with same name as HTML input file.
Output file: HTML file that can be used with LCL apps that use
HelpUtil unit's THelpUtilManager class.
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL.
}
uses
SysUtils,
Classes;
const
ProgramName = 'CvtHelp';
ProgramVersion = '0.01';
var
OldFileName : string;
HpjFileName : string;
NewFileName : string;
OldFileVar : TextFile;
HpjFileVar : TextFile;
NewFileVar : TextFile;
{$IFNDEF FPC}
MatchFound : TFilenameCaseMatch;
{$ENDIF}
MapSection : TStringList;
TitleStr : string;
CopyrightStr: string;
Footnotes : TStringList;
InStr : string;
FnStr : string;
FnPos : Integer;
FnRef : string;
PrevInStr : string;
TopicStr : string;
TopicMapped : Boolean;
FootIdx : Integer;
LinkPos : Integer;
UnlinkPos : Integer;
begin
if ParamCount < 2 then {List program useage?}
begin
WriteLn(ProgramName, ', version ', ProgramVersion,
' - converts WinHelp/RTF-based HTML file to help HTML file.');
WriteLn('Usage: ', ProgramName, ' infile outfile');
Halt;
end;
{Get name of HTML file to convert from command line}
OldFileName := ParamStr(1);
{$IFNDEF FPC}
OldFileName := ExpandFileNameCase(OldFileName, MatchFound);
{$ELSE}
OldFileName := ExpandFileName(OldFileName);
{$ENDIF}
HpjFileName := ChangeFileExt(OldFileName, '.hpj');
{Get name of HTML file to create from command line}
NewFileName := ParamStr(2);
{$IFNDEF FPC}
NewFileName := ExpandFileNameCase(NewFileName, MatchFound);
{$ELSE}
NewFileName := ExpandFileName(NewFileName);
{$ENDIF}
if (OldFileName = NewFileName) or
(HpjFileName = NewFileName) then
begin
WriteLn('Can''t use input file name for output file');
Halt;
end;
{Open input HTML file}
AssignFile(OldFileVar, OldFileName);
try
Reset(OldFileVar);
except
on EInOutError do
begin
WriteLn('Can''t open input file ', OldFileName);
Halt;
end;
end;
{Open WinHelp project file}
AssignFile(HpjFileVar, HpjFileName);
try
Reset(HpjFileVar);
except
on EInOutError do
begin
WriteLn('Can''t open WinHelp project file ', HpjFileName);
Halt;
end;
end;
MapSection := TStringList.Create;
while not Eof(HpjFileVar) do
begin
ReadLn(HpjFileVar, InStr);
if CompareText(InStr, '[OPTIONS]') = 0 then
begin
repeat
ReadLn(HpjFileVar, InStr);
if CompareText(Copy(InStr, 1, 6), 'TITLE=') = 0 then
TitleStr := Copy(InStr, 7, MaxInt)
else if CompareText(Copy(InStr, 1, 10), 'COPYRIGHT=') = 0 then
CopyrightStr := Copy(InStr, 11, MaxInt);
until Copy(InStr, 1, 1) = '[';
end
else if CompareText(InStr, '[MAP]') = 0 then
begin
repeat
ReadLn(HpjFileVar, InStr);
if (InStr <> '') and (Copy(InStr, 1, 1) <> '[') then
MapSection.Add(Copy(InStr, 1, Pos(' ', InStr)-1) + '=' +
Trim(Copy(InStr, Pos(' ', InStr), MaxInt)));
until Eof(HpjFileVar) or (Copy(InStr, 1, 1) = '[');
end;
end;
CloseFile(HpjFileVar);
{Create output HTML file}
AssignFile(NewFileVar, NewFileName);
try
Rewrite(NewFileVar);
except
on EInOutError do
begin
WriteLn('Can''t create output file ', NewFileName);
Halt;
end;
end;
Footnotes := TStringList.Create;
{Read through entire file, saving footnote topic references and names}
while not Eof(OldFileVar) do
begin
ReadLn(OldFileVar, InStr);
if CompareText(InStr, '<div><br clear=all>') = 0 then {Found footnotes?}
begin
while not Eof(OldFileVar) do
begin
ReadLn(OldFileVar, InStr);
if Pos('MsoFootnoteText', InStr) > 0 then {Found a footnote?}
begin
FnStr := InStr;
repeat
ReadLn(OldFileVar, InStr);
if InStr <> '' then
FnStr := FnStr + ' ' + InStr;
until InStr = '';
TopicStr := Copy(FnStr, Pos('</a>', FnStr) + 5, MaxInt);
TopicStr := Copy(TopicStr, 1, Length(TopicStr)-4);
if Pos('_', TopicStr) > 0 then
begin
FnPos := Pos('name=', FnStr) + 6;
FnRef := '';
repeat
FnRef := FnRef + FnStr[FnPos];
Inc(FnPos);
until FnStr[FnPos] = '"';
Footnotes.Add(FnRef + '=' + TopicStr);
end;
end;
end;
end;
end;
Reset(OldFileVar);
{Process input file}
while not Eof(OldFileVar) do
begin
ReadLn(OldFileVar, InStr);
if CompareText(Copy(InStr, 1, 7), '<title>') = 0 then {Found title?}
begin {Replace with title from .hpj file}
WriteLn(NewFileVar, '<title>', TitleStr, '</title>');
{Include AppleTitle line so file can be registered as help book on OS X.}
Write(NewFileVar, '<meta name="AppleTitle" content="');
if CompareText(Copy(TitleStr, Length(TitleStr)-4, 5), ' Help') = 0 then
Write(NewFileVar, Copy(TitleStr, 1, Length(TitleStr)-5)) {Don't include}
else
Write(NewFileVar, TitleStr);
WriteLn(NewFileVar, '">');
{Include copyright statement from .hpj file}
WriteLn(NewFileVar, '<!--');
WriteLn(NewFileVar, CopyrightStr);
WriteLn(NewFileVar, '-->');
end
else if Pos('class=Topictitle', InStr) > 0 then {Found a topic?}
begin
{Get footnote number _ftnXX}
FnPos := Pos('#_', InStr) + 1;
FnRef := '';
repeat
FnRef := FnRef + InStr[FnPos];
Inc(FnPos);
until InStr[FnPos] = '"';
{Insert anchor}
TopicStr := Footnotes.Values[FnRef];
if TopicStr <> '' then
begin
TopicMapped := False;
if MapSection.Values[TopicStr] <> '' then
begin
WriteLn(NewFileVar, '<a name="', MapSection.Values[TopicStr],
'"></a>');
TopicMapped := True;
end;
if not TopicMapped then {No mapping in project file for topic?}
begin {Just use topic name in anchor}
Write(NewFileVar, '<a name="', TopicStr, '"></a>');
end;
end;
Write(NewFileVar, Copy(InStr, 1, 20)); {Save part of 1st topic line}
repeat {Skip over rest of topic lines}
PrevInStr := InStr;
ReadLn(OldFileVar, InStr);
until InStr = '';
WriteLn(NewFileVar, Copy(PrevInStr, 36, MaxInt)); {Save part of last topic line}
end
else if CompareText(InStr, '<div><br clear=all>') = 0 then {Found footnotes?}
begin
repeat {Skip over footnotes}
ReadLn(OldFileVar, InStr);
until CompareText(InStr, '</body>') = 0;
WriteLn(NewFileVar, InStr);
end
else {Found normal line}
begin {See if it contains link to topic}
LinkPos := Pos('<u>', InStr);
if LinkPos > 0 then {Line contains link?}
begin
PrevInStr := InStr;
ReadLn(OldFileVar, InStr); {Get next line too}
InStr := PrevInStr + ' ' + InStr; {Combine}
for FootIdx := 0 to Footnotes.Count -1 do
begin
TopicStr := Footnotes.ValueFromIndex[FootIdx];
if Pos(TopicStr, InStr) > 0 then
begin
UnlinkPos := Pos('</u>', InStr);
Write(NewFileVar, Copy(InStr, 1, LinkPos-1),
'<a href="#');
if MapSection.Values[TopicStr] <> '' then
Write(NewFileVar, MapSection.Values[TopicStr])
else
Write(NewFileVar, TopicStr);
WriteLn(NewFileVar, '">',
Copy(InStr, LinkPos+3, UnlinkPos-LinkPos-3), '</a>',
Copy(InStr, UnlinkPos+4, MaxInt));
end;
end;
end
else
WriteLn(NewFileVar, InStr);
end;
end;
MapSection.Free;
Footnotes.Free;
CloseFile(OldFileVar);
CloseFile(NewFileVar);
end.

107
components/xdev_toolkit/DfmToLfm.ini Normal file
View File

@ -0,0 +1,107 @@
; DfmToLfm program configuration file.
; Be sure to add "=" after each key you add. The key's value can be omitted
; as it has no meaning to DfmToLfm.
; DfmToLfm deletes these .dfm properties when creating .lfm file.
; Note: If no class is specified, deletes that property from all classes.
[DeleteProps]
IsControl=
;NumGlyphs=
OldCreateOrder=
WantReturns=
Ctl3D=
ParentCtl3D=
OnClickCheck=
Flat=
IntegralHeight=
DesignSize=
AutoSelect=
BiDiMode=
ParentBiDiMode=
HideSelection=
ImeMode=
ImeName=
OEMConvert=
TRadioGroup.TabOrder=
TBitBtn.ParentFont=
TCheckBox.Font.Charset=
TCheckBox.Font.Color=
TCheckBox.Font.Height=
TCheckBox.Font.Name=
TCheckBox.Font.Style=
TCheckBox.ParentFont=
TCheckGroup.Font.Charset=
TCheckGroup.Font.Color=
TCheckGroup.Font.Height=
TCheckGroup.Font.Name=
TCheckGroup.Font.Style=
TCheckGroup.ParentFont=
TCheckListBox.Font.Charset=
TCheckListBox.Font.Color=
TCheckListBox.Font.Height=
TCheckListBox.Font.Name=
TCheckListBox.Font.Style=
TCheckListBox.ParentFont=
TRadioButton.Font.Charset=
TRadioButton.Font.Color=
TRadioButton.Font.Height=
TRadioButton.Font.Name=
TRadioButton.Font.Style=
TRadioButton.ParentFont=
TRadioGroup.Font.Charset=
TRadioGroup.Font.Color=
TRadioGroup.Font.Height=
TRadioGroup.Font.Name=
TRadioGroup.Font.Style=
TRadioGroup.ParentFont=
TBevel.Font.Charset=
TBevel.Font.Color=
TBevel.Font.Height=
TBevel.Font.Name=
TBevel.Font.Style=
TTabSheet.Font.Charset=
TTabSheet.Font.Color=
TTabSheet.Font.Height=
TTabSheet.Font.Name=
TTabSheet.Font.Style=
TNotebook.Font.Charset=
TNotebook.Font.Color=
TNotebook.Font.Height=
TNotebook.Font.Name=
TNotebook.Font.Style=
TNotebook.ParentFont=
TLabeledEdit.Font.Charset=
TLabeledEdit.Font.Color=
TLabeledEdit.Font.Height=
TLabeledEdit.Font.Name=
TLabeledEdit.Font.Style=
; When -p switch is used with DfmToLfm, don't try to add parent's font
; properties to these classes since they don't have font in LCL.
[NoFont]
TMainMenu=
TMenuItem=
TScrollBar=
TImage=
TTabSheet=
TCheckBox=
TCheckGroup=
TCheckListBox=
TRadioButton=
TRadioGroup=
TActionList=
TShape=
TBevel=
TNotebook=
TLabeledEdit=
TSplitter=
TOvcController=
TOvcSpinner=
TOvcTCCheckBox=
TOvcTCBitmap=
TOvcTCGlyphs=
TOvcTCIcon=

318
components/xdev_toolkit/DfmToLfm.pas Normal file
View File

@ -0,0 +1,318 @@
program DfmToLfm;
{
Converts Delphi form design file to a Lazarus form file by
deleting properties that are not supported by LCL and
optionally making changes to font properties. The resulting
Lazarus form file can then be converted to a Lazarus resource
file with LazRes.
Note that the Delphi form file must be a text file.
List of properties to delete and other configuration settings
are read from DfmToLfm.ini.
This utility (and Lazarus LazRes) can be used whenever design
changes are made to the form in Delphi.
Note: Use MakePasX to make the form's code file cross-platform
(a one-time conversion).
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL.
}
uses
SysUtils,
IniFiles;
const
ProgramName = 'DfmToLfm';
ProgramVersion = '0.01';
DfmFileExt = '.dfm'; {Delphi form file extension}
LfmFileExt = '.lfm'; {Lazarus form file extension}
CfgFileExt = '.ini'; {Extension for file with same name as program
containing configuration settings}
NoFontChanges = 0; {No font switch on command line}
UseParentFont = 1; {-p font switch on command line}
DeleteFontName = 2; {-d font switch on command line}
MaxNestedObjs = 20; {Maximum depth of nested controls on form}
MaxFontProps = 5; {Maximum font properties that can be saved}
type
TStackRec = record {Info about form objects}
ClassName : string;
FontPropCnt : Integer;
FontAdded : Boolean;
FontProps : array [1..MaxFontProps] of string;
end;
var
CfgFileName : string;
{$IFNDEF FPC}
MatchFound : TFilenameCaseMatch;
{$ENDIF}
FontSwitch : Integer;
CfgFileObj : TMemIniFile;
DfmFileName : string;
LfmFileName : string;
DfmFileVar : TextFile;
LfmFileVar : TextFile;
StackLevel : Integer;
StackRec : array [1..MaxNestedObjs] of TStackRec;
DeleteLine : Boolean;
InStr : string;
StripStr : string;
SkipStr : string;
ParentLevel : Integer;
FontPropNum : Integer;
begin
{Base configuration file name on program file location and program name}
CfgFileName := ExtractFilePath(ParamStr(0)) + ProgramName + CfgFileExt;
{$IFNDEF FPC}
CfgFileName := ExpandFileNameCase(CfgFileName, MatchFound);
{$ENDIF}
if ParamCount = 0 then {List program syntax and exit?}
begin
WriteLn(ProgramName, ', version ', ProgramVersion,
' - converts a Delphi form file to a Lazarus form file.');
WriteLn('Usage: ', ProgramName, ' filename', DfmFileExt, ' [-p|-d]');
WriteLn('Switches:');
WriteLn(' -p Add parent''s font to controls with no font ',
'(useful with Windows).');
WriteLn(' -d Delete font name from controls ',
'(useful with OS X and Linux).');
WriteLn('Looks for configuration data in file ', CfgFileName);
Halt;
end;
{Check for command line switches}
FontSwitch := NoFontChanges;
if FindCmdLineSwitch('p', ['-'], True) then
FontSwitch := UseParentFont
else if FindCmdLineSwitch('d', ['-'], True) then
FontSwitch := DeleteFontName;
{Load configuration file}
if not FileExists(CfgFileName) then
begin
WriteLn('Can''t load program configuration file ', CfgFileName);
Halt;
end;
CfgFileObj := TMemIniFile.Create(CfgFileName);
{Get name of Delphi form file from command line}
DfmFileName := ParamStr(1);
if ExtractFileExt(DfmFileName) = '' then
DfmFileName := DfmFileName + DfmFileExt;
{$IFNDEF FPC}
DfmFileName := ExpandFileNameCase(DfmFileName, MatchFound);
{$ELSE}
DfmFileName := ExpandFileName(DfmFileName);
{$ENDIF}
{Base Lazarus form file name on Delphi form file name}
LfmFileName := ChangeFileExt(DfmFileName, LfmFileExt);
{Open Delphi form file}
AssignFile(DfmFileVar, DfmFileName);
try
Reset(DfmFileVar);
except
on EInOutError do
begin
WriteLn('Can''t open Delphi form file ', DfmFileName);
Halt;
end;
end;
{Create Lazarus form file}
AssignFile(LfmFileVar, LfmFileName);
try
Rewrite(LfmFileVar);
except
on EInOutError do
begin
WriteLn('Can''t create Lazarus form file ', LfmFileName);
Halt;
end;
end;
StackLevel := 0;
while not Eof(DfmFileVar) do {Read and process Delphi form file}
begin
DeleteLine := False;
ReadLn(DfmFileVar, InStr); {Read property from form file}
StripStr := StringReplace(InStr, ' ', '', [rfReplaceAll]); {Strip spaces}
if ((CompareText('object ', Copy(Trim(InStr), 1, 7)) = 0) or
(CompareText('end', StripStr) = 0)) and {End of object's props reached?}
(StackLevel > 1) and {Object is nested?}
(not CfgFileObj.ValueExists(
'NoFont', StackRec[StackLevel].ClassName)) and {Class has font?}
(StackRec[StackLevel].FontPropCnt = 0) and {Object has no font?}
(FontSwitch = UseParentFont) and {Okay to insert parent font in object?}
(not StackRec[StackLevel].FontAdded) then {Font not inserted yet?}
begin
ParentLevel := StackLevel;
repeat
Dec(ParentLevel);
until (ParentLevel = 0) or
(StackRec[ParentLevel].FontPropCnt > 0);
if ParentLevel > 0 then {A parent has font?}
begin {Add font properties to current object}
for FontPropNum := 1 to StackRec[ParentLevel].FontPropCnt do
begin
WriteLn(LfmFileVar, StringOfChar(' ', (StackLevel-ParentLevel)*2),
StackRec[ParentLevel].FontProps[FontPropNum]);
end;
end;
StackRec[StackLevel].FontAdded := True;
end;
if CompareText('object ', Copy(Trim(InStr), 1, 7)) = 0 then
begin {Push object's class name on stack}
Inc(StackLevel);
if Pos(': ', InStr) > 0 then {Named control?}
StackRec[StackLevel].ClassName :=
Trim(Copy(InStr, Pos(': ', InStr)+2, MaxInt))
else {Unnamed control}
StackRec[StackLevel].ClassName := Trim(Copy(Trim(InStr), 7, MaxInt));
StackRec[StackLevel].FontPropCnt := 0;
StackRec[StackLevel].FontAdded := False;
end
else if CompareText('end', StripStr) = 0 then
begin {Pop current class from stack}
Dec(StackLevel);
end
else if CompareText('font.', Copy(Trim(InStr), 1, 5)) = 0 then
begin {Font property}
if FontSwitch <> NoFontChanges then
begin
if FontSwitch = UseParentFont then
begin {Save font property in case need it for child objects}
if StackRec[StackLevel].FontPropCnt < MaxFontProps then
begin
Inc(StackRec[StackLevel].FontPropCnt);
StackRec[StackLevel].FontProps[StackRec[StackLevel].FontPropCnt] :=
InStr;
end;
end
else {FontSwitch = DeleteFontName}
begin
if CompareText('font.name', Copy(Trim(InStr), 1, 9)) = 0 then
DeleteLine := True;
end;
end;
{Check if font property should be deleted from current object}
if CfgFileObj.ValueExists('DeleteProps',
StackRec[StackLevel].ClassName + '.' +
Copy(StripStr, 1, Pos('=', StripStr)-1)) then
DeleteLine := True;
end
else {Other property}
begin {Check if property should be deleted from current object}
if CfgFileObj.ValueExists('DeleteProps',
Copy(StripStr, 1, Pos('=', StripStr)-1)) or
CfgFileObj.ValueExists('DeleteProps',
StackRec[StackLevel].ClassName + '.' +
Copy(StripStr, 1, Pos('=', StripStr)-1)) then
begin {Property or class.property in list of props to delete?}
DeleteLine := True;
if Copy(StripStr, Length(StripStr), 1) = '(' then {Delete > 1 line?}
begin
repeat
ReadLn(DfmFileVar, SkipStr);
SkipStr := Trim(SkipStr);
until Copy(SkipStr, Length(SkipStr), 1) = ')';
end;
end;
end;
if not DeleteLine then {Include line in Lazarus form file?}
begin
try
{If Delphi form file does have Height and Width, reduce
to size of its ClientHeight or ClientWidth.}
if ((StackLevel = 1) and
(CompareText('Height=', Copy(StripStr, 1, 7)) = 0)) then
WriteLn(LfmFileVar,
' Height = ',
IntToStr(StrToInt(Copy(StripStr, 8, MaxInt)) - 34))
else if ((StackLevel = 1) and
(CompareText('Width=', Copy(StripStr, 1, 6)) = 0)) then
WriteLn(LfmFileVar,
' Width = ',
IntToStr(StrToInt(Copy(StripStr, 7, MaxInt)) - 8))
{LCL TGroupBox child controls' Top measures from a lower position
within group box than with VCL, so reduce Top value}
else if (StackLevel > 1) and
(CompareText('Top=', Copy(StripStr, 1, 4)) = 0) and
(CompareText('TGroupBox',
StackRec[Pred(StackLevel)].ClassName) = 0) then
WriteLn(LfmFileVar,
Copy(InStr, 1, Succ(Pos('=', InStr))),
IntToStr(StrToInt(Copy(StripStr, 5, MaxInt)) - 16))
{Lazarus IDE appears to swap Top and Left properties for non-visual
controls, so swap them for Orpheus table cell controls.}
else if ((CompareText('Top=', Copy(StripStr, 1, 4)) = 0) or
(CompareText('Left=', Copy(StripStr, 1, 5)) = 0)) and
((CompareText('TOvcTC',
Copy(StackRec[StackLevel].ClassName, 1, 6)) = 0) or
(CompareText('TO32TC',
Copy(StackRec[StackLevel].ClassName, 1, 6)) = 0) or
(CompareText('TOvcController',
StackRec[StackLevel].ClassName) = 0)) then
begin
if CompareText('Top=', Copy(StripStr, 1, 4)) = 0 then
WriteLn(LfmFileVar,
StringReplace(InStr, 'Top', 'Left', [rfIgnoreCase]))
else
WriteLn(LfmFileVar,
StringReplace(InStr, 'Left', 'Top', [rfIgnoreCase]));
end
else {No change to property}
WriteLn(LfmFileVar, InStr);
{Delphi form files don't always include Height or Width properties,
which are required by Lazarus, so add them based on ClientHeight
and ClientWidth properties, which apparently act the same as
Height and Width in Lazarus (unlike Delphi).}
if (CompareText('ClientHeight=', Copy(StripStr, 1, 13)) = 0) or
(CompareText('ClientWidth=', Copy(StripStr, 1, 12)) = 0) then
WriteLn(LfmFileVar,
StringReplace(InStr, 'Client', '', [rfIgnoreCase]));
except
on EInOutError do
begin
WriteLn('Can''t write to Lazarus form file ', LfmFileName);
Halt;
end;
end;
end;
end; {while not Eof}
CloseFile(DfmFileVar);
try
CloseFile(LfmFileVar);
except
on EInOutError do
begin
WriteLn('Can''t close Lazarus form file ', LfmFileName);
Halt;
end;
end;
CfgFileObj.Free;
WriteLn(LfmFileName, ' successfully created');
end.

154
components/xdev_toolkit/HelpUtil.pas Normal file
View File

@ -0,0 +1,154 @@
unit HelpUtil;
{
Isolates platform-specific help access for Lazarus LCL.
Assumes Application.HelpFile is set.
Create THelpUtilManager object in main form's FormCreate handler and
call its Free method in main form's FormDestroy handler.
Display help topic by calling Application.HelpContext.
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL. This means you can link your code to this
compiled unit (statically in a standalone executable or
dynamically in a library) without releasing your code. Only
changes to this unit need to be made publicly available.
}
interface
uses
SysUtils,
{$IFDEF MSWINDOWS}
Windows,
{$ELSE}
Unix,
{$ENDIF}
{$IFDEF LINUX}
FileUtil,
{$ENDIF}
Forms,
Dialogs,
HelpIntfs;
type
THelpUtilManager = class(THelpManager)
destructor Destroy; override;
procedure ShowError( ShowResult : TShowHelpResult;
const ErrMsg : string); override;
function ShowHelpForQuery( Query : THelpQuery;
AutoFreeQuery : Boolean;
var ErrMsg : string): TShowHelpResult; override;
end;
implementation
const
HELP_CONTEXT = 1;
HELP_QUIT = 2;
function DoHelpCommand(Command : Word;
Data : LongInt) : Boolean;
begin
{$IFDEF MSWINDOWS} {LCL doesn't have TApplication.HelpCommand, so call Win API}
Result := WinHelp(Application.MainForm.Handle,
PChar(Application.HelpFile),
Command, Data);
{$ENDIF}
end; {DoHelpCommand}
{THelpUtilManager}
destructor THelpUtilManager.Destroy;
begin
{$IFDEF MSWINDOWS}
DoHelpCommand(HELP_QUIT, 0);
{Shut down help application if running and not in use
by another instance of program}
{$ENDIF}
inherited Destroy;
end;
procedure THelpUtilManager.ShowError( ShowResult : TShowHelpResult;
const ErrMsg : string);
begin
if ShowResult = shrHelpNotFound then
MessageDlg('Help not implemented.', mtError, [mbOK], 0)
else if ShowResult = shrViewerNotFound then
MessageDlg('Help viewer not found.', mtError, [mbOK], 0)
else if ShowResult = shrViewerError then
MessageDlg('Unable to start help viewer.', mtError, [mbOK], 0)
else if ShowResult <> shrSuccess then
MessageDlg(ErrMsg, mtError, [mbOK], 0);
end;
function THelpUtilManager.ShowHelpForQuery( Query : THelpQuery;
AutoFreeQuery : Boolean;
var ErrMsg : string): TShowHelpResult;
{$IFDEF LINUX}
function SearchForBrowser(const BrowserFileName : string) : string;
begin
Result :=
SearchFileInPath(BrowserFileName, '', GetEnvironmentVariable('PATH'),
PathSeparator, [sffDontSearchInBasePath]);
end;
function GetBrowserPath : string;
begin
Result := SearchForBrowser('firefox');
if Result = '' then
Result := SearchForBrowser('konqueror'); {KDE browser}
if Result = '' then
Result := SearchForBrowser('epiphany'); {GNOME browser}
if Result = '' then
Result := SearchForBrowser('mozilla');
if Result = '' then
Result := SearchForBrowser('opera');
end;
{$ENDIF}
begin
if Query is THelpQueryContext then {Is a help context request?}
begin
{$IFDEF MSWINDOWS}
DoHelpCommand(HELP_CONTEXT, THelpQueryContext(Query).Context);
Result := shrSuccess;
{$ELSE}
{$IFDEF DARWIN}
if Shell('Open -a "Help Viewer" "' + Application.HelpFile + '"') = 127 then
// Note: With OS X earlier than 10.4 (Tiger), if connected to network
// but not connected to Internet, takes Help Viewer 1-2 minutes to
// recover and turn off rotating ball! Can comment out previous Shell
// and uncomment next line to use default browser instead.
// if Shell('Open "' + Application.HelpFile + '"') = 127 then
Result := shrViewerError
else
Result := shrSuccess;
{$ELSE} {For now, shell to first browser found, passing help file name}
if GetBrowserPath <> '' then {Found a browser?}
begin
if Shell(GetBrowserPath + ' ' + Application.HelpFile) = 127 then
Result := shrViewerError
else
Result := shrSuccess;
end
else
Result := shrViewerNotFound;
{$ENDIF}
{$ENDIF}
end
else {Not a help context request?}
Result := inherited ShowHelpForQuery(Query, AutoFreeQuery, ErrMsg);
end; {THelpUtilManager.ShowHelpForQuery}
end.

220
components/xdev_toolkit/MakePasX.pas Normal file
View File

@ -0,0 +1,220 @@
program MakePasX;
{
Makes Delphi form code file or project file cross-platform
so it can be compiled by both Delphi and Lazarus/FPC.
Note that this is a one-time conversion.
Note: Use DfmToLfm to convert form's design file to LCL
whenever changes are made to form in Delphi.
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL.
}
uses
SysUtils;
const
ProgramName = 'MakePasX';
ProgramVersion = '0.01';
PasFileExt = '.pas'; {Pascal code file extension}
DelProjFileExt = '.dpr'; {Delphi project file extension}
TmpFileExt = '.tmp'; {Create converted file with this extension}
BakFileExt = '.bak'; {Rename original file with this extension}
var
OldFileName : string;
NewFileName : string;
OldFileVar : TextFile;
NewFileVar : TextFile;
{$IFNDEF FPC}
MatchFound : TFilenameCaseMatch;
{$ENDIF}
IsProject : Boolean;
InStr : string;
FoundUses : Boolean;
Done : Boolean;
UnitPos : Integer;
HasAppInit : Boolean;
HasForm : Boolean;
begin
if ParamCount = 0 then {List program useage?}
begin
WriteLn(ProgramName, ', version ', ProgramVersion,
' - makes Delphi code file cross-platform.');
WriteLn('Usage: ', ProgramName, ' filename[', PasFileExt, '|',
DelProjFileExt, ']');
Halt;
end;
{Get name of Pascal code file to convert from command line}
OldFileName := ParamStr(1);
if ExtractFileExt(OldFileName) = '' then {No extension?}
OldFileName := OldFileName + PasFileExt; {Assume it's not a project file}
{$IFNDEF FPC}
OldFileName := ExpandFileNameCase(OldFileName, MatchFound);
{$ELSE}
OldFileName := ExpandFileName(OldFileName);
{$ENDIF}
IsProject := CompareText(ExtractFileExt(OldFileName), DelProjFileExt) = 0;
NewFileName := ChangeFileExt(OldFileName, TmpFileExt);
{Open code file}
AssignFile(OldFileVar, OldFileName);
try
Reset(OldFileVar);
except
on EInOutError do
begin
WriteLn('Can''t open Pascal code file ', OldFileName);
Halt;
end;
end;
{Create new code file}
AssignFile(NewFileVar, NewFileName);
try
Rewrite(NewFileVar);
except
on EInOutError do
begin
WriteLn('Can''t create new code file ', NewFileName);
Halt;
end;
end;
FoundUses := False;
HasAppInit := False;
HasForm := False;
while not Eof(OldFileVar) do {Read and convert Pascal code file}
begin
ReadLn(OldFileVar, InStr); {Read line of code}
if not IsProject then {Form code file?}
begin
if (CompareText(InStr, 'uses') = 0) and {Found uses section?}
(not FoundUses) then {And in interface section?}
begin {Note assumes "uses" appears on separate line from list of units}
FoundUses := True;
WriteLn(NewFileVar, InStr);
WriteLn(NewFileVar,
' {$IFNDEF LCL} Windows, Messages, ',
'{$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}');
ReadLn(OldFileVar, InStr);
repeat
UnitPos := Pos('WINDOWS,', UpperCase(InStr));
if UnitPos > 0 then
Delete(InStr, UnitPos, 8);
if Copy(InStr, UnitPos, 1) = ' ' then
Delete(InStr, UnitPos, 1);
UnitPos := Pos('MESSAGES,', UpperCase(InStr));
if UnitPos > 0 then
Delete(InStr, UnitPos, 9);
if Copy(InStr, UnitPos, 1) = ' ' then
Delete(InStr, UnitPos, 1);
UnitPos := Pos('WINTYPES,', UpperCase(InStr)); {Synonym for Windows}
if UnitPos > 0 then
Delete(InStr, UnitPos, 9);
if Copy(InStr, UnitPos, 1) = ' ' then
Delete(InStr, UnitPos, 1);
UnitPos := Pos('WINPROCS,', UpperCase(InStr)); {Synonym for Windows}
if UnitPos > 0 then
Delete(InStr, UnitPos, 9);
if Copy(InStr, UnitPos, 1) = ' ' then
Delete(InStr, UnitPos, 1);
WriteLn(NewFileVar, InStr);
Done := Pos(';', InStr) > 0;
if not Done then
ReadLn(OldFileVar, InStr);
until Done;
end {uses section}
else if CompareText(Copy(Trim(InStr), 1, 10),
'{$R *.dfm}') = 0 then {Form's resource file?}
begin
WriteLn(NewFileVar, '{$IFNDEF LCL}');
WriteLn(NewFileVar, InStr);
WriteLn(NewFileVar, '{$ENDIF}');
HasForm := True;
end
else if (CompareText(InStr, 'end.') = 0) and HasForm then {End of unit?}
begin
{Note: Make sure IFDEF goes after initialization since Delphi
inserts new event handlers immediately before initialization line.}
WriteLn(NewFileVar, 'initialization');
WriteLn(NewFileVar, '{$IFDEF LCL}');
WriteLn(NewFileVar, '{$I ', ChangeFileExt(ExtractFileName(OldFileName),
'.lrs} {Include form''s resource file}'));
WriteLn(NewFileVar, '{$ENDIF}');
WriteLn(NewFileVar);
WriteLn(NewFileVar, InStr);
end
else {Nothing to change with this line}
WriteLn(NewFileVar, InStr);
end
else {Delphi project file}
begin
if (CompareText(InStr, 'uses') = 0) and {Found uses section?}
(not FoundUses) then {And in interface section?}
begin {Note assumes "uses" appears on separate line from list of units}
FoundUses := True;
WriteLn(NewFileVar, InStr);
WriteLn(NewFileVar, '{$IFDEF LCL}');
WriteLn(NewFileVar, ' Interfaces,');
WriteLn(NewFileVar, '{$ENDIF}');
end
else if (CompareText(Copy(Trim(InStr), 1, 10), '{$R *.res}') = 0) or
(CompareText(Copy(Trim(InStr), 1, 10), '{$R *.r32}') = 0) or
(CompareText(Copy(Trim(InStr), 1, 10), '{$R *.r16}') = 0) then
begin {Program's resource file}
WriteLn(NewFileVar, '{$IFDEF MSWINDOWS}');
WriteLn(NewFileVar, InStr);
WriteLn(NewFileVar, '{$ENDIF}');
end
else if CompareText(Copy(Trim(InStr), 1, 3), '{$R') = 0 then
begin {Might be a type library or XP manifest resource file}
WriteLn(NewFileVar, '{$IFNDEF FPC}');
WriteLn(NewFileVar, InStr);
WriteLn(NewFileVar, '{$ENDIF}');
end
else if Pos('APPLICATION.INITIALIZE', UpperCase(InStr)) > 0 then
begin
HasAppInit := True;
WriteLn(NewFileVar, InStr);
end
else
begin
if (not HasAppInit) and
((Pos('APPLICATION.CREATEFORM', UpperCase(InStr)) > 0) or
(Pos('APPLICATION.RUN', UpperCase(InStr)) > 0)) then
begin
WriteLn(NewFileVar, ' Application.Initialize;'); {Laz needs this}
HasAppInit := True;
end;
WriteLn(NewFileVar, InStr);
end;
end;
end; {while not Eof}
DeleteFile(ChangeFileExt(OldFileName, BakFileExt));
CloseFile(OldFileVar);
RenameFile(OldFileName, ChangeFileExt(OldFileName, BakFileExt));
CloseFile(NewFileVar);
if not IsProject then
RenameFile(NewFileName, ChangeFileExt(NewFileName, PasFileExt))
else
RenameFile(NewFileName, ChangeFileExt(NewFileName, DelProjFileExt));
WriteLn(OldFileName, ' successfully converted.');
end.

79
components/xdev_toolkit/MakeVer.pas Normal file
View File

@ -0,0 +1,79 @@
program MakeVer;
{
Makes INI-style version file from Delphi .dof file.
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL.
}
uses
SysUtils,
Classes,
IniFiles;
const
ProgramName = 'MakeVer';
ProgramVersion = '0.01';
DofFileExt = '.dof'; {Delphi project options file extension}
VerFileExt = '.version'; {Linux/Mac version info file extension}
VersionSection = 'Version Info Keys';
var
DofFileName : string;
VerFileName : string;
DofIniFile : TIniFile;
VerIniFile : TIniFile;
VerStrList : TStringList;
{$IFNDEF FPC}
MatchFound : TFilenameCaseMatch;
{$ENDIF}
ItemNum : Integer;
begin
if ParamCount = 0 then {List program useage?}
begin
WriteLn(ProgramName, ', version ', ProgramVersion,
' - makes INI-style version file from Delphi .dof file.');
WriteLn('Usage: ', ProgramName, ' filename', DofFileExt);
Halt;
end;
{Get name of Delphi project options file from command line}
DofFileName := ParamStr(1);
if ExtractFileExt(DofFileName) = '' then
DofFileName := DofFileName + DofFileExt;
{$IFNDEF FPC}
DofFileName := ExpandFileNameCase(DofFileName, MatchFound);
{$ELSE}
DofFileName := ExpandFileName(DofFileName);
{$ENDIF}
VerFileName := ChangeFileExt(DofFileName, VerFileExt);
if not FileExists(DofFileName) then
begin
WriteLn(DofFileName, ' does not exist');
Halt;
end;
DofIniFile := TIniFile.Create(DofFileName);
VerStrList := TStringList.Create;
DofIniFile.ReadSectionValues(VersionSection, VerStrList); {Load vers strings}
VerIniFile := TIniFile.Create(VerFileName);
for ItemNum := 0 to Pred(VerStrList.Count) do {Write to version file}
begin
VerIniFile.WriteString(VersionSection, VerStrList.Names[ItemNum],
VerStrList.Values[VerStrList.Names[ItemNum]]);
end;
VerIniFile.UpdateFile; {Save to file}
VerIniFile.Free;
DofIniFile.Free;
WriteLn(VerFileName, ' successfully created');
end.

5
components/xdev_toolkit/ReadMe.txt Normal file
View File

@ -0,0 +1,5 @@
This is the XDev Toolkit.
See XDevStatus.html for more information.

256
components/xdev_toolkit/RtfDoc.pas Normal file
View File

@ -0,0 +1,256 @@
unit RtfDoc;
{
Class for creating RTF document.
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL. This means you can link your code to this
compiled unit (statically in a standalone executable or
dynamically in a library) without releasing your code. Only
changes to this unit need to be made publicly available.
}
interface
uses
SysUtils,
RtfPars;
type
TRtfDoc = class(TObject)
private
FParser : TRTFParser;
procedure DoGroup;
procedure DoCtrl;
procedure DoText;
{$IFDEF FPC}
procedure HandleError(s : ShortString);
{$ELSE} {Delphi}
procedure HandleError(s : string);
{$ENDIF}
protected
FFileName : string;
FFileVar : TextFile;
public
constructor Create;
destructor Destroy; override;
property Parser : TRTFParser read FParser;
property FileName : string read FFileName;
procedure Start(const FileName : string); virtual;
procedure Done; virtual;
procedure OutDefaultFontTable(DefFont : Integer); virtual;
procedure OutToken( AClass : Integer;
Major : Integer;
Minor : Integer;
Param : Integer;
const Text : string); virtual;
procedure OutCtrl(Major : Integer;
Minor : Integer;
Param : Integer); virtual;
procedure OutText(const Text : string); virtual;
end;
implementation
constructor TRtfDoc.Create;
begin
inherited Create;
FParser := TRTFParser.Create(nil);
end;
destructor TRtfDoc.Destroy;
begin
Parser.Free;
inherited Destroy;
end;
procedure TRtfDoc.Start(const FileName : string);
var
CurYear : Word;
CurMonth : Word;
CurDay : Word;
CurHour : Word;
CurMinute : Word;
CurSecond : Word;
CurSec100 : Word;
begin
FFileName := FileName;
AssignFile(FFileVar, FFileName);
Rewrite(FFileVar);
Parser.ResetParser;
Parser.ClassCallbacks[rtfGroup] := DoGroup;
Parser.ClassCallbacks[rtfText] := DoText;
Parser.ClassCallbacks[rtfControl] := DoCtrl;
Parser.DestinationCallbacks[rtfFontTbl] := nil;
Parser.DestinationCallbacks[rtfColorTbl] := nil;
Parser.DestinationCallbacks[rtfInfo] := nil;
Parser.OnRTFError := HandleError;
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfVersion, -1, 1);
OutCtrl(rtfCharSet, rtfAnsiCharSet, rtfNoParam);
{Output document creation date and time}
DecodeDate(Now, CurYear, CurMonth, CurDay);
DecodeTime(Now, CurHour, CurMinute, CurSecond, CurSec100);
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfDestination, rtfInfo, rtfNoParam);
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfSpecialChar, rtfICreateTime, rtfNoParam);
OutCtrl(rtfSpecialChar, rtfIYear, CurYear);
OutCtrl(rtfSpecialChar, rtfIMonth, CurMonth);
OutCtrl(rtfSpecialChar, rtfIDay, CurDay);
OutCtrl(rtfSpecialChar, rtfIHour, CurHour);
OutCtrl(rtfSpecialChar, rtfIMinute, CurMinute);
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
WriteLn(FFileVar);
end; {TRtfDoc.Start}
procedure TRtfDoc.OutDefaultFontTable(DefFont : Integer);
begin
{Output default font number}
OutCtrl(rtfDefFont, -1, DefFont);
{Output font table}
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfDestination, rtfFontTbl, rtfNoParam);
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfCharAttr, rtfFontNum, 0);
OutToken(rtfControl, rtfFontFamily, rtfFFModern, rtfNoParam,
'Courier New;');
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfCharAttr, rtfFontNum, 1);
OutToken(rtfControl, rtfFontFamily, rtfFFRoman, rtfNoParam,
'Times New Roman;');
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
OutCtrl(rtfCharAttr, rtfFontNum, 2);
OutToken(rtfControl, rtfFontFamily, rtfFFSwiss, rtfNoParam,
'Arial;');
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
WriteLn(FFileVar);
end; {TRtfDoc.OutDefaultFontTable}
procedure TRtfDoc.Done;
begin
WriteLn(FFileVar);
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
CloseFile(FFileVar);
end;
procedure TRtfDoc.OutToken( AClass : Integer;
Major : Integer;
Minor : Integer;
Param : Integer;
const Text : string);
begin
Parser.SetToken(AClass, Major, Minor, Param, Text);
Parser.RouteToken;
if Text <> '' then
Write(FFileVar, Text);
end;
procedure TRtfDoc.OutCtrl(Major : Integer;
Minor : Integer;
Param : Integer);
begin
OutToken(rtfControl, Major, Minor, Param, '');
end;
procedure TRtfDoc.OutText(const Text : string);
var
CharNum : Integer;
begin
for CharNum := 1 to Length(Text) do
OutToken(rtfText, Ord(Text[CharNum]), 0, rtfNoParam, '');
end;
procedure TRtfDoc.DoGroup;
begin
if Parser.rtfMajor = rtfBeginGroup then
Write(FFileVar, '{')
else
Write(FFileVar, '}');
end;
procedure TRtfDoc.DoCtrl;
var
RtfIdx : Integer;
begin
if (Parser.rtfMajor = rtfSpecialChar) and
(Parser.rtfMinor = rtfPar) then
WriteLn(FFileVar); {Make RTF file more human readable}
RtfIdx := 0;
while rtfKey[RtfIdx].rtfKStr <> '' do
begin
if (Parser.rtfMajor = rtfKey[RtfIdx].rtfKMajor) and
(Parser.rtfMinor = rtfKey[RtfIdx].rtfKMinor) then
begin
Write(FFileVar, '\');
Write(FFileVar, rtfKey[RtfIdx].rtfKStr);
if Parser.rtfParam <> rtfNoParam then
Write(FFileVar, IntToStr(Parser.rtfParam));
if rtfKey[RtfIdx].rtfKStr <> '*' then
Write(FFileVar, ' ');
Exit;
end;
Inc(RtfIdx);
end;
end; {TRtfDoc.DoCtrl}
procedure TRtfDoc.DoText;
var
AChar : Char;
begin
{rtfMajor contains the character ASCII code,
so just output it for now, preceded by \
if special char.}
AChar := Chr(Parser.rtfMajor);
case AChar of
'\' : Write(FFileVar, '\\');
'{' : Write(FFileVar, '\{');
'}' : Write(FFileVar, '\}');
else
begin
if AChar > #127 then {8-bit ANSI character?}
Write(FFileVar, '\''' + IntToHex(Ord(AChar), 2)) {Encode using 7-bit chars}
else {7-bit ANSI character}
Write(FFileVar, AChar);
end;
end;
end; {TRtfDoc.DoText}
{$IFDEF FPC}
procedure TRtfDoc.HandleError(s : ShortString);
begin
WriteLn(StdErr, s);
end;
{$ELSE} {Delphi}
procedure TRtfDoc.HandleError(s : string);
begin
WriteLn(ErrOutput, S);
end;
{$ENDIF}
end.

45
components/xdev_toolkit/TestRtfDoc.pas Normal file
View File

@ -0,0 +1,45 @@
program TestRtfDoc;
{
Test program for RtfDoc unit.
}
uses
SysUtils,
RtfPars, {Free Pascal unit with TRtfParser class and rtf constants}
RtfDoc; {Descendant class used in this program}
begin
with TRtfDoc.Create do {Create TRtfDoc object}
begin
try
try
Start('test.rtf'); {Create RTF file}
except
on EInOutError do {File read-only or some other I/O error}
begin
WriteLn('Can''t create file');
Exit;
end;
end;
OutDefaultFontTable(2); {Select font 2 (Arial) as default}
OutCtrl(rtfParAttr, rtfQuadCenter, rtfNoParam); {Center line}
OutCtrl(rtfCharAttr, rtfBold, 1); {Turn on bolding}
OutText('Hello'); {Output some text}
OutCtrl(rtfCharAttr, rtfBold, 0); {Turn off bolding}
OutText(' there!'); {Output some more text}
OutCtrl(rtfSpecialChar, rtfPar, rtfNoParam); {End of paragraph}
Done; {Close RTF file}
finally
Free; {Free TRtfDoc object}
end;
end;
end.

391
components/xdev_toolkit/ViewDoc.pas Normal file
View File

@ -0,0 +1,391 @@
unit ViewDoc;
{
Unit of functions for viewing documents with a word processor.
Author: Phil Hess.
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
License: Modified LGPL. This means you can link your code to this
compiled unit (statically in a standalone executable or
dynamically in a library) without releasing your code. Only
changes to this unit need to be made publicly available.
}
interface
uses
SysUtils,
Classes,
{$IFDEF MSWINDOWS}
Windows,
Registry,
ShellApi;
{$ENDIF}
{$IFDEF DARWIN} {OS X}
BaseUnix,
Unix;
{$ENDIF}
{$IFDEF LINUX}
FileUtil,
Unix;
{$ENDIF}
type
TViewerOptions = set of (ovwUseAsTemplate, ovwAddToDeleteList);
function GetViewerCount : Integer;
function GetViewerName(Viewer : Integer) : string;
function ViewDocument(const FileName : string;
Viewer : Integer;
Options : TViewerOptions;
var ErrorMsg : string) : Boolean;
function DeleteViewedDocs : Boolean;
implementation
const
{$IFDEF MSWINDOWS}
MaxViewers = 3; {Number of supported word processors}
{Names of word processors}
ViewerName : array [1..MaxViewers] of string =
('Microsoft Word',
'OpenOffice',
'AbiWord');
{Executable files}
ViewerExe : array [1..MaxViewers] of string =
('WINWORD.EXE',
'SOFFICE.EXE',
'AbiWord.exe');
{Command line startup switches.
If non-blank, start word processor with a new document
based on the specified template. If blank, open document
read-only to force user to save under different name.}
ViewerSwitch : array [1..MaxViewers] of string =
('/t',
'-n ',
'');
ViewerRegKey : array [1..MaxViewers] of string =
('',
'',
'SOFTWARE\Classes\AbiSuite.AbiWord\shell\open\command');
{$ENDIF}
{$IFDEF DARWIN} {OS X}
MaxViewers = 4;
ViewerName : array [1..MaxViewers] of string =
('Microsoft Word',
'Pages',
'NeoOffice',
'AbiWord');
{OS X Open command doesn't support passing switches to app}
ViewerSwitch : array [1..MaxViewers] of string =
('',
'',
'',
'');
MaxViewerFolders = 7;
ViewerFolders : array [1..MaxViewerFolders] of string =
('Microsoft Word',
'Microsoft Office 2004/Microsoft Word',
'Microsoft Office X/Microsoft Word',
'Pages.app',
'iWork ''06/Pages.app',
'NeoOffice.app',
'AbiWord.app');
{$ENDIF}
{$IFDEF LINUX}
MaxViewers = 2;
ViewerName : array [1..MaxViewers] of string =
('OpenOffice',
'AbiWord');
ViewerExe : array [1..MaxViewers] of string =
('soffice.bin',
'abiword');
ViewerSwitch : array [1..MaxViewers] of string =
('-n ',
'');
{$ENDIF}
var
DeleteList : TStringList; {List of files to delete when program exits;
object is created and destroyed in unit's
initialization and finalization sections}
function GetViewerCount : Integer;
{Return number of viewers defined.}
begin
Result := MaxViewers;
end;
function GetViewerName(Viewer : Integer) : string;
{Return viewer's name.}
begin
Result := ViewerName[Viewer];
end;
function LocateViewer(Viewer : Integer) : string;
{Return path to viewer's executable file,
or blank string if can't locate viewer.}
{$IFDEF MSWINDOWS}
var
Reg : TRegistry;
begin
Result := '';
{With Windows, installed programs usually have Registry entries
under the App Paths section, including complete path to program.}
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if ViewerRegKey[Viewer] = '' then
begin
if Reg.OpenKeyReadOnly(
'\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\' +
ViewerExe[Viewer]) then
begin {Found key, so assume program is installed}
try
if Reg.ReadString('') <> '' then {Key has (Default) registry entry?}
Result := Reg.ReadString('');
except {Trap exception if registry entry does not contain a string}
end;
end;
end
else {Non-standard registry key}
begin
if Reg.OpenKeyReadOnly(ViewerRegKey[Viewer]) then
begin {Found key, so assume program is installed}
try
if Reg.ReadString('') <> '' then {Key as (Default) registry entry?}
begin
Result := Reg.ReadString('');
if Copy(Result, 1, 1) = '"' then {Strip first quoted item?}
Result := Copy(Result, 2, Pos('"', Copy(Result, 2, MaxInt))-1);
end;
except
end;
end;
end;
finally
Reg.Free;
end;
{$ENDIF}
{$IFDEF DARWIN} //TODO: Search for app like OS X LaunchServices does.
var
FolderIdx : Integer;
LocIdx : Integer;
PathPrefix : string;
begin
Result := '';
FolderIdx := 0;
while (FolderIdx < MaxViewerFolders) and (Result = '') do
begin
Inc(FolderIdx);
if Pos(LowerCase(ViewerName[Viewer]),
LowerCase(ViewerFolders[FolderIdx])) > 0 then
begin
LocIdx := 0;
while (LocIdx < 4) and (Result = '') do
begin
Inc(LocIdx);
case LocIdx of
1 : PathPrefix := '/Applications/';
2 : PathPrefix := '~/Applications/';
3 : PathPrefix := '~/Desktop/';
4 : PathPrefix := '~/'
end;
if FileExists(PathPrefix + ViewerFolders[FolderIdx]) then
Result := PathPrefix + ViewerFolders[FolderIdx];
end;
end;
end;
{$ENDIF}
{$IFDEF LINUX}
begin
{Search path for specified file name, returning its
expanded file name that includes path to it.}
Result := SearchFileInPath(
ViewerExe[Viewer], '', GetEnvironmentVariable('PATH'),
PathSeparator, [sffDontSearchInBasePath]);
{$ENDIF}
end; {LocateViewer}
function LaunchViewer(const ProgPath : string;
const Params : string;
const DefaultDir : string) : Integer;
{Start viewer program with specified command line parameters
by shelling to it, returning shell's code.}
{$IFDEF MSWINDOWS}
var
ProgPathBuf : array [0..MAX_PATH] of Char;
ParamsBuf : array [0..MAX_PATH] of Char;
DefaultDirBuf : array [0..MAX_PATH] of Char;
begin
StrPCopy(ProgPathBuf, ProgPath);
StrPCopy(ParamsBuf, Params);
StrPCopy(DefaultDirBuf, DefaultDir);
Result := ShellExecute(0, nil, ProgPathBuf, ParamsBuf, DefaultDirBuf,
SW_SHOWNORMAL);
{$ENDIF}
{$IFDEF DARWIN}
begin
Result := Shell('Open -a ' + ProgPath + ' ' + Params);
{$ENDIF}
{$IFDEF LINUX}
begin
Result := Shell(ProgPath + ' ' + Params);
{$ENDIF}
end; {LaunchViewer}
function ViewDocument(const FileName : string;
Viewer : Integer;
Options : TViewerOptions;
var ErrorMsg : string) : Boolean;
{View FileName with Viewer. If successful, return True; if
error, return False and error message in ErrorMsg.}
var
ProgPath : string;
Switches : string;
ShellStatus : Integer;
{$IFDEF DARWIN}
FileInfo : Stat;
{$ENDIF}
begin
Result := False;
ErrorMsg := 'Unexpected error';
if not FileExists(FileName) then
begin
ErrorMsg := 'File does not exist.';
Exit;
end;
if ovwAddToDeleteList in Options then
DeleteList.Add(FileName);
if Viewer = 0 then {Use first word processor found?}
begin
ProgPath := '';
while (Viewer < MaxViewers) and (ProgPath = '') do
begin
Inc(Viewer);
ProgPath := LocateViewer(Viewer);
end;
if ProgPath = '' then
begin
ErrorMsg := 'Unable to locate a word processor.';
Exit;
end;
end
else {Use specified word processor}
begin
ProgPath := LocateViewer(Viewer);
if ProgPath = '' then
begin
ErrorMsg := ViewerName[Viewer] + ' does not appear to be installed.';
Exit;
end;
end;
Switches := '';
if ovwUseAsTemplate in Options then
begin
Switches := ViewerSwitch[Viewer];
if Switches = '' then {No "template" switch to pass?}
{Set file read-only so user has to save under different name}
{$IFDEF MSWINDOWS}
FileSetAttr(FileName, faReadOnly);
{$ELSE} {OS X and Linux}
begin
FpStat(FileName, FileInfo);
FpChmod(FileName, FileInfo.st_mode and ($FFFF XOR S_IWUSR));
end;
{$ENDIF}
end;
ShellStatus := LaunchViewer('"' + ProgPath + '"',
Switches + '"' + FileName + '"', '');
{$IFDEF MSWINDOWS}
if ShellStatus <= 32 then {Windows shell error?}
{$ELSE}
if ShellStatus = 127 then {Unix shell error?}
{$ENDIF}
begin
ErrorMsg := 'Shell error ' + IntToStr(ShellStatus) +
' attempting to start ' + ViewerName[Viewer] + '.';
Exit;
end;
ErrorMsg := '';
Result := True;
end; {ViewDocument}
function DeleteViewedDocs : Boolean;
{Attempt to delete documents in deletion list, returning
True if all documents deleted or False if unable to
delete all documents.}
var
DocNum : Integer;
{$IFDEF DARWIN}
FileInfo : Stat;
{$ENDIF}
begin
Result := True;
for DocNum := DeleteList.Count - 1 downto 0 do
begin
if FileExists(DeleteList.Strings[DocNum]) then
begin
{$IFDEF MSWINDOWS}
if (FileGetAttr(DeleteList.Strings[DocNum]) and faReadOnly) <> 0 then
FileSetAttr(DeleteList.Strings[DocNum],
FileGetAttr(DeleteList.Strings[DocNum]) - faReadOnly);
{$ELSE} {OS X and Linux}
FpStat(DeleteList.Strings[DocNum], FileInfo);
if (FileInfo.st_Mode or S_IWUSR) = 0 then {File read-only?}
FpChmod(DeleteList.Strings[DocNum], FileInfo.st_Mode or S_IWUSR);
{$ENDIF}
if SysUtils.DeleteFile(DeleteList.Strings[DocNum]) then
DeleteList.Delete(DocNum)
else
Result := False; {At least one doc not deleted}
end;
end; {for DocNum}
end; {DeleteViewedDocs}
initialization
DeleteList := TStringList.Create;
finalization
DeleteViewedDocs;
DeleteList.Free;
end.

66
components/xdev_toolkit/ViewWith.pas Normal file
View File

@ -0,0 +1,66 @@
program ViewWith;
{
Test program for ViewDoc unit.
}
uses
SysUtils,
ViewDoc;
var
VwrIdx : Integer;
Viewer : Integer;
Options : TViewerOptions;
InStr : string;
ErrorMsg : string;
Done : Boolean;
begin
if ParamCount < 2 then
begin
WriteLn('Usage: ViewWith viewername docfilename [-t] [-d]');
Exit;
end;
Viewer := 0;
for VwrIdx := 1 to GetViewerCount do
begin
if SameText(ParamStr(1), GetViewerName(VwrIdx)) then
Viewer := VwrIdx;
end;
if Viewer = 0 then
WriteLn('Specified viewer not supported - using first viewer found');
Options := [];
if FindCmdLineSwitch('t', ['-'], True) then {Treat file as template?}
Options := Options + [ovwUseAsTemplate];
if FindCmdLineSwitch('d', ['-'], True) then {Delete file before exiting?}
begin
Options := Options + [ovwAddToDeleteList];
Write('File will be deleted when done viewing - is this okay (Y/N)? ');
ReadLn(InStr);
if CompareText(InStr, 'y') <> 0 then
Exit;
end;
if not ViewDocument(ParamStr(2), Viewer, Options, ErrorMsg) then
begin
WriteLn(ErrorMsg);
Exit;
end;
if FindCmdLineSwitch('d', ['-'], True) and FileExists(ParamStr(2)) then
begin
repeat
Write('Press Enter when ready to delete file (or Ctrl+C to exit): ');
ReadLn(InStr);
Done := DeleteViewedDocs;
if not Done then
WriteLn(' Unable to delete file - may still be open in viewer');
until Done;
end;
end.

286
components/xdev_toolkit/XDevStatus.html Normal file
View File

@ -0,0 +1,286 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<!--Copyright 2007 Phil Hess-->
<HTML>
<HEAD>
<TITLE>Status of XDev Toolkit</TITLE>
<META NAME="AUTHOR" CONTENT="Phil Hess">
</HEAD>
<BODY>
<CENTER>
<H1>Status of XDev Toolkit</H1>
</CENTER>
<HR>
<H3>Contents</H3>
<A HREF="#Introduction">Introduction</A><BR>
<A HREF="#Installation">Installation</A><BR>
<A HREF="#CodeConverters">MakePasX & DfmToLfm: Delphi converters</A><BR>
<A HREF="#VersionInfo">MakeVer: Create a version info file</A><BR>
<A HREF="#HelpConverter">CvtHelp & HelpUtil: Convert WinHelp RTF to HTML</A><BR>
<A HREF="#OSXscripts">OS X scripts: Create an app bundle</A><BR>
<A HREF="#RTF">RtfDoc & ViewDoc: RTF document creation and viewing</A><BR>
<A HREF="#To_Do">To Do</A><BR>
<A HREF="#Other_Resources">Other Resources</A><P>
<HR>
<A name="Introduction"></A><H3>Introduction</H3>
These notes describe the status of the XDev Toolkit, a set of utilities for
cross-platform development with <A HREF="http://www.lazarus.freepascal.org">Lazarus</A>
and <A HREF="http://www.freepascal.org">Free Pascal</A>. Please send your bug
reports, suggestions and comments to:<P>
&nbsp;&nbsp;MacPgmr (at) fastermac (dot) net<P>
<I>Note:</I> You can also post to the Lazarus forum if you want your bug reports
and suggestions to be seen by the entire Lazarus community.<P>
The XDev Toolkit source code is here: <A HREF="http://web.fastermac.net/~MacPgmr/XDev/downloads">http://web.fastermac.net/~MacPgmr/XDev/downloads</A><P>
All source code included in the XDev Toolkit is released under the Modified LGPL license.
<HR>
<A name="Installation"></A><H3>Installation</H3>
<OL>
<LI>Unzip the source files into their own folder.<P>
<LI>Open a terminal window and compile each utility and test program with FPC.
For example:<P>
fpc -Sd DfmToLfm.pas
<LI>To see a utility's syntax, simply run it in a terminal window
without any parameters or switches. For example:<P>
dfmtolfm
</OL>
<HR>
<A name="CodeConverters"></A><H3>MakePasX & DfmToLfm: Delphi converters</H3>
These two utilities are provided for converting Delphi projects to Lazarus
and optionally maintaining the project's forms on both Delphi and Lazarus.
The MakePasX utility is used to make Delphi code files cross-platform (.dpr
and .pas). The DfmToLfm utility is used to create Lazarus form design files
(.lfm) from Delphi form design files (.dfm).<p>
Once you've converted a Delphi app to Lazarus you can continue to
develop the app with Delphi on Windows and use Lazarus to compile
the app on other platforms. This type of app can provide the best of both
worlds: taking advantage of the Windows-specific features of Delphi while
utilizing Free Pascal and Lazarus to add cross-platform capability to the app.
<OL>
<LI>Use the MakePasX utility to make the Delphi project file (.dpr) and form
code files (.pas) cross-platform. This is a one-time conversion that results
in a set of source files that can be compiled by both Delphi and Lazarus.<P>
<LI>Use the DfmToLfm utility to create Lazarus form files (.lfm) from the Delphi
form files (.dfm).<P>
<LI>Use the Lazarus lazres utility to create the Lazarus resource file (.lrs)
from the form file (.lfm) Repeat steps 2 and 3 whenever you make changes
to the Delphi form files. If your project has a number of forms, run these
utilities for each form in a batch or shell file to automate the conversion.<P>
<LI>Compile the resulting files with Lazarus on Windows
to test the converted code and form files.<P>
<LI>Move the Lazarus project's files over to OS X or Linux and compile and
test them there with that platform's version of Lazarus.
</OL>
<HR>
<A name="VersionInfo"></A><H3>MakeVer: Create a version info file</H3>
This simple utility extracts version information from a Delphi .dof file and
creates an INI-style .version file that can be distributed with a Lazarus app.<BR><BR>
<HR>
<A name="HelpConverter"></A><H3>CvtHelp & HelpUtil: Convert WinHelp RTF to HTML</H3>
The CvtHelp utility can be used to convert a WinHelp RTF help file
to an HTML file that can be used in a Lazarus app that uses the HelpUtil unit.
<OL>
<LI>Use Word to save the WinHelp RTF file to a "Web Page, Filtered" HTML file.
For example, open myapp.rtf and save it as myapp.htm.<P>
<LI>Run CvtHelp on the resulting HTML file and the WinHelp help project (.hpj)
file. For example:<P>
cvthelp myapp.htm myapp.html
<LI>Add the HelpUtil unit to the uses section of your Lazarus app's main form.<P>
<LI>In your main form's FormCreate handler:<P>
Application.HelpFile := ChangeFileExt(ParamStr(0), '.html');<P>
HelpManager := THelpUtilManager.Create;
<LI>In your main form's FormDestroy handler:<P>
HelpManager.Free;
<LI>To invoke help, add something like this to a menu command or button OnClick
handler:<P>
Application.HelpContext(1);
</OL>
For more information, refer to the CvtHelp and HelpUtil source code.<BR><BR>
<HR>
<A name="OSXscripts"></A><H3>OS X scripts: Create an app bundle</H3>
This script (create_app_mac.sh) creates an .app bundle (folder) for an executable
created with Lazarus and its Carbon widgetset so you can double-click the app
to start it or drag and drop the app on the dock.<P>
<UL>
<LI>Before using this script, make sure you've made it executable:<P>
chmod +x create_app_mac.sh<P>
<LI>Example: Your executable is file myapp and you want to create an .app bundle
for it named My Application.app:<P>
./create_app_mac.sh myapp "My Application"<P>
</UL>
For more information or to customize this script for a specific app,
open it in a text editor and read the comments.<P>
<HR>
<A name="RTF"></A><H3>RtfDoc & ViewDoc: RTF document creation and viewing</H3>
With Delphi, you can use a TRichEdit control to create, display and allow the
user to edit simple documents in Rich Text Format (RTF). TRichEdit is a wrapper
around the Windows RICHED32.DLL library that's also used by Windows WordPad
to create and edit RTF files. RTF is a well-documented text format that's
fully supported by Microsoft Word and OpenOffice.org.<P>
TRichEdit is a handy control for creating or displaying simple reports,
but if you try to use it for more than that you will be quickly disappointed
because TRichEdit has serious limitations. For one thing, Borland never added
support to TRichEdit for newer versions of the Rich Edit library (RICHED20.DLL).
And although it's possible to hack the Delphi ComCtrls unit to add support
for RICHED20.DLL, Microsoft never fixed some of the bugs in this library
or supported more than just a subset of RTF.<P>
Since Lazarus is a cross-platform tool, it doesn't provide a TRichEdit control.
And even if it did, this type of control might not meet your needs. After all,
TRichEdit is trying to be a word processor, something the creators of Word
and OpenOffice.org have spent many years developing. Wouldn't it make more
sense just to use an actual word processor to create and display reports?
<H4>Using TRtfParser to create RTF documents</H4>
With Windows, the easiest way to control a word processor externally from
another program is to start the Word or OpenOffice.org Automation server
and use the server to create, manipulate and display documents. But this
is a Windows-only solution; OS X and Linux don't have an equivalent to
Windows Automation.<P>
Fortunately Free Pascal includes a unit named RtfPars that includes the
TRtfParser class. While this class was designed to parse and proof existing
RTF documents, you can also run it "backwards" to create RTF documents as well.<P>
To simplify use of the TRtfParser class, the XDev Toolkit includes unit RtfDoc,
which introduces a TRtfParser descendant, TRtfDoc, which can be used
to create RTF files without knowing how TRtfParser works. For information
on how to use it, look at the RtfDoc.pas file and TestRtfDoc.pas example
program. You'll also want to look at the Free Pascal rtfdata.inc file for
a list of constants that you'll need to use with TRtfDoc.<P>
For more information on the RTF specification, refer to Microsoft's documentation.<P>
<H4>Using Word and OpenOffice.org to display RTF documents</H4>
Assuming you can create your RTF report document as described in the previous
section, you now need a way to display it with a word processor. With Windows,
you would probably start the Word or OpenOffice.org Automation server, load
the report document, then make the program visible so the user can browse,
edit, print or save the report. To do this in a cross-platform way, you can
instead shell to the word processor and pass the report file name on the
command line. Here are the steps:
<UL>
<LI>Determine that the word processor exists and the location of its executable.
<LI>Start the word processor by shelling to it, passing it the name of the RTF
report document.
<LI>Clean up.
</UL>
The XDev Toolkit includes unit ViewDoc, which takes care of most of the details.
The first two steps are handled by its ViewDocument function, to which you pass
the document name and which word processor to use (Word or OO) and let it
determine the word processor's location and launch it. The clean-up step is
handled by the unit's DeleteViewedDocs function. For more information on how
to use these functions, look at file ViewDoc.pas and ViewWith.pas, a test
program that uses the ViewDoc unit.<P>
Why would you need to clean up after launching the word processor? Usually
this step is necessary because the report document will be a temporary file
that you'll want to delete. You probably shouldn't require your users to name
each report document that your program creates. This will quickly annoy them;
it also forces your users to clean up the clutter of saved report documents.
Instead, you should use the GetTempFilename function (in the Lazarus FileUtil
unit) to get a file name to use for your temporary file, then delete this file
yourself at some point after launching the word processor. (Don't use the same
file name for all reports since this will restrict your users to viewing only
one report at a time.)<P>
But how can you delete a file if it's open in another program? Remember, your
word processor is running externally to your program and locks the file as
long as it's open. The file and the word processor won't be closed until the
user decides to close them. And even if the file has already been closed,
are you sure you want to delete it? What if your user made changes to the
report and saved it?<P>
The solution that ViewDocument uses is to start the word processor with
a switch that tells it to create a new document based on the report file
(that is, using it as a template). ViewDocument can also add the report file
to a list of temporary files to be deleted when your program shuts down. Even
though your program still can't delete the temporary file as long as the new
document based on it is open in the word processor, this does mean that if
the user saves the new document, it won't be with the report file's name.<P>
To delete the temporary files created by your program, call the DeleteViewedDocs
function in your main form's FormCloseQuery handler. If DeleteViewedDocs
returns False, you can remind your user to save or close any reports still
open in the word processor. DeleteViewedDocs is also called by the ViewDoc
unit's finalization code to clean up whatever it can when the program finally
does shut down.<P>
One final note: With OS X, the normal way to start a program from a terminal
command line or when shelling is to use the Open command. Unfortunately, the
only parameter that Open passes along to the program is the name of the file
to open, so there's no way to pass any switches to Word or NeoOffice. With OS X,
ViewDocument instead sets the temporary report file to read-only, thus forcing
the user to use a different name when saving the report. A disadvantage of this
approach is that the word processor shows the name of the temporary file in
the title bar (for example, rpt1.tmp) rather than Document1 or Untitled1 as it
normally does with a new document. ViewDocument also uses this approach with
AbiWord, which doesn't appear to support a command line template switch.
<HR>
<A name="To_Do"></A><H3>To Do</H3>
<OL>
<LI>Generalize MakeVer so it can use a Delphi .bdsproj file as input and
also be able to output version information to a Lazarus .lpi file.<P>
<LI>Review Free Pascal's rtfdata.inc file for additional bugs.
</OL>
<HR>
<A name="Other_Resources"></A><H3>Other Resources</H3>
<A HREF="http://wiki.lazarus.freepascal.org/The_Power_of_Proper_Planning_and_Practices">http://wiki.lazarus.freepascal.org/The_Power_of_Proper_Planning_and_Practices</A><P>
<A HREF="http://wiki.lazarus.freepascal.org/Multiplatform_Programming_Guide">http://wiki.lazarus.freepascal.org/Multiplatform_Programming_Guide</A><P>
<A HREF="http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips">http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips</A><P>
<A HREF="http://wiki.lazarus.freepascal.org/Deploying_Your_Application">http://wiki.lazarus.freepascal.org/Deploying_Your_Application</A><P>
<P>
<HR>
Last updated: April 15, 2007
<P>
</BODY>
</HTML>

83
components/xdev_toolkit/create_app_mac.sh Executable file
View File

@ -0,0 +1,83 @@
#!/bin/sh
# Force Bourne shell in case tcsh is default.
#
# Author: Phil Hess
# Revisions: 2007-03-17 - initial release.
# 2007-04-09 - added support for .icns file.
#
exename=$1
appname=$2
if [ "$appname" = "" ]
then
appname=$exename
fi
appfolder=$appname.app
plistfile=$appfolder/Contents/Info.plist
#
if [ "$exename" = "" ]
then
echo "Usage: $0 executable_file [app_name]"
echo "Creates .app bundle (folder) for specified executable file"
elif ! [ -e $exename ]
then
echo "$exename does not exist"
elif [ -e "$appfolder" ]
then
echo "$appfolder already exists"
else
echo "Creating $appfolder..."
mkdir "$appfolder"
mkdir "$appfolder/Contents"
mkdir "$appfolder/Contents/MacOS"
mkdir "$appfolder/Contents/Resources"
#
# Instead of copying executable into .app folder after each compile,
# simply create a symbolic link to executable.
# Tip: When you're ready to distribute your .app, delete the link
# and copy the executable into the .app folder.
ln -s ../../../$exename "$appfolder/Contents/MacOS/$exename"
#
# Create PkgInfo file using first 4 chars of application name.
echo "APPL"${appname:0:4} >$appfolder/Contents/PkgInfo
#
# If it exists, copy icons file with same name.
if [ -e "$exename.icns" ]
then
cp -p $exename.icns "$appfolder/Contents/Resources"
fi
#
# Create information property list file (Info.plist).
# Tip: By customizing this script for a specific app, you can set
# additional properties such as CFBundleGetInfoString for copyright
# info, CFBundleIconFile for name of icon file (.icns) in Resources,
# and CFBundleIdentifier (example: com.myorganization.myapp), as well
# as more precise CFBundleSignature (change PkgInfo file too) and
# CFBundleVersion strings.
echo '<?xml version="1.0" encoding="UTF-8"?>' >$plistfile
echo '<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">' >>$plistfile
echo '<plist version="1.0">' >>$plistfile
echo '<dict>' >>$plistfile
echo ' <key>CFBundleDevelopmentRegion</key>' >>$plistfile
echo ' <string>English</string>' >>$plistfile
echo ' <key>CFBundleExecutable</key>' >>$plistfile
echo ' <string>'$exename'</string>' >>$plistfile
if [ -e "$exename.icns" ]
then
echo ' <key>CFBundleIconFile</key>' >>$plistfile
echo ' <string>'$exename'.icns</string>' >>$plistfile
fi
echo ' <key>CFBundleInfoDictionaryVersion</key>' >>$plistfile
echo ' <string>6.0</string>' >>$plistfile
echo ' <key>CFBundleName</key>' >>$plistfile
echo ' <string>'$appname'</string>' >>$plistfile
echo ' <key>CFBundlePackageType</key>' >>$plistfile
echo ' <string>APPL</string>' >>$plistfile
echo ' <key>CFBundleSignature</key>' >>$plistfile
echo ' <string>'${appname:0:4}'</string>' >>$plistfile
echo ' <key>CFBundleVersion</key>' >>$plistfile
echo ' <string>1.0</string>' >>$plistfile
echo ' <key>CSResourcesFileMapped</key>' >>$plistfile
echo ' <true/>' >>$plistfile
echo '</dict>' >>$plistfile
echo '</plist>' >>$plistfile
fi