program GVSH;

{ Graphics Vision Shell,
  Copr. 1996 Matthias K"oppe
}

{$ifdef Windows}
{$M 16384, 8192}
{$endif Windows}

uses
  { Turbo Vision units }
  Drivers, Views, HistList, Memory,
  { Graphics and support units }
  {$ifdef Windows}
  WinTypes, Misc, WinRes, WinGr, VgaMem, Bitmap, ExtGraph,
  {$else !Windows}
  Misc, Vesa, Gr, WinRes, MetaGr, VgaMem, Bitmap, ExtGraph, MyMouse, MyFonts,
  {$endif Windows}
  { Standard units }
  Dos, Objects, Strings, Validate,
  { Graphics Vision standard units }
  GvDriver, GvViews, GvDialog, GvMenus, GvStdDlg, GvApp, GvMsgBox,
  GVTexts, GvEdit, GvBitmap, GvWinDlg, GvGadget, GvClock, GvEyes,
  GvFonts, GvFiler, GvTable, GvWList, GvWinNum, KeyNames, GvBWCC,
  GvValid, GvTerm, GvVirt, GvHint, GvColor, {$ifndef Windows} GvTv, {$endif}
  { GvSh units }
  GvClip, GvEditX, GvShCmd;

{ bpc2msg.exe, grep2msg.exe, tasm2msg.exe, bpcext.exe, redir.exe, redir.pif,
  bpc.exe, tasm.exe, tvhc.exe, td.exe, tdx.exe, tprof.exe
  need to be accessible in PATH.
}

var
  Res: PStream;
  ClipWindow: PEditWindow;

{$R GVSH.RES}

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

function LoadWinDialog(Name: PChar): PWinDialog;
{ Load a Windows dialog from the resource and center it.
}
var
  Dlg: PWinDialog;
begin
  Dlg := PWinDialog(Application^.ValidView(LoadDialog(Res^, Name)));
  If Dlg <> nil
  then Dlg^.Options := Dlg^.Options or ofCentered;
  LoadWinDialog := Dlg
end;

function WinDialog(Name: PChar; Data: pointer): Word;
{ Load a Windows dialog from the resource, center it on the desktop
  and execute it with the given Data.
}
var
  Dlg: PWinDialog;
  Result: Word;
begin
  Dlg := LoadWinDialog(Name);
  If Dlg = nil
  then begin
    WinDialog := cmCancel;
    Exit
  end;
  If Data <> nil
  then Dlg^.SetData(Data^);
  Result := Desktop^.ExecView(Dlg);
  If (Data <> nil) and (Result <> cmCancel)
  then Dlg^.GetData(Data^);
  WinDialog := Result
end;

function MyEditorDialog(Dialog: Integer; Info: Pointer): Word; {$ifndef FPK}far;{$endif}
{ Our EditorDialog implementation executes Windows-style Find and
  Replace dialogs instead of the built-in ones. Any other requests
  from GvEdit are redirected to the standard EditorDialog function.
}
Begin
  Case Dialog of
    edFind:
      MyEditorDialog :=
	WinDialog('find', Info);
    edReplace:
      MyEditorDialog :=
	WinDialog('replace', Info);
    else
      MyEditorDialog := StdEditorDialog(Dialog, Info)
  End;
End;

function BorMessageBox(Res: PStream; Name: PChar;
  BitmapRes: PStream; BitmapName: PChar; Text: string): PWinDialog;
{ This function retrieves a BWCC message box from a resource
  and puts a bitmap and a text into it.
}
var
  Dlg: PWinDialog;
  Bounds: TRect;
  P: PGView;
begin
  Dlg := LoadDialog(Res^, Name);
  If Dlg <> nil
  then begin
    { Control 33 is supposed to be a static template for a bitmap viewer.
      We insert a real bitmap viewer before the template. Then we kill the
      template.
    }
    P := Dlg^.GetControl(33);
    If P <> nil then
    with P^ do
    begin
      GetBounds(Bounds);
      Dlg^.InsertBefore(
	New(PBmpView, Init(Bounds, BitmapRes, BitmapName, 0)),
	P);
      Free
    end;
    { Control 34 is supposed to be an empty static text.
      We fill it with text.
    }
    P := Dlg^.GetControl(34);
    If P <> nil then
    PStaticText(P)^.Text := NewStr(Text);
    Dlg^.Options := Dlg^.Options or ofCentered;
  end;
  BorMessageBox := Dlg
end;

function BorCreateMessageBox(var Bounds: TRect;
  ATitle, AText: string; AOptions: Word): PDialog; {$ifndef FPK}far;{$endif}
{ This is our implementation of the CreateMessageBox hook function,
  using the above function to create a message box.
}
var
  DlgName, BmpName: PChar;
  Dialog: PDialog;
begin
  If LowMemory
  then begin
    BorCreateMessageBox := StdCreateMessageBox(Bounds, ATitle, AText, AOptions);
    Exit
  end;
  case AOptions and $0F00 of
    mfOKButton:
      DlgName := bwcc_dialog_Ok;
    mfOKButton + mfCancelButton:
      DlgName := bwcc_dialog_OkCancel;
    mfYesButton + mfNoButton + mfCancelButton:
      DlgName := bwcc_dialog_YesNoCancel;
    mfYesButton + mfNoButton:
      DlgName := bwcc_dialog_YesNo;
    else
      DlgName := bwcc_dialog_AbortRetryIgnore;
  end;
  case AOptions and $000F of
    mfWarning:
      BmpName := bwcc_bitmap_Exclamation;
    mfError:
      BmpName := bwcc_bitmap_Hand;
    mfInformation:
      BmpName := bwcc_bitmap_Information;
    mfConfirmation:
      BmpName := bwcc_bitmap_Question;
    else
      BmpName := nil;
  end;
  Dialog := BorMessageBox(BWCC, DlgName, BWCC, BmpName, AText);
  Dialog^.Title := NewStr(ATitle);
  If Bounds.B.X = -1
  then Dialog^.Options := Dialog^.Options or ofCentered
  else Dialog^.MoveTo(Bounds.A.X, Bounds.A.Y);
  BorCreateMessageBox := Dialog
end;

