help.pas

Turbo Pascal 6.0编译器源码

unit Help;

{$O+,F+,S-,X+,V-}

interface

uses Objects, Drivers, Views, Dialogs, TVars, HelpUtil, HelpScrn, HelpHist;

const

  HelpCommands = [cmCopy, cmCopyExample, cmCrossRef];

  CHelpView = #6#7#8#9#10#11#12#13;
  CHelpViewInDialog = #33#34#35#36#37#38#39#40;

type

  TColorArray = array[0..Length(CHelpView)-1] of Byte;

  PHelpView = ^THelpView;
  THelpView = object(TView)
    InDialog: Boolean;
    HScrollBar: PScrollBar;
    VScrollBar: PScrollBar;
    CurScreen: PHelpScreen;
    CurTopic: PHelpScreen;
    MainIndex: PHelpScreen;
    History: PHelpHistory;
    Buffer: PChar;
    BufSize: Word;
    CurIndex: Word;
    CursorPos, ScreenPos: TPos;
    CurWidth: Byte;
    BlockBeg, BlockEnd: TPos;
    BlockPresent: Boolean;
    HiliteIndex: Word;
    TrackWord: string[38];
    constructor Init(var R: TRect; AHScrollBar, AVScrollBar: PScrollBar;
      AInDialog: Boolean; ABufSize: Word);
    constructor Load(var S: TStream);
    destructor Done; virtual;
    procedure Store(var S: TStream);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Draw; virtual;
    function  GetPalette: PPalette; virtual;
    procedure SetState(AState: Word; Enable: Boolean); virtual;
    function  Valid(Command: Word): Boolean; virtual;
    procedure SetCurScreen(Index: Word);
    function  ReadPos(Index: Word; Pos1, Pos2: TPos; Width: Byte): Boolean;
    procedure Redraw;
    function  ShowPos(Index: Word; Pos1, Pos2: TPos; Width: Byte): Boolean;
    function  ReadScreen(Index: Word): Boolean;
    function  ShowScreen(Index: Word): Boolean;
    procedure PushPos;
    function  PushReadScreen(Index: Word): Boolean;
    function  PushShowScreen(Index: Word): Boolean;
    procedure PopPos;
    function  ShowContents: Boolean;
    function  ShowIndex: Boolean;
    function  ShowHelpOnHelp: Boolean;
    function  ValidScreen: Boolean;
    function  HasLinks: Boolean;
    procedure Format(Width: Word; Adjust: Boolean);
    procedure Reformat;
    procedure UpdateCommands;
    function  HasSelection: Boolean;
    function  HasExample: Boolean;
    procedure CopyToClip(var BegPos, EndPos: TPos);
    procedure Copy;
    procedure CopyExample;
    function  GetRowCount: Word;
    function  MaxLeftCol: Byte;
    procedure AdjustCol;
    procedure AdjustRow;
    procedure AdjustPos;
    procedure AdjustCursor(var Pos: TPos);
    procedure UpdateCursor;
    procedure ProcessScrollBars;
    procedure UpdateScrollBars;
    procedure GetColors(var Colors: TColorArray);
    procedure DrawRows(BegRow, EndRow: Word);
    procedure RedrawRows(BegRow, EndRow: Integer);
    function  ScrollBy(R, C: Word): Byte;
    function  ScrollTo(Row, Col: Integer; Len: Word; Center: Boolean): Byte;
    function  ScrollToCursor: Byte;
    function  MoveByRaw(R, C: Word; Hilite, Drag: Boolean): Byte;
    function  MoveBy(R, C: Integer; Drag: Boolean): Byte;
    procedure MoveToMouse(R, C: Word; Drag: Boolean);
    procedure MoveCode(RCode, CCode: Byte; Drag: Boolean);
    procedure ScrollToHilite(MoveCursor: Boolean; Ofs: Integer;
      Center: Boolean);
    procedure ChangeHilite(Index: Word; Scroll: Boolean; Ofs: Integer;
      Center: Boolean);
    procedure ChangeHiliteBy(D: Integer);
    procedure HiliteCurrent;
    function  IndexUnderCursor(var Pos: TPos): Word;
    procedure WordUnderCursor(var S: string);
    function  GoNextIndex: Word;
    procedure SetBlockAnchor(R, C: Word);
    procedure TrackChar(C: Char);
    procedure TrackBack;
    procedure TrackClear;
    function  HiliteTrack: Boolean;
    procedure GoCrossRef;
    procedure SearchCurWord;
    procedure SearchString(var S: string);
    procedure TrackString(var S: string);
  end;

