diff --git a/.gitattributes b/.gitattributes index cf0c1bfe44..a50f21e92c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1193,9 +1193,11 @@ installer/Makefile.fpc svneol=native#text/plain installer/install.dat -text installer/install.def -text installer/install.pas svneol=native#text/plain +installer/insthelp.pas svneol=native#text/plain installer/makelink.pas svneol=native#text/plain installer/scroll.pas svneol=native#text/plain installer/winshell.pas svneol=native#text/plain +installer/writeidx.pas svneol=native#text/plain packages/Makefile svneol=native#text/plain packages/Makefile.fpc svneol=native#text/plain packages/base/Makefile svneol=native#text/plain diff --git a/installer/install.pas b/installer/install.pas index 56a81c8e2e..bbe4c10ffe 100644 --- a/installer/install.pas +++ b/installer/install.pas @@ -90,7 +90,7 @@ program install; unzipdll, {$ENDIF} app,dialogs,views,menus,msgbox,colortxt,tabs,scroll, - WHTMLScn; + WHTMLScn,insthelp; const installerversion='1.0.8'; @@ -450,63 +450,6 @@ program install; GetProgDir := D; end; - function RTrim(const S: string): string; - var - i : longint; - begin - i:=length(s); - while (i>0) and (s[i]=' ') do - dec(i); - RTrim:=Copy(s,1,i); - end; - - function LTrim(const S: string): string; - var - i : longint; - begin - i:=1; - while (iS2 then R:= 1 else - R:=0; - CompareText:=R; - end; - - function ExtOf(const S: string): string; - var D: DirStr; E: ExtStr; N: NameStr; - begin - FSplit(S,D,N,E); - ExtOf:=E; - end; - - function DirAndNameOf(const S: string): string; - var D: DirStr; E: ExtStr; N: NameStr; - begin - FSplit(S,D,N,E); - DirAndNameOf:=D+N; - end; - - function DirOf(const S: string): string; - var D: DirStr; E: ExtStr; N: NameStr; - begin - FSplit(S,D,N,E); - DirOf:=D; - end; - function GetZipErrorInfo(error : longint) : string; var ErrorStr : string; diff --git a/installer/insthelp.pas b/installer/insthelp.pas new file mode 100644 index 0000000000..77149ae6dc --- /dev/null +++ b/installer/insthelp.pas @@ -0,0 +1,91 @@ +{ + Helper routines for installer + + This file is part of the Free Pascal installer. + + Copyright (c) 1993-2005 by Florian Klaempfl + member of the Free Pascal development team + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + 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. + + **********************************************************************} +unit insthelp; + + interface + + function RTrim(const S: string): string; + function LTrim(const S: string): string; + function Trim(const S: string): string; + function CompareText(S1, S2: string): integer; + function ExtOf(const S: string): string; + function DirAndNameOf(const S: string): string; + function DirOf(const S: string): string; + + implementation + + uses + dos; + + function RTrim(const S: string): string; + var + i : longint; + begin + i:=length(s); + while (i>0) and (s[i]=' ') do + dec(i); + RTrim:=Copy(s,1,i); + end; + + function LTrim(const S: string): string; + var + i : longint; + begin + i:=1; + while (iS2 then R:= 1 else + R:=0; + CompareText:=R; + end; + + function ExtOf(const S: string): string; + var D: DirStr; E: ExtStr; N: NameStr; + begin + FSplit(S,D,N,E); + ExtOf:=E; + end; + + function DirAndNameOf(const S: string): string; + var D: DirStr; E: ExtStr; N: NameStr; + begin + FSplit(S,D,N,E); + DirAndNameOf:=D+N; + end; + + function DirOf(const S: string): string; + var D: DirStr; E: ExtStr; N: NameStr; + begin + FSplit(S,D,N,E); + DirOf:=D; + end; + + end. diff --git a/installer/writeidx.pas b/installer/writeidx.pas new file mode 100644 index 0000000000..63434eb922 --- /dev/null +++ b/installer/writeidx.pas @@ -0,0 +1,112 @@ +{ + Help program to generate html help index + + This file is part of Free Pascal. + Copyright (c) 1993-2005 by Florian Klaempfl + member of the Free Pascal development team + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + 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. + + **********************************************************************} +{$mode objfpc} + uses + insthelp,sysutils,dos,objects,WHTMLScn; + + type + PFPHTMLFileLinkScanner = ^TFPHTMLFileLinkScanner; + TFPHTMLFileLinkScanner = object(THTMLFileLinkScanner) + function CheckURL(const URL: string): boolean; virtual; + function CheckText(const Text: string): boolean; virtual; + procedure ProcessDoc(Doc: PHTMLLinkScanFile); virtual; + end; + + + const + HTMLIndexExt = '.htx'; + + + procedure TFPHTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile); + begin + end; + + + function TFPHTMLFileLinkScanner.CheckURL(const URL: string): boolean; + var OK: boolean; + const HTTPPrefix = 'http:'; + FTPPrefix = 'ftp:'; + begin + OK:=inherited CheckURL(URL); + if OK then OK:=DirAndNameOf(URL)<>''; + if OK then OK:=CompareText(copy(ExtOf(URL),1,4),'.HTM')=0; + if OK then OK:=CompareText(copy(URL,1,length(HTTPPrefix)),HTTPPrefix)<>0; + if OK then OK:=CompareText(copy(URL,1,length(FTPPrefix)),FTPPrefix)<>0; + CheckURL:=OK; + end; + + + function TFPHTMLFileLinkScanner.CheckText(const Text: string): boolean; + var OK: boolean; + S: string; + begin + S:=Trim(Text); + OK:=(S<>'') and (copy(S,1,1)<>'['); + CheckText:=OK; + end; + + + procedure doerror(const s : ansistring); + begin + writeln(s); + writeln; + writeln('Press ENTER to continue'); + readln; + end; + + + procedure writehlpindex(filename : ansistring); + + var + LS : PFPHTMLFileLinkScanner; + BS : PBufStream; + Re : Word; + params : array[0..0] of pointer; + dir : searchrec; + + begin + writeln('Creating HTML index file, please wait ...'); + New(LS, Init(DirOf(FileName))); + LS^.ProcessDocument(FileName,[soSubDocsOnly]); + if LS^.GetDocumentCount=0 then + doerror(format('Problem creating help index %1, aborting',[filename])) + else + begin + FileName:=DirAndNameOf(FileName)+HTMLIndexExt; + begin + New(BS, Init(FileName, stCreate, 4096)); + if not(Assigned(BS)) then + doerror(format('Error while writing help index! '+ + 'No help index is created',[filename])) + else + begin + LS^.StoreDocuments(BS^); + if BS^.Status<>stOK then + doerror(format('Error while writing help index! '+ + 'No help index is created',[filename])); + Dispose(BS, Done); + end; + end; + end; + Dispose(LS, Done); + end; + + begin + if paramcount<>1 then + writeln('Usage: writeidx ') + else + writehlpindex(paramstr(1)); + end.