function LookUp(Path: string): string;
var
  SPath: string;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  SPath := GetEnv('PATH');
  FSplit(ParamStr(0), Dir, Name, Ext);
  SPath := SPath + ';' + Dir;
  Lookup := FSearch(Path, SPath)
end;

function ExecFull(Path: string; Params: string): Word;
{ Execute a sub-process. Path is the program to be executed,
  passing the Params.
}
begin
  {$ifndef Windows}
  DoneSysError;
  DoneVideo;
  Application^.DoneEvents;
  DoneDosMem;
  SwapVectors;
  {$endif !Windows}
  Exec(lookup(Path), Params);
  ExecFull := DosExitCode;
  {$ifndef Windows}
  SwapVectors;
  InitDosMem;
  Application^.InitEvents;
  InitVideo;
  InitSysError;
  Application^.Redraw;
  {$endif Windows}
end;

function ExecPiped(Path: string; Params: string; Out: PTextDevice;
  MsgWindow: PMessageWindow; Swap: Boolean): Word;
{ Execute a sub-process. Path can be a shell command or a program,
  which is executed with the given Params. Standard output and
  standard error are redirected to a file. If Swap is True, graphics
  mode is shut down and restored afterwards.
  If MsgWindow is Assigned, and the output data looks like IDE Message
  Filter output, the output is passed to the message outline. Otherwise,
  the output is written to the Out text device.
}
var
  TempName: string;
  Temp: Text;
  Arg, s: string;
  msg: PWinDialog;
  Buf: pointer;
  Event: TEvent;
begin
  If Swap
  then begin
    {$ifdef Windows}
    ExecCmdShow := sw_Show;
    {$else Windows}
    DoneSysError;
    DoneVideo;
    Application^.DoneEvents;
    DoneDosMem;
    SwapVectors;
    {$endif Windows}
  end
  else begin
    msg := BorMessageBox(Res, 'msg', BWCC, bwcc_bitmap_Information,
      GetStr(sExecuting));
    Application^.Insert(msg);
    {$ifdef Windows}
    { This allows for the (rooted!) messagebox to be painted
      by the system before we execute the tool. }
    Application^.GetEvent(Event);
    if Event.What <> evNothing then Application^.PutEvent(Event);
    ExecCmdShow := sw_ShowMinimized;
    ExecWait := true;
    {$else !Windows}
    DoneDosMem;
    {$endif Windows}
  end;
  TempName := GetEnv('TEMP');
  If TempName[Length(TempName)] = '\'
  then Dec(TempName[0]);
  TempName := TempName + '\sh.$$$';
  Assign(Temp, TempName);
  Arg := '/o ' + TempName + ' /eo ' + GetEnv('COMSPEC') + ' /c' + Path + ' ' + Params;
  Exec(lookup('redir.exe'), Arg);
  ExecPiped := DosExitCode;
  If Swap
  then begin
    {$ifndef Windows}
    SwapVectors;
    InitDosMem;
    Application^.InitEvents;
    InitVideo;
    InitSysError;
    Application^.Redraw;
    {$endif !Windows}
  end
  else begin
    {$ifdef Windows}
    ExecWait := false;
    ExecCmdShow := sw_Show;
    {$else !Windows}
    InitDosMem;
    {$endif Windows}
    Dispose(msg, Done);
  end;
  {$ifndef Windows}
  If (MsgWindow <> nil) and
     (MsgWindow^.MsgOutLine^.AddMessages(Path + ' ' + Params, TempName))
  then begin
    MsgWindow^.Show;
    Erase(Temp)
  end
  else
  {$endif !Windows}
       begin
    GetMem(Buf, 4096);
    SetTextBuf(Temp, Buf^, 4096);
    {$i-}
    Reset(Temp);
    {$i+}
    If IOResult = 0
    then begin
      If Out^.GOwner <> nil
      then Out^.GOwner^.Lock;
      while not Eof(Temp) do
      begin
	ReadLn(Temp, s);
	s := s + #13#10;
	Out^.StrWrite(TextBuf(pointer(@s[1])^), Length(s));
      end;
      If Out^.GOwner <> nil then
      with Out^.GOwner^ do
      begin
	Unlock;
	If not GetState(sfVisible)
	then begin
	  Show;
	  Select
	end;
      end;
      Close(Temp);
      Erase(Temp)
    end;
    FreeMem(Buf, 4096);
  end;
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

type
  PTermWindow = ^TTermWindow;
  TTermWindow = object(TWindow)
    Term: PTerminal;
    constructor Init(var Bounds: TRect; ATitle: string; DoHide: Boolean);
    procedure InitTerm; virtual;
  end;

constructor TTermWindow.Init;
begin
  inherited Init(Bounds, ATitle, wnNoNumber);
  If DoHide then Flags := Flags or wfHideClose;
  Flags := Flags and not wfBackground; { speed it up }
  Palette := wpCyanWindow; { actually a black one }
  InitTerm;
end;

procedure TTermWindow.InitTerm;
var
  R: TRect;
begin
  GetClientRect(R);
  Dec(R.B.X, 17);
  Dec(R.B.Y, 17);
  Term := Insert(
    New(PTerminal, Init(R, StandardScrollbar(sbHorizontal + sbHandleKeyboard),
      StandardScrollbar(sbVertical + sbHandleKeyboard), 8000)));
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

type
  PShWindow = ^TShWindow;
  TShWindow = object(TTermWindow)
    MsgWindow: PMessageWindow;
    constructor Init(var Bounds: TRect; ATitle: string;
      AMsgWindow: PMessageWindow);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Prompt;
  end;

constructor TShWindow.Init(var Bounds: TRect; ATitle: string;
  AMsgWindow: PMessageWindow);
begin
  inherited Init(Bounds, ATitle, false);
  MsgWindow := AMsgWindow;
  Prompt
end;

procedure TShWindow.HandleEvent(var Event: TEvent);
var
  CmdLn: string;
begin
  inherited HandleEvent(Event);
  If (Event.What = evKeyDown) and (Lo(Event.KeyCode) >= $20)
  then begin
    PutEvent(Event);
    If HistoryInputBox(GetStr(sExecTitle), GetStr(sExecLabel),
      CmdLn, 127, hiCmdLine) = cmOK
    then begin
      CmdLn[Length(CmdLn) + 1] := #10;
      Term^.StrWrite(TextBuf((@CmdLn[1])^), Length(CmdLn) + 1);
      ExecPiped('', CmdLn, Term, MsgWindow,
	GetShiftState and (kbLeftShift + kbRightShift) = 0);
      Message(Application, evBroadcast, cmUpdateTitle, nil);
      Prompt
    end;
    ClearEvent(Event);
  end