const

  RHelpView: TStreamRec = (
    ObjType: 10001;
    VmtLink: Ofs(TypeOf(THelpView)^);
    Load:    @THelpView.Load;
    Store:   @THelpView.Store
  );

procedure InitHelp;
function  HelpWindow: PWindow;
function  HelpDialog: PDialog;

implementation

uses Memory, App, VMemUtil, TWindows, Editor, Utils, Controls, TStdDlg, Context;

type
  PHelpWalker = ^THelpWalker;
  THelpWalker = object(TObject)
    Col: Integer;
    CurChar: Char;
    Index: Word;
    Screen: PHelpScreen;
    Text: PChar;
    Ofs: Word;
    constructor Init(AScreen: PHelpScreen; Row: Word);
    function  GetRow(Row: Word): Boolean;
    procedure SkipControls;
    procedure GoForward;
    procedure GoBack;
    procedure GoCol(ACol: Word);
    procedure GoEol;
  end;

constructor THelpWalker.Init(AScreen: PHelpScreen; Row: Word);
begin
  Screen := AScreen;
  GetRow(Row);
end;

function THelpWalker.GetRow(Row: Word): Boolean;
var
  Example: Boolean;
begin
  if Row >= Screen^.MaxRow then
  begin
    GetRow := False;
    Exit
  end;
  GetRow := True;
  Screen^.GetRow(Row, Text, Index, Example);
  Index := Index * 2;
  Ofs := 0;
  Col := 0;
  SkipControls;
end;

