paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 11:16:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

Chmmaker: Improved filename handling. Patch by David Mizzell, issue #41634.

Browse Source
This commit is contained in:
Maxim Ganetsky 2025-05-14 16:27:56 +03:00
parent 95c0189acd
commit 8001f45c6a
4 changed files with 212 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
tools/chmmaker/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
/chmmaker

11
tools/chmmaker/chmmaker.lpi
View File

@ -17,16 +17,9 @@
<Version Value="2"/> <Version Value="2"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local>
<LaunchingApplication PathPlusParams=""/>
</local>
<FormatVersion Value="2"/> <FormatVersion Value="2"/>
<Modes Count="1"> <Modes Count="1">
<Mode0 Name="default"> <Mode0 Name="default"/>
<local>
<LaunchingApplication PathPlusParams=""/>
</local>
</Mode0>
</Modes> </Modes>
</RunParams> </RunParams>
<RequiredPackages Count="3"> <RequiredPackages Count="3">
@ -79,7 +72,7 @@
</Parsing> </Parsing>
<Linking> <Linking>
<Debugging> <Debugging>
<DebugInfoType Value="dsStabs"/> <DebugInfoType Value="dsDwarf3"/>
</Debugging> </Debugging>
<Options> <Options>
<Win32> <Win32>

294
tools/chmmaker/unit1.lfm
View File