end;

procedure TShWindow.Prompt;
{ Simulate the shell prompt
}
var
  s, Pr: string;
  Dir: string;
  i: Integer;
begin
  with Term^ do
    If QueEmpty or (QueFront = 0) or (Buffer^[QueFront-1] = #10)
    then s := ''
    else s := #13#10;
  Pr := GetEnv('PROMPT');
  i := 1;
  while i <= Length(Pr) do
  begin
    if Pr[i] = '$'
    then begin
      case Upcase(Pr[i+1]) of
	'Q': s := s + '=';
	'$': s := s + '$';
	'G': s := s + '>';
	'L': s := s + '<';
	'B': s := s + '|';
	'H': If Length(s) > 0 then Dec(s[0]);
	'_': s := s + #13#10;
	'N':
	  begin
	    GetDir(0, Dir);
	    s := s + Dir[1]
	  end;
	'P':
	  begin
	    GetDir(0, Dir);
	    s := s + Dir
	  end;
      end;
      Inc(i, 2)
    end
    else
      s := s + Pr[i]
  end;
  Term^.StrWrite(TextBuf((@s[1])^), Length(s))
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}
var
  theLine: array[0..2047] of Char;
  Prefix: array[0..3] of Char;

procedure sw(ch: Char; on: Word);
const
  states: array[Boolean] of Char = ('-', '+');
var
  P: PChar;
begin
  P := StrECopy(StrEnd(theLine), Prefix);
  P[0] := ch;
  P[1] := states[on <> 0];
  P[2] := ' ';
  P[3] := #0
end;

procedure switches(chars: string; mask: Word);
var
  i: Integer;
begin
  For i := 1 to Length(chars) do
  begin
    sw(chars[i], mask and 1);
    mask := mask shr 1
  end;
end;

procedure addsw(s: PChar);
begin
  StrCat(theline, s);
  StrCat(theline, ' ')
end;

procedure addswp(s: string);
begin
  StrPCopy(StrEnd(theline), s);
  StrCat(theline, ' ')
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

type
  TDirs = record
    EXEDir: string;
    IncludeDir: string;
    UnitDir: string;
    ObjectDir: string;
    ResourceDir: string
  end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}
type
  TGREP = object
    text: string;
    mask: string;
    searchopt1: Word;
    wordchars: string[32];
    searchopt2: Word;
    outputmode: Word;
    outputopt: Word;
    procedure Init;
    function CmdLine: string;
  end;

procedure TGREP.Init;
begin
  text := '';
  mask := '*.PAS';
  searchopt1 := 0;
  wordchars := '[0-9A-Z_]';
  searchopt2 := 1;
  outputmode := 0;
  outputopt := 2;
end;

function TGREP.CmdLine: string;
begin
  theline[0] := #0; StrCopy(Prefix, '-');
  Switches('dr', searchopt1);
  If searchopt1 and 4 = 0
  then addsw('-w-')
  else begin
    StrCat(theline, '-w');
    StrPCopy(StrEnd(theline), wordchars);
    StrCat(theline, ' ')
  end;
  Switches('iv', searchopt2);
  If outputmode = 0
  then begin
    StrCat(theline, '-n+ "');
    StrPCopy(StrEnd(theline), text);
    StrCat(theline, '" ');
    StrPCopy(StrEnd(theline), mask);
    StrCat(theline, ' |grep2msg');
    CmdLine := StrPas(theline)
  end
  else begin
    Switches('onlz', outputopt);
    StrCat(theline, '"');
    StrPCopy(StrEnd(theline), text);
    StrCat(theline, '" ');
    StrPCopy(StrEnd(theline), mask);
    CmdLine := StrPas(theline)
  end
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

type
  TBPCOptions = record
    CodeOpt: Word;
    ErrorOpt: Word;
    DebugOpt: Word;
    SyntaxOpt: Word;
    FloatOpt: Word;
    Defines: string
  end;

  TBPC = object
    Target: Word;
    Options: array[0..2] of TBPCOptions;
    Linker: record
      MapOpt: Word;
      LinkerOpt: Word;
      DebugOpt: Word
    end;
    Memory: record
      RealStack: LongInt;
      RealMinHeap: LongInt;
      RealMaxHeap: LongInt;
      ProtStack: LongInt;
      WinStack: LongInt;
      WinHeap: LongInt
    end;
    procedure Init;
    function CmdLine(var Dirs: TDirs): string;
  end;

procedure TBPC.Init;
var
  i: Integer;
begin
  Target := 1;
  For i := 0 to 2 do
  with Options[i] do
  begin
    If i = 2
    then CodeOpt := 28
    else CodeOpt := 12;
    ErrorOpt := 6;
    DebugOpt := 7;
    SyntaxOpt := 5;
    FloatOpt := 2;
    Defines := ''
  end;
  with Linker do
  begin
    MapOpt := 0;
    LinkerOpt := 1;
    DebugOpt := 1
  end;
  with Memory do
  begin
    RealStack := 16384;
    RealMinHeap := 0;
    RealMaxHeap := 655360;
    ProtStack := 16384;
    WinStack := 8192;
    WinHeap := 8192
  end
end;

function TBPC.CmdLine(var Dirs: TDirs): string;
var
  s: string;
  F: Text;
  TempName: PathStr;
