П2 2 Модуль ManViewer pas
Листинг П2.2.Модуль ManViewer.pas
unit ManViewer;
{*********************************************************************}
{ }
{ Этот модуль поддерживает просмотрщик страниц man в среде Linux. }
{ Он не был опробован на различных unix-системах и формах Linux, }
{ за исключением RedHat. }
{ }
{ *******************************************************************}
interface
{ = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = }
implementation
uses HelpIntfs, Classes, SysUtils, LibC;
type
TManPageViewer = class(TInterfacedObject, ICustomHelpViewer)
private
FHelpStrings : TStringList;
FLastQuery : String;
FViewerID : Integer;
ChildPid : Integer;
procedure ProcessHelpStrings(StringBuf: PChar; HelpString: String);
procedure KillChild;
public
FHelpManager : IHelpManager;
constructor Create;
procedure InternalShutDown;
{ ICustomHelpViewer }
function GetViewerName : String;
function UnderstandsKeyword(const HelpString: String): Integer;
function GetHelpStrings(const HelpString: String): TStringList;
function CanShowTableOfContents : Boolean;
procedure ShowHelp(const HelpString: String);
procedure ShowTableOfContents;
procedure NotifyID(const ViewerID: Integer);
procedure SoftShutDown;
procedure ShutDown;
property HelpManager : IHelpManager read FHelpManager write FHelpManager;
property ViewerID : Integer read FViewerID;
destructor Destroy; override;
end;
var
HelpViewer : TManPageViewer;
const
{ man and its switches }
ExeName = 'man';
AllSwitch = '-a'; { отображает все man-страницы раздела }
WhereSwitch = '-w'; { где располагается man-страница? }
ViewerName = 'xterm';
MoreBugSwitch = '-cu';
ExecSwitch = '-e';
TitleSwitch = '-Т'; {установка заголовка окна }
ViewerTitle = 'Kylix man page viewer';
{ сигнал, используемой для завершения дочерних процессов }
KillSignal = SIGINT;
sFatalFork = 'Unable to fork(). Please consult the disaster manual.';
sNoTableOfContents = 'Unable to provide table of contents for man pages.';
{----------------------------------------------------------------------}
{ TManPageViewer }
constructor TManPageViewer.Create;
begin
inherited Create;
end;
procedure TManPageViewer.ProcessHelpStrings(StringBuf: PChar;
HelpString: String);
var
bufptr, lineptr, valptr, delim: PChar;
searching: boolean;
addstr : String;
begin
bufptr := StringBuf;
searching := true;
while searching do
begin
delim := #10#13;
lineptr := strsep(@bufptr, delim);
if (lineptr = nil) then
begin
searching := false;
end else
begin
delim := '.';
strsep(@lineptr, delim);
valptr := strsep(@lineptr, delim);
if valptr <>
nil then
begin
addstr := HelpString + ' (' + valptr + ') (' + GetViewerName + ')';
FHelpStrings.Add(addstr) ;
end;
end;
end;
end;
procedure TManPageViewer.KillChild;
begin
if ChildPid <>
0 then
begin
kill (ChildPid, KillSignal) ;
waitpid(ChildPid, nil, WNOHANG or WUNTRACED);
ChildPid := 0;
end;
end;
procedure TManPageViewer. IntemalShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager.Release(ViewerID);
ShutDown;
end;
{---------------------------------------------------------------------}
{ TManPageViewer —— ICustomHelpViewer }
function TManPageViewer.GetViewerName;
begin
Result := ExeName;
end;
function TManPageViewer.UnderstandsKeyword(const HelpString: String):
Integer;
var
SuccDescr, ErrDescr : TPipeDescriptors;
pid: Integer;
Args : array of PChar;
DescriptorSet : TFDSet;
WaitTime : TTiraeVal;
WaitStatus: Integer;
PipeStream : THandleStream;
ReadBuf : Pointer;
BytesRead: Integer;
Reading : Boolean;
begin
Result := 0;
if FHelpStrings <>
nil then FHelpStrings := nil;
SetLength(Args, 5);
Args[0] := ExeName ;
Args[ l ] := AllSwitch;
Args[2] := WhereSwitch;
Args[3] := PChar(HelpString);
Args[4] := nil;
pipe(SuccDescr) ;
pipe(ErrDescr) ;
pid := fork;
if pid = 0 then
begin
_close(SuccDescr.ReadDes);
_close(ErrDescr.ReadDes) ;
dup2(SuccDescr.WriteDes, stdout);
dup2(ErrDescr.WriteDes, stderr);
execvp (PChar(Args[0]), @Args[0]);
end
else begin
if pid = -1 then
begin
raise EHelpSystemException.Create(sFatalFork);
end else
begin
WaitStatus := waitpid(pid, nil, WUNTRACED);
if WaitStatus >
0 then
begin
WaitTime.tv_sec := 0;
WaitTime.tv_usec := 0;
FD_ZERO(DescriptorSet);
FD_SET(TSocket(SuccDescr.ReadDes), DescriptorSet);
FD_SET(TSocket(ErrDescr.ReadDes), DescriptorSet);
select(__FD_SETSIZE, @DescriptorSet, nil, nil, @WaitTime);
if FD_ISSET(TSocket(SuccDescr.ReadDes), DescriptorSet) then
begin
if FHelpStrings = nil then FHelpStrings := TStringList.Create;
PipeStream := THandleStream.Create(SuccDescr.ReadDes);
ReadBuf := Libc.malloc(1024);
memset(ReadBuf, 0, 1024);
Reading := true;
while Reading do
begin
BytesRead := PipeStream.Read(ReadBuf^, 1024);
if (BytesRead < 1024) then Reading := false;
ProcessHelpStrings(ReadBuf, HelpString);
memset(ReadBuf, 0, 1024);
end;
Libc.free(ReadBuf);
PipeStream.Free;
Result := FHelpStrings.Count;
FLastQuery := HelpString;
end else
begin
end;
end else
begin
if FHelpStrings = nil then FHelpStrings := TStringList.Create;
end;
end;
end;
_close(SuccDescr.WriteDes);
_close(ErrDescr.WriteDes);
_close(SuccDescr.ReadDes);
_close(ErrDescr.ReadDes);
end;
function TManPageViewer.GetHelpStrings(const HelpString: String): TStringList;
begin
Result := FHelpStrings;
end;
function TManPageViewer.CanShowTableOfContents:Boolean;
begin
Result := false;
end;
procedure TManPageViewer. ShowTableOfContents ;
begin
raise EHelpSystemException.Create(sNoTableOfContents);
end;
procedure TManPageViewer.ShowHelp(const HelpString: String);
var
KeywordEnd, Section, CompResult, CompString, Comparator: PChar;
Args : array of PChar;
pid : Integer;
begin
KillChild;
SetLength (Args, 9) ;
Args[0] = ViewerName;
Args[1 ] = MoreBugSwitch;
Args[2] = TitleSwitch;
Args[3] = ViewerTitle;
Args[4] = ExecSwitch;
Args[5] = ExeName;
Args[6] = AllSwitgh;
Args[7] = PChar(HelpString);
Args[8] = nil;
CompString := PChar(HelpString);
Comparator := Libc.malloc(2);
Comparator[0] := '(';
Comparator[1] := #0;
CompResult := strstr(CompString, Comparator);
Libc.free(Comparator);
if (CompResult <>
nil) then
begin
Section := Libc.malloc(2) ;
KeywordEnd := AnsiStrPos(PChar(HelpString), '(');
Section[0] := KeywordEnd[1];
Section [1] :=» #0;
Args[6] := Section;
{ #DEFINE DUMB_НАСК_ВУ_ТIRED_РROGRAMMER }
Args[7] := PChar(FLastQuery);
end
else begin
Section := nil;
end;
pid := fork;
if pid = 0 then
begin
execvp(PChar(Args[0]), @Args[0]);
end
else begin
if pid = -1 then
begin
raise EHelpSystemExceptiorv.Create (sFatalFork);
end
else begin
ChildPid := pid;
end;
end;
if Section о nil then Libc.free(Section);
end;
procedure TManPageViewer.NotifyID(const ViewerID: Integer);
begin
FViewerID := ViewerID;
end;
procedure TManPageViewer.SoftShutDown;
begin
KillChild;
end;
procedure TManPageViewer.ShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager := nil;
end;
destructor TManPageViewer.Destroy;
begin
inherited Destroy;
end;
{====================================================================}
initialization
if not Assigned(HelpViewer) then
begin
HelpViewer :=TManPageViewer.Create;
HelpIntfs.RegisterViewer(HelpViewer, HelpViewer.FHelpManager);
end;
finalization
if Assigned(HelpViewer) then
begin
HelpViewer.InternalShutDown;
end;
end.
Назад
Содержание
Вперед