@ -1,302 +1,305 @@
object CHMForm: TCHMForm object CHMForm: TCHMForm
Left = 269 Left = 371
Height = 511 Height = 639
Top = 217 Top = 200
Width = 611 Width = 764
HorzScrollBar.Page = 595 HorzScrollBar.Page = 741
VertScrollBar.Page = 427 VertScrollBar.Page = 534
ActiveControl = FileListBox ActiveControl = FileListBox
AutoScroll = True AutoScroll = True
Caption = 'Compiled HTML Help Project - [Made with Freepascal]' Caption = 'Compiled HTML Help Project - [Made with Freepascal]'
ClientHeight = 491 ClientHeight = 639
ClientWidth = 611 ClientWidth = 764
DesignTimePPI = 120
Menu = MainMenu1 Menu = MainMenu1
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '1.5' LCLVersion = '3.2.0.0'
object StatusBar1: TStatusBar object StatusBar1: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 29
Top = 468 Top = 610
Width = 611 Width = 764
Panels = <> Panels = <>
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 0 Left = 0
Height = 468 Height = 610
Top = 0 Top = 0
Width = 268 Width = 335
Align = alLeft Align = alLeft
Caption = 'Files' Caption = 'Files'
ClientHeight = 448 ClientHeight = 585
ClientWidth = 264 ClientWidth = 331
TabOrder = 0 TabOrder = 0
object FileListBox: TListBox object FileListBox: TListBox
Left = 0 Left = 0
Height = 314 Height = 417
Top = 0 Top = 0
Width = 264 Width = 331
Align = alClient Align = alClient
ItemHeight = 0 ItemHeight = 0
OnDrawItem = FileListBoxDrawItem
ScrollWidth = 262 ScrollWidth = 262
Sorted = True Sorted = True
Style = lbOwnerDrawFixed Style = lbOwnerDrawFixed
TabOrder = 0 TabOrder = 0
OnDrawItem = FileListBoxDrawItem
end end
object Panel2: TPanel object Panel2: TPanel
Left = 0 Left = 0
Height = 134 Height = 168
Top = 314 Top = 417
Width = 264 Width = 331
Align = alBottom Align = alBottom
ClientHeight = 134 ClientHeight = 168
ClientWidth = 264 ClientWidth = 331
TabOrder = 1 TabOrder = 1
object FilesNoteLabel: TLabel object FilesNoteLabel: TLabel
Left = 16 Left = 20
Height = 48 Height = 60
Top = 85 Top = 107
Width = 232 Width = 291
Align = alBottom Align = alBottom
AutoSize = False AutoSize = False
BorderSpacing.Left = 15 BorderSpacing.Left = 19
BorderSpacing.Right = 15 BorderSpacing.Right = 19
Caption = 'All files must be in the project file directory or a subdirectory.' Caption = 'All files must be in the project file directory or a subdirectory.'
ParentColor = False ParentColor = False
WordWrap = True WordWrap = True
end end
object AddFilesBtn: TButton object AddFilesBtn: TButton
Left = 11 Left = 14
Height = 25 Height = 31
Top = 3 Top = 4
Width = 81 Width = 101
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 5
Caption = 'Add Files' Caption = 'Add Files'
OnClick = AddFilesBtnClick
TabOrder = 0 TabOrder = 0
OnClick = AddFilesBtnClick
end end
object RemoveFilesBtn: TButton object RemoveFilesBtn: TButton
Left = 94 Left = 118
Height = 25 Height = 31
Top = 3 Top = 4
Width = 156 Width = 195
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 5
Caption = 'Remove Selected' Caption = 'Remove Selected'
OnClick = RemoveFilesBtnClick
TabOrder = 1 TabOrder = 1
OnClick = RemoveFilesBtnClick
end end
object AutoAddLinksBtn: TButton object AutoAddLinksBtn: TButton
Left = 11 Left = 14
Height = 25 Height = 31
Top = 59 Top = 74
Width = 239 Width = 299
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 5
Caption = 'Auto add HREF files' Caption = 'Auto add HREF files'
Enabled = False Enabled = False
OnClick = AutoAddLinksBtnClick
TabOrder = 2 TabOrder = 2
OnClick = AutoAddLinksBtnClick
end end
object AddAllBtn: TButton object AddAllBtn: TButton
Left = 11 Left = 14
Height = 25 Height = 31
Top = 32 Top = 40
Width = 239 Width = 299
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 5
Caption = 'Add all files in Project Directory' Caption = 'Add all files in Project Directory'
OnClick = AddAllBtnClick
TabOrder = 3 TabOrder = 3
OnClick = AddAllBtnClick
end end
end end
end end
object MainPanel: TPanel object MainPanel: TPanel
Left = 268 Left = 335
Height = 468 Height = 610
Top = 0 Top = 0
Width = 343 Width = 429
Align = alClient Align = alClient
ClientHeight = 468 ClientHeight = 610
ClientWidth = 343 ClientWidth = 429
TabOrder = 1 TabOrder = 1
object TableOfContentsLabel: TLabel object TableOfContentsLabel: TLabel
Left = 11 Left = 14
Height = 15 Height = 20
Top = 11 Top = 14
Width = 133 Width = 161
Caption = 'Table of Contents (*.hhc)' Caption = 'Table of Contents (*.hhc)'
ParentColor = False ParentColor = False
end end
object IndexLabel: TLabel object IndexLabel: TLabel
Left = 11 Left = 14
Height = 15 Height = 20
Top = 59 Top = 74
Width = 67 Width = 82
Caption = 'Index (*.hhk)' Caption = 'Index (*.hhk)'
ParentColor = False ParentColor = False
end end
object CompileTimeOptionsLabel: TLabel object CompileTimeOptionsLabel: TLabel
Left = 11 Left = 14
Height = 15 Height = 20
Top = 219 Top = 274
Width = 118 Width = 147
Caption = 'Compile time options:' Caption = 'Compile time options:'
ParentColor = False ParentColor = False
end end
object DefaultPageLabel: TLabel object DefaultPageLabel: TLabel
Left = 11 Left = 14
Height = 15 Height = 20
Top = 108 Top = 135
Width = 67 Width = 85
Caption = 'Default Page' Caption = 'Default Page'
ParentColor = False ParentColor = False
end end
object CHMFilenameLabel: TLabel object CHMFilenameLabel: TLabel
Left = 12 Left = 15
Height = 15 Height = 20
Top = 356 Top = 445
Width = 77 Width = 95
Caption = 'CHM filename' Caption = 'CHM filename'
ParentColor = False ParentColor = False
end end
object TOCEdit: TFileNameEdit object TOCEdit: TFileNameEdit
AnchorSideRight.Control = TOCEditBtn AnchorSideRight.Control = TOCEditBtn
Left = 10 Left = 12
Height = 23 Height = 29
Top = 31 Top = 39
Width = 236 Width = 295
OnAcceptFileName = TOCEditAcceptFileName OnAcceptFileName = TOCEditAcceptFileName
DialogOptions = [] DialogOptions = []
Filter = 'Table of Contents Files(*.hhc)|*.hhc|All files|*' Filter = 'Table of Contents Files(*.hhc)|*.hhc|All files|*'
FilterIndex = 0 FilterIndex = 0
HideDirectories = False HideDirectories = False
ButtonWidth = 23 ButtonWidth = 29
NumGlyphs = 1 NumGlyphs = 1
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSelect = False AutoSelect = False
AutoSize = False AutoSize = False
MaxLength = 0 MaxLength = 0
TabOrder = 0 TabOrder = 0
OnEditingDone = TOCEditEditingDone
end end
object IndexEdit: TFileNameEdit object IndexEdit: TFileNameEdit
AnchorSideRight.Control = IndexEditBtn AnchorSideRight.Control = IndexEditBtn
Left = 10 Left = 12
Height = 23 Height = 29
Top = 79 Top = 99
Width = 236 Width = 295
OnAcceptFileName = IndexEditAcceptFileName OnAcceptFileName = IndexEditAcceptFileName
DialogOptions = [] DialogOptions = []
Filter = 'Index Files(*.hhk)|*.hhk|All Files|*' Filter = 'Index Files(*.hhk)|*.hhk|All Files|*'
FilterIndex = 0 FilterIndex = 0
HideDirectories = False HideDirectories = False
ButtonWidth = 23 ButtonWidth = 29
NumGlyphs = 1 NumGlyphs = 1
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSelect = False AutoSelect = False
AutoSize = False AutoSize = False
MaxLength = 0 MaxLength = 0
TabOrder = 1 TabOrder = 1
OnEditingDone = IndexEditEditingDone
end end
object TOCEditBtn: TButton object TOCEditBtn: TButton
AnchorSideTop.Control = TOCEdit AnchorSideTop.Control = TOCEdit
AnchorSideRight.Control = MainPanel AnchorSideRight.Control = MainPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 276 Left = 345
Height = 25 Height = 30
Top = 31 Top = 39
Width = 60 Width = 75
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Left = 30 BorderSpacing.Left = 38
BorderSpacing.Right = 6 BorderSpacing.Right = 8
Caption = 'Edit' Caption = 'Edit'
Constraints.MinWidth = 60 Constraints.MinWidth = 75
OnClick = TOCEditBtnClick
TabOrder = 2 TabOrder = 2
OnClick = TOCEditBtnClick
end end
object IndexEditBtn: TButton object IndexEditBtn: TButton
AnchorSideTop.Control = IndexEdit AnchorSideTop.Control = IndexEdit
AnchorSideRight.Control = MainPanel AnchorSideRight.Control = MainPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 276 Left = 345
Height = 25 Height = 30
Top = 79 Top = 99
Width = 60 Width = 75
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Left = 30 BorderSpacing.Left = 38
BorderSpacing.Right = 6 BorderSpacing.Right = 8
Caption = 'Edit' Caption = 'Edit'
Constraints.MinWidth = 60 Constraints.MinWidth = 75
OnClick = IndexEditBtnClick
TabOrder = 3 TabOrder = 3
OnClick = IndexEditBtnClick
end end
object FollowLinksCheck: TCheckBox object FollowLinksCheck: TCheckBox
Left = 19 Left = 24
Height = 19 Height = 24
Top = 252 Top = 315
Width = 307 Width = 381
Caption = 'Parse *.htm* files to include '#10'linked pages and images' Caption = 'Parse *.htm* files to include '#10'linked pages and images'
Enabled = False Enabled = False
TabOrder = 4 TabOrder = 4
end end
object CreateSearchableCHMCheck: TCheckBox object CreateSearchableCHMCheck: TCheckBox
Left = 19 Left = 24
Height = 19 Height = 24
Hint = 'Only indexes files added to the project'#10'not files automatically added.' Hint = 'Only indexes files added to the project'#10'not files automatically added.'
Top = 304 Top = 380
Width = 149 Width = 183
Caption = 'Create a searchable chm' Caption = 'Create a searchable chm'
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 5 TabOrder = 5
end end
object DefaultPageCombo: TComboBox object DefaultPageCombo: TComboBox
Left = 11 Left = 14
Height = 23 Height = 28
Top = 128 Top = 160
Width = 287 Width = 359
AutoSelect = False AutoSelect = False
ItemHeight = 15 ItemHeight = 20
Style = csDropDownList Style = csDropDownList
TabOrder = 6 TabOrder = 6
end end
object CompileBtn: TButton object CompileBtn: TButton
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = CompileViewBtn AnchorSideRight.Control = CompileViewBtn
Left = 86 Left = 120
Height = 33 Height = 40
Top = 421 Top = 552
Width = 79 Width = 92
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Right = 9 BorderSpacing.Right = 11
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 5
Caption = 'Compile' Caption = 'Compile'
OnClick = CompileBtnClick
TabOrder = 7 TabOrder = 7
OnClick = CompileBtnClick
end end
object CompileViewBtn: TButton object CompileViewBtn: TButton
AnchorSideLeft.Control = CompileBtn AnchorSideLeft.Control = CompileBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
Left = 174 Left = 223
Height = 33 Height = 40
Top = 421 Top = 552
Width = 130 Width = 157
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Right = 13 BorderSpacing.Right = 16
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 5
Caption = 'Compile and View' Caption = 'Compile and View'
OnClick = CompileViewBtnClick
TabOrder = 8 TabOrder = 8
OnClick = CompileViewBtnClick
end end
object ChmFileNameEdit: TFileNameEdit object ChmFileNameEdit: TFileNameEdit
Left = 11 Left = 14
Height = 23 Height = 29
Top = 380 Top = 475
Width = 270 Width = 338
OnAcceptFileName = ChmFileNameEditAcceptFileName OnAcceptFileName = ChmFileNameEditAcceptFileName
DialogKind = dkSave DialogKind = dkSave
DialogTitle = 'Save CHM as...' DialogTitle = 'Save CHM as...'
@ -304,30 +307,31 @@ object CHMForm: TCHMForm
Filter = 'Compressed HTML Help Files|*.chm' Filter = 'Compressed HTML Help Files|*.chm'
FilterIndex = 0 FilterIndex = 0
HideDirectories = False HideDirectories = False
ButtonWidth = 23 ButtonWidth = 29
NumGlyphs = 1 NumGlyphs = 1
AutoSelect = False AutoSelect = False
AutoSize = False AutoSize = False
MaxLength = 0 MaxLength = 0
TabOrder = 9 TabOrder = 9
OnEditingDone = ChmFileNameEditEditingDone
end end
end end
object OpenDialog1: TOpenDialog object OpenDialog1: TOpenDialog
Filter = 'Help File Project(*.hfp)|*.hfp' Filter = 'Help File Project(*.hfp)|*.hfp'
FilterIndex = 0 FilterIndex = 0
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail] Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 10 Left = 13
top = 20 Top = 25
end end
object SaveDialog1: TSaveDialog object SaveDialog1: TSaveDialog
Filter = 'Help File Project(*.hfp)|*.hfp' Filter = 'Help File Project(*.hfp)|*.hfp'
FilterIndex = 0 FilterIndex = 0
left = 40 Left = 50
top = 20 Top = 25
end end
object MainMenu1: TMainMenu object MainMenu1: TMainMenu
left = 75 Left = 94
top = 20 Top = 25
object MenuItem1: TMenuItem object MenuItem1: TMenuItem
Caption = 'Project' Caption = 'Project'
object ProjNewItem: TMenuItem object ProjNewItem: TMenuItem
@ -386,7 +390,7 @@ object CHMForm: TCHMForm
object OpenDialog2: TOpenDialog object OpenDialog2: TOpenDialog
FilterIndex = 0 FilterIndex = 0
Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail] Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail]
left = 12 Left = 15
top = 304 Top = 380
end end
end end