begin
  theline[0] := #0;
  case Target of
    0: addsw('-cd');
    1: addsw('-cp');
    2: addsw('-cw');
  end;
  with Options[Target] do
  begin
    StrCopy(Prefix, '-$');
    Switches('foagkw', CodeOpt);
    Switches('rsiq', ErrorOpt);
    Switches('dly', DebugOpt);
    Switches('vbxtp', SyntaxOpt);
    Switches('ne', FloatOpt);
    StrCat(theline, '-d');
    StrPCopy(StrEnd(theline), Defines);
    StrCat(theline, ' ')
  end;
  StrCopy(Prefix, '-');
  with Linker do
  begin
    case MapOpt of
      1: addsw('-gs');
      2: addsw('-gp');
      3: addsw('-gd');
    end;
    If LinkerOpt = 1 then addsw('-l');
    If DebugOpt = 1 then addsw('-v');
  end;
  with Memory do
  begin
    case Target of
      0: FormatStr(s, '-$M%d,%d,%d', RealStack);
      1: FormatStr(s, '-$M%d', ProtStack);
      2: FormatStr(s, '-$M%d,%d', WinStack);
    end;
    addswp(s);
  end;
  TempName := GetEnv('TEMP');
  If TempName[Length(TempName)] = '\'
  then Dec(TempName[0]);
  TempName := TempName + '\switches.$$$';
  Assign(F, TempName);
  Rewrite(F);
  WriteLn(F, theline);
  WriteLn(F, '/i' + Dirs.IncludeDir);
  WriteLn(F, '/u' + Dirs.UnitDir);
  WriteLn(F, '/o' + Dirs.ObjectDir);
  WriteLn(F, '/r' + Dirs.ResourceDir);
  WriteLn(F, '/e' + Dirs.EXEDir);
  Close(F);
  CmdLine := '@' + TempName;
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

type
  TTASMOptions = record
    Passes: LongInt;
    Debug: Word;
    ListMode: Word;
    ListOptions: Word;
    ObjMode: Word;
    Float: Word;
    Symbols: Word;
    Segments: Word;
    Len: LongInt;
    Hash: LongInt;
    OutMode: Word;
    OutOptions: Word
  end;

  TTASM = object
    Options: TTASMOptions;
    Warnings: Word;
    procedure Init;
    function CmdLine(var Dirs: TDirs): string;
  end;

procedure TTASM.Init;
begin
  with Options do
  begin
    Passes := 1;
    Debug := 1;
    ListMode := 0;
    ListOptions := 0;
    ObjMode := 0;
    Float := 0;
    Symbols := 0;
    Segments := 0;
    Len := 12;
    Hash := 8192;
    OutMode := 0;
    OutOptions := 1
  end;
  Warnings := $F7F7;
end;

function TTASM.CmdLine(var Dirs: TDirs): string;
const
  Warn: array[0..14] of string[3] =
    ('ALN', 'ASS', 'BRK', 'ICG', 'LCO', 'OPI', 'OPP', 'OPS',
     'OVF', 'PDC', 'PQK', 'PRO', 'RES', 'TPI', 'UNI');
  PM: array[0..1] of Char = ('-', '+');
var
  s: string;
  w: Word;
  i: Integer;
  F: Text;
begin
  StrCopy(Prefix, '/');
  with Options do
  begin
    Str(Passes, s);
    addswp('/m' + s);
    case Debug of
      0: addsw('/zn');
      1: addsw('/zd');
      2: addsw('/zi');
    end;
    case ListMode of
      1: addsw('/l');
      2: addsw('/la');
    end;
    If ListOptions and 1 <> 0 then addsw('/n');
    If ListOptions and 2 <> 0 then addsw('/x');
    case ObjMode of
      0: addsw('/os');
      1: addsw('/o');
      2: addsw('/oi');
      2: addsw('/op');
    end;
    case Float of
      0: addsw('/r');
      1: addsw('/e');
    end;
    case Symbols of
      0: addsw('/mu');
      1: addsw('/mx');
      2: addsw('/ml');
    end;
    case Segments of
      0: addsw('/s');
      1: addsw('/a');
    end;
    Str(Len, s);
    addswp('/mv' + s);
    Str(Hash, s);
    addswp('/kh' + s);
    If OutMode = 1
    then begin
      If OutOptions and 1 <> 0 then addsw('/z');
      If OutOptions and 2 <> 0 then addsw('/t');
      CmdLine := '@switches.$$$';
    end
    else
      CmdLine := '@switches.$$$ | tasm2msg';
  end;
  Assign(F, 'switches.$$$');
  Rewrite(F);
  WriteLn(F, theline);
  w := Warnings;
  For i := 0 to 14 do
  begin
    WriteLn(F, '/w' + PM[w and 1] + Warn[i]);
    w := w shr 1
  end;
  WriteLn(F, '/i' + Dirs.IncludeDir);
  Close(F);
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

var
  BackBitmap: PathStr;
  IsVirtual: Boolean;
  VirtualFactor: TPoint;
const
  HintDelay: Word = 10;

type
  TShApp = object(TApplication)
    ToolTerm: PTextDevice;
    MsgWindow: PMessageWindow;
    ImageWindow: PDesktopImageWindow;
    GREP: TGREP;
    BPC: TBPC;
    TASM: TTASM;
    Dirs: TDirs;
    RunArgs: string;
    ProgPath: PathStr;
    LastEvent: Word;
    constructor Init;
    destructor Done; virtual;
    procedure GetEvent(var Event: TEvent); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitDesktop; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure InitTexts; virtual;
    function OpenEditor(FileName: FNameStr; Visible: Boolean): PEditWindow;
    function OpenTerminal(Title: string; Visible: Boolean;
      HideOnClose: Boolean): PTextDevice;
    procedure OutOfMemory; virtual;
    procedure SaveOpt(Path: string);
    procedure Timer(var Event: TEvent); virtual;
    procedure WriteShellMsg; virtual;
  end;

constructor TShApp.Init;
var
  R: TRect;
  Opt: PStream;
  P: PWindow;