procedure THelpWalker.SkipControls;
begin
  if Col < 1 then
  begin
    CurChar := ' ';
    Exit
  end;
  while (Text^ <> #0) and (Text^ < #7) do
  begin
    Inc(Ofs);
    if Text^ = #2 then
      Inc(Index);
    Inc(PtrRec(Text).Ofs);
  end;
  CurChar := Text^;
end;

procedure THelpWalker.GoForward;
begin
  if Col < 1 then
  begin
    Inc(Col);
    SkipControls;
    Exit
  end;
  if Text^ <> #0 then
  begin
    Inc(Col);
    Inc(PtrRec(Text).Ofs);
    Inc(Ofs);
    SkipControls;
  end;
end;

procedure THelpWalker.GoBack;
begin
  if Col > 0 then
  begin
    if Ofs > 0 then
      repeat
        Dec(PtrRec(Text).Ofs);
        Dec(Ofs);
        if Text^ = #2 then
          Dec(Index);
      until (Ofs = 0) or (Text^ >= #7);
    Dec(Col);
    SkipControls;
  end;
end;

procedure THelpWalker.GoCol(ACol: Word);
begin
  if Col < ACol then
    while (CurChar <> #0) and (Col < ACol) do
      GoForward
  else
    while Col > ACol do
      GoBack;
end;

procedure THelpWalker.GoEol;
begin
  while CurChar <> #0 do
    GoForward;
  if Col > 0 then
    repeat
      GoBack
    until (Col = 0) or (CurChar <> ' ');
  if CurChar <> ' ' then
    GoForward;
end;

var
  HelpHistory: THelpHistory;

constructor THelpView.Init(var R: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  AInDialog: Boolean; ABufSize: Word);
begin
  TView.Init(R);
  GrowMode := gfGrowHiX + gfGrowHiY;
  Options := Options or ofSelectable;
  EventMask := EventMask or (evBroadcast + evDebugger + evRightClick);
  InDialog := AInDialog;
  HScrollBar := AHScrollBar;
  VScrollBar := AVScrollBar;
  BufSize := ABufSize;
end;

constructor THelpView.Load(var S: TStream);
begin
  TView.Load(S);
  S.Read(InDialog, SizeOf(InDialog));
  History := @HelpHistory;
  GetPeerViewPtr(S, HScrollBar);
  GetPeerViewPtr(S, VScrollBar);
  S.Read(BufSize, SizeOf(BufSize));
  Buffer := MemAlloc(BufSize);
  CurScreen := nil;
  CurTopic := New(PHelpTopic, Init(Buffer, BufSize));
  MainIndex := New(PHelpIndex, Init(Buffer, BufSize));
  CurIndex := $FFFF;
end;

destructor THelpView.Done;
begin
  PushPos;
  if CurTopic <> nil then
    Dispose(CurTopic, Done);
  if MainIndex <> nil then
    Dispose(MainIndex, Done);
  if Buffer <> nil then
    FreeMem(Buffer, BufSize);
  TView.Done;
end;

procedure THelpView.Store(var S: TStream);
begin
  TView.Store(S);
  S.Write(InDialog, SizeOf(InDialog));
  PutPeerViewPtr(S, HScrollBar);
  PutPeerViewPtr(S, VScrollBar);
  S.Write(BufSize, SizeOf(BufSize));
end;

procedure THelpView.SetCurScreen(Index: Word);
begin
  if Index = 1 then
    CurScreen := MainIndex
  else
    CurScreen := CurTopic;
end;

function THelpView.ReadPos(Index: Word; Pos1, Pos2: TPos; Width: Byte):
  Boolean;
begin
  ReadPos := True;
  if Index = 0 then
    Index := 3;
  CurIndex := Index;
  if CurIndex = $FFFF then
    Exit;
  SetCurScreen(Index);
  if not CurScreen^.Read(Index) then
  begin
    CurIndex := $FFFF;
    ReadPos := False;
    Exit
  end;
  CursorPos := Pos1;
  ScreenPos := Pos2;
  BlockBeg.Clear;
  BlockEnd.Clear;
  BlockPresent := False;
  HiliteIndex := $FFFE;
  TrackClear;
  Format(Width, False);
end;

procedure THelpView.Redraw;
begin
  if ValidScreen then
  begin
    DrawView;
    HiliteCurrent
  end;
end;

function THelpView.ShowPos(Index: Word; Pos1, Pos2: TPos; Width: Byte):
  Boolean;
var
  B: Boolean;
begin
  B := ReadPos(Index, Pos1, Pos2, Width);
  if B then
    Redraw;
  ShowPos := B;
end;

function THelpView.ReadScreen(Index: Word): Boolean;
var
  s1, s2: TPos;

function Read(Index: Word): Boolean;
begin
  Read := ReadPos(Index, s1, s2, Size.X - 1);
end;

begin
  ReadScreen := True;
  s1.Clear;
  s2.Clear;
  if not Read(Index) then
  begin
    ReadScreen := False;
    Read($FFFF)
  end;
end;

function THelpView.ShowScreen(Index: Word): Boolean;
var
  B: Boolean;
begin
  B := ReadScreen(Index);
  if B then
    Redraw;
  ShowScreen := B;
end;

procedure THelpView.PushPos;
begin
  if (History <> nil) and (CurIndex <> $FFFF) then
    History^.Push(CurIndex, CursorPos, ScreenPos, CurWidth);
end;

function THelpView.PushReadScreen(Index: Word): Boolean;
begin
  PushPos;
  PushReadScreen := ReadScreen(Index);
end;

function THelpView.PushShowScreen(Index: Word): Boolean;
var
  B: Boolean;
begin
  B := PushReadScreen(Index);
  if B then
    Redraw;
  PushShowScreen := B;
end;

procedure THelpView.PopPos;
var
  Index: Word;
  s1, s2: TPos;
  Width: Word;
begin
  if (History <> nil) and not History^.Empty then
  begin
    History^.Pop(Index, s1, s2, Width);
    if not ShowPos(Index, s1, s2, Width) then
      ShowScreen(3);
  end else
    ShowScreen(3);
end;

function THelpView.ShowContents: Boolean;
begin
  ShowContents := PushShowScreen(hcContents);
end;

function THelpView.ShowIndex: Boolean;
begin
  ShowIndex := PushShowScreen(hcIndex);
end;

function THelpView.ShowHelpOnHelp: Boolean;
begin
  ShowHelpOnHelp := PushShowScreen(hcHelpOnHelp);
end;

function THelpView.ValidScreen: Boolean;
begin
  ValidScreen := CurIndex <> $FFFF;
end;

function THelpView.HasLinks: Boolean;
begin
  HasLinks := ValidScreen and (CurScreen^.MaxIndex > 0);
end;

procedure THelpView.Format(Width: Word; Adjust: Boolean);
var
  P: array[0..3] of PPos;
  N: Word;
  C: Byte;
begin
  C := ScreenPos.Col;
  N := 0;
  if Adjust then
  begin
    P[0] := @CursorPos;
    P[1] := @ScreenPos;
    P[2] := @BlockBeg;
    P[3] := @BlockEnd;
    N := 4;
  end;
  CurScreen^.Format(Width, P, N);
  ScreenPos.Col := C;
  CurWidth := Width;
end;

procedure THelpView.Reformat;
var
  Width: Word;
begin
  Width := Size.X - 1;
  if CurWidth <> Width then
    Format(Width, True);
end;

procedure THelpView.UpdateCommands;
var
  T: TCommandSet;
begin
  GetCommands(T);
  ChangeSet(T, cmCopy, HasSelection);
  ChangeSet(T, cmCrossRef, HasLinks);
  ChangeSet(T, cmCopyExample, HasExample);
  SetCommands(T);
end;

function THelpView.HasSelection: Boolean;
begin
  HasSelection := ValidScreen and not InDialog and
    (BlockBeg.Compare(BlockEnd) <> 0);
end;

function THelpView.HasExample: Boolean;
begin
  HasExample := ValidScreen and not InDialog and (CurScreen <> nil) and
    CurScreen^.HasExample;
end;

procedure THelpView.CopyToClip(var BegPos, EndPos: TPos);
var
  Row: Word;
  Text: PChar;
  TrailingSpaces: Boolean;
  MinLeadingSpaces, EatSpaces, RowLength, LeadingSpaces: Integer;
  Index: Word;
  Example: Boolean;
  NewText: string[80];

procedure Help2Text(Src: PChar; Dest: string); assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Src
        LES     DI,Dest
        MOV     BX,DI
        INC     DI
        MOV     CX,1
        MOV     AL,' '
        REP     STOSB
        MOV     CX,77
        JMP     @@2
@@1:    AND     AL,AL
        JZ      @@3
@@2:    LODSB
        CMP     AL,7
        JB      @@1
        STOSB
        LOOP    @@2
@@3:    SUB     CL,78
        NEG     CL
        JCXZ    @@4
        DEC     DI
        STD
        MOV     AL,' '
        REPE    SCASB
        JE      @@4
        INC     CX
@@4:    MOV     ES:[BX],CL
        CLD
        POP     DS
end;

procedure Row2Text(Row: Word);
begin
  CurScreen^.GetRow(Row, Text, Index, Example);
  Help2Text(Text, NewText);
end;

function GetLeadingSpaces(S: string): Word; assembler;
asm
        CLD
        LES     DI,S
        MOV     BX,DI
        MOV     CL,ES:[DI]
        SUB     CH,CH
        JCXZ    @@1
        INC     DI
        MOV     AL,' '
        REPE    SCASB
        JE      @@1
        SUB     DI,BX
        XCHG    AX,DI
        DEC     AX
        DEC     AX
        JMP     @@2
@@1:    MOV     AX,78
@@2:
end;

function RowLeadingSpaces(Row: Word): Word;
begin
  Row2Text(Row);
  RowLeadingSpaces := GetLeadingSpaces(NewText);
end;

function Inside(Row: Word): Boolean;
begin
  Inside := ((Row <> BegPos.Row) and (Row <> EndPos.Row)) or
    ((Row = BegPos.Row) and (Row < EndPos.Row) and (BegPos.Col = 0)) or