77
tools/chmmaker/unit1.pas
View File

@ -65,6 +65,7 @@ type
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject); procedure Button2Click(Sender: TObject);
procedure ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String); procedure ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String);
procedure ChmFileNameEditEditingDone(Sender: TObject);
procedure CompileBtnClick(Sender: TObject); procedure CompileBtnClick(Sender: TObject);
procedure CompileViewBtnClick(Sender: TObject); procedure CompileViewBtnClick(Sender: TObject);
procedure FileListBoxDrawItem({%H-}Control: TWinControl; Index: Integer; procedure FileListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
@ -74,6 +75,7 @@ type
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure IndexEditAcceptFileName(Sender: TObject; var Value: String); procedure IndexEditAcceptFileName(Sender: TObject; var Value: String);
procedure IndexEditBtnClick(Sender: TObject); procedure IndexEditBtnClick(Sender: TObject);
procedure IndexEditEditingDone(Sender: TObject);
procedure ProjCloseItemClick(Sender: TObject); procedure ProjCloseItemClick(Sender: TObject);
procedure ProjNewItemClick(Sender: TObject); procedure ProjNewItemClick(Sender: TObject);
procedure ProjOpenItemClick(Sender: TObject); procedure ProjOpenItemClick(Sender: TObject);
@ -83,6 +85,7 @@ type
procedure RemoveFilesBtnClick(Sender: TObject); procedure RemoveFilesBtnClick(Sender: TObject);
procedure TOCEditAcceptFileName(Sender: TObject; var Value: String); procedure TOCEditAcceptFileName(Sender: TObject; var Value: String);
procedure TOCEditBtnClick(Sender: TObject); procedure TOCEditBtnClick(Sender: TObject);
procedure TOCEditEditingDone(Sender: TObject);
private private
FModified: Boolean; FModified: Boolean;
procedure AddItems({%H-}AParentItem: TTreeNode; {%H-}ChmItems: TChmSiteMapItems); procedure AddItems({%H-}AParentItem: TTreeNode; {%H-}ChmItems: TChmSiteMapItems);
@ -218,23 +221,36 @@ end;
procedure TCHMForm.ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String); procedure TCHMForm.ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String);
begin begin
Modified := True;
Value := CreateRelativeProjectFile(Value);
if ExtractFileExt(Value) = '' then Value := Value+'.chm'; if ExtractFileExt(Value) = '' then Value := Value+'.chm';
Project.OutputFileName := Value;
end;
procedure TCHMForm.ChmFileNameEditEditingDone(Sender: TObject);
begin
// Normalize filename and store in Project
if (ChmFileNameEdit.FileName = '') then Exit;
if (ExtractFileExt(ChmFileNameEdit.FileName)) = '' then ChmFileNameEdit.FileName := ChmFileNameEdit.FileName + '.chm';
ChmFileNameEdit.FileName := CreateRelativeProjectFile(ChmFileNameEdit.FileName);
Project.OutputFileName := ChmFileNameEdit.FileName;
Modified := True;
end; end;
procedure TCHMForm.CompileBtnClick(Sender: TObject); procedure TCHMForm.CompileBtnClick(Sender: TObject);
var var
OutFile: TFileStream; OutFile: TFileStream;
begin begin
if ChmFileNameEdit.FileName = '' then if (Project.OutputFileName = '') then
begin begin
MessageDlg('You must set a filename for the output CHM file!', mtError, [mbCancel], 0); MessageDlg('You must set a filename for the output CHM file!', mtError, [mbCancel], 0);
Exit; Exit;
end; end;
Save(False); Save(False);
OutFile := TFileStream.Create(Project.OutputFileName, fmCreate or fmOpenWrite); OutFile := TFileStream.Create(CreateAbsoluteProjectFile(Project.OutputFileName), fmCreate or fmOpenWrite);
try try
Project.WriteChm(OutFile); Project.WriteChm(OutFile);
ShowMessage('CHM file '+ChmFileNameEdit.FileName+' was created.'); ShowMessage('CHM file '+Project.OutputFileName+' was created.');
finally finally
OutFile.Free; OutFile.Free;
end; end;
@ -248,7 +264,7 @@ var
Proc: TProcessUTF8; Proc: TProcessUTF8;
ext: String; ext: String;
begin begin
if ChmFileNameEdit.FileName = '' then if Project.OutputFileName = '' then
begin begin
MessageDlg('You must set a filename for the output CHM file!', mtError, [mbCancel], 0); MessageDlg('You must set a filename for the output CHM file!', mtError, [mbCancel], 0);
Exit; Exit;
@ -286,7 +302,7 @@ begin
LHelpConn := TLHelpConnection.Create; LHelpConn := TLHelpConnection.Create;
try try
LHelpConn.StartHelpServer('chmmaker', LHelpName); LHelpConn.StartHelpServer('chmmaker', LHelpName);
LHelpConn.OpenFile(ChmFileNameEdit.FileName); LHelpConn.OpenFile(CreateAbsoluteProjectFile(Project.OutputFileName));
finally finally
LHelpConn.Free; LHelpConn.Free;
end; end;
@ -341,8 +357,8 @@ end;
procedure TCHMForm.IndexEditAcceptFileName(Sender: TObject; var Value: String); procedure TCHMForm.IndexEditAcceptFileName(Sender: TObject; var Value: String);
begin begin
Modified := True; Modified := True;
//Value := ExtractRelativepath(Project.ProjectDir, Value); Value := CreateRelativeProjectFile(Value);
//WriteLn(Value); if ExtractFileExt(Value) = '' then Value := Value + '.hhk';
Project.IndexFileName := Value; Project.IndexFileName := Value;
end; end;
@ -351,12 +367,15 @@ var
Stream: TStream; Stream: TStream;
FileName: String; FileName: String;
begin begin
FileName := IndexEdit.FileName; if (Project.IndexFileName = '') then
if FileName = '' then
begin begin
FileName := Project.ProjectDir+'_index.hhk' Project.IndexFileName := '_index.hhk';
IndexEdit.FileName := Project.IndexFileName;
Modified := True;
end; end;
FileName := CreateAbsoluteProjectFile(Project.IndexFileName);
if FileExists(FileName) then if FileExists(FileName) then
begin begin
Stream := TFileStream.Create(FileName, fmOpenReadWrite); Stream := TFileStream.Create(FileName, fmOpenReadWrite);
@ -367,12 +386,22 @@ begin
end; end;
try try
if SitemapEditForm.Execute(Stream, stIndex, FileListBox.Items) then IndexEdit.FileName := FileName; SitemapEditForm.Execute(Stream, stIndex, FileListBox.Items);
finally finally
Stream.Free; Stream.Free;
end; end;
end; end;
procedure TCHMForm.IndexEditEditingDone(Sender: TObject);
begin
// Normalize filename and store in Project
if (IndexEdit.FileName = '') then Exit;
if (ExtractFileExt(IndexEdit.FileName)) = '' then IndexEdit.FileName := IndexEdit.FileName + '.hhk';
IndexEdit.FileName := CreateRelativeProjectFile(IndexEdit.FileName);
Project.IndexFileName := IndexEdit.FileName;
Modified := True;
end;
procedure TCHMForm.ProjCloseItemClick(Sender: TObject); procedure TCHMForm.ProjCloseItemClick(Sender: TObject);
begin begin
CloseProject; CloseProject;
@ -428,6 +457,8 @@ end;
procedure TCHMForm.TOCEditAcceptFileName(Sender: TObject; var Value: String); procedure TCHMForm.TOCEditAcceptFileName(Sender: TObject; var Value: String);
begin begin
Modified := True; Modified := True;
Value := CreateRelativeProjectFile(Value);
if ExtractFileExt(Value) = '' then Value := Value + '.hhc';
Project.TableOfContentsFileName := Value; Project.TableOfContentsFileName := Value;
end; end;
@ -435,14 +466,16 @@ procedure TCHMForm.TOCEditBtnClick(Sender: TObject);
var var
Stream: TStream; Stream: TStream;
FileName: String; FileName: String;
BDir: String;
begin begin
FileName := TOCEdit.FileName; if (Project.TableOfContentsFileName = '') then
if FileName = '' then
begin begin
FileName := Project.ProjectDir+'_table_of_contents.hhc' Project.TableOfContentsFileName := '_table_of_contents.hhc';
TOCEdit.FileName := Project.TableOfContentsFileName;
Modified := True;
end; end;
FileName := CreateAbsoluteProjectFile(Project.TableOfContentsFileName);
if FileExists(FileName) then if FileExists(FileName) then
begin begin
Stream := TFileStream.Create(FileName, fmOpenReadWrite); Stream := TFileStream.Create(FileName, fmOpenReadWrite);
@ -453,14 +486,22 @@ begin
end; end;
try try
BDir := ExtractFilePath(Project.FileName); SitemapEditForm.Execute(Stream, stTOC, FileListBox.Items);
FileName := ExtractRelativepath(BDir, FileName);
if SitemapEditForm.Execute(Stream, stTOC, FileListBox.Items) then TOCEdit.FileName := FileName;
finally finally
Stream.Free; Stream.Free;
end; end;
end; end;
procedure TCHMForm.TOCEditEditingDone(Sender: TObject);
begin
// Normalize filename and store in Project
if (TOCEdit.FileName = '') then Exit;
if (ExtractFileExt(TOCEdit.FileName)) = '' then TOCEdit.FileName := TOCEdit.FileName + '.hhc';
TOCEdit.FileName := CreateRelativeProjectFile(TOCEdit.FileName);
Project.TableOfContentsFileName := TOCEdit.FileName;
Modified := True;
end;
function TCHMForm.GetModified: Boolean; function TCHMForm.GetModified: Boolean;
begin begin
Result := (Project <> nil) and FModified; Result := (Project <> nil) and FModified;