Begin
  Randomize;
  { Start-up the Windows resource system. An empty file name means:
    Read the resource from the executable. ParamStr(0) works
    for DOS/DPMI targets but not for Windows target.
  }
  Res := OpenResource('' {ParamStr(0)} );
  If Res^.Status <> 0
  then begin
    PrintStr('Resource error.'^M^J);
    Halt(1)
  end;
  InitClasses;
  RegisterGvWinDlg;
  { We would normally need InitBWCC here. But our resource includes
    all the bitmaps and dialogs from BWCC, so this assignment gives
    the access needed.
  }
  BWCC := Res;
  { Set up desktop parameters
  }
  VirtualFactor.X := 3;
  VirtualFactor.Y := 3;
  BackBitmap := GetWinDir + 'BLAETTER.BMP';
  IsVirtual := false;
  { Handle the options file
  }
  Opt := New(PDosStream, Init('gvsh.opt', stOpenRead));
  If Opt^.Status = stOK
  then begin
    Opt^.Read(StdGrMode, SizeOf(StdGrMode));
    Opt^.Read(VirtualFactor, SizeOf(VirtualFactor));
    Opt^.Read(IsVirtual, SizeOf(IsVirtual));
    Opt^.Read(BackBitmap, SizeOf(BackBitmap));
    Opt^.Read(TShApp.GetPalette^, Length(CColor) + 1);
  end;
  { start-up Graphics Vision
  }
  inherited Init;
  { In DOS/DPMI mode, EnableCtl3D simply means: Use wf3dFrame for dialogs.
    In Windows mode, additionally the CTL3DV2.DLL is loaded.
    -- Must be called after Init.
  }
  EnableCtl3D;
  { the ImageWindow has been created in InitDesktop, so we can now insert it
  }
  Insert(ImageWindow);
  { change GvTv's palette with entries from our Graphics Vision palette
    (without this, our MessageOutline looks too much like text-mode)
  }
  {$ifndef Windows} UseGvPal; {$endif}
  { let's play with commands
  }
  WindowCmds := WindowCmds + [cmCloseAll];
  DisableCommands(WindowCmds);
  DisableCommands([cmSave, cmSaveAs, cmCut, cmCopy, cmPaste, cmClear,
    cmUndo, cmFind, cmReplace, cmSearchAgain]);
  { now we replace standard dialogs with nice BWCC equivalents
  }
  EditorDialog := MyEditorDialog;
  CreateMessageBox := BorCreateMessageBox;
  { open hidden standard windows
  }
  DeskTop^.GetExtent(R);
  ClipWindow := New(PClipWindow, Init(R, wnJustANumber));
  ClipWindow^.Hide;
  Application^.InsertWindow(ClipWindow);
  {ClipWindow := OpenEditor('', False);
  If ClipWindow <> nil then Begin
    Clipboard := ClipWindow^.Editor;
    Clipboard^.CanUndo := false;
  End;}
  ToolTerm := OpenTerminal(GetStr(sOutput), false, true);
  Desktop^.GetExtent(R);
  R.A.Y := 2 * R.B.Y div 3;
  R.A.X := 0; R.B.X := Size.X;
{$ifndef Windows}
  MsgWindow := New(PMessageWindow, Init(R, GetStr(sMessageTitle)));
  MsgWindow^.Hide;
  Desktop^.Insert(MsgWindow);
{$endif Windows}
  { start-up the command-line generation objects
  }
  BPC.Init;
  GREP.Init;
  TASM.Init;
  If Opt^.Status = stOK
  then begin
    Opt^.Read(BPC, SizeOf(BPC));
    Opt^.Read(GREP, SizeOf(GREP));
    Opt^.Read(TASM, SizeOf(TASM));
    Opt^.Read(Dirs, SizeOf(Dirs));
    Opt^.Read(RunArgs, SizeOf(RunArgs))
  end;
  Dispose(Opt, Done)
End;

destructor TShApp.Done;
Begin
  SaveOpt('gvsh.opt');
  inherited Done;
  {we don't use DoneBWCC since we did't use InitBWCC.}
  DoneClasses;
  Dispose(Res, Done);
End;

procedure TShApp.GetEvent(var Event: TEvent);
{ keep the time when the last user-input event occured
}
begin
  inherited GetEvent(Event);
  If Event.What and (evMouse + evKeyboard) <> 0
  then LastEvent := GetTimerTicks
end;

