Иллюстрированный самоучитель по Kylix


         

П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.

Назад
Содержание
Вперед


Содержание Назад Вперед