procedure TShApp.HandleEvent(var Event: TEvent);

	procedure Info;
	Begin
	  MessageBox(GetStr(sCopyright), nil, mfInformation + mfOkButton);
	End;

	procedure NewEditor;
	Begin
	  OpenEditor('', true);
	End;

	procedure Open;
	var
	  Data: PathStr;
	Begin
	  Data := '*.PAS';
	  If ExecuteDialog(New(PFileDialog, Init('*.PAS', GetStr(sOpenTitle),
	    GetStr(sOpenLabel), fdOpenButton + fdHelpButton, 30)), @Data) = cmFileOpen
	  then OpenEditor(Data, true);
	End;

	procedure ChDir;
	Begin
	  ExecuteDialog(New(PChDirDialog, Init(cdHelpButton, 31)), nil);
	  Message(Application, evBroadcast, cmUpdateTitle, nil)
	End;

	procedure SaveAll;

		procedure SaveWindow(P: PEditWindow); {$ifndef FPK}far;{$endif}
		Begin
		  If (TypeOf(P^) = TypeOf(TEditXWindow)) and (P <> ClipWindow)
		  then P^.Editor^.Save;
		End;

	Begin
	  Desktop^.ForEach(@SaveWindow);
	End;

	procedure ShowClip;
	Begin
	  ClipWindow^.Select;
	  ClipWindow^.Show;
	End;

	procedure CloseAll;
	var
	  P, NewP: PGView;
	begin
	  with Desktop^ do
	  begin
	    P := First;
	    while P <> nil do
	    begin
	      NewP := P^.NextView;
	      If P^.GetState(sfVisible) and
		 (Message(P, evBroadcast, 40 {cmHeyYou}, nil) = P) {is-window}
	      then PWindow(P)^.Close;
	      P := NewP
	    end
	  end
	End;

	procedure List;
	Begin
	  ExecuteWindowList(New(PWListDialog, Init(wlHelpButton)));
	End;

	procedure HandleNum;
	var
	  Num: Integer;
	begin
	  Num := GetNumberFromEvent(Event, etAltNumKeys);
	  If Num <> wnNoNumber then
	    Message(@Self, evBroadCast, cmSelectWindowNum, Ptr(0, Num));
	end;

	procedure ShowEyes;
	var
	  R: TRect;
	begin
	  If GetShiftState and (kbLeftShift or kbRightShift) = 0
	  then begin
	    R.Assign(0, 0, 100, 80);
	    R.Move(Random(Desktop^.Size.X - R.B.X),
	      Random(Desktop^.Size.Y - R.B.Y));
	    PGView(Desktop^.InsertBefore(
	      New(PDesktopEyes, Init(R)),
	      Desktop^.Background))^.HelpCtx := hcDesktopEyes;
	  end
	  else begin
	    R.Assign(0, 0, 120, 100);
	    R.Move(Random(Desktop^.Size.X - R.B.X),
	      Random(Desktop^.Size.Y - R.B.Y));
	    InsertWindow(New(PEyeWindow, Init(R)))
	  end
	end;

	procedure ShowClock;
	var
	  R: TRect;
	  Window: PStandardClockWindow;
	  i: Integer;
	begin
	  i := Random(150) + 80;
	  R.Assign(0, 0, i, i);
	  R.Move(Random(Desktop^.Size.X-i), Random(Desktop^.Size.Y-i));
	  Window := New(PStandardClockWindow, Init(R, clmAnalog, nil));
	  Window^.GrowClock;
	  Window^.Options := Window^.Options and not ofHoldFirst;
	  InsertWindow(Window)
	end;

	procedure LoadDesktop;
	var D: PFileDialog;
	Begin
	  D := New(PFileDialog, Init('*.bmp', GetStr(sBitmapTitle),
	    GetStr(sBitmapLabel), fdOpenButton, 0));
	  if ExecuteDialog(D, @BackBitmap) <> cmCancel
	  then PNewDesktop(Desktop)^.NewBitmap(BackBitmap);
	End;

	procedure LoadColors;
	var
	  D: PFileDialog;
	  Path: PathStr;
	  S: PStream;
	Begin
	  Path := '*.pal';
	  D := New(PFileDialog, Init('*.pal', GetStr(sColorsTitle),
	    GetStr(sColorsLabel), fdOpenButton, 0));
	  if ExecuteDialog(D, @Path) <> cmCancel
	  then begin
	    S := New(PDosStream, Init(Path, stOpenRead));
	    S^.Read(GetPalette^[1], Length(CColor));
	    Dispose(S, Done);
	    {$ifndef Windows} UseGvPal; {for GVTV} {$endif Windows}
	    Redraw
	  end
	end;

	procedure StoreColors;
	var
	  D: PFileDialog;
	  Path: PathStr;
	  S: PStream;
	Begin
	  Path := '*.pal';
	  D := New(PFileDialog, Init('*.pal', GetStr(sStoreColorsTitle),
	    GetStr(sStoreColorsLabel), fdOKButton, 0));
	  if ExecuteDialog(D, @Path) <> cmCancel
	  then begin
	    S := New(PDosStream, Init(Path, stCreate));
	    S^.Write(GetPalette^[1], Length(GetPalette^));
	    Dispose(S, Done);
	  end
	end;

	procedure Colors;
	Begin
	  If ExecuteDialog(New(PColorDialog,
	    Init('', LoadMenu(Res^, 'Color', mo_ColorGroups))),
	    Application^.GetPalette) = cmOK
	  then begin
	    {$ifndef Windows} UseGvPal; {for GVTV} {$endif Windows}
	    ReDraw
	  end
	End;

{$ifndef Windows}
	procedure ScreenMode;
	const
	  Modes: array[0..5] of Word =
	    (gr640x480x16, gr720x480x16, gr800x600x16,
	     gr640x480x256, gr800x600x256, gr1024x768x256);
	var
	  Data: record
	    Mode: Word;
	    Stat: Word;
	    Virt: Word;
	    X, Y: LongInt;
	  end;
	  R: TRect;
	  D: PWinDialog;

		procedure Rangify(ID: Integer; Min, Max: LongInt);
		var
		  Val: PValidator;
		begin
		  Val := New(PRangeValidator, Init(Min, Max));
		  Val^.Options := Val^.Options or voTransfer;
		  PInputLine(D^.GetControl(ID))^.SetValidator(Val)
		end;

	begin
	  For Data.Mode := 5 downto 0 do
	    If Modes[Data.Mode] = GrMode then Break;
	  Data.Stat := Byte(StatusLine^.GetState(sfVisible));
	  Data.Virt := Byte(IsVirtual);
	  Data.X := VirtualFactor.X;
	  Data.Y := VirtualFactor.Y;
	  D := LoadWinDialog('screen');
	  Rangify(77, 1, 5);
	  Rangify(78, 1, 5);
	  If ExecuteDialog(D, @Data) <> cmCancel
	  then begin
	    IsVirtual := Data.Virt = 1;
	    VirtualFactor.X := Data.X;
	    VirtualFactor.Y := Data.Y;
	    Lock;
	    If Modes[Data.Mode] <> GrMode
	    then begin
	      PNewDesktop(Desktop)^.NewBitmap('');
	      SetScreenMode(Modes[Data.Mode]);
	      PNewDesktop(Desktop)^.NewBitmap(BackBitmap)
	    end;
	    GetExtent(R);
	    R.A.Y := Menubar^.Origin.Y + Menubar^.Size.Y;
	    If Data.Stat = 0
	    then StatusLine^.Hide
	    else begin
	      R.B.Y := StatusLine^.Origin.Y;
	      StatusLine^.Show
	    end;
	    Desktop^.Locate(R);
	    If IsVirtual
	    then PVirtualDesktop(Desktop)^.SetFactor(VirtualFactor.X, VirtualFactor.Y)
	    else PVirtualDesktop(Desktop)^.SetFactor(1, 1);
	    Unlock;
	    If GrMode <> Modes[Data.Mode]
	    then MessageBox(
	      GetStr(sGraphicsMode),
	      nil, mfError + mfOKButton);
	  end
	end;
{$endif Windows}

	procedure ShellWindow;
	var
	  R: TRect;
	begin
	  Desktop^.GetExtent(R);
	  InsertWindow(New(PShWindow, Init(R, GetStr(sShellTitle), MsgWindow)));
	end;

	function CurrentEditor: PEditXWindow;

		function IsEdit(P: PGView): Boolean; {$ifndef FPK}far;{$endif}
		begin
		  IsEdit :=
		    (TypeOf(P^) = TypeOf(TEditXWindow)) and
		    (PEditXWindow(P)^.Editor^.FileName <> '')
		end;

	begin
	  CurrentEditor := PEditXWindow(Desktop^.FirstThat(@IsEdit))
	end;

	function CurrentFile: string;
	var
	  W: PEditXWindow;
	begin
	  W := CurrentEditor;
	  If W = nil
	  then CurrentFile := ''
	  else CurrentFile := W^.Editor^.FileName
	end;

	procedure GotoLinenum;
	var
	  D: PWinDialog;
	  N: LongInt;
	  O: TOpenFile;
	  Val: PValidator;
	begin
	  D := LoadWinDialog('linenumber');
	  Val := New(PRangeValidator, Init(1, 65535));
	  Val^.Options := Val^.Options or voTransfer;
	  N := 1;
	  with D^ do
	    PInputLine(GetControl(hiLineNum))^.SetValidator(Val);
	  If ExecuteDialog(D, @N) <> cmCancel
	  then begin
	    O.Name := '';
	    O.Row := N;
	    O.Col := 0;
	    Message(Application, evBroadcast, cmOpenFile, @O)
	  end
	end;

	procedure OpenFile;
	var
	  Win: PEditWindow;
	begin
	  with POpenFile(Event.InfoPtr)^ do
	  begin
	    Win := OpenEditor(Name, false);
	    Win^.HandleEvent(Event);
	    Win^.Show
	  end;
	  ClearEvent(Event)
	end;

        function CanPipe(s: string): string;
        begin
          if MsgWindow = nil
          then CanPipe := ''
          else CanPipe := s
        end;

	procedure BPMemory;
	var
	  D: PWinDialog;

		procedure Rangify(ID: Integer; Min, Max: LongInt);
		var
		  Val: PValidator;
		begin
		  Val := New(PRangeValidator, Init(Min, Max));
		  Val^.Options := Val^.Options or voTransfer;
		  PInputLine(D^.GetControl(ID))^.SetValidator(Val)
		end;

	begin
	  D := LoadWinDialog('bpc_memory');
	  Rangify(hiBPCRealStack, 1024, 65520);
	  Rangify(hiBPCRealMinHeap, 0, 655360);
	  Rangify(hiBPCRealMaxHeap, 0, 655360);
	  Rangify(hiBPCProtStack, 1024, 65520);
	  Rangify(hiBPCWinStack, 1024, 65536);
	  Rangify(hiBPCWinHeap, 1024, 65536);
	  ExecuteDialog(D, @BPC.Memory);
	end;

	procedure RunBP(Arg: string);
	var
	  Ed: PEditXWindow;
	  Path: PathStr;
	  Dir: DirStr;
	  Name: NameStr;
	  Ext: ExtStr;
	begin
	  Ed := CurrentEditor;
	  If Ed = nil then Exit;
	  If Ed^.Editor^.Modified
	  then Message(Ed, evCommand, cmSave, nil);
	  Path := Ed^.Editor^.FileName;
	  If ExecPiped('bpcext.exe', BPC.CmdLine(Dirs) + Arg +
	    Path + CanPipe('|bpc2msg'), ToolTerm, MsgWindow, false) = 0
	  then begin
	    FSplit(Path, Dir, Name, Ext);
	    Dir := Dirs.EXEDir;
	    If (Length(Dir) > 0) and (Dir[Length(Dir)] <> '\')
	    then Dir := Dir + '\';
	    ProgPath := Dir + Name + '.EXE';
	  end
	end;

	procedure TASMOptions;
	var
	  D: PWinDialog;

		procedure Rangify(ID: Integer; Min, Max: LongInt);
		var
		  Val: PValidator;
		begin
		  Val := New(PRangeValidator, Init(Min, Max));
		  Val^.Options := Val^.Options or voTransfer;
		  PInputLine(D^.GetControl(ID))^.SetValidator(Val)
		end;

	begin
	  D := LoadWinDialog('tasm_options');
	  Rangify(hiTASMSymbolLength, 12, 99);
	  Rangify(hiTASMSymbolCount, 1024, 32768);
	  Rangify(hiTASMPasses, 1, 9);
	  ExecuteDialog(D, @TASM.Options);
	end;

	procedure Make;
	var
	  MakeTarget: string;
	begin
	  MakeTarget := '';
	  If HistoryInputBox(GetStr(sMakeTitle), GetStr(sMakeLabel),
	    MakeTarget, 255, hiMakeTarget) = cmOK
	  then ExecPiped('make', MakeTarget, ToolTerm, MsgWindow, false);
	end;

Begin
  inherited HandleEvent(Event);
  HandleNum;
  If Event.What = evCommand
  then begin
    case Event.Command of
      cmAbout:
	Info;
      cmNew:
	NewEditor;
      cmOpen:
	Open;
      cmChangeDir:
	ChDir;
      cmSaveAll:
	SaveAll;
      cmShowClipboard:
	ShowClip;
      cmCloseAll:
	CloseAll;
      cmList:
	List;
      cmEyes:
	ShowEyes;
      cmClock:
	ShowClock;
      cmLineNumber:
	GoToLineNum;
      cmShowOutput:
	with ToolTerm^.GOwner^ do
	begin
	  Show;
	  Select
	end;
      cmShowMessages:
        if MsgWindow <> nil then
	with MsgWindow^ do
	begin
	  Show;
	  Select
	end;
      cmDesktopImage:
	with ImageWindow^ do
	begin
	  SetState(sfVisible, not GetState(sfVisible));
	end;
      cmShellWindow:
	ShellWindow;
{$ifndef Windows}
      cmScreenMode:
	ScreenMode;
{$endif !Windows}
      cmBackground:
	LoadDesktop;
      cmColors:
	Colors;
      cmLoadColors:
	LoadColors;
      cmStoreColors:
	StoreColors;
    { Tools
    }
      cmGREP:
	If WinDialog('grep', @GREP) = cmOK
	then ExecPiped('grep', GREP.CmdLine, ToolTerm, MsgWindow, false);
      cmMake:
	Make;
      cmArgs:
	HistoryInputBox(GetStr(sArgsTitle), GetStr(sArgsLabel),
	  RunArgs, 255, hiArgs);
      cmTD:
	ExecFull('td.exe', ProgPath + ' ' + RunArgs);
      cmTDX:
	ExecFull('tdx.exe', ProgPath + ' ' + RunArgs);
      cmTPROF:
	ExecFull('tprof.exe', ProgPath + ' ' + RunArgs);
      cmRun:
	ExecFull(ProgPath, RunArgs);
      cmTVHC:
	ExecPiped('tvhc.exe', CurrentFile, ToolTerm, MsgWindow, true);
      cmDirs:
	WinDialog('dirs', @Dirs);
    { Borland Pascal support
    }
      cmBPOptions:
	WinDialog('bpc_compiler', @BPC.Options[BPC.Target]);
      cmBPLinker:
	WinDialog('bpc_linker', @BPC.Linker);
      cmBPTarget:
	WinDialog('bpc_target', @BPC.Target);
      cmBPMemory:
	BPMemory;
      cmBPCompile:
	RunBP(' /q ');
      cmBPMake:
	RunBP(' /q /m ');
      cmBPBuild:
	RunBP(' /q /b ');
    { TASM support
    }
      cmTASMOptions:
	TASMOptions;
      cmTASMWarnings:
	WinDialog('tasm_warn', @TASM.Warnings);
      cmTASM:
	ExecPiped('tasm', TASM.CmdLine(Dirs) + ' ' + CurrentFile, ToolTerm, MsgWindow, false);
      else Exit;
    end;
    ClearEvent(Event)
  end else
  if (Event.What = evBroadcast) and (Event.Command = cmOpenFile)
  then OpenFile;
end;

procedure TShApp.InitDesktop;
var
  R: TRect;
begin
  Main^.GetExtent(R);
  R.Grow(0, -21);
  If IsVirtual
  then Desktop := New(PVirtualDesktop,
    Init(R, BackBitmap, VirtualFactor.X, VirtualFactor.Y))
  else Desktop := New(PVirtualDesktop,
    Init(R, BackBitmap, 1, 1));
  R.Assign(0, 0, 128, 96);
  R.Move(400, 200);
  ImageWindow := New(PDesktopImageWindow, Init(R, GetStr(sDesktop)));
  with ImageWindow^ do
  begin
    Flags := Flags or wfHideClose;
    Hide
  end
end;

procedure TShApp.InitMenuBar;
var
  R: TRect;
  Menu: PMenu;
  Acc: PAccelerators;
Begin
  { Load the menu structure from the resource
  }
  Menu := LoadMenu(Res^, 'Menu', mo_GraphicsVision);
  { Load the accelerator table from the resource
  }
  Acc := LoadAccelerators(Res^, 'GV' {nil will not work in Windows});
  { Add accelerator keys to the menu structure
  }
  AddAccelerators(Menu, Acc);
  { Get rid of the table
  }
  FreeAccelerators(Acc);
  { Create the menubar
  }
  Main^.GetExtent(R);
  R.B.Y := 21;
  MenuBar := New(PMenuBar, Init(R, Menu));
End;

procedure TShApp.InitStatusLine;
var
  R: TRect;
Begin
  Main^.GetExtent(R);
  R.A.Y := R.B.Y - 21;
  { We install a special StatusLine, which gets its hints from the
    language resource. We only define standard status keys here.
  }
  StatusLine := New(PHintStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKeyKN('Exit', kbAltX, cmQuit,
      StdStatusKeys(
      nil)),
    nil)))
End;

procedure TShApp.InitTexts;
{ Our application is a very Windows-bound one, so
  we choose to get the language-specific texts
  from the program resource.
}
begin
  SetTextResource(Res)
end;

function TShApp.OpenEditor(FileName: FNameStr; Visible: Boolean): PEditWindow;
var
  P: PEditWindow;
  R: TRect;
Begin
  DeskTop^.GetExtent(R);
  P := New(PEditXWindow, Init(R, FileName, wnJustANumber));
  If not Visible then P^.Hide;
  OpenEditor := PEditWindow(Application^.InsertWindow(P));
End;

function TShApp.OpenTerminal(Title: string; Visible: Boolean;
  HideOnClose: Boolean): PTextDevice;
var
  W: PTermWindow;
  R: TRect;
Begin
  DeskTop^.GetExtent(R);
  W := New(PTermWindow, Init(R, Title, HideOnClose));
  If not Visible then W^.Hide;
  OpenTerminal := W^.Term;
  Desktop^.Insert(W);
end;

procedure TShApp.OutOfMemory;
Begin
  MessageBox(GetStr(sOutOfMemory), nil,
    mfError + mfOkButton);
End;

procedure TShApp.SaveOpt(Path: string);
var
  Opt: PStream;
begin
  Opt := New(PDosStream, Init(Path, stCreate));
  Opt^.Write(StdGrMode, SizeOf(StdGrMode));
  Opt^.Write(VirtualFactor, SizeOf(VirtualFactor));
  Opt^.Write(IsVirtual, SizeOf(IsVirtual));
  Opt^.Write(BackBitmap, SizeOf(BackBitmap));
  Opt^.Write(TShApp.GetPalette^, Length(CColor) + 1);
  Opt^.Write(BPC, SizeOf(BPC));
  Opt^.Write(GREP, SizeOf(GREP));
  Opt^.Write(TASM, SizeOf(TASM));
  Opt^.Write(Dirs, SizeOf(Dirs));
  Opt^.Write(RunArgs, SizeOf(RunArgs));
  Dispose(Opt, Done)
end;

procedure TShApp.Timer(var Event: TEvent);
const
  HintActive: Boolean = false;
var
  P: PString;
  s: string;
  Wh: TPoint;
  Hint: PGView;
  R: TRect;
begin
  inherited Timer(Event);
  If (Event.InfoWord > LastEvent + HintDelay) and not HintActive
  then begin
    Wh := MouseWhere;
    P := Message(Application, evPositionalCtx, 0, pointer(Wh));
    If P <> nil
    then begin
      If Seg(P^) = 0
      then begin
	If Ofs(P^) < HelpCtxMinimum then Exit;
	s := GetStr(Ofs(P^));
	If s = '' then Exit;
      end
      else s := P^;
      GetExtent(R);
      R.A.X := Wh.x + 15;
      R.A.Y := Wh.y;
      Hint := New(PFlyingHint, Init(R, s));
      HintActive := true;
      ExecView(Hint);
      HintActive := false;
      Dispose(Hint, Done)
    end;
  end;
end;

procedure TShApp.WriteShellMsg;
Begin
  PrintStr(GetStr(sShellMsg));
End;

var
  ShApp: TShApp;

Begin
  ShApp.Init;
  ShApp.Run;
  ShApp.Done
End.

